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