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