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