Src/params.c

   1 /*
   2  * params.c - parameters
   3  *
   4  * This file is part of zsh, the Z shell.
   5  *
   6  * Copyright (c) 1992-1997 Paul Falstad
   7  * All rights reserved.
   8  *
   9  * Permission is hereby granted, without written agreement and without
  10  * license or royalty fees, to use, copy, modify, and distribute this
  11  * software and to distribute modified versions of this software for any
  12  * purpose, provided that the above copyright notice and the following
  13  * two paragraphs appear in all copies of this software.
  14  *
  15  * In no event shall Paul Falstad or the Zsh Development Group be liable
  16  * to any party for direct, indirect, special, incidental, or consequential
  17  * damages arising out of the use of this software and its documentation,
  18  * even if Paul Falstad and the Zsh Development Group have been advised of
  19  * the possibility of such damage.
  20  *
  21  * Paul Falstad and the Zsh Development Group specifically disclaim any
  22  * warranties, including, but not limited to, the implied warranties of
  23  * merchantability and fitness for a particular purpose.  The software
  24  * provided hereunder is on an "as is" basis, and Paul Falstad and the
  25  * Zsh Development Group have no obligation to provide maintenance,
  26  * support, updates, enhancements, or modifications.
  27  *
  28  */
  29
  30 #include "zsh.mdh"
  31 #include "params.pro"
  32
  33 #include "version.h"
  34 #ifdef CUSTOM_PATCHLEVEL
  35 #define ZSH_PATCHLEVEL  CUSTOM_PATCHLEVEL
  36 #else
  37 #include "patchlevel.h"
  38
  39 /* If removed from the ChangeLog for some reason */
  40 #ifndef ZSH_PATCHLEVEL
  41 #define ZSH_PATCHLEVEL "unknown"
  42 #endif
  43 #endif
  44
  45 /* what level of localness we are at */
  46
  47 /**/
  48 mod_export int locallevel;
  49
  50 /* Variables holding values of special parameters */
  51
  52 /**/
  53 mod_export
  54 char **pparams,         /* $argv        */
  55      **cdpath,          /* $cdpath      */
  56      **fpath,           /* $fpath       */
  57      **mailpath,        /* $mailpath    */
  58      **manpath,         /* $manpath     */
  59      **psvar,           /* $psvar       */
  60      **watch,           /* $watch       */
  61      **zsh_eval_context; /* $zsh_eval_context */
  62 /**/
  63 mod_export
  64 char **path,            /* $path        */
  65      **fignore;         /* $fignore     */
  66
  67 /**/
  68 mod_export
  69 char *argzero,          /* $0           */
  70      *posixzero,        /* $0           */
  71      *home,             /* $HOME        */
  72      *nullcmd,          /* $NULLCMD     */
  73      *oldpwd,           /* $OLDPWD      */
  74      *zoptarg,          /* $OPTARG      */
  75      *prompt,           /* $PROMPT      */
  76      *prompt2,          /* $PROMPT2     */
  77      *prompt3,          /* $PROMPT3     */
  78      *prompt4,          /* $PROMPT4     */
  79      *readnullcmd,      /* $READNULLCMD */
  80      *rprompt,          /* $RPROMPT     */
  81      *rprompt2,         /* $RPROMPT2    */
  82      *sprompt,          /* $SPROMPT     */
  83      *wordchars,        /* $WORDCHARS   */
  84      *zsh_name;         /* $ZSH_NAME    */
  85 /**/
  86 mod_export
  87 char *ifs,              /* $IFS         */
  88      *postedit,         /* $POSTEDIT    */
  89      *term,             /* $TERM        */
  90      *zsh_terminfo,     /* $TERMINFO    */
  91      *ttystrname,       /* $TTY         */
  92      *pwd;              /* $PWD         */
  93
  94 /**/
  95 mod_export
  96 zlong lastval,          /* $?           */
  97      mypid,             /* $$           */
  98      lastpid,           /* $!           */
  99      zterm_columns,     /* $COLUMNS     */
 100      zterm_lines,       /* $LINES       */
 101      rprompt_indent,    /* $ZLE_RPROMPT_INDENT */
 102      ppid,              /* $PPID        */
 103      zsh_subshell;      /* $ZSH_SUBSHELL */
 104 /**/
 105 zlong lineno,           /* $LINENO      */
 106      zoptind,           /* $OPTIND      */
 107      shlvl;             /* $SHLVL       */
 108
 109 /* $histchars */
 110
 111 /**/
 112 mod_export unsigned char bangchar;
 113 /**/
 114 unsigned char hatchar, hashchar;
 115
 116 /**/
 117 unsigned char keyboardhackchar = '\0';
 118
 119 /* $SECONDS = now.tv_sec - shtimer.tv_sec
 120  *          + (now.tv_usec - shtimer.tv_usec) / 1000000.0
 121  * (rounded to an integer if the parameter is not set to float) */
 122
 123 /**/
 124 struct timeval shtimer;
 125
 126 /* 0 if this $TERM setup is usable, otherwise it contains TERM_* flags */
 127
 128 /**/
 129 mod_export int termflags;
 130
 131 /* Standard methods for get/set/unset pointers in parameters */
 132
 133 /**/
 134 mod_export const struct gsu_scalar stdscalar_gsu =
 135 { strgetfn, strsetfn, stdunsetfn };
 136 /**/
 137 mod_export const struct gsu_scalar varscalar_gsu =
 138 { strvargetfn, strvarsetfn, stdunsetfn };
 139 /**/
 140 mod_export const struct gsu_scalar nullsetscalar_gsu =
 141 { strgetfn, nullstrsetfn, NULL };
 142
 143 /**/
 144 mod_export const struct gsu_integer stdinteger_gsu =
 145 { intgetfn, intsetfn, stdunsetfn };
 146 /**/
 147 mod_export const struct gsu_integer varinteger_gsu =
 148 { intvargetfn, intvarsetfn, stdunsetfn };
 149 /**/
 150 mod_export const struct gsu_integer nullsetinteger_gsu =
 151 { intgetfn, NULL, NULL };
 152
 153 /**/
 154 mod_export const struct gsu_float stdfloat_gsu =
 155 { floatgetfn, floatsetfn, stdunsetfn };
 156
 157 /**/
 158 mod_export const struct gsu_array stdarray_gsu =
 159 { arrgetfn, arrsetfn, stdunsetfn };
 160 /**/
 161 mod_export const struct gsu_array vararray_gsu =
 162 { arrvargetfn, arrvarsetfn, stdunsetfn };
 163
 164 /**/
 165 mod_export const struct gsu_hash stdhash_gsu =
 166 { hashgetfn, hashsetfn, stdunsetfn };
 167 /**/
 168 mod_export const struct gsu_hash nullsethash_gsu =
 169 { hashgetfn, nullsethashfn, nullunsetfn };
 170
 171
 172 /* Non standard methods (not exported) */
 173 static const struct gsu_integer pound_gsu =
 174 { poundgetfn, nullintsetfn, stdunsetfn };
 175 static const struct gsu_integer errno_gsu =
 176 { errnogetfn, errnosetfn, stdunsetfn };
 177 static const struct gsu_integer gid_gsu =
 178 { gidgetfn, gidsetfn, stdunsetfn };
 179 static const struct gsu_integer egid_gsu =
 180 { egidgetfn, egidsetfn, stdunsetfn };
 181 static const struct gsu_integer histsize_gsu =
 182 { histsizegetfn, histsizesetfn, stdunsetfn };
 183 static const struct gsu_integer random_gsu =
 184 { randomgetfn, randomsetfn, stdunsetfn };
 185 static const struct gsu_integer savehist_gsu =
 186 { savehistsizegetfn, savehistsizesetfn, stdunsetfn };
 187 static const struct gsu_integer intseconds_gsu =
 188 { intsecondsgetfn, intsecondssetfn, stdunsetfn };
 189 static const struct gsu_float floatseconds_gsu =
 190 { floatsecondsgetfn, floatsecondssetfn, stdunsetfn };
 191 static const struct gsu_integer uid_gsu =
 192 { uidgetfn, uidsetfn, stdunsetfn };
 193 static const struct gsu_integer euid_gsu =
 194 { euidgetfn, euidsetfn, stdunsetfn };
 195 static const struct gsu_integer ttyidle_gsu =
 196 { ttyidlegetfn, nullintsetfn, stdunsetfn };
 197
 198 static const struct gsu_scalar argzero_gsu =
 199 { argzerogetfn, argzerosetfn, nullunsetfn };
 200 static const struct gsu_scalar username_gsu =
 201 { usernamegetfn, usernamesetfn, stdunsetfn };
 202 static const struct gsu_scalar dash_gsu =
 203 { dashgetfn, nullstrsetfn, stdunsetfn };
 204 static const struct gsu_scalar histchars_gsu =
 205 { histcharsgetfn, histcharssetfn, stdunsetfn };
 206 static const struct gsu_scalar home_gsu =
 207 { homegetfn, homesetfn, stdunsetfn };
 208 static const struct gsu_scalar term_gsu =
 209 { termgetfn, termsetfn, stdunsetfn };
 210 static const struct gsu_scalar terminfo_gsu =
 211 { terminfogetfn, terminfosetfn, stdunsetfn };
 212 static const struct gsu_scalar wordchars_gsu =
 213 { wordcharsgetfn, wordcharssetfn, stdunsetfn };
 214 static const struct gsu_scalar ifs_gsu =
 215 { ifsgetfn, ifssetfn, stdunsetfn };
 216 static const struct gsu_scalar underscore_gsu =
 217 { underscoregetfn, nullstrsetfn, stdunsetfn };
 218 static const struct gsu_scalar keyboard_hack_gsu =
 219 { keyboardhackgetfn, keyboardhacksetfn, stdunsetfn };
 220 #ifdef USE_LOCALE
 221 static const struct gsu_scalar lc_blah_gsu =
 222 { strgetfn, lcsetfn, stdunsetfn };
 223 static const struct gsu_scalar lang_gsu =
 224 { strgetfn, langsetfn, stdunsetfn };
 225 static const struct gsu_scalar lc_all_gsu =
 226 { strgetfn, lc_allsetfn, stdunsetfn };
 227 #endif
 228
 229 static const struct gsu_integer varint_readonly_gsu =
 230 { intvargetfn, nullintsetfn, stdunsetfn };
 231 static const struct gsu_integer zlevar_gsu =
 232 { intvargetfn, zlevarsetfn, stdunsetfn };
 233
 234 static const struct gsu_scalar colonarr_gsu =
 235 { colonarrgetfn, colonarrsetfn, stdunsetfn };
 236
 237 static const struct gsu_integer argc_gsu =
 238 { poundgetfn, nullintsetfn, stdunsetfn };
 239 static const struct gsu_array pipestatus_gsu =
 240 { pipestatgetfn, pipestatsetfn, stdunsetfn };
 241
 242 /* Nodes for special parameters for parameter hash table */
 243
 244 #ifdef HAVE_UNION_INIT
 245 # define BR(X) {X}
 246 typedef struct param initparam;
 247 #else
 248 # define BR(X) X
 249 typedef struct iparam {
 250     struct hashnode *next;
 251     char *nam;                  /* hash data                             */
 252     int flags;                  /* PM_* flags (defined in zsh.h)         */
 253     void *value;
 254     void *gsu;                  /* get/set/unset methods */
 255     int base;                   /* output base                           */
 256     int width;                  /* output field width                    */
 257     char *env;                  /* location in environment, if exported  */
 258     char *ename;                /* name of corresponding environment var */
 259     Param old;                  /* old struct for use with local         */
 260     int level;                  /* if (old != NULL), level of localness  */
 261 } initparam;
 262 #endif
 263
 264 static initparam special_params[] ={
 265 #define GSU(X) BR((GsuScalar)(void *)(&(X)))
 266 #define NULL_GSU BR((GsuScalar)(void *)NULL)
 267 #define IPDEF1(A,B,C) {{NULL,A,PM_INTEGER|PM_SPECIAL|C},BR(NULL),GSU(B),10,0,NULL,NULL,NULL,0}
 268 IPDEF1("#", pound_gsu, PM_READONLY),
 269 IPDEF1("ERRNO", errno_gsu, PM_UNSET),
 270 IPDEF1("GID", gid_gsu, PM_DONTIMPORT | PM_RESTRICTED),
 271 IPDEF1("EGID", egid_gsu, PM_DONTIMPORT | PM_RESTRICTED),
 272 IPDEF1("HISTSIZE", histsize_gsu, PM_RESTRICTED),
 273 IPDEF1("RANDOM", random_gsu, 0),
 274 IPDEF1("SAVEHIST", savehist_gsu, PM_RESTRICTED),
 275 IPDEF1("SECONDS", intseconds_gsu, 0),
 276 IPDEF1("UID", uid_gsu, PM_DONTIMPORT | PM_RESTRICTED),
 277 IPDEF1("EUID", euid_gsu, PM_DONTIMPORT | PM_RESTRICTED),
 278 IPDEF1("TTYIDLE", ttyidle_gsu, PM_READONLY),
 279
 280 #define IPDEF2(A,B,C) {{NULL,A,PM_SCALAR|PM_SPECIAL|C},BR(NULL),GSU(B),0,0,NULL,NULL,NULL,0}
 281 IPDEF2("USERNAME", username_gsu, PM_DONTIMPORT|PM_RESTRICTED),
 282 IPDEF2("-", dash_gsu, PM_READONLY),
 283 IPDEF2("histchars", histchars_gsu, PM_DONTIMPORT),
 284 IPDEF2("HOME", home_gsu, PM_UNSET),
 285 IPDEF2("TERM", term_gsu, PM_UNSET),
 286 IPDEF2("TERMINFO", terminfo_gsu, PM_UNSET),
 287 IPDEF2("WORDCHARS", wordchars_gsu, 0),
 288 IPDEF2("IFS", ifs_gsu, PM_DONTIMPORT),
 289 IPDEF2("_", underscore_gsu, PM_DONTIMPORT),
 290 IPDEF2("KEYBOARD_HACK", keyboard_hack_gsu, PM_DONTIMPORT),
 291 IPDEF2("0", argzero_gsu, 0),
 292
 293 #ifdef USE_LOCALE
 294 # define LCIPDEF(name) IPDEF2(name, lc_blah_gsu, PM_UNSET)
 295 IPDEF2("LANG", lang_gsu, PM_UNSET),
 296 IPDEF2("LC_ALL", lc_all_gsu, PM_UNSET),
 297 # ifdef LC_COLLATE
 298 LCIPDEF("LC_COLLATE"),
 299 # endif
 300 # ifdef LC_CTYPE
 301 LCIPDEF("LC_CTYPE"),
 302 # endif
 303 # ifdef LC_MESSAGES
 304 LCIPDEF("LC_MESSAGES"),
 305 # endif
 306 # ifdef LC_NUMERIC
 307 LCIPDEF("LC_NUMERIC"),
 308 # endif
 309 # ifdef LC_TIME
 310 LCIPDEF("LC_TIME"),
 311 # endif
 312 #endif /* USE_LOCALE */
 313
 314 #define IPDEF4(A,B) {{NULL,A,PM_INTEGER|PM_READONLY|PM_SPECIAL},BR((void *)B),GSU(varint_readonly_gsu),10,0,NULL,NULL,NULL,0}
 315 IPDEF4("!", &lastpid),
 316 IPDEF4("$", &mypid),
 317 IPDEF4("?", &lastval),
 318 IPDEF4("HISTCMD", &curhist),
 319 IPDEF4("LINENO", &lineno),
 320 IPDEF4("PPID", &ppid),
 321 IPDEF4("ZSH_SUBSHELL", &zsh_subshell),
 322
 323 #define IPDEF5(A,B,F) {{NULL,A,PM_INTEGER|PM_SPECIAL},BR((void *)B),GSU(F),10,0,NULL,NULL,NULL,0}
 324 #define IPDEF5U(A,B,F) {{NULL,A,PM_INTEGER|PM_SPECIAL|PM_UNSET},BR((void *)B),GSU(F),10,0,NULL,NULL,NULL,0}
 325 IPDEF5("COLUMNS", &zterm_columns, zlevar_gsu),
 326 IPDEF5("LINES", &zterm_lines, zlevar_gsu),
 327 IPDEF5U("ZLE_RPROMPT_INDENT", &rprompt_indent, zlevar_gsu),
 328 IPDEF5("SHLVL", &shlvl, varinteger_gsu),
 329
 330 /* Don't import internal integer status variables. */
 331 #define IPDEF6(A,B,F) {{NULL,A,PM_INTEGER|PM_SPECIAL|PM_DONTIMPORT},BR((void *)B),GSU(F),10,0,NULL,NULL,NULL,0}
 332 IPDEF6("OPTIND", &zoptind, varinteger_gsu),
 333 IPDEF6("TRY_BLOCK_ERROR", &try_errflag, varinteger_gsu),
 334 IPDEF6("TRY_BLOCK_INTERRUPT", &try_interrupt, varinteger_gsu),
 335
 336 #define IPDEF7(A,B) {{NULL,A,PM_SCALAR|PM_SPECIAL},BR((void *)B),GSU(varscalar_gsu),0,0,NULL,NULL,NULL,0}
 337 #define IPDEF7U(A,B) {{NULL,A,PM_SCALAR|PM_SPECIAL|PM_UNSET},BR((void *)B),GSU(varscalar_gsu),0,0,NULL,NULL,NULL,0}
 338 IPDEF7("OPTARG", &zoptarg),
 339 IPDEF7("NULLCMD", &nullcmd),
 340 IPDEF7U("POSTEDIT", &postedit),
 341 IPDEF7("READNULLCMD", &readnullcmd),
 342 IPDEF7("PS1", &prompt),
 343 IPDEF7U("RPS1", &rprompt),
 344 IPDEF7U("RPROMPT", &rprompt),
 345 IPDEF7("PS2", &prompt2),
 346 IPDEF7U("RPS2", &rprompt2),
 347 IPDEF7U("RPROMPT2", &rprompt2),
 348 IPDEF7("PS3", &prompt3),
 349 IPDEF7("PS4", &prompt4),
 350 IPDEF7("SPROMPT", &sprompt),
 351
 352 #define IPDEF8(A,B,C,D) {{NULL,A,D|PM_SCALAR|PM_SPECIAL},BR((void *)B),GSU(colonarr_gsu),0,0,NULL,C,NULL,0}
 353 IPDEF8("CDPATH", &cdpath, "cdpath", 0),
 354 IPDEF8("FIGNORE", &fignore, "fignore", 0),
 355 IPDEF8("FPATH", &fpath, "fpath", 0),
 356 IPDEF8("MAILPATH", &mailpath, "mailpath", 0),
 357 IPDEF8("WATCH", &watch, "watch", 0),
 358 IPDEF8("PATH", &path, "path", PM_RESTRICTED),
 359 IPDEF8("PSVAR", &psvar, "psvar", 0),
 360 IPDEF8("ZSH_EVAL_CONTEXT", &zsh_eval_context, "zsh_eval_context", PM_READONLY),
 361
 362 /* MODULE_PATH is not imported for security reasons */
 363 IPDEF8("MODULE_PATH", &module_path, "module_path", PM_DONTIMPORT|PM_RESTRICTED),
 364
 365 #define IPDEF9F(A,B,C,D) {{NULL,A,D|PM_ARRAY|PM_SPECIAL|PM_DONTIMPORT},BR((void *)B),GSU(vararray_gsu),0,0,NULL,C,NULL,0}
 366 #define IPDEF9(A,B,C) IPDEF9F(A,B,C,0)
 367 IPDEF9F("*", &pparams, NULL, PM_ARRAY|PM_SPECIAL|PM_DONTIMPORT|PM_READONLY),
 368 IPDEF9F("@", &pparams, NULL, PM_ARRAY|PM_SPECIAL|PM_DONTIMPORT|PM_READONLY),
 369
 370 /*
 371  * This empty row indicates the end of parameters available in
 372  * all emulations.
 373  */
 374 {{NULL,NULL,0},BR(NULL),NULL_GSU,0,0,NULL,NULL,NULL,0},
 375
 376 #define IPDEF10(A,B) {{NULL,A,PM_ARRAY|PM_SPECIAL},BR(NULL),GSU(B),10,0,NULL,NULL,NULL,0}
 377
 378 /*
 379  * The following parameters are not available in sh/ksh compatibility *
 380  * mode.
 381  */
 382
 383 /* All of these have sh compatible equivalents.                */
 384 IPDEF1("ARGC", argc_gsu, PM_READONLY),
 385 IPDEF2("HISTCHARS", histchars_gsu, PM_DONTIMPORT),
 386 IPDEF4("status", &lastval),
 387 IPDEF7("prompt", &prompt),
 388 IPDEF7("PROMPT", &prompt),
 389 IPDEF7("PROMPT2", &prompt2),
 390 IPDEF7("PROMPT3", &prompt3),
 391 IPDEF7("PROMPT4", &prompt4),
 392 IPDEF8("MANPATH", &manpath, "manpath", 0),
 393 IPDEF9("argv", &pparams, NULL),
 394 IPDEF9("fignore", &fignore, "FIGNORE"),
 395 IPDEF9("cdpath", &cdpath, "CDPATH"),
 396 IPDEF9("fpath", &fpath, "FPATH"),
 397 IPDEF9("mailpath", &mailpath, "MAILPATH"),
 398 IPDEF9("manpath", &manpath, "MANPATH"),
 399 IPDEF9("psvar", &psvar, "PSVAR"),
 400 IPDEF9("watch", &watch, "WATCH"),
 401
 402 IPDEF9F("zsh_eval_context", &zsh_eval_context, "ZSH_EVAL_CONTEXT", PM_READONLY),
 403
 404 IPDEF9F("module_path", &module_path, "MODULE_PATH", PM_RESTRICTED),
 405 IPDEF9F("path", &path, "PATH", PM_RESTRICTED),
 406
 407 /* These are known to zsh alone. */
 408
 409 IPDEF10("pipestatus", pipestatus_gsu),
 410
 411 {{NULL,NULL,0},BR(NULL),NULL_GSU,0,0,NULL,NULL,NULL,0},
 412 };
 413
 414 /*
 415  * Special way of referring to the positional parameters.  Unlike $*
 416  * and $@, this is not readonly.  This parameter is not directly
 417  * visible in user space.
 418  */
 419 initparam argvparam_pm = IPDEF9F("", &pparams, NULL, \
 420                                  PM_ARRAY|PM_SPECIAL|PM_DONTIMPORT);
 421
 422 #undef BR
 423
 424 #define IS_UNSET_VALUE(V) \
 425         ((V) && (!(V)->pm || ((V)->pm->node.flags & PM_UNSET) || \
 426                  !(V)->pm->node.nam || !*(V)->pm->node.nam))
 427
 428 static Param argvparam;
 429
 430 /* hash table containing the parameters */
 431
 432 /**/
 433 mod_export HashTable paramtab, realparamtab;
 434
 435 /**/
 436 mod_export HashTable
 437 newparamtable(int size, char const *name)
 438 {
 439     HashTable ht;
 440     if (!size)
 441         size = 17;
 442     ht = newhashtable(size, name, NULL);
 443
 444     ht->hash        = hasher;
 445     ht->emptytable  = emptyhashtable;
 446     ht->filltable   = NULL;
 447     ht->cmpnodes    = strcmp;
 448     ht->addnode     = addhashnode;
 449     ht->getnode     = getparamnode;
 450     ht->getnode2    = getparamnode;
 451     ht->removenode  = removehashnode;
 452     ht->disablenode = NULL;
 453     ht->enablenode  = NULL;
 454     ht->freenode    = freeparamnode;
 455     ht->printnode   = printparamnode;
 456
 457     return ht;
 458 }
 459
 460 /**/
 461 static HashNode
 462 getparamnode(HashTable ht, const char *nam)
 463 {
 464     HashNode hn = gethashnode2(ht, nam);
 465     Param pm = (Param) hn;
 466
 467     if (pm && pm->u.str && (pm->node.flags & PM_AUTOLOAD)) {
 468         char *mn = dupstring(pm->u.str);
 469
 470         (void)ensurefeature(mn, "p:", (pm->node.flags & PM_AUTOALL) ? NULL :
 471                             nam);
 472         hn = gethashnode2(ht, nam);
 473         if (!hn) {
 474             /*
 475              * This used to be a warning, but surely if we allow
 476              * stuff to go ahead with the autoload stub with
 477              * no error status we're in for all sorts of mayhem?
 478              */
 479             zerr("autoloading module %s failed to define parameter: %s", mn,
 480                  nam);
 481         }
 482     }
 483     return hn;
 484 }
 485
 486 /* Copy a parameter hash table */
 487
 488 static HashTable outtable;
 489
 490 /**/
 491 static void
 492 scancopyparams(HashNode hn, UNUSED(int flags))
 493 {
 494     /* Going into a real parameter, so always use permanent storage */
 495     Param pm = (Param)hn;
 496     Param tpm = (Param) zshcalloc(sizeof *tpm);
 497     tpm->node.nam = ztrdup(pm->node.nam);
 498     copyparam(tpm, pm, 0);
 499     addhashnode(outtable, tpm->node.nam, tpm);
 500 }
 501
 502 /**/
 503 HashTable
 504 copyparamtable(HashTable ht, char *name)
 505 {
 506     HashTable nht = newparamtable(ht->hsize, name);
 507     outtable = nht;
 508     scanhashtable(ht, 0, 0, 0, scancopyparams, 0);
 509     outtable = NULL;
 510     return nht;
 511 }
 512
 513 /* Flag to freeparamnode to unset the struct */
 514
 515 static int delunset;
 516
 517 /* Function to delete a parameter table. */
 518
 519 /**/
 520 mod_export void
 521 deleteparamtable(HashTable t)
 522 {
 523     /* The parameters in the hash table need to be unset *
 524      * before being deleted.                             */
 525     int odelunset = delunset;
 526     delunset = 1;
 527     deletehashtable(t);
 528     delunset = odelunset;
 529 }
 530
 531 static unsigned numparamvals;
 532
 533 /**/
 534 mod_export void
 535 scancountparams(UNUSED(HashNode hn), int flags)
 536 {
 537     ++numparamvals;
 538     if ((flags & SCANPM_WANTKEYS) && (flags & SCANPM_WANTVALS))
 539         ++numparamvals;
 540 }
 541
 542 static Patprog scanprog;
 543 static char *scanstr;
 544 static char **paramvals;
 545 static Param foundparam;
 546
 547 /**/
 548 static void
 549 scanparamvals(HashNode hn, int flags)
 550 {
 551     struct value v;
 552     Patprog prog;
 553
 554     if (numparamvals && !(flags & SCANPM_MATCHMANY) &&
 555         (flags & (SCANPM_MATCHVAL|SCANPM_MATCHKEY|SCANPM_KEYMATCH)))
 556         return;
 557     v.pm = (Param)hn;
 558     if ((flags & SCANPM_KEYMATCH)) {
 559         char *tmp = dupstring(v.pm->node.nam);
 560
 561         tokenize(tmp);
 562         remnulargs(tmp);
 563
 564         if (!(prog = patcompile(tmp, 0, NULL)) || !pattry(prog, scanstr))
 565             return;
 566     } else if ((flags & SCANPM_MATCHKEY) && !pattry(scanprog, v.pm->node.nam)) {
 567         return;
 568     }
 569     foundparam = v.pm;
 570     if (flags & SCANPM_WANTKEYS) {
 571         paramvals[numparamvals++] = v.pm->node.nam;
 572         if (!(flags & (SCANPM_WANTVALS|SCANPM_MATCHVAL)))
 573             return;
 574     }
 575     v.isarr = (PM_TYPE(v.pm->node.flags) & (PM_ARRAY|PM_HASHED));
 576     v.flags = 0;
 577     v.start = 0;
 578     v.end = -1;
 579     paramvals[numparamvals] = getstrvalue(&v);
 580     if (flags & SCANPM_MATCHVAL) {
 581         if (pattry(scanprog, paramvals[numparamvals])) {
 582             numparamvals += ((flags & SCANPM_WANTVALS) ? 1 :
 583                              !(flags & SCANPM_WANTKEYS));
 584         } else if (flags & SCANPM_WANTKEYS)
 585             --numparamvals;     /* Value didn't match, discard key */
 586     } else
 587         ++numparamvals;
 588     foundparam = NULL;
 589 }
 590
 591 /**/
 592 char **
 593 paramvalarr(HashTable ht, int flags)
 594 {
 595     DPUTS((flags & (SCANPM_MATCHKEY|SCANPM_MATCHVAL)) && !scanprog,
 596           "BUG: scanning hash without scanprog set");
 597     numparamvals = 0;
 598     if (ht)
 599         scanhashtable(ht, 0, 0, PM_UNSET, scancountparams, flags);
 600     paramvals = (char **) zhalloc((numparamvals + 1) * sizeof(char *));
 601     if (ht) {
 602         numparamvals = 0;
 603         scanhashtable(ht, 0, 0, PM_UNSET, scanparamvals, flags);
 604     }
 605     paramvals[numparamvals] = 0;
 606     return paramvals;
 607 }
 608
 609 /* Return the full array (no indexing) referred to by a Value. *
 610  * The array value is cached for the lifetime of the Value.    */
 611
 612 /**/
 613 static char **
 614 getvaluearr(Value v)
 615 {
 616     if (v->arr)
 617         return v->arr;
 618     else if (PM_TYPE(v->pm->node.flags) == PM_ARRAY)
 619         return v->arr = v->pm->gsu.a->getfn(v->pm);
 620     else if (PM_TYPE(v->pm->node.flags) == PM_HASHED) {
 621         v->arr = paramvalarr(v->pm->gsu.h->getfn(v->pm), v->isarr);
 622         /* Can't take numeric slices of associative arrays */
 623         v->start = 0;
 624         v->end = numparamvals + 1;
 625         return v->arr;
 626     } else
 627         return NULL;
 628 }
 629
 630 /*
 631  * Split environment string into (name, value) pair.
 632  * this is used to avoid in-place editing of environment table
 633  * that results in core dump on some systems
 634  */
 635
 636 static int
 637 split_env_string(char *env, char **name, char **value)
 638 {
 639     char *str, *tenv;
 640
 641     if (!env || !name || !value)
 642         return 0;
 643
 644     tenv = strcpy(zhalloc(strlen(env) + 1), env);
 645     for (str = tenv; *str && *str != '='; str++) {
 646         if (STOUC(*str) >= 128) {
 647             /*
 648              * We'll ignore environment variables with names not
 649              * from the portable character set since we don't
 650              * know of a good reason to accept them.
 651              */
 652             return 0;
 653         }
 654     }
 655     if (str != tenv && *str == '=') {
 656         *str = '\0';
 657         *name = tenv;
 658         *value = str + 1;
 659         return 1;
 660     } else
 661         return 0;
 662 }
 663
 664 /* Set up parameter hash table.  This will add predefined  *
 665  * parameter entries as well as setting up parameter table *
 666  * entries for environment variables we inherit.           */
 667
 668 /**/
 669 void
 670 createparamtable(void)
 671 {
 672     Param ip, pm;
 673 #if !defined(HAVE_PUTENV) && !defined(USE_SET_UNSET_ENV)
 674     char **new_environ;
 675     int  envsize;
 676 #endif
 677 #ifndef USE_SET_UNSET_ENV
 678     char **envp;
 679 #endif
 680     char **envp2, **sigptr, **t;
 681     char buf[50], *str, *iname, *ivalue, *hostnam;
 682     int  oae = opts[ALLEXPORT];
 683 #ifdef HAVE_UNAME
 684     struct utsname unamebuf;
 685     char *machinebuf;
 686 #endif
 687
 688     paramtab = realparamtab = newparamtable(151, "paramtab");
 689
 690     /* Add the special parameters to the hash table */
 691     for (ip = special_params; ip->node.nam; ip++)
 692         paramtab->addnode(paramtab, ztrdup(ip->node.nam), ip);
 693     if (!EMULATION(EMULATE_SH|EMULATE_KSH))
 694         while ((++ip)->node.nam)
 695             paramtab->addnode(paramtab, ztrdup(ip->node.nam), ip);
 696
 697     argvparam = (Param) &argvparam_pm;
 698
 699     noerrs = 2;
 700
 701     /* Add the standard non-special parameters which have to    *
 702      * be initialized before we copy the environment variables. *
 703      * We don't want to override whatever values the user has   *
 704      * given them in the environment.                           */
 705     opts[ALLEXPORT] = 0;
 706     setiparam("MAILCHECK", 60);
 707     setiparam("LOGCHECK", 60);
 708     setiparam("KEYTIMEOUT", 40);
 709     setiparam("LISTMAX", 100);
 710     /*
 711      * We used to get the output baud rate here.  However, that's
 712      * pretty irrelevant to a terminal on an X display and can lead
 713      * to unnecessary delays if it's wrong (which it probably is).
 714      * Furthermore, even if the output is slow it's very likely
 715      * to be because of WAN delays, not covered by the output
 716      * baud rate.
 717      * So allow the user to set it in the special cases where it's
 718      * useful.
 719      */
 720     setsparam("TMPPREFIX", ztrdup_metafy(DEFAULT_TMPPREFIX));
 721     setsparam("TIMEFMT", ztrdup_metafy(DEFAULT_TIMEFMT));
 722     setsparam("WATCHFMT", ztrdup_metafy(default_watchfmt));
 723
 724     hostnam = (char *)zalloc(256);
 725     gethostname(hostnam, 256);
 726     setsparam("HOST", ztrdup_metafy(hostnam));
 727     zfree(hostnam, 256);
 728
 729     setsparam("LOGNAME",
 730               ztrdup_metafy((str = getlogin()) && *str ?
 731                             str : cached_username));
 732
 733 #if !defined(HAVE_PUTENV) && !defined(USE_SET_UNSET_ENV)
 734     /* Copy the environment variables we are inheriting to dynamic *
 735      * memory, so we can do mallocs and frees on it.               */
 736     envsize = sizeof(char *)*(1 + arrlen(environ));
 737     new_environ = (char **) zalloc(envsize);
 738     memcpy(new_environ, environ, envsize);
 739     environ = new_environ;
 740 #endif
 741
 742     /* Use heap allocation to avoid many small alloc/free calls */
 743     pushheap();
 744
 745     /* Now incorporate environment variables we are inheriting *
 746      * into the parameter hash table. Copy them into dynamic   *
 747      * memory so that we can free them if needed               */
 748     for (
 749 #ifndef USE_SET_UNSET_ENV
 750         envp =
 751 #endif
 752             envp2 = environ; *envp2; envp2++) {
 753         if (split_env_string(*envp2, &iname, &ivalue)) {
 754             if (!idigit(*iname) && isident(iname) && !strchr(iname, '[')) {
 755                 if ((!(pm = (Param) paramtab->getnode(paramtab, iname)) ||
 756                      !(pm->node.flags & PM_DONTIMPORT || pm->node.flags & PM_EXPORTED)) &&
 757                     (pm = assignsparam(iname, metafy(ivalue, -1, META_DUP),
 758                                        ASSPM_ENV_IMPORT))) {
 759                     pm->node.flags |= PM_EXPORTED;
 760                     if (pm->node.flags & PM_SPECIAL)
 761                         pm->env = mkenvstr (pm->node.nam,
 762                                             getsparam(pm->node.nam), pm->node.flags);
 763                     else
 764                         pm->env = ztrdup(*envp2);
 765 #ifndef USE_SET_UNSET_ENV
 766                     *envp++ = pm->env;
 767 #endif
 768                 }
 769             }
 770         }
 771     }
 772     popheap();
 773 #ifndef USE_SET_UNSET_ENV
 774     *envp = '\0';
 775 #endif
 776     opts[ALLEXPORT] = oae;
 777
 778     if (EMULATION(EMULATE_ZSH))
 779     {
 780         /*
 781          * For native emulation we always set the variable home
 782          * (see setupvals()).
 783          */
 784         pm = (Param) paramtab->getnode(paramtab, "HOME");
 785         pm->node.flags &= ~PM_UNSET;
 786         if (!(pm->node.flags & PM_EXPORTED))
 787             addenv(pm, home);
 788     }
 789     pm = (Param) paramtab->getnode(paramtab, "LOGNAME");
 790     if (!(pm->node.flags & PM_EXPORTED))
 791         addenv(pm, pm->u.str);
 792     pm = (Param) paramtab->getnode(paramtab, "SHLVL");
 793     sprintf(buf, "%d", (int)++shlvl);
 794     /* shlvl value in environment needs updating unconditionally */
 795     addenv(pm, buf);
 796
 797     /* Add the standard non-special parameters */
 798     set_pwd_env();
 799 #ifdef HAVE_UNAME
 800     if(uname(&unamebuf)) setsparam("CPUTYPE", ztrdup("unknown"));
 801     else
 802     {
 803        machinebuf = ztrdup_metafy(unamebuf.machine);
 804        setsparam("CPUTYPE", machinebuf);
 805     }
 806
 807 #else
 808     setsparam("CPUTYPE", ztrdup_metafy("unknown"));
 809 #endif
 810     setsparam("MACHTYPE", ztrdup_metafy(MACHTYPE));
 811     setsparam("OSTYPE", ztrdup_metafy(OSTYPE));
 812     setsparam("TTY", ztrdup_metafy(ttystrname));
 813     setsparam("VENDOR", ztrdup_metafy(VENDOR));
 814     setsparam("ZSH_NAME", ztrdup_metafy(zsh_name));
 815     setsparam("ZSH_VERSION", ztrdup_metafy(ZSH_VERSION));
 816     setsparam("ZSH_PATCHLEVEL", ztrdup_metafy(ZSH_PATCHLEVEL));
 817     setaparam("signals", sigptr = zalloc((SIGCOUNT+4) * sizeof(char *)));
 818     for (t = sigs; (*sigptr++ = ztrdup_metafy(*t++)); );
 819
 820     noerrs = 0;
 821 }
 822
 823 /* assign various functions used for non-special parameters */
 824
 825 /**/
 826 mod_export void
 827 assigngetset(Param pm)
 828 {
 829     switch (PM_TYPE(pm->node.flags)) {
 830     case PM_SCALAR:
 831         pm->gsu.s = &stdscalar_gsu;
 832         break;
 833     case PM_INTEGER:
 834         pm->gsu.i = &stdinteger_gsu;
 835         break;
 836     case PM_EFLOAT:
 837     case PM_FFLOAT:
 838         pm->gsu.f = &stdfloat_gsu;
 839         break;
 840     case PM_ARRAY:
 841         pm->gsu.a = &stdarray_gsu;
 842         break;
 843     case PM_HASHED:
 844         pm->gsu.h = &stdhash_gsu;
 845         break;
 846     default:
 847         DPUTS(1, "BUG: tried to create param node without valid flag");
 848         break;
 849     }
 850 }
 851
 852 /* Create a parameter, so that it can be assigned to.  Returns NULL if the *
 853  * parameter already exists or can't be created, otherwise returns the     *
 854  * parameter node.  If a parameter of the same name exists in an outer     *
 855  * scope, it is hidden by a newly created parameter.  An already existing  *
 856  * parameter node at the current level may be `created' and returned       *
 857  * provided it is unset and not special.  If the parameter can't be        *
 858  * created because it already exists, the PM_UNSET flag is cleared.        */
 859
 860 /**/
 861 mod_export Param
 862 createparam(char *name, int flags)
 863 {
 864     Param pm, oldpm;
 865
 866     if (paramtab != realparamtab)
 867         flags = (flags & ~PM_EXPORTED) | PM_HASHELEM;
 868
 869     if (name != nulstring) {
 870         oldpm = (Param) (paramtab == realparamtab ?
 871                          gethashnode2(paramtab, name) :
 872                          paramtab->getnode(paramtab, name));
 873
 874         DPUTS(oldpm && oldpm->level > locallevel,
 875               "BUG: old local parameter not deleted");
 876         if (oldpm && (oldpm->level == locallevel || !(flags & PM_LOCAL))) {
 877             if (isset(POSIXBUILTINS) && (oldpm->node.flags & PM_READONLY)) {
 878                 zerr("read-only variable: %s", name);
 879                 return NULL;
 880             }
 881             if (!(oldpm->node.flags & PM_UNSET) || (oldpm->node.flags & PM_SPECIAL)) {
 882                 oldpm->node.flags &= ~PM_UNSET;
 883                 if ((oldpm->node.flags & PM_SPECIAL) && oldpm->ename) {
 884                     Param altpm =
 885                         (Param) paramtab->getnode(paramtab, oldpm->ename);
 886                     if (altpm)
 887                         altpm->node.flags &= ~PM_UNSET;
 888                 }
 889                 return NULL;
 890             }
 891             if ((oldpm->node.flags & PM_RESTRICTED) && isset(RESTRICTED)) {
 892                 zerr("%s: restricted", name);
 893                 return NULL;
 894             }
 895
 896             pm = oldpm;
 897             pm->base = pm->width = 0;
 898             oldpm = pm->old;
 899         } else {
 900             pm = (Param) zshcalloc(sizeof *pm);
 901             if ((pm->old = oldpm)) {
 902                 /*
 903                  * needed to avoid freeing oldpm, but we do take it
 904                  * out of the environment when it's hidden.
 905                  */
 906                 if (oldpm->env)
 907                     delenv(oldpm);
 908                 paramtab->removenode(paramtab, name);
 909             }
 910             paramtab->addnode(paramtab, ztrdup(name), pm);
 911         }
 912
 913         if (isset(ALLEXPORT) && !(flags & PM_HASHELEM))
 914             flags |= PM_EXPORTED;
 915     } else {
 916         pm = (Param) hcalloc(sizeof *pm);
 917         pm->node.nam = nulstring;
 918     }
 919     pm->node.flags = flags & ~PM_LOCAL;
 920
 921     if(!(pm->node.flags & PM_SPECIAL))
 922         assigngetset(pm);
 923     return pm;
 924 }
 925
 926 /* Empty dummy function for special hash parameters. */
 927
 928 /**/
 929 static void
 930 shempty(void)
 931 {
 932 }
 933
 934 /*
 935  * Create a simple special hash parameter.
 936  *
 937  * This is for hashes added internally --- it's not possible to add
 938  * special hashes from shell commands.  It's currently used
 939  * - by addparamdef() for special parameters in the zsh/parameter
 940  *   module
 941  * - by ztie for special parameters tied to databases.
 942  */
 943
 944 /**/
 945 mod_export Param
 946 createspecialhash(char *name, GetNodeFunc get, ScanTabFunc scan, int flags)
 947 {
 948     Param pm;
 949     HashTable ht;
 950
 951     if (!(pm = createparam(name, PM_SPECIAL|PM_HASHED|flags)))
 952         return NULL;
 953
 954     /*
 955      * If there's an old parameter, we'll put the new one at
 956      * the current locallevel, so that the old parameter is
 957      * exposed again after leaving the function.  Otherwise,
 958      * we'll leave it alone.  Usually this means the parameter
 959      * will stay in place until explicitly unloaded, however
 960      * if the parameter was previously unset within a function
 961      * we'll inherit the level of that function and follow the
 962      * standard convention that the parameter remains local
 963      * even if unset.
 964      *
 965      * These semantics are similar to those of a normal parameter set
 966      * within a function without a local definition.
 967      */
 968     if (pm->old)
 969         pm->level = locallevel;
 970     pm->gsu.h = (flags & PM_READONLY) ? &stdhash_gsu :
 971         &nullsethash_gsu;
 972     pm->u.hash = ht = newhashtable(0, name, NULL);
 973
 974     ht->hash        = hasher;
 975     ht->emptytable  = (TableFunc) shempty;
 976     ht->filltable   = NULL;
 977     ht->addnode     = (AddNodeFunc) shempty;
 978     ht->getnode     = ht->getnode2 = get;
 979     ht->removenode  = (RemoveNodeFunc) shempty;
 980     ht->disablenode = NULL;
 981     ht->enablenode  = NULL;
 982     ht->freenode    = (FreeNodeFunc) shempty;
 983     ht->printnode   = printparamnode;
 984     ht->scantab     = scan;
 985
 986     return pm;
 987 }
 988
 989
 990 /*
 991  * Copy a parameter
 992  *
 993  * If fakecopy is set, we are just saving the details of a special
 994  * parameter.  Otherwise, the result will be used as a real parameter
 995  * and we need to do more work.
 996  */
 997
 998 /**/
 999 void
1000 copyparam(Param tpm, Param pm, int fakecopy)
1001 {
1002     /*
1003      * Note that tpm, into which we're copying, may not be in permanent
1004      * storage.  However, the values themselves are later used directly
1005      * to set the parameter, so must be permanently allocated (in accordance
1006      * with sets.?fn() usage).
1007      */
1008     tpm->node.flags = pm->node.flags;
1009     tpm->base = pm->base;
1010     tpm->width = pm->width;
1011     tpm->level = pm->level;
1012     if (!fakecopy)
1013         tpm->node.flags &= ~PM_SPECIAL;
1014     switch (PM_TYPE(pm->node.flags)) {
1015     case PM_SCALAR:
1016         tpm->u.str = ztrdup(pm->gsu.s->getfn(pm));
1017         break;
1018     case PM_INTEGER:
1019         tpm->u.val = pm->gsu.i->getfn(pm);
1020         break;
1021     case PM_EFLOAT:
1022     case PM_FFLOAT:
1023         tpm->u.dval = pm->gsu.f->getfn(pm);
1024         break;
1025     case PM_ARRAY:
1026         tpm->u.arr = zarrdup(pm->gsu.a->getfn(pm));
1027         break;
1028     case PM_HASHED:
1029         tpm->u.hash = copyparamtable(pm->gsu.h->getfn(pm), pm->node.nam);
1030         break;
1031     }
1032     /*
1033      * If the value is going to be passed as a real parameter (e.g. this is
1034      * called from inside an associative array), we need the gets and sets
1035      * functions to be useful.
1036      *
1037      * In this case we assume the saved parameter is not itself special,
1038      * so we just use the standard functions.  This is also why we switch off
1039      * PM_SPECIAL.
1040      */
1041     if (!fakecopy)
1042         assigngetset(tpm);
1043 }
1044
1045 /* Return 1 if the string s is a valid identifier, else return 0. */
1046
1047 /**/
1048 mod_export int
1049 isident(char *s)
1050 {
1051     char *ss;
1052
1053     if (!*s)                    /* empty string is definitely not valid */
1054         return 0;
1055
1056     if (idigit(*s)) {
1057         /* If the first character is `s' is a digit, then all must be */
1058         for (ss = ++s; *ss; ss++)
1059             if (!idigit(*ss))
1060                 break;
1061     } else {
1062         /* Find the first character in `s' not in the iident type table */
1063         ss = itype_end(s, IIDENT, 0);
1064     }
1065
1066     /* If the next character is not [, then it is *
1067      * definitely not a valid identifier.         */
1068     if (!*ss)
1069         return 1;
1070     if (s == ss)
1071         return 0;
1072     if (*ss != '[')
1073         return 0;
1074
1075     /* Require balanced [ ] pairs with something between */
1076     if (!(ss = parse_subscript(++ss, 1, ']')))
1077         return 0;
1078     untokenize(s);
1079     return !ss[1];
1080 }
1081
1082 /*
1083  * Parse a single argument to a parameter subscript.
1084  * The subscripts starts at *str; *str is updated (input/output)
1085  *
1086  * *inv is set to indicate if the subscript is reversed (output)
1087  * v is the Value for the parameter being accessed (input; note
1088  *  v->isarr may be modified, and if v is a hash the parameter will
1089  *  be updated to the element of the hash)
1090  * a2 is 1 if this is the second subscript of a range (input)
1091  * *w is only set if we need to find the end of a word (input; should
1092  *  be set to 0 by the caller).
1093  *
1094  * The final two arguments are to support multibyte characters.
1095  * If supplied they are set to the length of the character before
1096  * the index position and the one at the index position.  If
1097  * multibyte characters are not in use they are set to 1 for
1098  * consistency.  Note they aren't fully handled if a2 is non-zero,
1099  * since they aren't needed.
1100  *
1101  * Returns a raw offset into the value from the start or end (i.e.
1102  * after the arithmetic for Meta and possible multibyte characters has
1103  * been taken into account).  This actually gives the offset *after*
1104  * the character in question; subtract *prevcharlen if necessary.
1105  */
1106
1107 /**/
1108 static zlong
1109 getarg(char **str, int *inv, Value v, int a2, zlong *w,
1110        int *prevcharlen, int *nextcharlen)
1111 {
1112     int hasbeg = 0, word = 0, rev = 0, ind = 0, down = 0, l, i, ishash;
1113     int keymatch = 0, needtok = 0, arglen, len;
1114     char *s = *str, *sep = NULL, *t, sav, *d, **ta, **p, *tt, c;
1115     zlong num = 1, beg = 0, r = 0, quote_arg = 0;
1116     Patprog pprog = NULL;
1117
1118     /*
1119      * If in NO_EXEC mode, the parameters won't be set up properly,
1120      * so just pretend everything is a hash for subscript parsing
1121      */
1122
1123     ishash = (unset(EXECOPT) ||
1124               (v->pm && PM_TYPE(v->pm->node.flags) == PM_HASHED));
1125     if (prevcharlen)
1126         *prevcharlen = 1;
1127     if (nextcharlen)
1128         *nextcharlen = 1;
1129
1130     /* first parse any subscription flags */
1131     if (v->pm && (*s == '(' || *s == Inpar)) {
1132         int escapes = 0;
1133         int waste;
1134         for (s++; *s != ')' && *s != Outpar && s != *str; s++) {
1135             switch (*s) {
1136             case 'r':
1137                 rev = 1;
1138                 keymatch = down = ind = 0;
1139                 break;
1140             case 'R':
1141                 rev = down = 1;
1142                 keymatch = ind = 0;
1143                 break;
1144             case 'k':
1145                 keymatch = ishash;
1146                 rev = 1;
1147                 down = ind = 0;
1148                 break;
1149             case 'K':
1150                 keymatch = ishash;
1151                 rev = down = 1;
1152                 ind = 0;
1153                 break;
1154             case 'i':
1155                 rev = ind = 1;
1156                 down = keymatch = 0;
1157                 break;
1158             case 'I':
1159                 rev = ind = down = 1;
1160                 keymatch = 0;
1161                 break;
1162             case 'w':
1163                 /* If the parameter is a scalar, then make subscription *
1164                  * work on a per-word basis instead of characters.      */
1165                 word = 1;
1166                 break;
1167             case 'f':
1168                 word = 1;
1169                 sep = "\n";
1170                 break;
1171             case 'e':
1172                 quote_arg = 1;
1173                 break;
1174             case 'n':
1175                 t = get_strarg(++s, &arglen);
1176                 if (!*t)
1177                     goto flagerr;
1178                 sav = *t;
1179                 *t = '\0';
1180                 num = mathevalarg(s + arglen, &d);
1181                 if (!num)
1182                     num = 1;
1183                 *t = sav;
1184                 s = t + arglen - 1;
1185                 break;
1186             case 'b':
1187                 hasbeg = 1;
1188                 t = get_strarg(++s, &arglen);
1189                 if (!*t)
1190                     goto flagerr;
1191                 sav = *t;
1192                 *t = '\0';
1193                 if ((beg = mathevalarg(s + arglen, &d)) > 0)
1194                     beg--;
1195                 *t = sav;
1196                 s = t + arglen - 1;
1197                 break;
1198             case 'p':
1199                 escapes = 1;
1200                 break;
1201             case 's':
1202                 /* This gives the string that separates words *
1203                  * (for use with the `w' flag).               */
1204                 t = get_strarg(++s, &arglen);
1205                 if (!*t)
1206                     goto flagerr;
1207                 sav = *t;
1208                 *t = '\0';
1209                 s += arglen;
1210                 sep = escapes ? getkeystring(s, &waste, GETKEYS_SEP, NULL)
1211                     : dupstring(s);
1212                 *t = sav;
1213                 s = t + arglen - 1;
1214                 break;
1215             default:
1216               flagerr:
1217                 num = 1;
1218                 word = rev = ind = down = keymatch = 0;
1219                 sep = NULL;
1220                 s = *str - 1;
1221             }
1222         }
1223         if (s != *str)
1224             s++;
1225     }
1226     if (num < 0) {
1227         down = !down;
1228         num = -num;
1229     }
1230     if (v->isarr & SCANPM_WANTKEYS)
1231         *inv = (ind || !(v->isarr & SCANPM_WANTVALS));
1232     else if (v->isarr & SCANPM_WANTVALS)
1233         *inv = 0;
1234     else {
1235         if (v->isarr) {
1236             if (ind) {
1237                 v->isarr |= SCANPM_WANTKEYS;
1238                 v->isarr &= ~SCANPM_WANTVALS;
1239             } else if (rev)
1240                 v->isarr |= SCANPM_WANTVALS;
1241             /*
1242              * This catches the case where we are using "k" (rather
1243              * than "K") on a hash.
1244              */
1245             if (!down && keymatch && ishash)
1246                 v->isarr &= ~SCANPM_MATCHMANY;
1247         }
1248         *inv = ind;
1249     }
1250
1251     for (t = s, i = 0;
1252          (c = *t) && ((c != Outbrack &&
1253                        (ishash || c != ',')) || i); t++) {
1254         /* Untokenize inull() except before brackets and double-quotes */
1255         if (inull(c)) {
1256             c = t[1];
1257             if (c == '[' || c == ']' ||
1258                 c == '(' || c == ')' ||
1259                 c == '{' || c == '}') {
1260                 /* This test handles nested subscripts in hash keys */
1261                 if (ishash && i)
1262                     *t = ztokens[*t - Pound];
1263                 needtok = 1;
1264                 ++t;
1265             } else if (c != '"')
1266                 *t = ztokens[*t - Pound];
1267             continue;
1268         }
1269         /* Inbrack and Outbrack are probably never found here ... */
1270         if (c == '[' || c == Inbrack)
1271             i++;
1272         else if (c == ']' || c == Outbrack)
1273             i--;
1274         if (ispecial(c))
1275             needtok = 1;
1276     }
1277     if (!c)
1278         return 0;
1279     *str = tt = t;
1280
1281     /*
1282      * If in NO_EXEC mode, the parameters won't be set up properly,
1283      * so there's no additional sanity checking we can do.
1284      * Just return 0 now.
1285      */
1286     if (unset(EXECOPT))
1287         return 0;
1288
1289     s = dupstrpfx(s, t - s);
1290
1291     /* If we're NOT reverse subscripting, strip the inull()s so brackets *
1292      * are not backslashed after parsestr().  Otherwise leave them alone *
1293      * so that the brackets will be escaped when we patcompile() or when *
1294      * subscript arithmetic is performed (for nested subscripts).        */
1295     if (ishash && (keymatch || !rev))
1296         remnulargs(s);
1297     if (needtok) {
1298         s = dupstring(s);
1299         if (parsestr(&s))
1300             return 0;
1301         singsub(&s);
1302     } else if (rev)
1303         remnulargs(s);  /* This is probably always a no-op, but ... */
1304     if (!rev) {
1305         if (ishash) {
1306             HashTable ht = v->pm->gsu.h->getfn(v->pm);
1307             if (!ht) {
1308                 ht = newparamtable(17, v->pm->node.nam);
1309                 v->pm->gsu.h->setfn(v->pm, ht);
1310             }
1311             untokenize(s);
1312             if (!(v->pm = (Param) ht->getnode(ht, s))) {
1313                 HashTable tht = paramtab;
1314                 paramtab = ht;
1315                 v->pm = createparam(s, PM_SCALAR|PM_UNSET);
1316                 paramtab = tht;
1317             }
1318             v->isarr = (*inv ? SCANPM_WANTINDEX : 0);
1319             v->start = 0;
1320             *inv = 0;   /* We've already obtained the "index" (key) */
1321             *w = v->end = -1;
1322             r = isset(KSHARRAYS) ? 1 : 0;
1323         } else {
1324             r = mathevalarg(s, &s);
1325             if (isset(KSHARRAYS) && r >= 0)
1326                 r++;
1327         }
1328         if (word && !v->isarr) {
1329             s = t = getstrvalue(v);
1330             i = wordcount(s, sep, 0);
1331             if (r < 0)
1332                 r += i + 1;
1333             if (r < 1)
1334                 r = 1;
1335             if (r > i)
1336                 r = i;
1337             if (!s || !*s)
1338                 return 0;
1339             while ((d = findword(&s, sep)) && --r);
1340             if (!d)
1341                 return 0;
1342
1343             if (!a2 && *tt != ',')
1344                 *w = (zlong)(s - t);
1345
1346             return (a2 ? s : d + 1) - t;
1347         } else if (!v->isarr && !word) {
1348             int lastcharlen = 1;
1349             s = getstrvalue(v);
1350             /*
1351              * Note for the confused (= pws):  the index r we
1352              * have so far is that specified by the user.  The value
1353              * passed back is an offset from the start or end of
1354              * the string.  Hence it needs correcting at least
1355              * for Meta characters and maybe for multibyte characters.
1356              */
1357             if (r > 0) {
1358                 zlong nchars = r;
1359
1360                 MB_METACHARINIT();
1361                 for (t = s; nchars && *t; nchars--)
1362                     t += (lastcharlen = MB_METACHARLEN(t));
1363                 /* for consistency, keep any remainder off the end */
1364                 r = (zlong)(t - s) + nchars;
1365                 if (prevcharlen && !nchars /* ignore if off the end */)
1366                     *prevcharlen = lastcharlen;
1367                 if (nextcharlen && *t)
1368                     *nextcharlen = MB_METACHARLEN(t);
1369             } else if (r == 0) {
1370                 if (prevcharlen)
1371                     *prevcharlen = 0;
1372                 if (nextcharlen && *s) {
1373                     MB_METACHARINIT();
1374                     *nextcharlen = MB_METACHARLEN(s);
1375                 }
1376             } else {
1377                 zlong nchars = (zlong)MB_METASTRLEN(s) + r;
1378
1379                 if (nchars < 0) {
1380                     /* make sure this isn't valid as a raw pointer */
1381                     r -= (zlong)strlen(s);
1382                 } else {
1383                     MB_METACHARINIT();
1384                     for (t = s; nchars && *t; nchars--)
1385                         t += (lastcharlen = MB_METACHARLEN(t));
1386                     r = - (zlong)strlen(t); /* keep negative */
1387                     if (prevcharlen)
1388                         *prevcharlen = lastcharlen;
1389                     if (nextcharlen && *t)
1390                         *nextcharlen = MB_METACHARLEN(t);
1391                 }
1392             }
1393         }
1394     } else {
1395         if (!v->isarr && !word) {
1396             l = strlen(s);
1397             if (a2) {
1398                 if (!l || *s != '*') {
1399                     d = (char *) hcalloc(l + 2);
1400                     *d = '*';
1401                     strcpy(d + 1, s);
1402                     s = d;
1403                 }
1404             } else {
1405                 if (!l || s[l - 1] != '*' || (l > 1 && s[l - 2] == '\\')) {
1406                     d = (char *) hcalloc(l + 2);
1407                     strcpy(d, s);
1408                     strcat(d, "*");
1409                     s = d;
1410                 }
1411             }
1412         }
1413         if (!keymatch) {
1414             if (quote_arg)
1415                 untokenize(s);
1416             else
1417                 tokenize(s);
1418             remnulargs(s);
1419             pprog = patcompile(s, 0, NULL);
1420         } else
1421             pprog = NULL;
1422
1423         if (v->isarr) {
1424             if (ishash) {
1425                 scanprog = pprog;
1426                 scanstr = s;
1427                 if (keymatch)
1428                     v->isarr |= SCANPM_KEYMATCH;
1429                 else {
1430                     if (!pprog)
1431                         return 1;
1432                     if (ind)
1433                         v->isarr |= SCANPM_MATCHKEY;
1434                     else
1435                         v->isarr |= SCANPM_MATCHVAL;
1436                 }
1437                 if (down)
1438                     v->isarr |= SCANPM_MATCHMANY;
1439                 if ((ta = getvaluearr(v)) &&
1440                     (*ta || ((v->isarr & SCANPM_MATCHMANY) &&
1441                              (v->isarr & (SCANPM_MATCHKEY | SCANPM_MATCHVAL |
1442                                           SCANPM_KEYMATCH))))) {
1443                     *inv = (v->flags & VALFLAG_INV) ? 1 : 0;
1444                     *w = v->end;
1445                     scanprog = NULL;
1446                     return 1;
1447                 }
1448                 scanprog = NULL;
1449             } else
1450                 ta = getarrvalue(v);
1451             if (!ta || !*ta)
1452                 return !down;
1453             len = arrlen(ta);
1454             if (beg < 0)
1455                 beg += len;
1456             if (down) {
1457                 if (beg < 0)
1458                     return 0;
1459             } else if (beg >= len)
1460                 return len + 1;
1461             if (beg >= 0 && beg < len) {
1462                 if (down) {
1463                     if (!hasbeg)
1464                         beg = len - 1;
1465                     for (r = 1 + beg, p = ta + beg; p >= ta; r--, p--) {
1466                         if (pprog && pattry(pprog, *p) && !--num)
1467                             return r;
1468                     }
1469                 } else
1470                     for (r = 1 + beg, p = ta + beg; *p; r++, p++)
1471                         if (pprog && pattry(pprog, *p) && !--num)
1472                             return r;
1473             }
1474         } else if (word) {
1475             ta = sepsplit(d = s = getstrvalue(v), sep, 1, 1);
1476             len = arrlen(ta);
1477             if (beg < 0)
1478                 beg += len;
1479             if (down) {
1480                 if (beg < 0)
1481                     return 0;
1482             } else if (beg >= len)
1483                 return len + 1;
1484             if (beg >= 0 && beg < len) {
1485                 if (down) {
1486                     if (!hasbeg)
1487                         beg = len - 1;
1488                     for (r = 1 + beg, p = ta + beg; p >= ta; p--, r--)
1489                         if (pprog && pattry(pprog, *p) && !--num)
1490                             break;
1491                     if (p < ta)
1492                         return 0;
1493                 } else {
1494                     for (r = 1 + beg, p = ta + beg; *p; r++, p++)
1495                         if (pprog && pattry(pprog, *p) && !--num)
1496                             break;
1497                     if (!*p)
1498                         return 0;
1499                 }
1500             }
1501             if (a2)
1502                 r++;
1503             for (i = 0; (t = findword(&d, sep)) && *t; i++)
1504                 if (!--r) {
1505                     r = (zlong)(t - s + (a2 ? -1 : 1));
1506                     if (!a2 && *tt != ',')
1507                         *w = r + strlen(ta[i]) - 1;
1508                     return r;
1509                 }
1510             return a2 ? -1 : 0;
1511         } else {
1512             /* Searching characters */
1513             int slen;
1514             d = getstrvalue(v);
1515             if (!d || !*d)
1516                 return 0;
1517             /*
1518              * beg and len are character counts, not raw offsets.
1519              * Remember we need to return a raw offset.
1520              */
1521             len = MB_METASTRLEN(d);
1522             slen = strlen(d);
1523             if (beg < 0)
1524                 beg += len;
1525             MB_METACHARINIT();
1526             if (beg >= 0 && beg < len) {
1527                 char *de = d + slen;
1528
1529                 if (a2) {
1530                     /*
1531                      * Second argument: we don't need to
1532                      * handle prevcharlen or nextcharlen, but
1533                      * we do need to handle characters appropriately.
1534                      */
1535                     if (down) {
1536                         int nmatches = 0;
1537                         char *lastpos = NULL;
1538
1539                         if (!hasbeg)
1540                             beg = len;
1541
1542                         /*
1543                          * See below: we have to move forward,
1544                          * but need to count from the end.
1545                          */
1546                         for (t = d, r = 0; r <= beg; r++) {
1547                             sav = *t;
1548                             *t = '\0';
1549                             if (pprog && pattry(pprog, d)) {
1550                                 nmatches++;
1551                                 lastpos = t;
1552                             }
1553                             *t = sav;
1554                             if (t == de)
1555                                 break;
1556                             t += MB_METACHARLEN(t);
1557                         }
1558
1559                         if (nmatches >= num) {
1560                             if (num > 1) {
1561                                 nmatches -= num;
1562                                 MB_METACHARINIT();
1563                                 for (t = d, r = 0; ; r++) {
1564                                     sav = *t;
1565                                     *t = '\0';
1566                                     if (pprog && pattry(pprog, d) &&
1567                                         nmatches-- == 0) {
1568                                         lastpos = t;
1569                                         *t = sav;
1570                                         break;
1571                                     }
1572                                     *t = sav;
1573                                     t += MB_METACHARLEN(t);
1574                                 }
1575                             }
1576                             /* else lastpos is already OK */
1577
1578                             return lastpos - d;
1579                         }
1580                     } else {
1581                         /*
1582                          * This handling of the b flag
1583                          * gives odd results, but this is the
1584                          * way it's always worked.
1585                          */
1586                         for (t = d; beg && t <= de; beg--)
1587                             t += MB_METACHARLEN(t);
1588                         for (;;) {
1589                             sav = *t;
1590                             *t = '\0';
1591                             if (pprog && pattry(pprog, d) && !--num) {
1592                                 *t = sav;
1593                                 /*
1594                                  * This time, don't increment
1595                                  * pointer, since it's already
1596                                  * after everything we matched.
1597                                  */
1598                                 return t - d;
1599                             }
1600                             *t = sav;
1601                             if (t == de)
1602                                 break;
1603                             t += MB_METACHARLEN(t);
1604                         }
1605                     }
1606                 } else {
1607                     /*
1608                      * First argument: this is the only case
1609                      * where we need prevcharlen and nextcharlen.
1610                      */
1611                     int lastcharlen;
1612
1613                     if (down) {
1614                         int nmatches = 0;
1615                         char *lastpos = NULL;
1616
1617                         if (!hasbeg)
1618                             beg = len;
1619
1620                         /*
1621                          * We can only move forward through
1622                          * multibyte strings, so record the
1623                          * matches.
1624                          * Unfortunately the count num works
1625                          * from the end, so it's easy to get the
1626                          * last one but we need to repeat if
1627                          * we want another one.
1628                          */
1629                         for (t = d, r = 0; r <= beg; r++) {
1630                             if (pprog && pattry(pprog, t)) {
1631                                 nmatches++;
1632                                 lastpos = t;
1633                             }
1634                             if (t == de)
1635                                 break;
1636                             t += MB_METACHARLEN(t);
1637                         }
1638
1639                         if (nmatches >= num) {
1640                             if (num > 1) {
1641                                 /*
1642                                  * Need to start again and repeat
1643                                  * to get the right match.
1644                                  */
1645                                 nmatches -= num;
1646                                 MB_METACHARINIT();
1647                                 for (t = d, r = 0; ; r++) {
1648                                     if (pprog && pattry(pprog, t) &&
1649                                         nmatches-- == 0) {
1650                                         lastpos = t;
1651                                         break;
1652                                     }
1653                                     t += MB_METACHARLEN(t);
1654                                 }
1655                             }
1656                             /* else lastpos is already OK */
1657
1658                             /* return pointer after matched char */
1659                             lastpos +=
1660                                 (lastcharlen = MB_METACHARLEN(lastpos));
1661                             if (prevcharlen)
1662                                 *prevcharlen = lastcharlen;
1663                             if (nextcharlen)
1664                                 *nextcharlen = MB_METACHARLEN(lastpos);
1665                             return lastpos - d;
1666                         }
1667
1668                         for (r = beg + 1, t = d + beg; t >= d; r--, t--) {
1669                             if (pprog && pattry(pprog, t) &&
1670                                 !--num)
1671                                 return r;
1672                         }
1673                     } else {
1674                         for (t = d; beg && t <= de; beg--)
1675                             t += MB_METACHARLEN(t);
1676                         for (;;) {
1677                             if (pprog && pattry(pprog, t) && !--num) {
1678                                 /* return pointer after matched char */
1679                                 t += (lastcharlen = MB_METACHARLEN(t));
1680                                 if (prevcharlen)
1681                                     *prevcharlen = lastcharlen;
1682                                 if (nextcharlen)
1683                                     *nextcharlen = MB_METACHARLEN(t);
1684                                 return t - d;
1685                             }
1686                             if (t == de)
1687                                 break;
1688                             t += MB_METACHARLEN(t);
1689                         }
1690                     }
1691                 }
1692             }
1693             return down ? 0 : slen + 1;
1694         }
1695     }
1696     return r;
1697 }
1698
1699 /**/
1700 int
1701 getindex(char **pptr, Value v, int flags)
1702 {
1703     int start, end, inv = 0;
1704     char *s = *pptr, *tbrack;
1705
1706     *s++ = '[';
1707     /* Error handled after untokenizing */
1708     s = parse_subscript(s, flags & SCANPM_DQUOTED, ']');
1709     /* Now we untokenize everything except inull() markers so we can check *
1710      * for the '*' and '@' special subscripts.  The inull()s are removed  *
1711      * in getarg() after we know whether we're doing reverse indexing.    */
1712     for (tbrack = *pptr + 1; *tbrack && tbrack != s; tbrack++) {
1713         if (inull(*tbrack) && !*++tbrack)
1714             break;
1715         if (itok(*tbrack))      /* Need to check for Nularg here? */
1716             *tbrack = ztokens[*tbrack - Pound];
1717     }
1718     /* If we reached the end of the string (s == NULL) we have an error */
1719     if (*tbrack)
1720         *tbrack = Outbrack;
1721     else {
1722         zerr("invalid subscript");
1723         *pptr = tbrack;
1724         return 1;
1725     }
1726     s = *pptr + 1;
1727     if ((s[0] == '*' || s[0] == '@') && s + 1 == tbrack) {
1728         if ((v->isarr || IS_UNSET_VALUE(v)) && s[0] == '@')
1729             v->isarr |= SCANPM_ISVAR_AT;
1730         v->start = 0;
1731         v->end = -1;
1732         s += 2;
1733     } else {
1734         zlong we = 0, dummy;
1735         int startprevlen, startnextlen;
1736
1737         start = getarg(&s, &inv, v, 0, &we, &startprevlen, &startnextlen);
1738
1739         if (inv) {
1740             if (!v->isarr && start != 0) {
1741                 char *t, *p;
1742                 t = getstrvalue(v);
1743                 /*
1744                  * Note for the confused (= pws): this is an inverse
1745                  * offset so at this stage we need to convert from
1746                  * the immediate offset into the value that we have
1747                  * into a logical character position.
1748                  */
1749                 if (start > 0) {
1750                     int nstart = 0;
1751                     char *target = t + start - startprevlen;
1752
1753                     p = t;
1754                     MB_METACHARINIT();
1755                     while (*p) {
1756                         /*
1757                          * move up characters, counting how many we
1758                          * found
1759                          */
1760                         p += MB_METACHARLEN(p);
1761                         if (p < target)
1762                             nstart++;
1763                         else {
1764                             if (p == target)
1765                                 nstart++;
1766                             else
1767                                 p = target; /* pretend we hit exactly */
1768                             break;
1769                         }
1770                     }
1771                     /* if start was too big, keep the difference */
1772                     start = nstart + (target - p) + 1;
1773                 } else {
1774                     zlong startoff = start + strlen(t);
1775 #ifdef DEBUG
1776                     dputs("BUG: can't have negative inverse offsets???");
1777 #endif
1778                     if (startoff < 0) {
1779                         /* invalid: keep index but don't dereference */
1780                         start = startoff;
1781                     } else {
1782                         /* find start in full characters */
1783                         MB_METACHARINIT();
1784                         for (p = t; p < t + startoff;)
1785                             p += MB_METACHARLEN(p);
1786                         start = - MB_METASTRLEN(p);
1787                     }
1788                 }
1789             }
1790             if (start > 0 && (isset(KSHARRAYS) || (v->pm->node.flags & PM_HASHED)))
1791                 start--;
1792             if (v->isarr != SCANPM_WANTINDEX) {
1793                 v->flags |= VALFLAG_INV;
1794                 v->isarr = 0;
1795                 v->start = start;
1796                 v->end = start + 1;
1797             }
1798             if (*s == ',') {
1799                 zerr("invalid subscript");
1800                 *tbrack = ']';
1801                 *pptr = tbrack+1;
1802                 return 1;
1803             }
1804             if (s == tbrack)
1805                 s++;
1806         } else {
1807             int com;
1808
1809             if ((com = (*s == ','))) {
1810                 s++;
1811                 end = getarg(&s, &inv, v, 1, &dummy, NULL, NULL);
1812             } else {
1813                 end = we ? we : start;
1814             }
1815             if (start != end)
1816                 com = 1;
1817             /*
1818              * Somehow the logic sometimes forces us to use the previous
1819              * or next character to what we would expect, which is
1820              * why we had to calculate them in getarg().
1821              */
1822             if (start > 0)
1823                 start -= startprevlen;
1824             else if (start == 0 && end == 0)
1825             {
1826                 /*
1827                  * Strictly, this range is entirely off the
1828                  * start of the available index range.
1829                  * This can't happen with KSH_ARRAYS; we already
1830                  * altered the start index in getarg().
1831                  * Are we being strict?
1832                  */
1833                 if (isset(KSHZEROSUBSCRIPT)) {
1834                     /*
1835                      * We're not.
1836                      * Treat this as accessing the first element of the
1837                      * array.
1838                      */
1839                     end = startnextlen;
1840                 } else {
1841                     /*
1842                      * We are.  Flag that this range is invalid
1843                      * for setting elements.  Set the indexes
1844                      * to a range that returns empty for other accesses.
1845                      */
1846                     v->flags |= VALFLAG_EMPTY;
1847                     start = -1;
1848                     com = 1;
1849                 }
1850             }
1851             if (s == tbrack) {
1852                 s++;
1853                 if (v->isarr && !com &&
1854                     (!(v->isarr & SCANPM_MATCHMANY) ||
1855                      !(v->isarr & (SCANPM_MATCHKEY | SCANPM_MATCHVAL |
1856                                    SCANPM_KEYMATCH))))
1857                     v->isarr = 0;
1858                 v->start = start;
1859                 v->end = end;
1860             } else
1861                 s = *pptr;
1862         }
1863     }
1864     *tbrack = ']';
1865     *pptr = s;
1866     return 0;
1867 }
1868
1869
1870 /**/
1871 mod_export Value
1872 getvalue(Value v, char **pptr, int bracks)
1873 {
1874   return fetchvalue(v, pptr, bracks, 0);
1875 }
1876
1877 /**/
1878 mod_export Value
1879 fetchvalue(Value v, char **pptr, int bracks, int flags)
1880 {
1881     char *s, *t, *ie;
1882     char sav, c;
1883     int ppar = 0;
1884
1885     s = t = *pptr;
1886
1887     if (idigit(c = *s)) {
1888         if (bracks >= 0)
1889             ppar = zstrtol(s, &s, 10);
1890         else
1891             ppar = *s++ - '0';
1892     }
1893     else if ((ie = itype_end(s, IIDENT, 0)) != s)
1894         s = ie;
1895     else if (c == Quest)
1896         *s++ = '?';
1897     else if (c == Pound)
1898         *s++ = '#';
1899     else if (c == String)
1900         *s++ = '$';
1901     else if (c == Qstring)
1902         *s++ = '$';
1903     else if (c == Star)
1904         *s++ = '*';
1905     else if (c == '#' || c == '-' || c == '?' || c == '$' ||
1906              c == '!' || c == '@' || c == '*')
1907         s++;
1908     else
1909         return NULL;
1910
1911     if ((sav = *s))
1912         *s = '\0';
1913     if (ppar) {
1914         if (v)
1915             memset(v, 0, sizeof(*v));
1916         else
1917             v = (Value) hcalloc(sizeof *v);
1918         v->pm = argvparam;
1919         v->flags = 0;
1920         v->start = ppar - 1;
1921         v->end = ppar;
1922         if (sav)
1923             *s = sav;
1924     } else {
1925         Param pm;
1926         int isvarat;
1927
1928         isvarat = (t[0] == '@' && !t[1]);
1929         pm = (Param) paramtab->getnode(paramtab, *t == '0' ? "0" : t);
1930         if (sav)
1931             *s = sav;
1932         *pptr = s;
1933         if (!pm || (pm->node.flags & PM_UNSET))
1934             return NULL;
1935         if (v)
1936             memset(v, 0, sizeof(*v));
1937         else
1938             v = (Value) hcalloc(sizeof *v);
1939         if (PM_TYPE(pm->node.flags) & (PM_ARRAY|PM_HASHED)) {
1940             /* Overload v->isarr as the flag bits for hashed arrays. */
1941             v->isarr = flags | (isvarat ? SCANPM_ISVAR_AT : 0);
1942             /* If no flags were passed, we need something to represent *
1943              * `true' yet differ from an explicit WANTVALS.  Use a     *
1944              * special flag for this case.                             */
1945             if (!v->isarr)
1946                 v->isarr = SCANPM_ARRONLY;
1947         }
1948         v->pm = pm;
1949         v->flags = 0;
1950         v->start = 0;
1951         v->end = -1;
1952         if (bracks > 0 && (*s == '[' || *s == Inbrack)) {
1953             if (getindex(&s, v, flags)) {
1954                 *pptr = s;
1955                 return v;
1956             }
1957         } else if (!(flags & SCANPM_ASSIGNING) && v->isarr &&
1958                    itype_end(t, IIDENT, 1) != t && isset(KSHARRAYS))
1959             v->end = 1, v->isarr = 0;
1960     }
1961     if (!bracks && *s)
1962         return NULL;
1963     *pptr = s;
1964 #if 0
1965     /*
1966      * Check for large subscripts that might be erroneous.
1967      * This code is too gross in several ways:
1968      * - the limit is completely arbitrary
1969      * - the test vetoes operations on existing arrays
1970      * - it's not at all clear a general test on large arrays of
1971      *   this kind is any use.
1972      *
1973      * Until someone comes up with workable replacement code it's
1974      * therefore commented out.
1975      */
1976     if (v->start > MAX_ARRLEN) {
1977         zerr("subscript too %s: %d", "big", v->start + !isset(KSHARRAYS));
1978         return NULL;
1979     }
1980     if (v->start < -MAX_ARRLEN) {
1981         zerr("subscript too %s: %d", "small", v->start);
1982         return NULL;
1983     }
1984     if (v->end > MAX_ARRLEN+1) {
1985         zerr("subscript too %s: %d", "big", v->end - !!isset(KSHARRAYS));
1986         return NULL;
1987     }
1988     if (v->end < -MAX_ARRLEN) {
1989         zerr("subscript too %s: %d", "small", v->end);
1990         return NULL;
1991     }
1992 #endif
1993     return v;
1994 }
1995
1996 /**/
1997 mod_export char *
1998 getstrvalue(Value v)
1999 {
2000     char *s, **ss;
2001     char buf[BDIGBUFSIZE];
2002
2003     if (!v)
2004         return hcalloc(1);
2005
2006     if ((v->flags & VALFLAG_INV) && !(v->pm->node.flags & PM_HASHED)) {
2007         sprintf(buf, "%d", v->start);
2008         s = dupstring(buf);
2009         return s;
2010     }
2011
2012     switch(PM_TYPE(v->pm->node.flags)) {
2013     case PM_HASHED:
2014         /* (!v->isarr) should be impossible unless emulating ksh */
2015         if (!v->isarr && EMULATION(EMULATE_KSH)) {
2016             s = dupstring("[0]");
2017             if (getindex(&s, v, 0) == 0)
2018                 s = getstrvalue(v);
2019             return s;
2020         } /* else fall through */
2021     case PM_ARRAY:
2022         ss = getvaluearr(v);
2023         if (v->isarr)
2024             s = sepjoin(ss, NULL, 1);
2025         else {
2026             if (v->start < 0)
2027                 v->start += arrlen(ss);
2028             s = (v->start >= arrlen(ss) || v->start < 0) ?
2029                 (char *) hcalloc(1) : ss[v->start];
2030         }
2031         return s;
2032     case PM_INTEGER:
2033         convbase(buf, v->pm->gsu.i->getfn(v->pm), v->pm->base);
2034         s = dupstring(buf);
2035         break;
2036     case PM_EFLOAT:
2037     case PM_FFLOAT:
2038         s = convfloat(v->pm->gsu.f->getfn(v->pm),
2039                       v->pm->base, v->pm->node.flags, NULL);
2040         break;
2041     case PM_SCALAR:
2042         s = v->pm->gsu.s->getfn(v->pm);
2043         break;
2044     default:
2045         s = "";
2046         DPUTS(1, "BUG: param node without valid type");
2047         break;
2048     }
2049
2050     if (v->flags & VALFLAG_SUBST) {
2051         if (v->pm->node.flags & (PM_LEFT|PM_RIGHT_B|PM_RIGHT_Z)) {
2052             unsigned int fwidth = v->pm->width ? v->pm->width : MB_METASTRLEN(s);
2053             switch (v->pm->node.flags & (PM_LEFT | PM_RIGHT_B | PM_RIGHT_Z)) {
2054                 char *t, *tend;
2055                 unsigned int t0;
2056
2057             case PM_LEFT:
2058             case PM_LEFT | PM_RIGHT_Z:
2059                 t = s;
2060                 if (v->pm->node.flags & PM_RIGHT_Z)
2061                     while (*t == '0')
2062                         t++;
2063                 else
2064                     while (iblank(*t))
2065                         t++;
2066                 MB_METACHARINIT();
2067                 for (tend = t, t0 = 0; t0 < fwidth && *tend; t0++)
2068                     tend += MB_METACHARLEN(tend);
2069                 /*
2070                  * t0 is the number of characters from t used,
2071                  * hence (fwidth - t0) is the number of padding
2072                  * characters.  fwidth is a misnomer: we use
2073                  * character counts, not character widths.
2074                  *
2075                  * (tend - t) is the number of bytes we need
2076                  * to get fwidth characters or the entire string;
2077                  * the characters may be multiple bytes.
2078                  */
2079                 fwidth -= t0; /* padding chars remaining */
2080                 t0 = tend - t; /* bytes to copy from string */
2081                 s = (char *) hcalloc(t0 + fwidth + 1);
2082                 memcpy(s, t, t0);
2083                 if (fwidth)
2084                     memset(s + t0, ' ', fwidth);
2085                 s[t0 + fwidth] = '\0';
2086                 break;
2087             case PM_RIGHT_B:
2088             case PM_RIGHT_Z:
2089             case PM_RIGHT_Z | PM_RIGHT_B:
2090                 {
2091                     int zero = 1;
2092                     /* Calculate length in possibly multibyte chars */
2093                     unsigned int charlen = MB_METASTRLEN(s);
2094
2095                     if (charlen < fwidth) {
2096                         char *valprefend = s;
2097                         int preflen;
2098                         if (v->pm->node.flags & PM_RIGHT_Z) {
2099                             /*
2100                              * This is a documented feature: when deciding
2101                              * whether to pad with zeroes, ignore
2102                              * leading blanks already in the value;
2103                              * only look for numbers after that.
2104                              * Not sure how useful this really is.
2105                              * It's certainly confusing to code around.
2106                              */
2107                             for (t = s; iblank(*t); t++)
2108                                 ;
2109                             /*
2110                              * Allow padding after initial minus
2111                              * for numeric variables.
2112                              */
2113                             if ((v->pm->node.flags &
2114                                  (PM_INTEGER|PM_EFLOAT|PM_FFLOAT)) &&
2115                                 *t == '-')
2116                                 t++;
2117                             /*
2118                              * Allow padding after initial 0x or
2119                              * base# for integer variables.
2120                              */
2121                             if (v->pm->node.flags & PM_INTEGER) {
2122                                 if (isset(CBASES) &&
2123                                     t[0] == '0' && t[1] == 'x')
2124                                     t += 2;
2125                                 else if ((valprefend = strchr(t, '#')))
2126                                     t = valprefend + 1;
2127                             }
2128                             valprefend = t;
2129                             if (!*t)
2130                                 zero = 0;
2131                             else if (v->pm->node.flags &
2132                                      (PM_INTEGER|PM_EFLOAT|PM_FFLOAT)) {
2133                                 /* zero always OK */
2134                             } else if (!idigit(*t))
2135                                 zero = 0;
2136                         }
2137                         /* number of characters needed for padding */
2138                         fwidth -= charlen;
2139                         /* bytes from original string */
2140                         t0 = strlen(s);
2141                         t = (char *) hcalloc(fwidth + t0 + 1);
2142                         /* prefix guaranteed to be single byte chars */
2143                         preflen = valprefend - s;
2144                         memset(t + preflen,
2145                                (((v->pm->node.flags & PM_RIGHT_B)
2146                                  || !zero) ?       ' ' : '0'), fwidth);
2147                         /*
2148                          * Copy - or 0x or base# before any padding
2149                          * zeroes.
2150                          */
2151                         if (preflen)
2152                             memcpy(t, s, preflen);
2153                         memcpy(t + preflen + fwidth,
2154                                valprefend, t0 - preflen);
2155                         t[fwidth + t0] = '\0';
2156                         s = t;
2157                     } else {
2158                         /* Need to skip (charlen - fwidth) chars */
2159                         for (t0 = charlen - fwidth; t0; t0--)
2160                             s += MB_METACHARLEN(s);
2161                     }
2162                 }
2163                 break;
2164             }
2165         }
2166         switch (v->pm->node.flags & (PM_LOWER | PM_UPPER)) {
2167         case PM_LOWER:
2168             s = casemodify(s, CASMOD_LOWER);
2169             break;
2170         case PM_UPPER:
2171             s = casemodify(s, CASMOD_UPPER);
2172             break;
2173         }
2174     }
2175     if (v->start == 0 && v->end == -1)
2176         return s;
2177
2178     if (v->start < 0) {
2179         v->start += strlen(s);
2180         if (v->start < 0)
2181             v->start = 0;
2182     }
2183     if (v->end < 0) {
2184         v->end += strlen(s);
2185         if (v->end >= 0) {
2186             char *eptr = s + v->end;
2187             if (*eptr)
2188                 v->end += MB_METACHARLEN(eptr);
2189         }
2190     }
2191     s = (v->start > (int)strlen(s)) ? dupstring("") : dupstring(s + v->start);
2192     if (v->end <= v->start)
2193         s[0] = '\0';
2194     else if (v->end - v->start <= (int)strlen(s))
2195         s[v->end - v->start] = '\0';
2196
2197     return s;
2198 }
2199
2200 static char *nular[] = {"", NULL};
2201
2202 /**/
2203 mod_export char **
2204 getarrvalue(Value v)
2205 {
2206     char **s;
2207
2208     if (!v)
2209         return arrdup(nular);
2210     else if (IS_UNSET_VALUE(v))
2211         return arrdup(&nular[1]);
2212     if (v->flags & VALFLAG_INV) {
2213         char buf[DIGBUFSIZE];
2214
2215         s = arrdup(nular);
2216         sprintf(buf, "%d", v->start);
2217         s[0] = dupstring(buf);
2218         return s;
2219     }
2220     s = getvaluearr(v);
2221     if (v->start == 0 && v->end == -1)
2222         return s;
2223     if (v->start < 0)
2224         v->start += arrlen(s);
2225     if (v->end < 0)
2226         v->end += arrlen(s) + 1;
2227     if (v->start > arrlen(s) || v->start < 0)
2228         s = arrdup(nular);
2229     else
2230         s = arrdup(s + v->start);
2231     if (v->end <= v->start)
2232         s[0] = NULL;
2233     else if (v->end - v->start <= arrlen(s))
2234         s[v->end - v->start] = NULL;
2235     return s;
2236 }
2237
2238 /**/
2239 mod_export zlong
2240 getintvalue(Value v)
2241 {
2242     if (!v)
2243         return 0;
2244     if (v->flags & VALFLAG_INV)
2245         return v->start;
2246     if (v->isarr) {
2247         char **arr = getarrvalue(v);
2248         if (arr) {
2249             char *scal = sepjoin(arr, NULL, 1);
2250             return mathevali(scal);
2251         } else
2252             return 0;
2253     }
2254     if (PM_TYPE(v->pm->node.flags) == PM_INTEGER)
2255         return v->pm->gsu.i->getfn(v->pm);
2256     if (v->pm->node.flags & (PM_EFLOAT|PM_FFLOAT))
2257         return (zlong)v->pm->gsu.f->getfn(v->pm);
2258     return mathevali(getstrvalue(v));
2259 }
2260
2261 /**/
2262 mnumber
2263 getnumvalue(Value v)
2264 {
2265     mnumber mn;
2266     mn.type = MN_INTEGER;
2267
2268
2269     if (!v) {
2270         mn.u.l = 0;
2271     } else if (v->flags & VALFLAG_INV) {
2272         mn.u.l = v->start;
2273     } else if (v->isarr) {
2274         char **arr = getarrvalue(v);
2275         if (arr) {
2276             char *scal = sepjoin(arr, NULL, 1);
2277             return matheval(scal);
2278         } else
2279             mn.u.l = 0;
2280     } else if (PM_TYPE(v->pm->node.flags) == PM_INTEGER) {
2281         mn.u.l = v->pm->gsu.i->getfn(v->pm);
2282     } else if (v->pm->node.flags & (PM_EFLOAT|PM_FFLOAT)) {
2283         mn.type = MN_FLOAT;
2284         mn.u.d = v->pm->gsu.f->getfn(v->pm);
2285     } else
2286         return matheval(getstrvalue(v));
2287     return mn;
2288 }
2289
2290 /**/
2291 void
2292 export_param(Param pm)
2293 {
2294     char buf[BDIGBUFSIZE], *val;
2295
2296     if (PM_TYPE(pm->node.flags) & (PM_ARRAY|PM_HASHED)) {
2297 #if 0   /* Requires changes elsewhere in params.c and builtin.c */
2298         if (EMULATION(EMULATE_KSH) /* isset(KSHARRAYS) */) {
2299             struct value v;
2300             v.isarr = 1;
2301             v.flags = 0;
2302             v.start = 0;
2303             v.end = -1;
2304             val = getstrvalue(&v);
2305         } else
2306 #endif
2307             return;
2308     } else if (PM_TYPE(pm->node.flags) == PM_INTEGER)
2309         convbase(val = buf, pm->gsu.i->getfn(pm), pm->base);
2310     else if (pm->node.flags & (PM_EFLOAT|PM_FFLOAT))
2311         val = convfloat(pm->gsu.f->getfn(pm), pm->base,
2312                         pm->node.flags, NULL);
2313     else
2314         val = pm->gsu.s->getfn(pm);
2315
2316     addenv(pm, val);
2317 }
2318
2319 /**/
2320 mod_export void
2321 setstrvalue(Value v, char *val)
2322 {
2323     assignstrvalue(v, val, 0);
2324 }
2325
2326 /**/
2327 mod_export void
2328 assignstrvalue(Value v, char *val, int flags)
2329 {
2330     if (unset(EXECOPT))
2331         return;
2332     if (v->pm->node.flags & PM_READONLY) {
2333         zerr("read-only variable: %s", v->pm->node.nam);
2334         zsfree(val);
2335         return;
2336     }
2337     if ((v->pm->node.flags & PM_RESTRICTED) && isset(RESTRICTED)) {
2338         zerr("%s: restricted", v->pm->node.nam);
2339         zsfree(val);
2340         return;
2341     }
2342     if ((v->pm->node.flags & PM_HASHED) &&
2343         (v->isarr & (SCANPM_MATCHMANY|SCANPM_ARRONLY))) {
2344         zerr("%s: attempt to set slice of associative array", v->pm->node.nam);
2345         zsfree(val);
2346         return;
2347     }
2348     if (v->flags & VALFLAG_EMPTY) {
2349         zerr("%s: assignment to invalid subscript range", v->pm->node.nam);
2350         zsfree(val);
2351         return;
2352     }
2353     v->pm->node.flags &= ~PM_UNSET;
2354     switch (PM_TYPE(v->pm->node.flags)) {
2355     case PM_SCALAR:
2356         if (v->start == 0 && v->end == -1) {
2357             v->pm->gsu.s->setfn(v->pm, val);
2358             if ((v->pm->node.flags & (PM_LEFT | PM_RIGHT_B | PM_RIGHT_Z)) &&
2359                 !v->pm->width)
2360                 v->pm->width = strlen(val);
2361         } else {
2362             char *z, *x;
2363             int zlen;
2364
2365             z = dupstring(v->pm->gsu.s->getfn(v->pm));
2366             zlen = strlen(z);
2367             if ((v->flags & VALFLAG_INV) && unset(KSHARRAYS))
2368                 v->start--, v->end--;
2369             if (v->start < 0) {
2370                 v->start += zlen;
2371                 if (v->start < 0)
2372                     v->start = 0;
2373             }
2374             if (v->start > zlen)
2375                 v->start = zlen;
2376             if (v->end < 0) {
2377                 v->end += zlen;
2378                 if (v->end < 0) {
2379                     v->end = 0;
2380                 } else if (v->end >= zlen) {
2381                     v->end = zlen;
2382                 } else {
2383 #ifdef MULTIBYTE_SUPPORT
2384                     if (isset(MULTIBYTE)) {
2385                         v->end += MB_METACHARLEN(z + v->end);
2386                     } else {
2387                         v->end++;
2388                     }
2389 #else
2390                     v->end++;
2391 #endif
2392                 }
2393             }
2394             else if (v->end > zlen)
2395                 v->end = zlen;
2396             x = (char *) zalloc(v->start + strlen(val) + zlen - v->end + 1);
2397             strncpy(x, z, v->start);
2398             strcpy(x + v->start, val);
2399             strcat(x + v->start, z + v->end);
2400             v->pm->gsu.s->setfn(v->pm, x);
2401             zsfree(val);
2402         }
2403         break;
2404     case PM_INTEGER:
2405         if (val) {
2406             zlong ival;
2407             if (flags & ASSPM_ENV_IMPORT) {
2408                 char *ptr;
2409                 ival = zstrtol_underscore(val, &ptr, 0, 1);
2410             } else
2411                 ival = mathevali(val);
2412             v->pm->gsu.i->setfn(v->pm, ival);
2413             if ((v->pm->node.flags & (PM_LEFT | PM_RIGHT_B | PM_RIGHT_Z)) &&
2414                 !v->pm->width)
2415                 v->pm->width = strlen(val);
2416             zsfree(val);
2417         }
2418         if (!v->pm->base && lastbase != -1)
2419             v->pm->base = lastbase;
2420         break;
2421     case PM_EFLOAT:
2422     case PM_FFLOAT:
2423         if (val) {
2424             mnumber mn;
2425             if (flags & ASSPM_ENV_IMPORT) {
2426                 char *ptr;
2427                 mn.type = MN_FLOAT;
2428                 mn.u.d = strtod(val, &ptr);
2429             } else
2430                 mn = matheval(val);
2431             v->pm->gsu.f->setfn(v->pm, (mn.type & MN_FLOAT) ? mn.u.d :
2432                                (double)mn.u.l);
2433             if ((v->pm->node.flags & (PM_LEFT | PM_RIGHT_B | PM_RIGHT_Z)) &&
2434                 !v->pm->width)
2435                 v->pm->width = strlen(val);
2436             zsfree(val);
2437         }
2438         break;
2439     case PM_ARRAY:
2440         {
2441             char **ss = (char **) zalloc(2 * sizeof(char *));
2442
2443             ss[0] = val;
2444             ss[1] = NULL;
2445             setarrvalue(v, ss);
2446         }
2447         break;
2448     case PM_HASHED:
2449         {
2450             if (foundparam == NULL)
2451             {
2452                 zerr("%s: attempt to set associative array to scalar",
2453                      v->pm->node.nam);
2454                 zsfree(val);
2455                 return;
2456             }
2457             else
2458                 foundparam->gsu.s->setfn(foundparam, val);
2459         }
2460         break;
2461     }
2462     if ((!v->pm->env && !(v->pm->node.flags & PM_EXPORTED) &&
2463          !(isset(ALLEXPORT) && !(v->pm->node.flags & PM_HASHELEM))) ||
2464         (v->pm->node.flags & PM_ARRAY) || v->pm->ename)
2465         return;
2466     export_param(v->pm);
2467 }
2468
2469 /**/
2470 void
2471 setnumvalue(Value v, mnumber val)
2472 {
2473     char buf[BDIGBUFSIZE], *p;
2474
2475     if (unset(EXECOPT))
2476         return;
2477     if (v->pm->node.flags & PM_READONLY) {
2478         zerr("read-only variable: %s", v->pm->node.nam);
2479         return;
2480     }
2481     if ((v->pm->node.flags & PM_RESTRICTED) && isset(RESTRICTED)) {
2482         zerr("%s: restricted", v->pm->node.nam);
2483         return;
2484     }
2485     switch (PM_TYPE(v->pm->node.flags)) {
2486     case PM_SCALAR:
2487     case PM_ARRAY:
2488         if ((val.type & MN_INTEGER) || outputradix) {
2489             if (!(val.type & MN_INTEGER))
2490                 val.u.l = (zlong) val.u.d;
2491             p = convbase_underscore(buf, val.u.l, outputradix,
2492                                     outputunderscore);
2493         } else
2494             p = convfloat_underscore(val.u.d, outputunderscore);
2495         setstrvalue(v, ztrdup(p));
2496         break;
2497     case PM_INTEGER:
2498         v->pm->gsu.i->setfn(v->pm, (val.type & MN_INTEGER) ? val.u.l :
2499                             (zlong) val.u.d);
2500         setstrvalue(v, NULL);
2501         break;
2502     case PM_EFLOAT:
2503     case PM_FFLOAT:
2504         v->pm->gsu.f->setfn(v->pm, (val.type & MN_INTEGER) ?
2505                             (double)val.u.l : val.u.d);
2506         setstrvalue(v, NULL);
2507         break;
2508     }
2509 }
2510
2511 /**/
2512 mod_export void
2513 setarrvalue(Value v, char **val)
2514 {
2515     if (unset(EXECOPT))
2516         return;
2517     if (v->pm->node.flags & PM_READONLY) {
2518         zerr("read-only variable: %s", v->pm->node.nam);
2519         freearray(val);
2520         return;
2521     }
2522     if ((v->pm->node.flags & PM_RESTRICTED) && isset(RESTRICTED)) {
2523         zerr("%s: restricted", v->pm->node.nam);
2524         freearray(val);
2525         return;
2526     }
2527     if (!(PM_TYPE(v->pm->node.flags) & (PM_ARRAY|PM_HASHED))) {
2528         freearray(val);
2529         zerr("%s: attempt to assign array value to non-array",
2530              v->pm->node.nam);
2531         return;
2532     }
2533     if (v->flags & VALFLAG_EMPTY) {
2534         zerr("%s: assignment to invalid subscript range", v->pm->node.nam);
2535         freearray(val);
2536         return;
2537     }
2538     if (v->start == 0 && v->end == -1) {
2539         if (PM_TYPE(v->pm->node.flags) == PM_HASHED)
2540             arrhashsetfn(v->pm, val, 0);
2541         else
2542             v->pm->gsu.a->setfn(v->pm, val);
2543     } else if (v->start == -1 && v->end == 0 &&
2544             PM_TYPE(v->pm->node.flags) == PM_HASHED) {
2545         arrhashsetfn(v->pm, val, 1);
2546     } else {
2547         char **old, **new, **p, **q, **r;
2548         int n, ll, i;
2549
2550         if ((PM_TYPE(v->pm->node.flags) == PM_HASHED)) {
2551             freearray(val);
2552             zerr("%s: attempt to set slice of associative array",
2553                  v->pm->node.nam);
2554             return;
2555         }
2556         if ((v->flags & VALFLAG_INV) && unset(KSHARRAYS)) {
2557             if (v->start > 0)
2558                 v->start--;
2559             v->end--;
2560         }
2561         q = old = v->pm->gsu.a->getfn(v->pm);
2562         n = arrlen(old);
2563         if (v->start < 0) {
2564             v->start += n;
2565             if (v->start < 0)
2566                 v->start = 0;
2567         }
2568         if (v->end < 0) {
2569             v->end += n + 1;
2570             if (v->end < 0)
2571                 v->end = 0;
2572         }
2573         if (v->end < v->start)
2574             v->end = v->start;
2575
2576         ll = v->start + arrlen(val);
2577         if (v->end <= n)
2578             ll += n - v->end + 1;
2579
2580         p = new = (char **) zshcalloc(sizeof(char *) * (ll + 1));
2581
2582         for (i = 0; i < v->start; i++)
2583             *p++ = i < n ? ztrdup(*q++) : ztrdup("");
2584         for (r = val; *r;)
2585             *p++ = ztrdup(*r++);
2586         if (v->end < n)
2587             for (q = old + v->end; *q;)
2588                 *p++ = ztrdup(*q++);
2589         *p = NULL;
2590
2591         v->pm->gsu.a->setfn(v->pm, new);
2592         freearray(val);
2593     }
2594 }
2595
2596 /* Retrieve an integer parameter */
2597
2598 /**/
2599 mod_export zlong
2600 getiparam(char *s)
2601 {
2602     struct value vbuf;
2603     Value v;
2604
2605     if (!(v = getvalue(&vbuf, &s, 1)))
2606         return 0;
2607     return getintvalue(v);
2608 }
2609
2610 /* Retrieve a numerical parameter, either integer or floating */
2611
2612 /**/
2613 mnumber
2614 getnparam(char *s)
2615 {
2616     struct value vbuf;
2617     Value v;
2618
2619     if (!(v = getvalue(&vbuf, &s, 1))) {
2620         mnumber mn;
2621         mn.type = MN_INTEGER;
2622         mn.u.l = 0;
2623         return mn;
2624     }
2625     return getnumvalue(v);
2626 }
2627
2628 /* Retrieve a scalar (string) parameter */
2629
2630 /**/
2631 mod_export char *
2632 getsparam(char *s)
2633 {
2634     struct value vbuf;
2635     Value v;
2636
2637     if (!(v = getvalue(&vbuf, &s, 0)))
2638         return NULL;
2639     return getstrvalue(v);
2640 }
2641
2642 /* Retrieve an array parameter */
2643
2644 /**/
2645 mod_export char **
2646 getaparam(char *s)
2647 {
2648     struct value vbuf;
2649     Value v;
2650
2651     if (!idigit(*s) && (v = getvalue(&vbuf, &s, 0)) &&
2652         PM_TYPE(v->pm->node.flags) == PM_ARRAY)
2653         return v->pm->gsu.a->getfn(v->pm);
2654     return NULL;
2655 }
2656
2657 /* Retrieve an assoc array parameter as an array */
2658
2659 /**/
2660 mod_export char **
2661 gethparam(char *s)
2662 {
2663     struct value vbuf;
2664     Value v;
2665
2666     if (!idigit(*s) && (v = getvalue(&vbuf, &s, 0)) &&
2667         PM_TYPE(v->pm->node.flags) == PM_HASHED)
2668         return paramvalarr(v->pm->gsu.h->getfn(v->pm), SCANPM_WANTVALS);
2669     return NULL;
2670 }
2671
2672 /* Retrieve the keys of an assoc array parameter as an array */
2673
2674 /**/
2675 mod_export char **
2676 gethkparam(char *s)
2677 {
2678     struct value vbuf;
2679     Value v;
2680
2681     if (!idigit(*s) && (v = getvalue(&vbuf, &s, 0)) &&
2682         PM_TYPE(v->pm->node.flags) == PM_HASHED)
2683         return paramvalarr(v->pm->gsu.h->getfn(v->pm), SCANPM_WANTKEYS);
2684     return NULL;
2685 }
2686
2687 /**/
2688 mod_export Param
2689 assignsparam(char *s, char *val, int flags)
2690 {
2691     struct value vbuf;
2692     Value v;
2693     char *t = s;
2694     char *ss, *copy, *var;
2695     size_t lvar;
2696     mnumber lhs, rhs;
2697     int sstart;
2698
2699     if (!isident(s)) {
2700         zerr("not an identifier: %s", s);
2701         zsfree(val);
2702         errflag |= ERRFLAG_ERROR;
2703         return NULL;
2704     }
2705     queue_signals();
2706     if ((ss = strchr(s, '['))) {
2707         *ss = '\0';
2708         if (!(v = getvalue(&vbuf, &s, 1)))
2709             createparam(t, PM_ARRAY);
2710         else {
2711             if (v->pm->node.flags & PM_READONLY) {
2712                 zerr("read-only variable: %s", v->pm->node.nam);
2713                 *ss = '[';
2714                 zsfree(val);
2715                 return NULL;
2716             }
2717             flags &= ~ASSPM_WARN_CREATE;
2718         }
2719         *ss = '[';
2720         v = NULL;
2721     } else {
2722         if (!(v = getvalue(&vbuf, &s, 1)))
2723             createparam(t, PM_SCALAR);
2724         else if ((((v->pm->node.flags & PM_ARRAY) && !(flags & ASSPM_AUGMENT)) ||
2725                  (v->pm->node.flags & PM_HASHED)) &&
2726                  !(v->pm->node.flags & (PM_SPECIAL|PM_TIED)) &&
2727                  unset(KSHARRAYS)) {
2728             unsetparam(t);
2729             createparam(t, PM_SCALAR);
2730             v = NULL;
2731         }
2732         else
2733             flags &= ~ASSPM_WARN_CREATE;
2734     }
2735     if (!v && !(v = getvalue(&vbuf, &t, 1))) {
2736         unqueue_signals();
2737         zsfree(val);
2738         return NULL;
2739     }
2740     if ((flags & ASSPM_WARN_CREATE) && v->pm->level == 0)
2741         zwarn("scalar parameter %s created globally in function",
2742               v->pm->node.nam);
2743     if (flags & ASSPM_AUGMENT) {
2744         if (v->start == 0 && v->end == -1) {
2745             switch (PM_TYPE(v->pm->node.flags)) {
2746             case PM_SCALAR:
2747                 v->start = INT_MAX;  /* just append to scalar value */
2748                 break;
2749             case PM_INTEGER:
2750             case PM_EFLOAT:
2751             case PM_FFLOAT:
2752                 rhs = matheval(val);
2753                 lhs = getnumvalue(v);
2754                 if (lhs.type == MN_FLOAT) {
2755                     if ((rhs.type) == MN_FLOAT)
2756                         lhs.u.d = lhs.u.d + rhs.u.d;
2757                     else
2758                         lhs.u.d = lhs.u.d + (double)rhs.u.l;
2759                 } else {
2760                     if ((rhs.type) == MN_INTEGER)
2761                         lhs.u.l = lhs.u.l + rhs.u.l;
2762                     else
2763                         lhs.u.l = lhs.u.l + (zlong)rhs.u.d;
2764                 }
2765                 setnumvalue(v, lhs);
2766                 unqueue_signals();
2767                 zsfree(val);
2768                 return v->pm; /* avoid later setstrvalue() call */
2769             case PM_ARRAY:
2770                 if (unset(KSHARRAYS)) {
2771                     v->start = arrlen(v->pm->gsu.a->getfn(v->pm));
2772                     v->end = v->start + 1;
2773                 } else {
2774                     /* ksh appends scalar to first element */
2775                     v->end = 1;
2776                     goto kshappend;
2777                 }
2778                 break;
2779             }
2780         } else {
2781             switch (PM_TYPE(v->pm->node.flags)) {
2782             case PM_SCALAR:
2783                 if (v->end > 0)
2784                     v->start = v->end;
2785                 else
2786                     v->start = v->end = strlen(v->pm->gsu.s->getfn(v->pm)) +
2787                         v->end + 1;
2788                 break;
2789             case PM_INTEGER:
2790             case PM_EFLOAT:
2791             case PM_FFLOAT:
2792                 unqueue_signals();
2793                 zerr("attempt to add to slice of a numeric variable");
2794                 zsfree(val);
2795                 return NULL;
2796             case PM_ARRAY:
2797               kshappend:
2798                 /* treat slice as the end element */
2799                 v->start = sstart = v->end > 0 ? v->end - 1 : v->end;
2800                 v->isarr = 0;
2801                 var = getstrvalue(v);
2802                 v->start = sstart;
2803                 copy = val;
2804                 lvar = strlen(var);
2805                 val = (char *)zalloc(lvar + strlen(val) + 1);
2806                 strcpy(val, var);
2807                 strcpy(val + lvar, copy);
2808                 zsfree(copy);
2809                 break;
2810             }
2811         }
2812     }
2813
2814     assignstrvalue(v, val, flags);
2815     unqueue_signals();
2816     return v->pm;
2817 }
2818
2819 /**/
2820 mod_export Param
2821 assignaparam(char *s, char **val, int flags)
2822 {
2823     struct value vbuf;
2824     Value v;
2825     char *t = s;
2826     char *ss;
2827
2828     if (!isident(s)) {
2829         zerr("not an identifier: %s", s);
2830         freearray(val);
2831         errflag |= ERRFLAG_ERROR;
2832         return NULL;
2833     }
2834     queue_signals();
2835     if ((ss = strchr(s, '['))) {
2836         *ss = '\0';
2837         if (!(v = getvalue(&vbuf, &s, 1)))
2838             createparam(t, PM_ARRAY);
2839         else
2840             flags &= ~ASSPM_WARN_CREATE;
2841         *ss = '[';
2842         if (v && PM_TYPE(v->pm->node.flags) == PM_HASHED) {
2843             unqueue_signals();
2844             zerr("%s: attempt to set slice of associative array",
2845                  v->pm->node.nam);
2846             freearray(val);
2847             errflag |= ERRFLAG_ERROR;
2848             return NULL;
2849         }
2850         v = NULL;
2851     } else {
2852         if (!(v = fetchvalue(&vbuf, &s, 1, SCANPM_ASSIGNING)))
2853             createparam(t, PM_ARRAY);
2854         else if (!(PM_TYPE(v->pm->node.flags) & (PM_ARRAY|PM_HASHED)) &&
2855                  !(v->pm->node.flags & (PM_SPECIAL|PM_TIED))) {
2856             int uniq = v->pm->node.flags & PM_UNIQUE;
2857             if (flags & ASSPM_AUGMENT) {
2858                 /* insert old value at the beginning of the val array */
2859                 char **new;
2860                 int lv = arrlen(val);
2861
2862                 new = (char **) zalloc(sizeof(char *) * (lv + 2));
2863                 *new = ztrdup(getstrvalue(v));
2864                 memcpy(new+1, val, sizeof(char *) * (lv + 1));
2865                 free(val);
2866                 val = new;
2867             }
2868             unsetparam(t);
2869             createparam(t, PM_ARRAY | uniq);
2870             v = NULL;
2871         }
2872         else
2873             flags &= ~ASSPM_WARN_CREATE;
2874     }
2875     if (!v)
2876         if (!(v = fetchvalue(&vbuf, &t, 1, SCANPM_ASSIGNING))) {
2877             unqueue_signals();
2878             freearray(val);
2879             return NULL;
2880         }
2881
2882     if ((flags & ASSPM_WARN_CREATE) && v->pm->level == 0)
2883         zwarn("array parameter %s created globally in function",
2884               v->pm->node.nam);
2885     if (flags & ASSPM_AUGMENT) {
2886         if (v->start == 0 && v->end == -1) {
2887             if (PM_TYPE(v->pm->node.flags) & PM_ARRAY) {
2888                 v->start = arrlen(v->pm->gsu.a->getfn(v->pm));
2889                 v->end = v->start + 1;
2890             } else if (PM_TYPE(v->pm->node.flags) & PM_HASHED)
2891                 v->start = -1, v->end = 0;
2892         } else {
2893             if (v->end > 0)
2894                 v->start = v->end--;
2895             else if (PM_TYPE(v->pm->node.flags) & PM_ARRAY) {
2896                 v->end = arrlen(v->pm->gsu.a->getfn(v->pm)) + v->end;
2897                 v->start = v->end + 1;
2898             }
2899         }
2900     }
2901
2902     setarrvalue(v, val);
2903     unqueue_signals();
2904     return v->pm;
2905 }
2906
2907 /**/
2908 mod_export Param
2909 sethparam(char *s, char **val)
2910 {
2911     struct value vbuf;
2912     Value v;
2913     char *t = s;
2914
2915     if (!isident(s)) {
2916         zerr("not an identifier: %s", s);
2917         freearray(val);
2918         errflag |= ERRFLAG_ERROR;
2919         return NULL;
2920     }
2921     if (strchr(s, '[')) {
2922         freearray(val);
2923         zerr("nested associative arrays not yet supported");
2924         errflag |= ERRFLAG_ERROR;
2925         return NULL;
2926     }
2927     if (unset(EXECOPT))
2928         return NULL;
2929     queue_signals();
2930     if (!(v = fetchvalue(&vbuf, &s, 1, SCANPM_ASSIGNING)))
2931         createparam(t, PM_HASHED);
2932     else if (!(PM_TYPE(v->pm->node.flags) & PM_HASHED) &&
2933              !(v->pm->node.flags & PM_SPECIAL)) {
2934         unsetparam(t);
2935         createparam(t, PM_HASHED);
2936         v = NULL;
2937     }
2938     if (!v)
2939         if (!(v = fetchvalue(&vbuf, &t, 1, SCANPM_ASSIGNING))) {
2940             unqueue_signals();
2941             return NULL;
2942         }
2943     setarrvalue(v, val);
2944     unqueue_signals();
2945     return v->pm;
2946 }
2947
2948
2949 /*
2950  * Set a generic shell number, floating point or integer.
2951  */
2952
2953 /**/
2954 Param
2955 setnparam(char *s, mnumber val)
2956 {
2957     struct value vbuf;
2958     Value v;
2959     char *t = s, *ss;
2960     Param pm;
2961
2962     if (!isident(s)) {
2963         zerr("not an identifier: %s", s);
2964         errflag |= ERRFLAG_ERROR;
2965         return NULL;
2966     }
2967     if (unset(EXECOPT))
2968         return NULL;
2969     queue_signals();
2970     ss = strchr(s, '[');
2971     v = getvalue(&vbuf, &s, 1);
2972     if (v && (v->pm->node.flags & (PM_ARRAY|PM_HASHED)) &&
2973         !(v->pm->node.flags & (PM_SPECIAL|PM_TIED)) &&
2974         /*
2975          * not sure what KSHARRAYS has got to do with this...
2976          * copied this from assignsparam().
2977          */
2978         unset(KSHARRAYS) && !ss) {
2979         unsetparam_pm(v->pm, 0, 1);
2980         s = t;
2981         v = NULL;
2982     }
2983     if (!v) {
2984         /* s has been updated by getvalue, so check again */
2985         ss = strchr(s, '[');
2986         if (ss)
2987             *ss = '\0';
2988         pm = createparam(t, ss ? PM_ARRAY :
2989                          (val.type & MN_INTEGER) ? PM_INTEGER : PM_FFLOAT);
2990         if (!pm)
2991             pm = (Param) paramtab->getnode(paramtab, t);
2992         DPUTS(!pm, "BUG: parameter not created");
2993         if (ss) {
2994             *ss = '[';
2995         } else if (val.type & MN_INTEGER) {
2996             pm->base = outputradix;
2997         }
2998         v = getvalue(&vbuf, &t, 1);
2999         DPUTS(!v, "BUG: value not found for new parameter");
3000     }
3001     setnumvalue(v, val);
3002     unqueue_signals();
3003     return v->pm;
3004 }
3005
3006 /* Simplified interface to setnparam */
3007
3008 /**/
3009 mod_export Param
3010 setiparam(char *s, zlong val)
3011 {
3012     mnumber mnval;
3013     mnval.type = MN_INTEGER;
3014     mnval.u.l = val;
3015     return setnparam(s, mnval);
3016 }
3017
3018
3019 /* Unset a parameter */
3020
3021 /**/
3022 mod_export void
3023 unsetparam(char *s)
3024 {
3025     Param pm;
3026
3027     queue_signals();
3028     if ((pm = (Param) (paramtab == realparamtab ?
3029                        gethashnode2(paramtab, s) :
3030                        paramtab->getnode(paramtab, s))))
3031         unsetparam_pm(pm, 0, 1);
3032     unqueue_signals();
3033 }
3034
3035 /* Unset a parameter */
3036
3037 /**/
3038 mod_export int
3039 unsetparam_pm(Param pm, int altflag, int exp)
3040 {
3041     Param oldpm, altpm;
3042     char *altremove;
3043
3044     if ((pm->node.flags & PM_READONLY) && pm->level <= locallevel) {
3045         zerr("read-only variable: %s", pm->node.nam);
3046         return 1;
3047     }
3048     if ((pm->node.flags & PM_RESTRICTED) && isset(RESTRICTED)) {
3049         zerr("%s: restricted", pm->node.nam);
3050         return 1;
3051     }
3052
3053     if (pm->ename && !altflag)
3054         altremove = ztrdup(pm->ename);
3055     else
3056         altremove = NULL;
3057
3058     if (!(pm->node.flags & PM_UNSET))
3059         pm->gsu.s->unsetfn(pm, exp);
3060     if (pm->env)
3061         delenv(pm);
3062
3063     /* remove it under its alternate name if necessary */
3064     if (altremove) {
3065         altpm = (Param) paramtab->getnode(paramtab, altremove);
3066         /* tied parameters are at the same local level as each other */
3067         oldpm = NULL;
3068         while (altpm && altpm->level > pm->level) {
3069             /* param under alternate name hidden by a local */
3070             oldpm = altpm;
3071             altpm = altpm->old;
3072         }
3073         if (altpm) {
3074             if (oldpm && !altpm->level) {
3075                 oldpm->old = NULL;
3076                 /* fudge things so removenode isn't called */
3077                 altpm->level = 1;
3078             }
3079             unsetparam_pm(altpm, 1, exp);
3080         }
3081
3082         zsfree(altremove);
3083     }
3084
3085     /*
3086      * If this was a local variable, we need to keep the old
3087      * struct so that it is resurrected at the right level.
3088      * This is partly because when an array/scalar value is set
3089      * and the parameter used to be the other sort, unsetparam()
3090      * is called.  Beyond that, there is an ambiguity:  should
3091      * foo() { local bar; unset bar; } make the global bar
3092      * available or not?  The following makes the answer "no".
3093      *
3094      * Some specials, such as those used in zle, still need removing
3095      * from the parameter table; they have the PM_REMOVABLE flag.
3096      */
3097     if ((pm->level && locallevel >= pm->level) ||
3098         (pm->node.flags & (PM_SPECIAL|PM_REMOVABLE)) == PM_SPECIAL)
3099         return 0;
3100
3101     /* remove parameter node from table */
3102     paramtab->removenode(paramtab, pm->node.nam);
3103
3104     if (pm->old) {
3105         oldpm = pm->old;
3106         paramtab->addnode(paramtab, oldpm->node.nam, oldpm);
3107         if ((PM_TYPE(oldpm->node.flags) == PM_SCALAR) &&
3108             !(pm->node.flags & PM_HASHELEM) &&
3109             (oldpm->node.flags & PM_NAMEDDIR) &&
3110             oldpm->gsu.s == &stdscalar_gsu)
3111             adduserdir(oldpm->node.nam, oldpm->u.str, 0, 0);
3112         if (oldpm->node.flags & PM_EXPORTED) {
3113             /*
3114              * Re-export the old value which we removed in typeset_single().
3115              * I don't think we need to test for ALL_EXPORT here, since if
3116              * it was used to export the parameter originally the parameter
3117              * should still have the PM_EXPORTED flag.
3118              */
3119             export_param(oldpm);
3120         }
3121     }
3122
3123     paramtab->freenode(&pm->node); /* free parameter node */
3124
3125     return 0;
3126 }
3127
3128 /* Standard function to unset a parameter.  This is mostly delegated to *
3129  * the specific set function.
3130  *
3131  * This could usefully be made type-specific, but then we need
3132  * to be more careful when calling the unset method directly.
3133  */
3134
3135 /**/
3136 mod_export void
3137 stdunsetfn(Param pm, UNUSED(int exp))
3138 {
3139     switch (PM_TYPE(pm->node.flags)) {
3140         case PM_SCALAR:
3141             if (pm->gsu.s->setfn)
3142                 pm->gsu.s->setfn(pm, NULL);
3143             break;
3144
3145         case PM_ARRAY:
3146             if (pm->gsu.a->setfn)
3147                 pm->gsu.a->setfn(pm, NULL);
3148             break;
3149
3150         case PM_HASHED:
3151             if (pm->gsu.h->setfn)
3152                 pm->gsu.h->setfn(pm, NULL);
3153             break;
3154
3155         default:
3156             if (!(pm->node.flags & PM_SPECIAL))
3157                 pm->u.str = NULL;
3158             break;
3159     }
3160     if ((pm->node.flags & (PM_SPECIAL|PM_TIED)) == PM_TIED) {
3161         if (pm->ename) {
3162             zsfree(pm->ename);
3163             pm->ename = NULL;
3164         }
3165         pm->node.flags &= ~PM_TIED;
3166     }
3167     pm->node.flags |= PM_UNSET;
3168 }
3169
3170 /* Function to get value of an integer parameter */
3171
3172 /**/
3173 mod_export zlong
3174 intgetfn(Param pm)
3175 {
3176     return pm->u.val;
3177 }
3178
3179 /* Function to set value of an integer parameter */
3180
3181 /**/
3182 static void
3183 intsetfn(Param pm, zlong x)
3184 {
3185     pm->u.val = x;
3186 }
3187
3188 /* Function to get value of a floating point parameter */
3189
3190 /**/
3191 static double
3192 floatgetfn(Param pm)
3193 {
3194     return pm->u.dval;
3195 }
3196
3197 /* Function to set value of an integer parameter */
3198
3199 /**/
3200 static void
3201 floatsetfn(Param pm, double x)
3202 {
3203     pm->u.dval = x;
3204 }
3205
3206 /* Function to get value of a scalar (string) parameter */
3207
3208 /**/
3209 mod_export char *
3210 strgetfn(Param pm)
3211 {
3212     return pm->u.str ? pm->u.str : (char *) hcalloc(1);
3213 }
3214
3215 /* Function to set value of a scalar (string) parameter */
3216
3217 /**/
3218 mod_export void
3219 strsetfn(Param pm, char *x)
3220 {
3221     zsfree(pm->u.str);
3222     pm->u.str = x;
3223     if (!(pm->node.flags & PM_HASHELEM) &&
3224         ((pm->node.flags & PM_NAMEDDIR) || isset(AUTONAMEDIRS))) {
3225         pm->node.flags |= PM_NAMEDDIR;
3226         adduserdir(pm->node.nam, x, 0, 0);
3227     }
3228 }
3229
3230 /* Function to get value of an array parameter */
3231
3232 static char *nullarray = NULL;
3233
3234 /**/
3235 char **
3236 arrgetfn(Param pm)
3237 {
3238     return pm->u.arr ? pm->u.arr : &nullarray;
3239 }
3240
3241 /* Function to set value of an array parameter */
3242
3243 /**/
3244 mod_export void
3245 arrsetfn(Param pm, char **x)
3246 {
3247     if (pm->u.arr && pm->u.arr != x)
3248         freearray(pm->u.arr);
3249     if (pm->node.flags & PM_UNIQUE)
3250         uniqarray(x);
3251     pm->u.arr = x;
3252     /* Arrays tied to colon-arrays may need to fix the environment */
3253     if (pm->ename && x)
3254         arrfixenv(pm->ename, x);
3255 }
3256
3257 /* Function to get value of an association parameter */
3258
3259 /**/
3260 mod_export HashTable
3261 hashgetfn(Param pm)
3262 {
3263     return pm->u.hash;
3264 }
3265
3266 /* Function to set value of an association parameter */
3267
3268 /**/
3269 mod_export void
3270 hashsetfn(Param pm, HashTable x)
3271 {
3272     if (pm->u.hash && pm->u.hash != x)
3273         deleteparamtable(pm->u.hash);
3274     pm->u.hash = x;
3275 }
3276
3277 /* Function to dispose of setting of an unsettable hash */
3278
3279 /**/
3280 mod_export void
3281 nullsethashfn(UNUSED(Param pm), HashTable x)
3282 {
3283     deleteparamtable(x);
3284 }
3285
3286 /* Function to set value of an association parameter using key/value pairs */
3287
3288 /**/
3289 mod_export void
3290 arrhashsetfn(Param pm, char **val, int augment)
3291 {
3292     /* Best not to shortcut this by using the existing hash table,   *
3293      * since that could cause trouble for special hashes.  This way, *
3294      * it's up to pm->gsu.h->setfn() what to do.                     */
3295     int alen = arrlen(val);
3296     HashTable opmtab = paramtab, ht = 0;
3297     char **aptr = val;
3298     Value v = (Value) hcalloc(sizeof *v);
3299     v->end = -1;
3300
3301     if (alen % 2) {
3302         freearray(val);
3303         zerr("bad set of key/value pairs for associative array");
3304         return;
3305     }
3306     if (alen)
3307         if (!(augment && (ht = paramtab = pm->gsu.h->getfn(pm))))
3308             ht = paramtab = newparamtable(17, pm->node.nam);
3309     while (*aptr) {
3310         /* The parameter name is ztrdup'd... */
3311         v->pm = createparam(*aptr, PM_SCALAR|PM_UNSET);
3312         /*
3313          * createparam() doesn't return anything if the parameter
3314          * already existed.
3315          */
3316         if (!v->pm)
3317             v->pm = (Param) paramtab->getnode(paramtab, *aptr);
3318         zsfree(*aptr++);
3319         /* ...but we can use the value without copying. */
3320         setstrvalue(v, *aptr++);
3321     }
3322     paramtab = opmtab;
3323     pm->gsu.h->setfn(pm, ht);
3324     free(val);          /* not freearray() */
3325 }
3326
3327 /*
3328  * These functions are used as the set function for special parameters that
3329  * cannot be set by the user.  The set is incomplete as the only such
3330  * parameters are scalar and integer.
3331  */
3332
3333 /**/
3334 mod_export void
3335 nullstrsetfn(UNUSED(Param pm), char *x)
3336 {
3337     zsfree(x);
3338 }
3339
3340 /**/
3341 mod_export void
3342 nullintsetfn(UNUSED(Param pm), UNUSED(zlong x))
3343 {}
3344
3345 /**/
3346 mod_export void
3347 nullunsetfn(UNUSED(Param pm), UNUSED(int exp))
3348 {}
3349
3350
3351 /* Function to get value of generic special integer *
3352  * parameter.  data is pointer to global variable   *
3353  * containing the integer value.                    */
3354
3355 /**/
3356 mod_export zlong
3357 intvargetfn(Param pm)
3358 {
3359     return *pm->u.valptr;
3360 }
3361
3362 /* Function to set value of generic special integer *
3363  * parameter.  data is pointer to global variable   *
3364  * where the value is to be stored.                 */
3365
3366 /**/
3367 mod_export void
3368 intvarsetfn(Param pm, zlong x)
3369 {
3370     *pm->u.valptr = x;
3371 }
3372
3373 /* Function to set value of any ZLE-related integer *
3374  * parameter.  data is pointer to global variable   *
3375  * where the value is to be stored.                 */
3376
3377 /**/
3378 void
3379 zlevarsetfn(Param pm, zlong x)
3380 {
3381     zlong *p = pm->u.valptr;
3382
3383     *p = x;
3384     if (p == &zterm_lines || p == &zterm_columns)
3385         adjustwinsize(2 + (p == &zterm_columns));
3386 }
3387
3388 /* Function to set value of generic special scalar    *
3389  * parameter.  data is pointer to a character pointer *
3390  * representing the scalar (string).                  */
3391
3392 /**/
3393 mod_export void
3394 strvarsetfn(Param pm, char *x)
3395 {
3396     char **q = ((char **)pm->u.data);
3397
3398     zsfree(*q);
3399     *q = x;
3400 }
3401
3402 /* Function to get value of generic special scalar    *
3403  * parameter.  data is pointer to a character pointer *
3404  * representing the scalar (string).                  */
3405
3406 /**/
3407 mod_export char *
3408 strvargetfn(Param pm)
3409 {
3410     char *s = *((char **)pm->u.data);
3411
3412     if (!s)
3413         return hcalloc(1);
3414     return s;
3415 }
3416
3417 /* Function to get value of generic special array  *
3418  * parameter.  data is a pointer to the pointer to *
3419  * a pointer (a pointer to a variable length array *
3420  * of pointers).                                   */
3421
3422 /**/
3423 mod_export char **
3424 arrvargetfn(Param pm)
3425 {
3426     char **arrptr = *((char ***)pm->u.data);
3427
3428     return arrptr ? arrptr : &nullarray;
3429 }
3430
3431 /* Function to set value of generic special array parameter.    *
3432  * data is pointer to a variable length array of pointers which *
3433  * represents this array of scalars (strings).  If pm->ename is *
3434  * non NULL, then it is a colon separated environment variable  *
3435  * version of this array which will need to be updated.         */
3436
3437 /**/
3438 mod_export void
3439 arrvarsetfn(Param pm, char **x)
3440 {
3441     char ***dptr = (char ***)pm->u.data;
3442
3443     if (*dptr != x)
3444         freearray(*dptr);
3445     if (pm->node.flags & PM_UNIQUE)
3446         uniqarray(x);
3447     /*
3448      * Special tied arrays point to variables accessible in other
3449      * ways which need to be set to NULL.  We can't do this
3450      * with user tied variables since we can leak memory.
3451      */
3452     if ((pm->node.flags & PM_SPECIAL) && !x)
3453         *dptr = mkarray(NULL);
3454     else
3455         *dptr = x;
3456     if (pm->ename) {
3457         if (x)
3458             arrfixenv(pm->ename, x);
3459         else if (*dptr == path)
3460             pathchecked = path;
3461     }
3462 }
3463
3464 /**/
3465 char *
3466 colonarrgetfn(Param pm)
3467 {
3468     char ***dptr = (char ***)pm->u.data;
3469     return *dptr ? zjoin(*dptr, ':', 1) : "";
3470 }
3471
3472 /**/
3473 void
3474 colonarrsetfn(Param pm, char *x)
3475 {
3476     char ***dptr = (char ***)pm->u.data;
3477     /*
3478      * We have to make sure this is never NULL, since that
3479      * can cause problems.
3480      */
3481     if (*dptr)
3482         freearray(*dptr);
3483     if (x)
3484         *dptr = colonsplit(x, pm->node.flags & PM_UNIQUE);
3485     else
3486         *dptr = mkarray(NULL);
3487     if (pm->ename)
3488         arrfixenv(pm->node.nam, *dptr);
3489     zsfree(x);
3490 }
3491
3492 /**/
3493 char *
3494 tiedarrgetfn(Param pm)
3495 {
3496     struct tieddata *dptr = (struct tieddata *)pm->u.data;
3497     return *dptr->arrptr ? zjoin(*dptr->arrptr, STOUC(dptr->joinchar), 1) : "";
3498 }
3499
3500 /**/
3501 void
3502 tiedarrsetfn(Param pm, char *x)
3503 {
3504     struct tieddata *dptr = (struct tieddata *)pm->u.data;
3505
3506     if (*dptr->arrptr)
3507         freearray(*dptr->arrptr);
3508     if (x) {
3509         char sepbuf[3];
3510         if (imeta(dptr->joinchar))
3511         {
3512             sepbuf[0] = Meta;
3513             sepbuf[1] = dptr->joinchar ^ 32;
3514             sepbuf[2] = '\0';
3515         }
3516         else
3517         {
3518             sepbuf[0] = dptr->joinchar;
3519             sepbuf[1] = '\0';
3520         }
3521         *dptr->arrptr = sepsplit(x, sepbuf, 0, 0);
3522         if (pm->node.flags & PM_UNIQUE)
3523             uniqarray(*dptr->arrptr);
3524         zsfree(x);
3525     } else
3526         *dptr->arrptr = NULL;
3527     if (pm->ename)
3528         arrfixenv(pm->node.nam, *dptr->arrptr);
3529 }
3530
3531 /**/
3532 void
3533 tiedarrunsetfn(Param pm, UNUSED(int exp))
3534 {
3535     /*
3536      * Special unset function because we allocated a struct tieddata
3537      * in typeset_single to hold the special data which we now
3538      * need to delete.
3539      */
3540     pm->gsu.s->setfn(pm, NULL);
3541     zfree(pm->u.data, sizeof(struct tieddata));
3542     /* paranoia -- shouldn't need these, but in case we reuse the struct... */
3543     pm->u.data = NULL;
3544     zsfree(pm->ename);
3545     pm->ename = NULL;
3546     pm->node.flags &= ~PM_TIED;
3547     pm->node.flags |= PM_UNSET;
3548 }
3549
3550 /**/
3551 static void
3552 simple_arrayuniq(char **x, int freeok)
3553 {
3554     char **t, **p = x;
3555     char *hole = "";
3556
3557     /* Find duplicates and replace them with holes */
3558     while (*++p)
3559         for (t = x; t < p; t++)
3560             if (*t != hole && !strcmp(*p, *t)) {
3561                 if (freeok)
3562                     zsfree(*p);
3563                 *p = hole;
3564                 break;
3565             }
3566     /* Swap non-holes into holes in optimal jumps */
3567     for (p = t = x; *t != NULL; t++) {
3568         if (*t == hole) {
3569             while (*p == hole)
3570                 ++p;
3571             if ((*t = *p) != NULL)
3572                 *p++ = hole;
3573         } else if (p == t)
3574             p++;
3575     }
3576     /* Erase all the remaining holes, just in case */
3577     while (++t < p)
3578         *t = NULL;
3579 }
3580
3581 /**/
3582 static void
3583 arrayuniq_freenode(HashNode hn)
3584 {
3585     (void)hn;
3586 }
3587
3588 /**/
3589 HashTable
3590 newuniqtable(zlong size)
3591 {
3592     HashTable ht = newhashtable((int)size, "arrayuniq", NULL);
3593     /* ??? error checking */
3594
3595     ht->hash        = hasher;
3596     ht->emptytable  = emptyhashtable;
3597     ht->filltable   = NULL;
3598     ht->cmpnodes    = strcmp;
3599     ht->addnode     = addhashnode;
3600     ht->getnode     = gethashnode2;
3601     ht->getnode2    = gethashnode2;
3602     ht->removenode  = removehashnode;
3603     ht->disablenode = disablehashnode;
3604     ht->enablenode  = enablehashnode;
3605     ht->freenode    = arrayuniq_freenode;
3606     ht->printnode   = NULL;
3607
3608     return ht;
3609 }
3610
3611 /**/
3612 static void
3613 arrayuniq(char **x, int freeok)
3614 {
3615     char **it, **write_it;
3616     zlong array_size = arrlen(x);
3617     HashTable ht;
3618
3619     if (array_size == 0)
3620         return;
3621     if (array_size < 10 || !(ht = newuniqtable(array_size + 1))) {
3622         /* fallback to simpler routine */
3623         simple_arrayuniq(x, freeok);
3624         return;
3625     }
3626
3627     for (it = x, write_it = x; *it;) {
3628         if (! gethashnode2(ht, *it)) {
3629             HashNode new_node = zhalloc(sizeof(struct hashnode));
3630             if (!new_node) {
3631                 /* Oops, out of heap memory, no way to recover */
3632                 zerr("out of memory in arrayuniq");
3633                 break;
3634             }
3635             (void) addhashnode2(ht, *it, new_node);
3636             *write_it = *it;
3637             if (it != write_it)
3638                 *it = NULL;
3639             ++write_it;
3640         }
3641         else {
3642             if (freeok)
3643                 zsfree(*it);
3644             *it = NULL;
3645         }
3646         ++it;
3647     }
3648
3649     deletehashtable(ht);
3650 }
3651
3652 /**/
3653 void
3654 uniqarray(char **x)
3655 {
3656     if (!x || !*x)
3657         return;
3658     arrayuniq(x, !zheapptr(*x));
3659 }
3660
3661 /**/
3662 void
3663 zhuniqarray(char **x)
3664 {
3665     if (!x || !*x)
3666         return;
3667     arrayuniq(x, 0);
3668 }
3669
3670 /* Function to get value of special parameter `#' and `ARGC' */
3671
3672 /**/
3673 zlong
3674 poundgetfn(UNUSED(Param pm))
3675 {
3676     return arrlen(pparams);
3677 }
3678
3679 /* Function to get value for special parameter `RANDOM' */
3680
3681 /**/
3682 zlong
3683 randomgetfn(UNUSED(Param pm))
3684 {
3685     return rand() & 0x7fff;
3686 }
3687
3688 /* Function to set value of special parameter `RANDOM' */
3689
3690 /**/
3691 void
3692 randomsetfn(UNUSED(Param pm), zlong v)
3693 {
3694     srand((unsigned int)v);
3695 }
3696
3697 /* Function to get value for special parameter `SECONDS' */
3698
3699 /**/
3700 zlong
3701 intsecondsgetfn(UNUSED(Param pm))
3702 {
3703     struct timeval now;
3704     struct timezone dummy_tz;
3705
3706     gettimeofday(&now, &dummy_tz);
3707
3708     return (zlong)(now.tv_sec - shtimer.tv_sec) +
3709         (zlong)(now.tv_usec - shtimer.tv_usec) / (zlong)1000000;
3710 }
3711
3712 /* Function to set value of special parameter `SECONDS' */
3713
3714 /**/
3715 void
3716 intsecondssetfn(UNUSED(Param pm), zlong x)
3717 {
3718     struct timeval now;
3719     struct timezone dummy_tz;
3720     zlong diff;
3721
3722     gettimeofday(&now, &dummy_tz);
3723     diff = (zlong)now.tv_sec - x;
3724     shtimer.tv_sec = diff;
3725     if ((zlong)shtimer.tv_sec != diff)
3726         zwarn("SECONDS truncated on assignment");
3727     shtimer.tv_usec = 0;
3728 }
3729
3730 /**/
3731 double
3732 floatsecondsgetfn(UNUSED(Param pm))
3733 {
3734     struct timeval now;
3735     struct timezone dummy_tz;
3736
3737     gettimeofday(&now, &dummy_tz);
3738
3739     return (double)(now.tv_sec - shtimer.tv_sec) +
3740         (double)(now.tv_usec - shtimer.tv_usec) / 1000000.0;
3741 }
3742
3743 /**/
3744 void
3745 floatsecondssetfn(UNUSED(Param pm), double x)
3746 {
3747     struct timeval now;
3748     struct timezone dummy_tz;
3749
3750     gettimeofday(&now, &dummy_tz);
3751     shtimer.tv_sec = now.tv_sec - (zlong)x;
3752     shtimer.tv_usec = now.tv_usec - (zlong)((x - (zlong)x) * 1000000.0);
3753 }
3754
3755 /**/
3756 double
3757 getrawseconds(void)
3758 {
3759     return (double)shtimer.tv_sec + (double)shtimer.tv_usec / 1000000.0;
3760 }
3761
3762 /**/
3763 void
3764 setrawseconds(double x)
3765 {
3766     shtimer.tv_sec = (zlong)x;
3767     shtimer.tv_usec = (zlong)((x - (zlong)x) * 1000000.0);
3768 }
3769
3770 /**/
3771 int
3772 setsecondstype(Param pm, int on, int off)
3773 {
3774     int newflags = (pm->node.flags | on) & ~off;
3775     int tp = PM_TYPE(newflags);
3776     /* Only one of the numeric types is allowed. */
3777     if (tp == PM_EFLOAT || tp == PM_FFLOAT)
3778     {
3779         pm->gsu.f = &floatseconds_gsu;
3780     }
3781     else if (tp == PM_INTEGER)
3782     {
3783         pm->gsu.i = &intseconds_gsu;
3784     }
3785     else
3786         return 1;
3787     pm->node.flags = newflags;
3788     return 0;
3789 }
3790
3791 /* Function to get value for special parameter `USERNAME' */
3792
3793 /**/
3794 char *
3795 usernamegetfn(UNUSED(Param pm))
3796 {
3797     return get_username();
3798 }
3799
3800 /* Function to set value of special parameter `USERNAME' */
3801
3802 /**/
3803 void
3804 usernamesetfn(UNUSED(Param pm), char *x)
3805 {
3806 #if defined(HAVE_SETUID) && defined(HAVE_GETPWNAM)
3807     struct passwd *pswd;
3808
3809     if (x && (pswd = getpwnam(x)) && (pswd->pw_uid != cached_uid)) {
3810 # ifdef USE_INITGROUPS
3811         initgroups(x, pswd->pw_gid);
3812 # endif
3813         if (setgid(pswd->pw_gid))
3814             zwarn("failed to change group ID: %e", errno);
3815         else if (setuid(pswd->pw_uid))
3816             zwarn("failed to change user ID: %e", errno);
3817         else {
3818             zsfree(cached_username);
3819             cached_username = ztrdup(pswd->pw_name);
3820             cached_uid = pswd->pw_uid;
3821         }
3822     }
3823 #endif /* HAVE_SETUID && HAVE_GETPWNAM */
3824     zsfree(x);
3825 }
3826
3827 /* Function to get value for special parameter `UID' */
3828
3829 /**/
3830 zlong
3831 uidgetfn(UNUSED(Param pm))
3832 {
3833     return getuid();
3834 }
3835
3836 /* Function to set value of special parameter `UID' */
3837
3838 /**/
3839 void
3840 uidsetfn(UNUSED(Param pm), zlong x)
3841 {
3842 #ifdef HAVE_SETUID
3843     if (setuid((uid_t)x))
3844         zwarn("failed to change user ID: %e", errno);
3845 #endif
3846 }
3847
3848 /* Function to get value for special parameter `EUID' */
3849
3850 /**/
3851 zlong
3852 euidgetfn(UNUSED(Param pm))
3853 {
3854     return geteuid();
3855 }
3856
3857 /* Function to set value of special parameter `EUID' */
3858
3859 /**/
3860 void
3861 euidsetfn(UNUSED(Param pm), zlong x)
3862 {
3863 #ifdef HAVE_SETEUID
3864     if (seteuid((uid_t)x))
3865         zwarn("failed to change effective user ID: %e", errno);
3866 #endif
3867 }
3868
3869 /* Function to get value for special parameter `GID' */
3870
3871 /**/
3872 zlong
3873 gidgetfn(UNUSED(Param pm))
3874 {
3875     return getgid();
3876 }
3877
3878 /* Function to set value of special parameter `GID' */
3879
3880 /**/
3881 void
3882 gidsetfn(UNUSED(Param pm), zlong x)
3883 {
3884 #ifdef HAVE_SETUID
3885     if (setgid((gid_t)x))
3886         zwarn("failed to change group ID: %e", errno);
3887 #endif
3888 }
3889
3890 /* Function to get value for special parameter `EGID' */
3891
3892 /**/
3893 zlong
3894 egidgetfn(UNUSED(Param pm))
3895 {
3896     return getegid();
3897 }
3898
3899 /* Function to set value of special parameter `EGID' */
3900
3901 /**/
3902 void
3903 egidsetfn(UNUSED(Param pm), zlong x)
3904 {
3905 #ifdef HAVE_SETEUID
3906     if (setegid((gid_t)x))
3907         zwarn("failed to change effective group ID: %e", errno);
3908 #endif
3909 }
3910
3911 /**/
3912 zlong
3913 ttyidlegetfn(UNUSED(Param pm))
3914 {
3915     struct stat ttystat;
3916
3917     if (SHTTY == -1 || fstat(SHTTY, &ttystat))
3918         return -1;
3919     return time(NULL) - ttystat.st_atime;
3920 }
3921
3922 /* Function to get value for special parameter `IFS' */
3923
3924 /**/
3925 char *
3926 ifsgetfn(UNUSED(Param pm))
3927 {
3928     return ifs;
3929 }
3930
3931 /* Function to set value of special parameter `IFS' */
3932
3933 /**/
3934 void
3935 ifssetfn(UNUSED(Param pm), char *x)
3936 {
3937     zsfree(ifs);
3938     ifs = x;
3939     inittyptab();
3940 }
3941
3942 /* Functions to set value of special parameters `LANG' and `LC_*' */
3943
3944 #ifdef USE_LOCALE
3945 static struct localename {
3946     char *name;
3947     int category;
3948 } lc_names[] = {
3949 #ifdef LC_COLLATE
3950     {"LC_COLLATE", LC_COLLATE},
3951 #endif
3952 #ifdef LC_CTYPE
3953     {"LC_CTYPE", LC_CTYPE},
3954 #endif
3955 #ifdef LC_MESSAGES
3956     {"LC_MESSAGES", LC_MESSAGES},
3957 #endif
3958 #ifdef LC_NUMERIC
3959     {"LC_NUMERIC", LC_NUMERIC},
3960 #endif
3961 #ifdef LC_TIME
3962     {"LC_TIME", LC_TIME},
3963 #endif
3964     {NULL, 0}
3965 };
3966
3967 /**/
3968 static void
3969 setlang(char *x)
3970 {
3971     struct localename *ln;
3972     char *x2;
3973
3974     if ((x2 = getsparam("LC_ALL")) && *x2)
3975         return;
3976
3977     /*
3978      * Set the global locale to the value passed, but override
3979      * this with any non-empty definitions for specific
3980      * categories.
3981      *
3982      * We only use non-empty definitions because empty values aren't
3983      * valid as locales; when passed to setlocale() they mean "use the
3984      * environment variable", but if that's what we're setting the value
3985      * from this is meaningless.  So just all $LANG to show through in
3986      * that case.
3987      */
3988     setlocale(LC_ALL, x ? x : "");
3989     queue_signals();
3990     for (ln = lc_names; ln->name; ln++)
3991         if ((x = getsparam(ln->name)) && *x)
3992             setlocale(ln->category, x);
3993     unqueue_signals();
3994 }
3995
3996 /**/
3997 void
3998 lc_allsetfn(Param pm, char *x)
3999 {
4000     strsetfn(pm, x);
4001     /*
4002      * Treat an empty LC_ALL the same as an unset one,
4003      * namely by using LANG as the default locale but overriding
4004      * that with any LC_* that are set.
4005      */
4006     if (!x || !*x) {
4007         x = getsparam("LANG");
4008         if (x && *x) {
4009             queue_signals();
4010             setlang(x);
4011             unqueue_signals();
4012         }
4013     }
4014     else
4015         setlocale(LC_ALL, x);
4016 }
4017
4018 /**/
4019 void
4020 langsetfn(Param pm, char *x)
4021 {
4022     strsetfn(pm, x);
4023     setlang(x);
4024 }
4025
4026 /**/
4027 void
4028 lcsetfn(Param pm, char *x)
4029 {
4030     char *x2;
4031     struct localename *ln;
4032
4033     strsetfn(pm, x);
4034     if ((x2 = getsparam("LC_ALL")) && *x2)
4035         return;
4036     queue_signals();
4037     /* Treat empty LC_* the same as unset. */
4038     if (!x || !*x)
4039         x = getsparam("LANG");
4040
4041     /*
4042      * If we've got no non-empty string at this
4043      * point (after checking $LANG, too),
4044      * we shouldn't bother setting anything.
4045      */
4046     if (x && *x) {
4047         for (ln = lc_names; ln->name; ln++)
4048             if (!strcmp(ln->name, pm->node.nam))
4049                 setlocale(ln->category, x);
4050     }
4051     unqueue_signals();
4052 }
4053 #endif /* USE_LOCALE */
4054
4055 /* Function to set value for special parameter `0' */
4056
4057 /**/
4058 static void
4059 argzerosetfn(UNUSED(Param pm), char *x)
4060 {
4061     if (x) {
4062         if (!isset(POSIXARGZERO)) {
4063             zsfree(argzero);
4064             argzero = ztrdup(x);
4065         }
4066         zsfree(x);
4067     }
4068 }
4069
4070 /* Function to get value for special parameter `0' */
4071
4072 /**/
4073 static char *
4074 argzerogetfn(UNUSED(Param pm))
4075 {
4076     if (isset(POSIXARGZERO))
4077         return posixzero;
4078     return argzero;
4079 }
4080
4081 /* Function to get value for special parameter `HISTSIZE' */
4082
4083 /**/
4084 zlong
4085 histsizegetfn(UNUSED(Param pm))
4086 {
4087     return histsiz;
4088 }
4089
4090 /* Function to set value of special parameter `HISTSIZE' */
4091
4092 /**/
4093 void
4094 histsizesetfn(UNUSED(Param pm), zlong v)
4095 {
4096     if ((histsiz = v) < 1)
4097         histsiz = 1;
4098     resizehistents();
4099 }
4100
4101 /* Function to get value for special parameter `SAVEHIST' */
4102
4103 /**/
4104 zlong
4105 savehistsizegetfn(UNUSED(Param pm))
4106 {
4107     return savehistsiz;
4108 }
4109
4110 /* Function to set value of special parameter `SAVEHIST' */
4111
4112 /**/
4113 void
4114 savehistsizesetfn(UNUSED(Param pm), zlong v)
4115 {
4116     if ((savehistsiz = v) < 0)
4117         savehistsiz = 0;
4118 }
4119
4120 /* Function to set value for special parameter `ERRNO' */
4121
4122 /**/
4123 void
4124 errnosetfn(UNUSED(Param pm), zlong x)
4125 {
4126     errno = (int)x;
4127     if ((zlong)errno != x)
4128         zwarn("errno truncated on assignment");
4129 }
4130
4131 /* Function to get value for special parameter `ERRNO' */
4132
4133 /**/
4134 zlong
4135 errnogetfn(UNUSED(Param pm))
4136 {
4137     return errno;
4138 }
4139
4140 /* Function to get value for special parameter `KEYBOARD_HACK' */
4141
4142 /**/
4143 char *
4144 keyboardhackgetfn(UNUSED(Param pm))
4145 {
4146     static char buf[2];
4147
4148     buf[0] = keyboardhackchar;
4149     buf[1] = '\0';
4150     return buf;
4151 }
4152
4153
4154 /* Function to set value of special parameter `KEYBOARD_HACK' */
4155
4156 /**/
4157 void
4158 keyboardhacksetfn(UNUSED(Param pm), char *x)
4159 {
4160     if (x) {
4161         int len, i;
4162
4163         unmetafy(x, &len);
4164         if (len > 1) {
4165             len = 1;
4166             zwarn("Only one KEYBOARD_HACK character can be defined");  /* could be changed if needed */
4167         }
4168         for (i = 0; i < len; i++) {
4169             if (!isascii(STOUC(x[i]))) {
4170                 zwarn("KEYBOARD_HACK can only contain ASCII characters");
4171                 return;
4172             }
4173         }
4174         keyboardhackchar = len ? STOUC(x[0]) : '\0';
4175         free(x);
4176     } else
4177         keyboardhackchar = '\0';
4178 }
4179
4180 /* Function to get value for special parameter `histchar' */
4181
4182 /**/
4183 char *
4184 histcharsgetfn(UNUSED(Param pm))
4185 {
4186     static char buf[4];
4187
4188     buf[0] = bangchar;
4189     buf[1] = hatchar;
4190     buf[2] = hashchar;
4191     buf[3] = '\0';
4192     return buf;
4193 }
4194
4195 /* Function to set value of special parameter `histchar' */
4196
4197 /**/
4198 void
4199 histcharssetfn(UNUSED(Param pm), char *x)
4200 {
4201     if (x) {
4202         int len, i;
4203
4204         unmetafy(x, &len);
4205         if (len > 3)
4206             len = 3;
4207         for (i = 0; i < len; i++) {
4208             if (!isascii(STOUC(x[i]))) {
4209                 zwarn("HISTCHARS can only contain ASCII characters");
4210                 return;
4211             }
4212         }
4213         bangchar = len ? STOUC(x[0]) : '\0';
4214         hatchar =  len > 1 ? STOUC(x[1]) : '\0';
4215         hashchar = len > 2 ? STOUC(x[2]) : '\0';
4216         free(x);
4217     } else {
4218         bangchar = '!';
4219         hashchar = '#';
4220         hatchar = '^';
4221     }
4222     inittyptab();
4223 }
4224
4225 /* Function to get value for special parameter `HOME' */
4226
4227 /**/
4228 char *
4229 homegetfn(UNUSED(Param pm))
4230 {
4231     return home;
4232 }
4233
4234 /* Function to set value of special parameter `HOME' */
4235
4236 /**/
4237 void
4238 homesetfn(UNUSED(Param pm), char *x)
4239 {
4240     zsfree(home);
4241     if (x && isset(CHASELINKS) && (home = xsymlink(x)))
4242         zsfree(x);
4243     else
4244         home = x ? x : ztrdup("");
4245     finddir(NULL);
4246 }
4247
4248 /* Function to get value for special parameter `WORDCHARS' */
4249
4250 /**/
4251 char *
4252 wordcharsgetfn(UNUSED(Param pm))
4253 {
4254     return wordchars;
4255 }
4256
4257 /* Function to set value of special parameter `WORDCHARS' */
4258
4259 /**/
4260 void
4261 wordcharssetfn(UNUSED(Param pm), char *x)
4262 {
4263     zsfree(wordchars);
4264     wordchars = x;
4265     inittyptab();
4266 }
4267
4268 /* Function to get value for special parameter `_' */
4269
4270 /**/
4271 char *
4272 underscoregetfn(UNUSED(Param pm))
4273 {
4274     char *u = dupstring(zunderscore);
4275
4276     untokenize(u);
4277     return u;
4278 }
4279
4280 /* Function used when we need to reinitialise the terminal */
4281
4282 static void
4283 term_reinit_from_pm(void)
4284 {
4285     /* If non-interactive, delay setting up term till we need it. */
4286     if (unset(INTERACTIVE) || !*term)
4287         termflags |= TERM_UNKNOWN;
4288     else
4289         init_term();
4290 }
4291
4292 /* Function to get value for special parameter `TERM' */
4293
4294 /**/
4295 char *
4296 termgetfn(UNUSED(Param pm))
4297 {
4298     return term;
4299 }
4300
4301 /* Function to set value of special parameter `TERM' */
4302
4303 /**/
4304 void
4305 termsetfn(UNUSED(Param pm), char *x)
4306 {
4307     zsfree(term);
4308     term = x ? x : ztrdup("");
4309     term_reinit_from_pm();
4310 }
4311
4312 /* Function to get value of special parameter `TERMINFO' */
4313
4314 /**/
4315 char *
4316 terminfogetfn(UNUSED(Param pm))
4317 {
4318     return zsh_terminfo ? zsh_terminfo : dupstring("");
4319 }
4320
4321 /* Function to set value of special parameter `TERMINFO' */
4322
4323 /**/
4324 void
4325 terminfosetfn(Param pm, char *x)
4326 {
4327     zsfree(zsh_terminfo);
4328     zsh_terminfo = x;
4329
4330     /*
4331      * terminfo relies on the value being exported before
4332      * we reinitialise the terminal.  This is a bit inefficient.
4333      */
4334     if ((pm->node.flags & PM_EXPORTED) && x)
4335         addenv(pm, x);
4336
4337     term_reinit_from_pm();
4338 }
4339
4340 /* Function to get value for special parameter `pipestatus' */
4341
4342 /**/
4343 static char **
4344 pipestatgetfn(UNUSED(Param pm))
4345 {
4346     char **x = (char **) zhalloc((numpipestats + 1) * sizeof(char *));
4347     char buf[DIGBUFSIZE], **p;
4348     int *q, i;
4349
4350     for (p = x, q = pipestats, i = numpipestats; i--; p++, q++) {
4351         sprintf(buf, "%d", *q);
4352         *p = dupstring(buf);
4353     }
4354     *p = NULL;
4355
4356     return x;
4357 }
4358
4359 /* Function to get value for special parameter `pipestatus' */
4360
4361 /**/
4362 static void
4363 pipestatsetfn(UNUSED(Param pm), char **x)
4364 {
4365     if (x) {
4366         int i;
4367
4368         for (i = 0; *x && i < MAX_PIPESTATS; i++, x++)
4369             pipestats[i] = atoi(*x);
4370         numpipestats = i;
4371     }
4372     else
4373         numpipestats = 0;
4374 }
4375
4376 /**/
4377 void
4378 arrfixenv(char *s, char **t)
4379 {
4380     Param pm;
4381     int joinchar;
4382
4383     if (t == path)
4384         cmdnamtab->emptytable(cmdnamtab);
4385
4386     pm = (Param) paramtab->getnode(paramtab, s);
4387
4388     /*
4389      * Only one level of a parameter can be exported.  Unless
4390      * ALLEXPORT is set, this must be global.
4391      */
4392
4393     if (pm->node.flags & PM_HASHELEM)
4394         return;
4395
4396     if (isset(ALLEXPORT))
4397         pm->node.flags |= PM_EXPORTED;
4398
4399     /*
4400      * Do not "fix" parameters that were not exported
4401      */
4402
4403     if (!(pm->node.flags & PM_EXPORTED))
4404         return;
4405
4406     if (pm->node.flags & PM_TIED)
4407         joinchar = STOUC(((struct tieddata *)pm->u.data)->joinchar);
4408     else
4409         joinchar = ':';
4410
4411     addenv(pm, t ? zjoin(t, joinchar, 1) : "");
4412 }
4413
4414
4415 /**/
4416 int
4417 zputenv(char *str)
4418 {
4419     DPUTS(!str, "Attempt to put null string into environment.");
4420 #ifdef USE_SET_UNSET_ENV
4421     /*
4422      * If we are using unsetenv() to remove values from the
4423      * environment, which is the safe thing to do, we
4424      * need to use setenv() to put them there in the first place.
4425      * Unfortunately this is a slightly different interface
4426      * from what zputenv() assumes.
4427      */
4428     char *ptr;
4429     int ret;
4430
4431     for (ptr = str; *ptr && STOUC(*ptr) < 128 && *ptr != '='; ptr++)
4432         ;
4433     if (STOUC(*ptr) >= 128) {
4434         /*
4435          * Environment variables not in the portable character
4436          * set are non-standard and we don't really know of
4437          * a use for them.
4438          *
4439          * We'll disable until someone complains.
4440          */
4441         return 1;
4442     } else if (*ptr) {
4443         *ptr = '\0';
4444         ret = setenv(str, ptr+1, 1);
4445         *ptr = '=';
4446     } else {
4447         /* safety first */
4448         DPUTS(1, "bad environment string");
4449         ret = setenv(str, ptr, 1);
4450     }
4451     return ret;
4452 #else
4453 #ifdef HAVE_PUTENV
4454     return putenv(str);
4455 #else
4456     char **ep;
4457     int num_env;
4458
4459
4460     /* First check if there is already an environment *
4461      * variable matching string `name'.               */
4462     if (findenv(str, &num_env)) {
4463         environ[num_env] = str;
4464     } else {
4465     /* Else we have to make room and add it */
4466         num_env = arrlen(environ);
4467         environ = (char **) zrealloc(environ, (sizeof(char *)) * (num_env + 2));
4468
4469         /* Now add it at the end */
4470         ep = environ + num_env;
4471         *ep = str;
4472         *(ep + 1) = NULL;
4473     }
4474     return 0;
4475 #endif
4476 #endif
4477 }
4478
4479 /**/
4480 #ifndef USE_SET_UNSET_ENV
4481 /**/
4482 static int
4483 findenv(char *name, int *pos)
4484 {
4485     char **ep, *eq;
4486     int  nlen;
4487
4488
4489     eq = strchr(name, '=');
4490     nlen = eq ? eq - name : (int)strlen(name);
4491     for (ep = environ; *ep; ep++)
4492         if (!strncmp (*ep, name, nlen) && *((*ep)+nlen) == '=') {
4493             if (pos)
4494                 *pos = ep - environ;
4495             return 1;
4496         }
4497
4498     return 0;
4499 }
4500 /**/
4501 #endif
4502
4503 /* Given *name = "foo", it searches the environment for string *
4504  * "foo=bar", and returns a pointer to the beginning of "bar"  */
4505
4506 /**/
4507 mod_export char *
4508 zgetenv(char *name)
4509 {
4510 #ifdef HAVE_GETENV
4511     return getenv(name);
4512 #else
4513     char **ep, *s, *t;
4514
4515     for (ep = environ; *ep; ep++) {
4516        for (s = *ep, t = name; *s && *s == *t; s++, t++);
4517        if (*s == '=' && !*t)
4518            return s + 1;
4519     }
4520     return NULL;
4521 #endif
4522 }
4523
4524 /**/
4525 static void
4526 copyenvstr(char *s, char *value, int flags)
4527 {
4528     while (*s++) {
4529         if ((*s = *value++) == Meta)
4530             *s = *value++ ^ 32;
4531         if (flags & PM_LOWER)
4532             *s = tulower(*s);
4533         else if (flags & PM_UPPER)
4534             *s = tuupper(*s);
4535     }
4536 }
4537
4538 /**/
4539 void
4540 addenv(Param pm, char *value)
4541 {
4542     char *newenv = 0;
4543 #ifndef USE_SET_UNSET_ENV
4544     char *oldenv = 0, *env = 0;
4545     int pos;
4546
4547     /*
4548      * First check if there is already an environment
4549      * variable matching string `name'.
4550      */
4551     if (findenv(pm->node.nam, &pos))
4552         oldenv = environ[pos];
4553 #endif
4554
4555      newenv = mkenvstr(pm->node.nam, value, pm->node.flags);
4556      if (zputenv(newenv)) {
4557         zsfree(newenv);
4558         pm->env = NULL;
4559         return;
4560     }
4561 #ifdef USE_SET_UNSET_ENV
4562      /*
4563       * If we are using setenv/unsetenv to manage the environment,
4564       * we simply store the string we created in pm->env since
4565       * memory management of the environment is handled entirely
4566       * by the system.
4567       *
4568       * TODO: is this good enough to fix problem cases from
4569       * the other branch?  If so, we don't actually need to
4570       * store pm->env at all, just a flag that the value was set.
4571       */
4572      if (pm->env)
4573          zsfree(pm->env);
4574      pm->env = newenv;
4575 #else
4576     /*
4577      * Under Cygwin we must use putenv() to maintain consistency.
4578      * Unfortunately, current version (1.1.2) copies argument and may
4579      * silently reuse existing environment string. This tries to
4580      * check for both cases
4581      */
4582     if (findenv(pm->node.nam, &pos)) {
4583         env = environ[pos];
4584         if (env != oldenv)
4585             zsfree(oldenv);
4586         if (env != newenv)
4587             zsfree(newenv);
4588         pm->node.flags |= PM_EXPORTED;
4589         pm->env = env;
4590         return;
4591     }
4592
4593     DPUTS(1, "addenv should never reach the end");
4594     pm->env = NULL;
4595 #endif
4596 }
4597
4598
4599 /* Given strings *name = "foo", *value = "bar", *
4600  * return a new string *str = "foo=bar".        */
4601
4602 /**/
4603 static char *
4604 mkenvstr(char *name, char *value, int flags)
4605 {
4606     char *str, *s = value;
4607     int len_name, len_value = 0;
4608
4609     len_name = strlen(name);
4610     if (s)
4611         while (*s && (*s++ != Meta || *s++ != 32))
4612             len_value++;
4613     s = str = (char *) zalloc(len_name + len_value + 2);
4614     strcpy(s, name);
4615     s += len_name;
4616     *s = '=';
4617     if (value)
4618         copyenvstr(s, value, flags);
4619     else
4620         *++s = '\0';
4621     return str;
4622 }
4623
4624 /* Given *name = "foo", *value = "bar", add the    *
4625  * string "foo=bar" to the environment.  Return a  *
4626  * pointer to the location of this new environment *
4627  * string.                                         */
4628
4629
4630 #ifndef USE_SET_UNSET_ENV
4631 /**/
4632 void
4633 delenvvalue(char *x)
4634 {
4635     char **ep;
4636
4637     for (ep = environ; *ep; ep++) {
4638         if (*ep == x)
4639             break;
4640     }
4641     if (*ep) {
4642         for (; (ep[0] = ep[1]); ep++);
4643     }
4644     zsfree(x);
4645 }
4646 #endif
4647
4648
4649 /* Delete a pointer from the list of pointers to environment *
4650  * variables by shifting all the other pointers up one slot. */
4651
4652 /**/
4653 void
4654 delenv(Param pm)
4655 {
4656 #ifdef USE_SET_UNSET_ENV
4657     unsetenv(pm->node.nam);
4658     zsfree(pm->env);
4659 #else
4660     delenvvalue(pm->env);
4661 #endif
4662     pm->env = NULL;
4663     /*
4664      * Note we don't remove PM_EXPORT from the flags.  This
4665      * may be asking for trouble but we need to know later
4666      * if we restore this parameter to its old value.
4667      */
4668 }
4669
4670 /*
4671  * Guts of convbase: this version can return the number of digits
4672  * sans any base discriminator.
4673  */
4674
4675 /**/
4676 void
4677 convbase_ptr(char *s, zlong v, int base, int *ndigits)
4678 {
4679     int digs = 0;
4680     zulong x;
4681
4682     if (v < 0)
4683         *s++ = '-', v = -v;
4684     if (base >= -1 && base <= 1)
4685         base = -10;
4686
4687     if (base > 0) {
4688         if (isset(CBASES) && base == 16)
4689             sprintf(s, "0x");
4690         else if (isset(CBASES) && base == 8 && isset(OCTALZEROES))
4691             sprintf(s, "0");
4692         else if (base != 10)
4693             sprintf(s, "%d#", base);
4694         else
4695             *s = 0;
4696         s += strlen(s);
4697     } else
4698         base = -base;
4699     for (x = v; x; digs++)
4700         x /= base;
4701     if (!digs)
4702         digs = 1;
4703     if (ndigits)
4704         *ndigits = digs;
4705     s[digs--] = '\0';
4706     x = v;
4707     while (digs >= 0) {
4708         int dig = x % base;
4709
4710         s[digs--] = (dig < 10) ? '0' + dig : dig - 10 + 'A';
4711         x /= base;
4712     }
4713 }
4714
4715 /*
4716  * Basic conversion of integer to a string given a base.
4717  * If 0 base is 10.
4718  * If negative no base discriminator is output.
4719  */
4720
4721 /**/
4722 mod_export void
4723 convbase(char *s, zlong v, int base)
4724 {
4725     convbase_ptr(s, v, base, NULL);
4726 }
4727
4728 /*
4729  * Add underscores to converted integer for readability with given spacing.
4730  * s is as for convbase: at least BDIGBUFSIZE.
4731  * If underscores were added, returned value with underscores comes from
4732  * heap, else the returned value is s.
4733  */
4734
4735 /**/
4736 char *
4737 convbase_underscore(char *s, zlong v, int base, int underscore)
4738 {
4739     char *retptr, *sptr, *dptr;
4740     int ndigits, nunderscore, mod, len;
4741
4742     convbase_ptr(s, v, base, &ndigits);
4743
4744     if (underscore <= 0)
4745         return s;
4746
4747     nunderscore = (ndigits - 1) / underscore;
4748     if (!nunderscore)
4749         return s;
4750     len = strlen(s);
4751     retptr = zhalloc(len + nunderscore + 1);
4752     mod = 0;
4753     memcpy(retptr, s, len - ndigits);
4754     sptr = s + len;
4755     dptr = retptr + len + nunderscore;
4756     /* copy the null */
4757     *dptr-- = *sptr--;
4758     for (;;) {
4759         *dptr = *sptr;
4760         if (!--ndigits)
4761             break;
4762         dptr--;
4763         sptr--;
4764         if (++mod == underscore) {
4765             mod = 0;
4766             *dptr-- = '_';
4767         }
4768     }
4769
4770     return retptr;
4771 }
4772
4773 /*
4774  * Convert a floating point value for output.
4775  * Unlike convbase(), this has its own internal storage and returns
4776  * a value from the heap.
4777  */
4778
4779 /**/
4780 char *
4781 convfloat(double dval, int digits, int flags, FILE *fout)
4782 {
4783     char fmt[] = "%.*e";
4784     char *prev_locale, *ret;
4785
4786     /*
4787      * The difficulty with the buffer size is that a %f conversion
4788      * prints all digits before the decimal point: with 64 bit doubles,
4789      * that's around 310.  We can't check without doing some quite
4790      * serious floating point operations we'd like to avoid.
4791      * Then we are liable to get all the digits
4792      * we asked for after the decimal point, or we should at least
4793      * bargain for it.  So we just allocate 512 + digits.  This
4794      * should work until somebody decides on 128-bit doubles.
4795      */
4796     if (!(flags & (PM_EFLOAT|PM_FFLOAT))) {
4797         /*
4798          * Conversion from a floating point expression without using
4799          * a variable.  The best bet in this case just seems to be
4800          * to use the general %g format with something like the maximum
4801          * double precision.
4802          */
4803         fmt[3] = 'g';
4804         if (!digits)
4805             digits = 17;
4806     } else {
4807         if (flags & PM_FFLOAT)
4808             fmt[3] = 'f';
4809         if (digits <= 0)
4810             digits = 10;
4811         if (flags & PM_EFLOAT) {
4812             /*
4813              * Here, we are given the number of significant figures, but
4814              * %e wants the number of decimal places (unlike %g)
4815              */
4816             digits--;
4817         }
4818     }
4819 #ifdef USE_LOCALE
4820     prev_locale = dupstring(setlocale(LC_NUMERIC, NULL));
4821     setlocale(LC_NUMERIC, "POSIX");
4822 #endif
4823     if (fout) {
4824         fprintf(fout, fmt, digits, dval);
4825         ret = NULL;
4826     } else {
4827         VARARR(char, buf, 512 + digits);
4828         sprintf(buf, fmt, digits, dval);
4829         if (!strchr(buf, 'e') && !strchr(buf, '.'))
4830             strcat(buf, ".");
4831         ret = dupstring(buf);
4832     }
4833 #ifdef USE_LOCALE
4834     if (prev_locale) setlocale(LC_NUMERIC, prev_locale);
4835 #endif
4836     return ret;
4837 }
4838
4839 /*
4840  * convert float to string with basic options but inserting underscores
4841  * for readability.
4842  */
4843
4844 /**/
4845 char *convfloat_underscore(double dval, int underscore)
4846 {
4847     int ndigits_int = 0, ndigits_frac = 0, nunderscore, len;
4848     char *s, *retptr, *sptr, *dptr;
4849
4850     s = convfloat(dval, 0, 0, NULL);
4851     if (underscore <= 0)
4852         return s;
4853
4854     /*
4855      * Count the number of digits before and after the decimal point, if any.
4856      */
4857     sptr = s;
4858     if (*sptr == '-')
4859         sptr++;
4860     while (idigit(*sptr)) {
4861         ndigits_int++;
4862         sptr++;
4863     }
4864     if (*sptr == '.') {
4865         sptr++;
4866         while (idigit(*sptr)) {
4867             ndigits_frac++;
4868             sptr++;
4869         }
4870     }
4871
4872     /*
4873      * Work out how many underscores to insert --- remember we
4874      * put them in integer and fractional parts separately.
4875      */
4876     nunderscore = (ndigits_int-1) / underscore + (ndigits_frac-1) / underscore;
4877     if (!nunderscore)
4878         return s;
4879     len = strlen(s);
4880     dptr = retptr = zhalloc(len + nunderscore + 1);
4881
4882     /*
4883      * Insert underscores in integer part.
4884      * Grouping starts from the point in both directions.
4885      */
4886     sptr = s;
4887     if (*sptr == '-')
4888         *dptr++ = *sptr++;
4889     while (ndigits_int) {
4890         *dptr++ = *sptr++;
4891         if (--ndigits_int && !(ndigits_int % underscore))
4892             *dptr++ = '_';
4893     }
4894     if (ndigits_frac) {
4895         /*
4896          * Insert underscores in the fractional part.
4897          */
4898         int mod = 0;
4899         /* decimal point, we already checked */
4900         *dptr++ = *sptr++;
4901         while (ndigits_frac) {
4902             *dptr++ = *sptr++;
4903             mod++;
4904             if (--ndigits_frac && mod == underscore) {
4905                 *dptr++ = '_';
4906                 mod = 0;
4907             }
4908         }
4909     }
4910     /* Copy exponent and anything else up to null */
4911     while ((*dptr++ = *sptr++))
4912         ;
4913     return retptr;
4914 }
4915
4916 /* Start a parameter scope */
4917
4918 /**/
4919 mod_export void
4920 startparamscope(void)
4921 {
4922     locallevel++;
4923 }
4924
4925 /* End a parameter scope: delete the parameters local to the scope. */
4926
4927 /**/
4928 mod_export void
4929 endparamscope(void)
4930 {
4931     queue_signals();
4932     locallevel--;
4933     /* This pops anything from a higher locallevel */
4934     saveandpophiststack(0, HFILE_USE_OPTIONS);
4935     scanhashtable(paramtab, 0, 0, 0, scanendscope, 0);
4936     unqueue_signals();
4937 }
4938
4939 /**/
4940 static void
4941 scanendscope(HashNode hn, UNUSED(int flags))
4942 {
4943     Param pm = (Param)hn;
4944     if (pm->level > locallevel) {
4945         if ((pm->node.flags & (PM_SPECIAL|PM_REMOVABLE)) == PM_SPECIAL) {
4946             /*
4947              * Removable specials are normal in that they can be removed
4948              * to reveal an ordinary parameter beneath.  Here we handle
4949              * non-removable specials, which were made local by stealth
4950              * (see newspecial code in typeset_single()).  In fact the
4951              * visible pm is always the same struct; the pm->old is
4952              * just a place holder for old data and flags.
4953              */
4954             Param tpm = pm->old;
4955
4956             if (!strcmp(pm->node.nam, "SECONDS"))
4957             {
4958                 setsecondstype(pm, PM_TYPE(tpm->node.flags), PM_TYPE(pm->node.flags));
4959                 /*
4960                  * We restore SECONDS by restoring its raw internal value
4961                  * that we cached off into tpm->u.dval.
4962                  */
4963                 setrawseconds(tpm->u.dval);
4964                 tpm->node.flags |= PM_NORESTORE;
4965             }
4966             DPUTS(!tpm || PM_TYPE(pm->node.flags) != PM_TYPE(tpm->node.flags) ||
4967                   !(tpm->node.flags & PM_SPECIAL),
4968                   "BUG: in restoring scope of special parameter");
4969             pm->old = tpm->old;
4970             pm->node.flags = (tpm->node.flags & ~PM_NORESTORE);
4971             pm->level = tpm->level;
4972             pm->base = tpm->base;
4973             pm->width = tpm->width;
4974             if (pm->env)
4975                 delenv(pm);
4976
4977             if (!(tpm->node.flags & (PM_NORESTORE|PM_READONLY)))
4978                 switch (PM_TYPE(pm->node.flags)) {
4979                 case PM_SCALAR:
4980                     pm->gsu.s->setfn(pm, tpm->u.str);
4981                     break;
4982                 case PM_INTEGER:
4983                     pm->gsu.i->setfn(pm, tpm->u.val);
4984                     break;
4985                 case PM_EFLOAT:
4986                 case PM_FFLOAT:
4987                     pm->gsu.f->setfn(pm, tpm->u.dval);
4988                     break;
4989                 case PM_ARRAY:
4990                     pm->gsu.a->setfn(pm, tpm->u.arr);
4991                     break;
4992                 case PM_HASHED:
4993                     pm->gsu.h->setfn(pm, tpm->u.hash);
4994                     break;
4995                 }
4996             zfree(tpm, sizeof(*tpm));
4997
4998             if (pm->node.flags & PM_EXPORTED)
4999                 export_param(pm);
5000         } else
5001             unsetparam_pm(pm, 0, 0);
5002     }
5003 }
5004
5005
5006 /**********************************/
5007 /* Parameter Hash Table Functions */
5008 /**********************************/
5009
5010 /**/
5011 void
5012 freeparamnode(HashNode hn)
5013 {
5014     Param pm = (Param) hn;
5015
5016     /* Since the second flag to unsetfn isn't used, I don't *
5017      * know what its value should be.                       */
5018     if (delunset)
5019         pm->gsu.s->unsetfn(pm, 1);
5020     zsfree(pm->node.nam);
5021     /* If this variable was tied by the user, ename was ztrdup'd */
5022     if (pm->node.flags & PM_TIED)
5023         zsfree(pm->ename);
5024     zfree(pm, sizeof(struct param));
5025 }
5026
5027 /* Print a parameter */
5028
5029 enum paramtypes_flags {
5030     PMTF_USE_BASE       = (1<<0),
5031     PMTF_USE_WIDTH      = (1<<1),
5032     PMTF_TEST_LEVEL     = (1<<2)
5033 };
5034
5035 struct paramtypes {
5036     int binflag;        /* The relevant PM_FLAG(S) */
5037     const char *string; /* String for verbose output */
5038     int typeflag;       /* Flag for typeset -? */
5039     int flags;          /* The enum above */
5040 };
5041
5042 static const struct paramtypes pmtypes[] = {
5043     { PM_AUTOLOAD, "undefined", 0, 0},
5044     { PM_INTEGER, "integer", 'i', PMTF_USE_BASE},
5045     { PM_EFLOAT, "float", 'E', 0},
5046     { PM_FFLOAT, "float", 'F', 0},
5047     { PM_ARRAY, "array", 'a', 0},
5048     { PM_HASHED, "association", 'A', 0},
5049     { 0, "local", 0, PMTF_TEST_LEVEL},
5050     { PM_LEFT, "left justified", 'L', PMTF_USE_WIDTH},
5051     { PM_RIGHT_B, "right justified", 'R', PMTF_USE_WIDTH},
5052     { PM_RIGHT_Z, "zero filled", 'Z', PMTF_USE_WIDTH},
5053     { PM_LOWER, "lowercase", 'l', 0},
5054     { PM_UPPER, "uppercase", 'u', 0},
5055     { PM_READONLY, "readonly", 'r', 0},
5056     { PM_TAGGED, "tagged", 't', 0},
5057     { PM_EXPORTED, "exported", 'x', 0}
5058 };
5059
5060 #define PMTYPES_SIZE ((int)(sizeof(pmtypes)/sizeof(struct paramtypes)))
5061
5062 static void
5063 printparamvalue(Param p, int printflags)
5064 {
5065     char *t, **u;
5066
5067     if (p->node.flags & PM_AUTOLOAD) {
5068         putchar('\n');
5069         return;
5070     }
5071     if (printflags & PRINT_KV_PAIR)
5072         putchar(' ');
5073     else if ((printflags & PRINT_TYPESET) &&
5074              (PM_TYPE(p->node.flags) == PM_ARRAY || PM_TYPE(p->node.flags) == PM_HASHED))
5075         printf("%s=", p->node.nam);
5076     else
5077         putchar('=');
5078
5079     /* How the value is displayed depends *
5080      * on the type of the parameter       */
5081     switch (PM_TYPE(p->node.flags)) {
5082     case PM_SCALAR:
5083         /* string: simple output */
5084         if (p->gsu.s->getfn && (t = p->gsu.s->getfn(p)))
5085             quotedzputs(t, stdout);
5086         break;
5087     case PM_INTEGER:
5088         /* integer */
5089 #ifdef ZSH_64_BIT_TYPE
5090         fputs(output64(p->gsu.i->getfn(p)), stdout);
5091 #else
5092         printf("%ld", p->gsu.i->getfn(p));
5093 #endif
5094         break;
5095     case PM_EFLOAT:
5096     case PM_FFLOAT:
5097         /* float */
5098         convfloat(p->gsu.f->getfn(p), p->base, p->node.flags, stdout);
5099         break;
5100     case PM_ARRAY:
5101         /* array */
5102         if (!(printflags & PRINT_KV_PAIR))
5103             putchar('(');
5104         u = p->gsu.a->getfn(p);
5105         if(*u) {
5106             quotedzputs(*u++, stdout);
5107             while (*u) {
5108                 putchar(' ');
5109                 quotedzputs(*u++, stdout);
5110             }
5111         }
5112         if (!(printflags & PRINT_KV_PAIR))
5113             putchar(')');
5114         break;
5115     case PM_HASHED:
5116         /* association */
5117         if (!(printflags & PRINT_KV_PAIR))
5118             putchar('(');
5119         {
5120             HashTable ht = p->gsu.h->getfn(p);
5121             if (ht)
5122                 scanhashtable(ht, 1, 0, PM_UNSET,
5123                               ht->printnode, PRINT_KV_PAIR);
5124         }
5125         if (!(printflags & PRINT_KV_PAIR))
5126             putchar(')');
5127         break;
5128     }
5129     if (printflags & PRINT_KV_PAIR)
5130         putchar(' ');
5131     else
5132         putchar('\n');
5133 }
5134
5135 /**/
5136 mod_export void
5137 printparamnode(HashNode hn, int printflags)
5138 {
5139     Param p = (Param) hn;
5140     int array_typeset;
5141
5142     if (p->node.flags & PM_UNSET) {
5143         if (isset(POSIXBUILTINS) && (p->node.flags & PM_READONLY) &&
5144             (printflags & PRINT_TYPESET))
5145         {
5146             /*
5147              * Special POSIX rules: show the parameter as readonly
5148              * even though it's unset, but with no value.
5149              */
5150             printflags |= PRINT_NAMEONLY;
5151         }
5152         else
5153             return;
5154     }
5155
5156     if (printflags & PRINT_TYPESET) {
5157         if ((p->node.flags & (PM_READONLY|PM_SPECIAL)) ==
5158             (PM_READONLY|PM_SPECIAL)) {
5159             /*
5160              * It's not possible to restore the state of
5161              * these, so don't output.
5162              */
5163             return;
5164         }
5165         /*
5166          * Printing the value of array: this needs to be on
5167          * a separate line so more care is required.
5168          */
5169         array_typeset = (PM_TYPE(p->node.flags) == PM_ARRAY ||
5170                          PM_TYPE(p->node.flags) == PM_HASHED) &&
5171             !(printflags & PRINT_NAMEONLY);
5172         if (array_typeset && (p->node.flags & PM_READONLY)) {
5173             /*
5174              * We need to create the array before making it
5175              * readonly.
5176              */
5177             printf("typeset -a ");
5178             zputs(p->node.nam, stdout);
5179             putchar('\n');
5180             printparamvalue(p, printflags);
5181             printflags |= PRINT_NAMEONLY;
5182         }
5183         printf("typeset ");
5184     }
5185     else
5186         array_typeset = 0;
5187
5188     /* Print the attributes of the parameter */
5189     if (printflags & (PRINT_TYPE|PRINT_TYPESET)) {
5190         int doneminus = 0, i;
5191         const struct paramtypes *pmptr;
5192
5193         for (pmptr = pmtypes, i = 0; i < PMTYPES_SIZE; i++, pmptr++) {
5194             int doprint = 0;
5195             if (pmptr->flags & PMTF_TEST_LEVEL) {
5196                 if (p->level)
5197                     doprint = 1;
5198             } else if (p->node.flags & pmptr->binflag)
5199                 doprint = 1;
5200
5201             if (doprint) {
5202                 if (printflags & PRINT_TYPESET) {
5203                     if (pmptr->typeflag) {
5204                         if (!doneminus) {
5205                             putchar('-');
5206                             doneminus = 1;
5207                         }
5208                         putchar(pmptr->typeflag);
5209                     }
5210                 } else {
5211                     printf("%s ", pmptr->string);
5212                 }
5213                 if ((pmptr->flags & PMTF_USE_BASE) && p->base) {
5214                     printf("%d ", p->base);
5215                     doneminus = 0;
5216                 }
5217                 if ((pmptr->flags & PMTF_USE_WIDTH) && p->width) {
5218                     printf("%d ", p->width);
5219                     doneminus = 0;
5220                 }
5221             }
5222         }
5223         if (doneminus)
5224             putchar(' ');
5225     }
5226
5227     if ((printflags & PRINT_NAMEONLY) ||
5228         ((p->node.flags & PM_HIDEVAL) && !(printflags & PRINT_INCLUDEVALUE))) {
5229         zputs(p->node.nam, stdout);
5230         putchar('\n');
5231     } else {
5232         quotedzputs(p->node.nam, stdout);
5233
5234         if (array_typeset)
5235             putchar('\n');
5236         printparamvalue(p, printflags);
5237     }
5238 }