1/***********************************************************************
2*                                                                      *
3*               This software is part of the ast package               *
4*          Copyright (c) 1982-2010 AT&T Intellectual Property          *
5*                      and is licensed under the                       *
6*                  Common Public License, Version 1.0                  *
7*                    by AT&T Intellectual Property                     *
8*                                                                      *
9*                A copy of the License is available at                 *
10*            http://www.opensource.org/licenses/cpl1.0.txt             *
11*         (with md5 checksum 059e8cd6165cb4c31e351f2b69388fd9)         *
12*                                                                      *
13*              Information and Software Systems Research               *
14*                            AT&T Research                             *
15*                           Florham Park NJ                            *
16*                                                                      *
17*                  David Korn <dgk@research.att.com>                   *
18*                                                                      *
19***********************************************************************/
20#pragma prototyped
21/*
22 * UNIX shell
23 *
24 * S. R. Bourne
25 * Rewritten by David Korn
26 * AT&T Labs
27 *
28 *  This is the parser for a shell language
29 */
30
31#if KSHELL
32#include	"defs.h"
33#else
34#include	<shell.h>
35#include	<ctype.h>
36#endif
37#include	<fcin.h>
38#include	<error.h>
39#include	"shlex.h"
40#include	"history.h"
41#include	"builtins.h"
42#include	"test.h"
43#include	"history.h"
44
45#define HERE_MEM	1024	/* size of here-docs kept in memory */
46
47#define hash	nvlink.hl._hash
48
49/* These routines are local to this module */
50
51static Shnode_t	*makeparent(Lex_t*, int, Shnode_t*);
52static Shnode_t	*makelist(Lex_t*, int, Shnode_t*, Shnode_t*);
53static struct argnod	*qscan(struct comnod*, int);
54static struct ionod	*inout(Lex_t*,struct ionod*, int);
55static Shnode_t	*sh_cmd(Lex_t*,int,int);
56static Shnode_t	*term(Lex_t*,int);
57static Shnode_t	*list(Lex_t*,int);
58static struct regnod	*syncase(Lex_t*,int);
59static Shnode_t	*item(Lex_t*,int);
60static Shnode_t	*simple(Lex_t*,int, struct ionod*);
61static int	skipnl(Lex_t*,int);
62static Shnode_t	*test_expr(Lex_t*,int);
63static Shnode_t	*test_and(Lex_t*);
64static Shnode_t	*test_or(Lex_t*);
65static Shnode_t	*test_primary(Lex_t*);
66
67#define	sh_getlineno(lp)	(lp->lastline)
68
69#ifndef NIL
70#   define NIL(type)	((type)0)
71#endif /* NIL */
72#define CNTL(x)		((x)&037)
73
74
75#if !KSHELL
76static struct stdata
77{
78	struct slnod    *staklist;
79	int	cmdline;
80} st;
81#endif
82
83static int		opt_get;
84static int		loop_level;
85static struct argnod	*label_list;
86static struct argnod	*label_last;
87
88#define getnode(type)	((Shnode_t*)stakalloc(sizeof(struct type)))
89
90#if SHOPT_KIA
91#include	"path.h"
92/*
93 * write out entities for each item in the list
94 * type=='V' for variable assignment lists
95 * Otherwise type is determined by the command */
96static unsigned long writedefs(Lex_t *lexp,struct argnod *arglist, int line, int type, struct argnod *cmd)
97{
98	register struct argnod *argp = arglist;
99	register char *cp;
100	register int n,eline;
101	int width=0;
102	unsigned long r=0;
103	static char atbuff[20];
104	int  justify=0;
105	char *attribute = atbuff;
106	unsigned long parent=lexp->script;
107	if(type==0)
108	{
109		parent = lexp->current;
110		type = 'v';
111		switch(*argp->argval)
112		{
113		    case 'a':
114			type='p';
115			justify = 'a';
116			break;
117		    case 'e':
118			*attribute++ =  'x';
119			break;
120		    case 'r':
121			*attribute++ = 'r';
122			break;
123		    case 'l':
124			break;
125		}
126		while(argp = argp->argnxt.ap)
127		{
128			if((n= *(cp=argp->argval))!='-' && n!='+')
129				break;
130			if(cp[1]==n)
131				break;
132			while((n= *++cp))
133			{
134				if(isdigit(n))
135					width = 10*width + n-'0';
136				else if(n=='L' || n=='R' || n =='Z')
137					justify=n;
138				else
139					*attribute++ = n;
140			}
141		}
142	}
143	else if(cmd)
144		parent=kiaentity(lexp,sh_argstr(cmd),-1,'p',-1,-1,lexp->unknown,'b',0,"");
145	*attribute = 0;
146	while(argp)
147	{
148		if((cp=strchr(argp->argval,'='))||(cp=strchr(argp->argval,'?')))
149			n = cp-argp->argval;
150		else
151			n = strlen(argp->argval);
152		eline = lexp->sh->inlineno-(lexp->token==NL);
153		r=kiaentity(lexp,argp->argval,n,type,line,eline,parent,justify,width,atbuff);
154		sfprintf(lexp->kiatmp,"p;%..64d;v;%..64d;%d;%d;s;\n",lexp->current,r,line,eline);
155		argp = argp->argnxt.ap;
156	}
157	return(r);
158}
159#endif /* SHOPT_KIA */
160
161static void typeset_order(const char *str,int line)
162{
163	register int		c,n=0;
164	unsigned const char	*cp=(unsigned char*)str;
165	static unsigned char	*table;
166	if(*cp!='+' && *cp!='-')
167		return;
168	if(!table)
169	{
170		table = calloc(1,256);
171		for(cp=(unsigned char*)"bflmnprstuxACHS";c = *cp; cp++)
172			table[c] = 1;
173		for(cp=(unsigned char*)"aiEFLRXhTZ";c = *cp; cp++)
174			table[c] = 2;
175		for(c='0'; c <='9'; c++)
176			table[c] = 3;
177	}
178	for(cp=(unsigned char*)str; c= *cp++; n=table[c])
179	{
180		if(table[c] < n)
181			errormsg(SH_DICT,ERROR_warn(0),e_lextypeset,line,str);
182	}
183}
184
185/*
186 * add type definitions when compiling with -n
187 */
188static void check_typedef(struct comnod *tp)
189{
190	char	*cp=0;
191	if(tp->comtyp&COMSCAN)
192	{
193		struct argnod *ap = tp->comarg;
194		while(ap = ap->argnxt.ap)
195		{
196			if(!(ap->argflag&ARG_RAW) || memcmp(ap->argval,"--",2))
197				break;
198			if(sh_isoption(SH_NOEXEC))
199				typeset_order(ap->argval,tp->comline);
200			if(memcmp(ap->argval,"-T",2)==0)
201			{
202				if(ap->argval[2])
203					cp = ap->argval+2;
204				else if((ap->argnxt.ap)->argflag&ARG_RAW)
205					cp = (ap->argnxt.ap)->argval;
206				if(cp)
207					break;
208			}
209		}
210	}
211	else
212	{
213		struct dolnod *dp = (struct dolnod*)tp->comarg;
214		char **argv = dp->dolval + dp->dolbot+1;
215		while((cp= *argv++) && memcmp(cp,"--",2))
216		{
217			if(sh_isoption(SH_NOEXEC))
218				typeset_order(cp,tp->comline);
219			if(memcmp(cp,"-T",2)==0)
220			{
221				if(cp[2])
222					cp = cp+2;
223				else
224					cp = *argv;
225				break;
226			}
227		}
228	}
229	if(cp)
230	{
231		Namval_t	*mp=(Namval_t*)tp->comnamp ,*bp;
232		bp = sh_addbuiltin(cp,mp->nvalue.bfp, (void*)0);
233		nv_onattr(bp,nv_isattr(mp,NV_PUBLIC));
234	}
235}
236
237/*
238 * Make a parent node for fork() or io-redirection
239 */
240static Shnode_t	*makeparent(Lex_t *lp, int flag, Shnode_t *child)
241{
242	register Shnode_t	*par = getnode(forknod);
243	par->fork.forktyp = flag;
244	par->fork.forktre = child;
245	par->fork.forkio = 0;
246	par->fork.forkline = sh_getlineno(lp)-1;
247	return(par);
248}
249
250static int paramsub(const char *str)
251{
252	register int c,sub=0,lit=0;
253	while(c= *str++)
254	{
255		if(c=='$' && !lit)
256		{
257			if(*str=='(')
258				return(0);
259			if(sub)
260				continue;
261			if(*str=='{')
262				str++;
263			if(!isdigit(*str) && strchr("?#@*!$ ",*str)==0)
264				return(1);
265		}
266		else if(c=='`')
267			return(0);
268		else if(c=='[' && !lit)
269			sub++;
270		else if(c==']' && !lit)
271			sub--;
272		else if(c=='\'')
273			lit = !lit;
274	}
275	return(0);
276}
277
278static Shnode_t *getanode(Lex_t *lp, struct argnod *ap)
279{
280	register Shnode_t *t = getnode(arithnod);
281	t->ar.artyp = TARITH;
282	t->ar.arline = sh_getlineno(lp);
283	t->ar.arexpr = ap;
284	if(ap->argflag&ARG_RAW)
285		t->ar.arcomp = sh_arithcomp(ap->argval);
286	else
287	{
288		if(sh_isoption(SH_NOEXEC) && (ap->argflag&ARG_MAC) && paramsub(ap->argval))
289			errormsg(SH_DICT,ERROR_warn(0),"%d: parameter substitution requires unnecessary string to number conversion",lp->sh->inlineno-(lp->token=='\n'));
290		t->ar.arcomp = 0;
291	}
292	return(t);
293}
294
295/*
296 *  Make a node corresponding to a command list
297 */
298static Shnode_t	*makelist(Lex_t *lexp, int type, Shnode_t *l, Shnode_t *r)
299{
300	register Shnode_t	*t;
301	if(!l || !r)
302		sh_syntax(lexp);
303	else
304	{
305		if((type&COMMSK) == TTST)
306			t = getnode(tstnod);
307		else
308			t = getnode(lstnod);
309		t->lst.lsttyp = type;
310		t->lst.lstlef = l;
311		t->lst.lstrit = r;
312	}
313	return(t);
314}
315
316/*
317 * entry to shell parser
318 * Flag can be the union of SH_EOF|SH_NL
319 */
320
321void	*sh_parse(Shell_t *shp, Sfio_t *iop, int flag)
322{
323	register Shnode_t	*t;
324	Lex_t			*lexp = (Lex_t*)shp->lex_context;
325	Fcin_t	sav_input;
326	struct argnod *sav_arg = lexp->arg;
327	int	sav_prompt = shp->nextprompt;
328	if(shp->binscript && (sffileno(iop)==shp->infd || (flag&SH_FUNEVAL)))
329		return((void*)sh_trestore(shp,iop));
330	fcsave(&sav_input);
331	shp->st.staklist = 0;
332	lexp->heredoc = 0;
333	lexp->inlineno = shp->inlineno;
334	lexp->firstline = shp->st.firstline;
335	shp->nextprompt = 1;
336	loop_level = 0;
337	label_list = label_last = 0;
338	if(sh_isoption(SH_INTERACTIVE))
339		sh_onstate(SH_INTERACTIVE);
340	if(sh_isoption(SH_VERBOSE))
341		sh_onstate(SH_VERBOSE);
342	sh_lexopen(lexp,shp,0);
343	if(fcfopen(iop) < 0)
344		return(NIL(void*));
345	if(fcfile())
346	{
347		char *cp = fcfirst();
348		if( cp[0]==CNTL('k') &&  cp[1]==CNTL('s') && cp[2]==CNTL('h') && cp[3]==0)
349		{
350			int version;
351			fcseek(4);
352			fcgetc(version);
353			fcclose();
354			fcrestore(&sav_input);
355			lexp->arg = sav_arg;
356			if(version > 3)
357				errormsg(SH_DICT,ERROR_exit(1),e_lexversion);
358			if(sffileno(iop)==shp->infd || (flag&SH_FUNEVAL))
359				shp->binscript = 1;
360			sfgetc(iop);
361			return((void*)sh_trestore(shp,iop));
362		}
363	}
364	flag &= ~SH_FUNEVAL;
365	if((flag&SH_NL) && (shp->inlineno=error_info.line+shp->st.firstline)==0)
366		shp->inlineno=1;
367#if KSHELL
368	shp->nextprompt = 2;
369#endif
370	t = sh_cmd(lexp,(flag&SH_EOF)?EOFSYM:'\n',SH_SEMI|SH_EMPTY|(flag&SH_NL));
371	fcclose();
372	fcrestore(&sav_input);
373	lexp->arg = sav_arg;
374	/* unstack any completed alias expansions */
375	if((sfset(iop,0,0)&SF_STRING) && !sfreserve(iop,0,-1))
376	{
377		Sfio_t *sp = sfstack(iop,NULL);
378		if(sp)
379			sfclose(sp);
380	}
381	shp->nextprompt = sav_prompt;
382	if(flag&SH_NL)
383	{
384		shp->st.firstline = lexp->firstline;
385		shp->inlineno = lexp->inlineno;
386	}
387	stkseek(shp->stk,0);
388	return((void*)t);
389}
390
391/*
392 * This routine parses up the matching right parenthesis and returns
393 * the parse tree
394 */
395Shnode_t *sh_dolparen(Lex_t* lp)
396{
397	register Shnode_t *t=0;
398	Sfio_t *sp = fcfile();
399	int line = lp->sh->inlineno;
400	lp->sh->inlineno = error_info.line+lp->sh->st.firstline;
401	sh_lexopen(lp,lp->sh,1);
402	lp->comsub = 1;
403	switch(sh_lex(lp))
404	{
405	    /* ((...)) arithmetic expression */
406	    case EXPRSYM:
407		t = getanode(lp,lp->arg);
408		break;
409	    case LPAREN:
410		t = sh_cmd(lp,RPAREN,SH_NL|SH_EMPTY);
411		break;
412	    case LBRACE:
413		t = sh_cmd(lp,RBRACE,SH_NL|SH_EMPTY);
414		break;
415	}
416	lp->comsub = 0;
417	if(!sp && (sp=fcfile()))
418	{
419		/*
420		 * This code handles the case where string has been converted
421		 * to a file by an alias setup
422		 */
423		register int c;
424		char *cp;
425		if(fcgetc(c) > 0)
426			fcseek(-1);
427		cp = fcseek(0);
428		fcclose();
429		fcsopen(cp);
430		sfclose(sp);
431	}
432	lp->sh->inlineno = line;
433	return(t);
434}
435
436/*
437 * remove temporary files and stacks
438 */
439
440void	sh_freeup(Shell_t *shp)
441{
442	if(shp->st.staklist)
443		sh_funstaks(shp->st.staklist,-1);
444	shp->st.staklist = 0;
445}
446
447/*
448 * increase reference count for each stack in function list when flag>0
449 * decrease reference count for each stack in function list when flag<=0
450 * stack is freed when reference count is zero
451 */
452
453void sh_funstaks(register struct slnod *slp,int flag)
454{
455	register struct slnod *slpold;
456	while(slpold=slp)
457	{
458		if(slp->slchild)
459			sh_funstaks(slp->slchild,flag);
460		slp = slp->slnext;
461		if(flag<=0)
462			stakdelete(slpold->slptr);
463		else
464			staklink(slpold->slptr);
465	}
466}
467/*
468 * cmd
469 *	empty
470 *	list
471 *	list & [ cmd ]
472 *	list [ ; cmd ]
473 */
474
475static Shnode_t	*sh_cmd(Lex_t *lexp, register int sym, int flag)
476{
477	register Shnode_t	*left, *right;
478	register int type = FINT|FAMP;
479	if(sym==NL)
480		lexp->lasttok = 0;
481	left = list(lexp,flag);
482	if(lexp->token==NL)
483	{
484		if(flag&SH_NL)
485			lexp->token=';';
486	}
487	else if(!left && !(flag&SH_EMPTY))
488		sh_syntax(lexp);
489	switch(lexp->token)
490	{
491	    case COOPSYM:		/* set up a cooperating process */
492		type |= (FPIN|FPOU|FPCL|FCOOP);
493		/* FALL THRU */
494	    case '&':
495		if(left)
496		{
497			/* (...)& -> {...;} & */
498			if(left->tre.tretyp==TPAR)
499				left = left->par.partre;
500			left = makeparent(lexp,TFORK|type, left);
501		}
502		/* FALL THRU */
503	    case ';':
504		if(!left)
505			sh_syntax(lexp);
506		if(right=sh_cmd(lexp,sym,flag|SH_EMPTY))
507			left=makelist(lexp,TLST, left, right);
508		break;
509	    case EOFSYM:
510		if(sym==NL)
511			break;
512	    default:
513		if(sym && sym!=lexp->token)
514		{
515			if(sym!=ELSESYM || (lexp->token!=ELIFSYM && lexp->token!=FISYM))
516				sh_syntax(lexp);
517		}
518	}
519	return(left);
520}
521
522/*
523 * list
524 *	term
525 *	list && term
526 *	list || term
527 *      unfortunately, these are equal precedence
528 */
529static Shnode_t	*list(Lex_t *lexp, register int flag)
530{
531	register Shnode_t	*t = term(lexp,flag);
532	register int 	token;
533	while(t && ((token=lexp->token)==ANDFSYM || token==ORFSYM))
534		t = makelist(lexp,(token==ANDFSYM?TAND:TORF), t, term(lexp,SH_NL|SH_SEMI));
535	return(t);
536}
537
538/*
539 * term
540 *	item
541 *	item | term
542 */
543static Shnode_t	*term(Lex_t *lexp,register int flag)
544{
545	register Shnode_t	*t;
546	register int token;
547	if(flag&SH_NL)
548		token = skipnl(lexp,flag);
549	else
550		token = sh_lex(lexp);
551	/* check to see if pipeline is to be timed */
552	if(token==TIMESYM || token==NOTSYM)
553	{
554		t = getnode(parnod);
555		t->par.partyp=TTIME;
556		if(lexp->token==NOTSYM)
557			t->par.partyp |= COMSCAN;
558		t->par.partre = term(lexp,0);
559	}
560	else if((t=item(lexp,SH_NL|SH_EMPTY|(flag&SH_SEMI))) && lexp->token=='|')
561	{
562		register Shnode_t	*tt;
563		int showme = t->tre.tretyp&FSHOWME;
564		t = makeparent(lexp,TFORK|FPOU,t);
565		if(tt=term(lexp,SH_NL))
566		{
567			switch(tt->tre.tretyp&COMMSK)
568			{
569			    case TFORK:
570				tt->tre.tretyp |= FPIN|FPCL;
571				break;
572			    case TFIL:
573				tt->lst.lstlef->tre.tretyp |= FPIN|FPCL;
574				break;
575			    default:
576				tt= makeparent(lexp,TSETIO|FPIN|FPCL,tt);
577			}
578			t=makelist(lexp,TFIL,t,tt);
579			t->tre.tretyp |= showme;
580		}
581		else if(lexp->token)
582			sh_syntax(lexp);
583	}
584	return(t);
585}
586
587/*
588 * case statement
589 */
590static struct regnod*	syncase(Lex_t *lexp,register int esym)
591{
592	register int tok = skipnl(lexp,0);
593	register struct regnod	*r;
594	if(tok==esym)
595		return(NIL(struct regnod*));
596	r = (struct regnod*)stakalloc(sizeof(struct regnod));
597	r->regptr=0;
598	r->regflag=0;
599	if(tok==LPAREN)
600		skipnl(lexp,0);
601	while(1)
602	{
603		if(!lexp->arg)
604			sh_syntax(lexp);
605		lexp->arg->argnxt.ap=r->regptr;
606		r->regptr = lexp->arg;
607		if((tok=sh_lex(lexp))==RPAREN)
608			break;
609		else if(tok=='|')
610			sh_lex(lexp);
611		else
612			sh_syntax(lexp);
613	}
614	r->regcom=sh_cmd(lexp,0,SH_NL|SH_EMPTY|SH_SEMI);
615	if((tok=lexp->token)==BREAKCASESYM)
616		r->regnxt=syncase(lexp,esym);
617	else if(tok==FALLTHRUSYM)
618	{
619		r->regflag++;
620		r->regnxt=syncase(lexp,esym);
621	}
622	else
623	{
624		if(tok!=esym && tok!=EOFSYM)
625			sh_syntax(lexp);
626		r->regnxt=0;
627	}
628	if(lexp->token==EOFSYM)
629		return(NIL(struct regnod*));
630	return(r);
631}
632
633/*
634 * This routine creates the parse tree for the arithmetic for
635 * When called, shlex.arg contains the string inside ((...))
636 * When the first argument is missing, a while node is returned
637 * Otherise a list containing an arithmetic command and a while
638 * is returned.
639 */
640static Shnode_t	*arithfor(Lex_t *lexp,register Shnode_t *tf)
641{
642	register Shnode_t	*t, *tw = tf;
643	register int	offset;
644	register struct argnod *argp;
645	register int n;
646	Stk_t		*stkp = lexp->sh->stk;
647	int argflag = lexp->arg->argflag;
648	/* save current input */
649	Fcin_t	sav_input;
650	fcsave(&sav_input);
651	fcsopen(lexp->arg->argval);
652	/* split ((...)) into three expressions */
653	for(n=0; ; n++)
654	{
655		register int c;
656		argp = (struct argnod*)stkseek(stkp,ARGVAL);
657		argp->argnxt.ap = 0;
658		argp->argchn.cp = 0;
659		argp->argflag = argflag;
660		if(n==2)
661			break;
662		/* copy up to ; onto the stack */
663		sh_lexskip(lexp,';',1,ST_NESTED);
664		offset = stktell(stkp)-1;
665		if((c=fcpeek(-1))!=';')
666			break;
667		/* remove trailing white space */
668		while(offset>ARGVAL && ((c= *stkptr(stkp,offset-1)),isspace(c)))
669			offset--;
670		/* check for empty initialization expression  */
671		if(offset==ARGVAL && n==0)
672			continue;
673		stkseek(stkp,offset);
674		/* check for empty condition and treat as while((1)) */
675		if(offset==ARGVAL)
676			sfputc(stkp,'1');
677		argp = (struct argnod*)stkfreeze(stkp,1);
678		t = getanode(lexp,argp);
679		if(n==0)
680			tf = makelist(lexp,TLST,t,tw);
681		else
682			tw->wh.whtre = t;
683	}
684	while((offset=fcpeek(0)) && isspace(offset))
685		fcseek(1);
686	stakputs(fcseek(0));
687	argp = (struct argnod*)stakfreeze(1);
688	fcrestore(&sav_input);
689	if(n<2)
690	{
691		lexp->token = RPAREN|SYMREP;
692		sh_syntax(lexp);
693	}
694	/* check whether the increment is present */
695	if(*argp->argval)
696	{
697		t = getanode(lexp,argp);
698		tw->wh.whinc = (struct arithnod*)t;
699	}
700	else
701		tw->wh.whinc = 0;
702	sh_lexopen(lexp, lexp->sh,1);
703	if((n=sh_lex(lexp))==NL)
704		n = skipnl(lexp,0);
705	else if(n==';')
706		n = sh_lex(lexp);
707	if(n!=DOSYM && n!=LBRACE)
708		sh_syntax(lexp);
709	tw->wh.dotre = sh_cmd(lexp,n==DOSYM?DONESYM:RBRACE,SH_NL);
710	tw->wh.whtyp = TWH;
711	return(tf);
712
713}
714
715static Shnode_t *funct(Lex_t *lexp)
716{
717	Shell_t	*shp = lexp->sh;
718	register Shnode_t *t;
719	register int flag;
720	struct slnod *volatile slp=0;
721	Stak_t *savstak;
722	Sfoff_t	first, last;
723	struct functnod *volatile fp;
724	Sfio_t *iop;
725#if SHOPT_KIA
726	unsigned long current = lexp->current;
727#endif /* SHOPT_KIA */
728	int jmpval, saveloop=loop_level;
729	struct argnod *savelabel = label_last;
730	struct  checkpt buff;
731	int save_optget = opt_get;
732	void	*in_mktype = shp->mktype;
733	shp->mktype = 0;
734	opt_get = 0;
735	t = getnode(functnod);
736	t->funct.functline = shp->inlineno;
737	t->funct.functtyp=TFUN;
738	t->funct.functargs = 0;
739	if(!(flag = (lexp->token==FUNCTSYM)))
740		t->funct.functtyp |= FPOSIX;
741	else if(sh_lex(lexp))
742		sh_syntax(lexp);
743	if(!(iop=fcfile()))
744	{
745		iop = sfopen(NIL(Sfio_t*),fcseek(0),"s");
746		fcclose();
747		fcfopen(iop);
748	}
749	t->funct.functloc = first = fctell();
750	if(!shp->st.filename || sffileno(iop)<0)
751	{
752		if(fcfill() >= 0)
753			fcseek(-1);
754		if(sh_isstate(SH_HISTORY) && shp->hist_ptr)
755			t->funct.functloc = sfseek(shp->hist_ptr->histfp,(off_t)0,SEEK_CUR);
756		else
757		{
758			/* copy source to temporary file */
759			t->funct.functloc = 0;
760			if(lexp->sh->heredocs)
761				t->funct.functloc = sfseek(lexp->sh->heredocs,(Sfoff_t)0, SEEK_END);
762			else
763				lexp->sh->heredocs = sftmp(HERE_MEM);
764			lexp->sh->funlog = lexp->sh->heredocs;
765			t->funct.functtyp |= FPIN;
766		}
767	}
768	t->funct.functnam= (char*)lexp->arg->argval;
769#if SHOPT_KIA
770	if(lexp->kiafile)
771		lexp->current = kiaentity(lexp,t->funct.functnam,-1,'p',-1,-1,lexp->script,'p',0,"");
772#endif /* SHOPT_KIA */
773	if(flag)
774	{
775		lexp->token = sh_lex(lexp);
776#if SHOPT_BASH
777		if(lexp->token == LPAREN)
778		{
779			if((lexp->token = sh_lex(lexp)) == RPAREN)
780				t->funct.functtyp |= FPOSIX;
781			else
782				sh_syntax(lexp);
783		}
784#endif
785	}
786	if(t->funct.functtyp&FPOSIX)
787		skipnl(lexp,0);
788	else
789	{
790		if(lexp->token==0)
791			t->funct.functargs = (struct comnod*)simple(lexp,SH_NOIO|SH_FUNDEF,NIL(struct ionod*));
792		while(lexp->token==NL)
793			lexp->token = sh_lex(lexp);
794	}
795	if((flag && lexp->token!=LBRACE) || lexp->token==EOFSYM)
796		sh_syntax(lexp);
797	sh_pushcontext(&buff,1);
798	jmpval = sigsetjmp(buff.buff,0);
799	if(jmpval == 0)
800	{
801		/* create a new stak frame to compile the command */
802		savstak = stakcreate(STAK_SMALL);
803		savstak = stakinstall(savstak, 0);
804		slp = (struct slnod*)stakalloc(sizeof(struct slnod)+sizeof(struct functnod));
805		slp->slchild = 0;
806		slp->slnext = shp->st.staklist;
807		shp->st.staklist = 0;
808		t->funct.functstak = (struct slnod*)slp;
809		/*
810		 * store the pathname of function definition file on stack
811		 * in name field of fake for node
812		 */
813		fp = (struct functnod*)(slp+1);
814		fp->functtyp = TFUN|FAMP;
815		fp->functnam = 0;
816		fp->functline = t->funct.functline;
817		if(shp->st.filename)
818			fp->functnam = stakcopy(shp->st.filename);
819		loop_level = 0;
820		label_last = label_list;
821		if(!flag && lexp->token==0)
822		{
823			/* copy current word token to current stak frame */
824			struct argnod *ap;
825			flag = ARGVAL + strlen(lexp->arg->argval);
826			ap = (struct argnod*)stakalloc(flag);
827			memcpy(ap,lexp->arg,flag);
828			lexp->arg = ap;
829		}
830		t->funct.functtre = item(lexp,SH_NOIO);
831	}
832	else if(shp->shcomp)
833		exit(1);
834	sh_popcontext(&buff);
835	loop_level = saveloop;
836	label_last = savelabel;
837	/* restore the old stack */
838	if(slp)
839	{
840		slp->slptr =  stakinstall(savstak,0);
841		slp->slchild = shp->st.staklist;
842	}
843#if SHOPT_KIA
844	lexp->current = current;
845#endif /* SHOPT_KIA */
846	if(jmpval)
847	{
848		if(slp && slp->slptr)
849		{
850			shp->st.staklist = slp->slnext;
851			stakdelete(slp->slptr);
852		}
853		siglongjmp(*shp->jmplist,jmpval);
854	}
855	shp->st.staklist = (struct slnod*)slp;
856	last = fctell();
857	fp->functline = (last-first);
858	fp->functtre = t;
859	shp->mktype = in_mktype;
860	if(lexp->sh->funlog)
861	{
862		if(fcfill()>0)
863			fcseek(-1);
864		lexp->sh->funlog = 0;
865	}
866#if 	SHOPT_KIA
867	if(lexp->kiafile)
868		kiaentity(lexp,t->funct.functnam,-1,'p',t->funct.functline,shp->inlineno-1,lexp->current,'p',0,"");
869#endif /* SHOPT_KIA */
870	t->funct.functtyp |= opt_get;
871	opt_get = save_optget;
872	return(t);
873}
874
875/*
876 * Compound assignment
877 */
878static struct argnod *assign(Lex_t *lexp, register struct argnod *ap, int tdef)
879{
880	register int n;
881	register Shnode_t *t, **tp;
882	register struct comnod *ac;
883	Stk_t	*stkp = lexp->sh->stk;
884	int array=0;
885	Namval_t *np;
886	n = strlen(ap->argval)-1;
887	if(ap->argval[n]!='=')
888		sh_syntax(lexp);
889	if(ap->argval[n-1]=='+')
890	{
891		ap->argval[n--]=0;
892		array = ARG_APPEND;
893	}
894	/* shift right */
895	while(n > 0)
896	{
897		ap->argval[n] = ap->argval[n-1];
898		n--;
899	}
900	*ap->argval=0;
901	t = getnode(fornod);
902	t->for_.fornam = (char*)(ap->argval+1);
903	t->for_.fortyp = sh_getlineno(lexp);
904	tp = &t->for_.fortre;
905	ap->argchn.ap = (struct argnod*)t;
906	ap->argflag &= ARG_QUOTED;
907	ap->argflag |= array;
908	lexp->assignok = SH_ASSIGN;
909	lexp->aliasok = 1;
910	array=0;
911	if((n=skipnl(lexp,0))==RPAREN || n==LPAREN)
912	{
913		int index= 0;
914		struct argnod **settail;
915		ac = (struct comnod*)getnode(comnod);
916		settail= &ac->comset;
917		memset((void*)ac,0,sizeof(*ac));
918		ac->comline = sh_getlineno(lexp);
919		while(n==LPAREN)
920		{
921			struct argnod *ap;
922			ap = (struct argnod*)stkseek(stkp,ARGVAL);
923			ap->argflag= ARG_ASSIGN;
924			sfprintf(stkp,"[%d]=",index++);
925			ap = (struct argnod*)stkfreeze(stkp,1);
926			ap->argnxt.ap = 0;
927			ap = assign(lexp,ap,0);
928			ap->argflag |= ARG_MESSAGE;
929			*settail = ap;
930			settail = &(ap->argnxt.ap);
931			while((n = skipnl(lexp,0))==0)
932			{
933				ap = (struct argnod*)stkseek(stkp,ARGVAL);
934				ap->argflag= ARG_ASSIGN;
935				sfprintf(stkp,"[%d]=",index++);
936				stakputs(lexp->arg->argval);
937				ap = (struct argnod*)stkfreeze(stkp,1);
938				ap->argnxt.ap = 0;
939				ap->argflag = lexp->arg->argflag;
940				*settail = ap;
941				settail = &(ap->argnxt.ap);
942			}
943		}
944	}
945	else if(n && n!=FUNCTSYM)
946		sh_syntax(lexp);
947	else if(n!=FUNCTSYM && !(lexp->arg->argflag&ARG_ASSIGN) && !((np=nv_search(lexp->arg->argval,lexp->sh->fun_tree,0)) && (nv_isattr(np,BLT_DCL)|| np==SYSDOT)))
948	{
949		array=SH_ARRAY;
950		if(fcgetc(n)==LPAREN)
951		{
952			int c;
953			if(fcgetc(c)==RPAREN)
954			{
955				lexp->token =  SYMRES;
956				array = 0;
957			}
958			else
959				fcseek(-2);
960		}
961		else if(n>0)
962			fcseek(-1);
963		if(array && tdef)
964			sh_syntax(lexp);
965	}
966	while(1)
967	{
968		if((n=lexp->token)==RPAREN)
969			break;
970		if(n==FUNCTSYM || n==SYMRES)
971			ac = (struct comnod*)funct(lexp);
972		else
973			ac = (struct comnod*)simple(lexp,SH_NOIO|SH_ASSIGN|array,NIL(struct ionod*));
974		if((n=lexp->token)==RPAREN)
975			break;
976		if(n!=NL && n!=';')
977			sh_syntax(lexp);
978		lexp->assignok = SH_ASSIGN;
979		if((n=skipnl(lexp,0)) || array)
980		{
981			if(n==RPAREN)
982				break;
983			if(array ||  n!=FUNCTSYM)
984				sh_syntax(lexp);
985		}
986		if((n!=FUNCTSYM) && !(lexp->arg->argflag&ARG_ASSIGN) && !((np=nv_search(lexp->arg->argval,lexp->sh->fun_tree,0)) && (nv_isattr(np,BLT_DCL)||np==SYSDOT)))
987		{
988			struct argnod *arg = lexp->arg;
989			if(n!=0)
990				sh_syntax(lexp);
991			/* check for sys5 style function */
992			if(sh_lex(lexp)!=LPAREN || sh_lex(lexp)!=RPAREN)
993			{
994				lexp->arg = arg;
995				lexp->token = 0;
996				sh_syntax(lexp);
997			}
998			lexp->arg = arg;
999			lexp->token = SYMRES;
1000		}
1001		t = makelist(lexp,TLST,(Shnode_t*)ac,t);
1002		*tp = t;
1003		tp = &t->lst.lstrit;
1004	}
1005	*tp = (Shnode_t*)ac;
1006	lexp->assignok = 0;
1007	return(ap);
1008}
1009
1010/*
1011 * item
1012 *
1013 *	( cmd ) [ < in ] [ > out ]
1014 *	word word* [ < in ] [ > out ]
1015 *	if ... then ... else ... fi
1016 *	for ... while ... do ... done
1017 *	case ... in ... esac
1018 *	begin ... end
1019 */
1020
1021static Shnode_t	*item(Lex_t *lexp,int flag)
1022{
1023	register Shnode_t	*t;
1024	register struct ionod	*io;
1025	register int tok = (lexp->token&0xff);
1026	int savwdval = lexp->lasttok;
1027	int savline = lexp->lastline;
1028	int showme=0, comsub;
1029	if(!(flag&SH_NOIO) && (tok=='<' || tok=='>' || lexp->token==IOVNAME))
1030		io=inout(lexp,NIL(struct ionod*),1);
1031	else
1032		io=0;
1033	if((tok=lexp->token) && tok!=EOFSYM && tok!=FUNCTSYM)
1034	{
1035		lexp->lastline =  sh_getlineno(lexp);
1036		lexp->lasttok = lexp->token;
1037	}
1038	switch(tok)
1039	{
1040	    /* [[ ... ]] test expression */
1041	    case BTESTSYM:
1042		t = test_expr(lexp,ETESTSYM);
1043		t->tre.tretyp &= ~TTEST;
1044		break;
1045	    /* ((...)) arithmetic expression */
1046	    case EXPRSYM:
1047		t = getanode(lexp,lexp->arg);
1048		sh_lex(lexp);
1049		goto done;
1050
1051	    /* case statement */
1052	    case CASESYM:
1053	    {
1054		int savetok = lexp->lasttok;
1055		int saveline = lexp->lastline;
1056		t = getnode(swnod);
1057		if(sh_lex(lexp))
1058			sh_syntax(lexp);
1059		t->sw.swarg=lexp->arg;
1060		t->sw.swtyp=TSW;
1061		t->sw.swio = 0;
1062		t->sw.swtyp |= FLINENO;
1063		t->sw.swline =  lexp->sh->inlineno;
1064		if((tok=skipnl(lexp,0))!=INSYM && tok!=LBRACE)
1065			sh_syntax(lexp);
1066		if(!(t->sw.swlst=syncase(lexp,tok==INSYM?ESACSYM:RBRACE)) && lexp->token==EOFSYM)
1067		{
1068			lexp->lasttok = savetok;
1069			lexp->lastline = saveline;
1070			sh_syntax(lexp);
1071		}
1072		break;
1073	    }
1074
1075	    /* if statement */
1076	    case IFSYM:
1077	    {
1078		register Shnode_t	*tt;
1079		t = getnode(ifnod);
1080		t->if_.iftyp=TIF;
1081		t->if_.iftre=sh_cmd(lexp,THENSYM,SH_NL);
1082		t->if_.thtre=sh_cmd(lexp,ELSESYM,SH_NL|SH_SEMI);
1083		tok = lexp->token;
1084		t->if_.eltre=(tok==ELSESYM?sh_cmd(lexp,FISYM,SH_NL|SH_SEMI):
1085			(tok==ELIFSYM?(lexp->token=IFSYM, tt=item(lexp,SH_NOIO)):0));
1086		if(tok==ELIFSYM)
1087		{
1088			if(!tt || tt->tre.tretyp!=TSETIO)
1089				goto done;
1090			t->if_.eltre = tt->fork.forktre;
1091			tt->fork.forktre = t;
1092			t = tt;
1093			goto done;
1094		}
1095		break;
1096	    }
1097
1098	    /* for and select statement */
1099	    case FORSYM:
1100	    case SELECTSYM:
1101	    {
1102		t = getnode(fornod);
1103		t->for_.fortyp=(lexp->token==FORSYM?TFOR:TSELECT);
1104		t->for_.forlst=0;
1105		t->for_.forline =  lexp->sh->inlineno;
1106		if(sh_lex(lexp))
1107		{
1108			if(lexp->token!=EXPRSYM || t->for_.fortyp!=TFOR)
1109				sh_syntax(lexp);
1110			/* arithmetic for */
1111			t = arithfor(lexp,t);
1112			break;
1113		}
1114		t->for_.fornam=(char*) lexp->arg->argval;
1115		t->for_.fortyp |= FLINENO;
1116#if SHOPT_KIA
1117		if(lexp->kiafile)
1118			writedefs(lexp,lexp->arg,lexp->sh->inlineno,'v',NIL(struct argnod*));
1119#endif /* SHOPT_KIA */
1120		while((tok=sh_lex(lexp))==NL);
1121		if(tok==INSYM)
1122		{
1123			if(sh_lex(lexp))
1124			{
1125				if(lexp->token != NL && lexp->token !=';')
1126					sh_syntax(lexp);
1127				/* some Linux scripts assume this */
1128				if(sh_isoption(SH_NOEXEC))
1129					errormsg(SH_DICT,ERROR_warn(0),e_lexemptyfor,lexp->sh->inlineno-(lexp->token=='\n'));
1130				t->for_.forlst = (struct comnod*)getnode(comnod);
1131				(t->for_.forlst)->comarg = 0;
1132				(t->for_.forlst)->comset = 0;
1133				(t->for_.forlst)->comnamp = 0;
1134				(t->for_.forlst)->comnamq = 0;
1135				(t->for_.forlst)->comstate = 0;
1136				(t->for_.forlst)->comio = 0;
1137				(t->for_.forlst)->comtyp = 0;
1138			}
1139			else
1140				t->for_.forlst=(struct comnod*)simple(lexp,SH_NOIO,NIL(struct ionod*));
1141			if(lexp->token != NL && lexp->token !=';')
1142				sh_syntax(lexp);
1143			tok = skipnl(lexp,0);
1144		}
1145		/* 'for i;do cmd' is valid syntax */
1146		else if(tok==';')
1147			tok=sh_lex(lexp);
1148		if(tok!=DOSYM && tok!=LBRACE)
1149			sh_syntax(lexp);
1150		loop_level++;
1151		t->for_.fortre=sh_cmd(lexp,tok==DOSYM?DONESYM:RBRACE,SH_NL|SH_SEMI);
1152		if(--loop_level==0)
1153			label_last = label_list;
1154		break;
1155	    }
1156
1157	    /* This is the code for parsing function definitions */
1158	    case FUNCTSYM:
1159		return(funct(lexp));
1160
1161#if SHOPT_NAMESPACE
1162	    case NSPACESYM:
1163		t = getnode(fornod);
1164		t->for_.fortyp=TNSPACE;
1165		t->for_.forlst=0;
1166		if(sh_lex(lexp))
1167			sh_syntax(lexp);
1168		t->for_.fornam=(char*) lexp->arg->argval;
1169		while((tok=sh_lex(lexp))==NL);
1170		if(tok!=LBRACE)
1171			sh_syntax(lexp);
1172		t->for_.fortre = sh_cmd(lexp,RBRACE,SH_NL);
1173		break;
1174#endif /* SHOPT_NAMESPACE */
1175
1176	    /* while and until */
1177	    case WHILESYM:
1178	    case UNTILSYM:
1179		t = getnode(whnod);
1180		t->wh.whtyp=(lexp->token==WHILESYM ? TWH : TUN);
1181		loop_level++;
1182		t->wh.whtre = sh_cmd(lexp,DOSYM,SH_NL);
1183		t->wh.dotre = sh_cmd(lexp,DONESYM,SH_NL|SH_SEMI);
1184		if(--loop_level==0)
1185			label_last = label_list;
1186		t->wh.whinc = 0;
1187		break;
1188
1189	    case LABLSYM:
1190	    {
1191		register struct argnod *argp = label_list;
1192		while(argp)
1193		{
1194			if(strcmp(argp->argval,lexp->arg->argval)==0)
1195				errormsg(SH_DICT,ERROR_exit(3),e_lexsyntax3,lexp->sh->inlineno,argp->argval);
1196			argp = argp->argnxt.ap;
1197		}
1198		lexp->arg->argnxt.ap = label_list;
1199		label_list = lexp->arg;
1200		label_list->argchn.len = sh_getlineno(lexp);
1201		label_list->argflag = loop_level;
1202		skipnl(lexp,flag);
1203		if(!(t = item(lexp,SH_NL)))
1204			sh_syntax(lexp);
1205		tok = (t->tre.tretyp&(COMSCAN|COMSCAN-1));
1206		if(sh_isoption(SH_NOEXEC) && tok!=TWH && tok!=TUN && tok!=TFOR && tok!=TSELECT)
1207			errormsg(SH_DICT,ERROR_warn(0),e_lexlabignore,label_list->argchn.len,label_list->argval);
1208		return(t);
1209	    }
1210
1211	    /* command group with {...} */
1212	    case LBRACE:
1213		comsub = lexp->comsub;
1214		lexp->comsub = 0;
1215		t = sh_cmd(lexp,RBRACE,SH_NL|SH_SEMI);
1216		lexp->comsub = comsub;
1217		break;
1218
1219	    case LPAREN:
1220		t = getnode(parnod);
1221		t->par.partre=sh_cmd(lexp,RPAREN,SH_NL|SH_SEMI);
1222		t->par.partyp=TPAR;
1223		break;
1224
1225	    default:
1226		if(io==0)
1227			return(0);
1228
1229	    case ';':
1230		if(io==0)
1231		{
1232			if(!(flag&SH_SEMI))
1233				return(0);
1234			if(sh_lex(lexp)==';')
1235				sh_syntax(lexp);
1236			showme =  FSHOWME;
1237		}
1238	    /* simple command */
1239	    case 0:
1240		t = (Shnode_t*)simple(lexp,flag,io);
1241		if(t->com.comarg && lexp->intypeset && (lexp->sh->shcomp || sh_isoption(SH_NOEXEC) || sh.dot_depth))
1242			check_typedef(&t->com);
1243		lexp->intypeset = 0;
1244		lexp->inexec = 0;
1245		t->tre.tretyp |= showme;
1246		return(t);
1247	}
1248	sh_lex(lexp);
1249	if(io=inout(lexp,io,0))
1250	{
1251		if((tok=t->tre.tretyp&COMMSK) != TFORK)
1252			tok = TSETIO;
1253		t=makeparent(lexp,tok,t);
1254		t->tre.treio=io;
1255	}
1256done:
1257	lexp->lasttok = savwdval;
1258	lexp->lastline = savline;
1259	return(t);
1260}
1261
1262static struct argnod *process_sub(Lex_t *lexp,int tok)
1263{
1264	struct argnod *argp;
1265	Shnode_t *t;
1266	int mode = (tok==OPROCSYM);
1267	t = sh_cmd(lexp,RPAREN,SH_NL);
1268	argp = (struct argnod*)stkalloc(lexp->sh->stk,sizeof(struct argnod));
1269	*argp->argval = 0;
1270	argp->argchn.ap = (struct argnod*)makeparent(lexp,mode?TFORK|FPIN|FAMP|FPCL:TFORK|FPOU,t);
1271	argp->argflag =  (ARG_EXP|mode);
1272	return(argp);
1273}
1274
1275
1276/*
1277 * This is for a simple command, for list, or compound assignment
1278 */
1279static Shnode_t *simple(Lex_t *lexp,int flag, struct ionod *io)
1280{
1281	register struct comnod *t;
1282	register struct argnod	*argp;
1283	register int tok;
1284	Stk_t		*stkp = lexp->sh->stk;
1285	struct argnod	**argtail;
1286	struct argnod	**settail;
1287	int	cmdarg=0;
1288	int	argno = 0, argmax=0;
1289	int	assignment = 0;
1290	int	key_on = (!(flag&SH_NOIO) && sh_isoption(SH_KEYWORD));
1291	int	associative=0;
1292	if((argp=lexp->arg) && (argp->argflag&ARG_ASSIGN) && argp->argval[0]=='[')
1293	{
1294		flag |= SH_ARRAY;
1295		associative = 1;
1296	}
1297	t = (struct comnod*)getnode(comnod);
1298	t->comio=io; /*initial io chain*/
1299	/* set command line number for error messages */
1300	t->comline = sh_getlineno(lexp);
1301	argtail = &(t->comarg);
1302	t->comset = 0;
1303	t->comnamp = 0;
1304	t->comnamq = 0;
1305	t->comstate = 0;
1306	settail = &(t->comset);
1307	while(lexp->token==0)
1308	{
1309		argp = lexp->arg;
1310		if(*argp->argval==LBRACE && (flag&SH_FUNDEF) && argp->argval[1]==0)
1311		{
1312			lexp->token = LBRACE;
1313			break;
1314		}
1315		if(associative && argp->argval[0]!='[')
1316			sh_syntax(lexp);
1317		/* check for assignment argument */
1318		if((argp->argflag&ARG_ASSIGN) && assignment!=2)
1319		{
1320			*settail = argp;
1321			settail = &(argp->argnxt.ap);
1322			lexp->assignok = (flag&SH_ASSIGN)?SH_ASSIGN:1;
1323			if(assignment)
1324			{
1325				struct argnod *ap=argp;
1326				char *last, *cp;
1327				if(assignment==1)
1328				{
1329					last = strchr(argp->argval,'=');
1330					if(last && (last[-1]==']'|| (last[-1]=='+' && last[-2]==']')) && (cp=strchr(argp->argval,'[')) && (cp < last))
1331						last = cp;
1332					stkseek(stkp,ARGVAL);
1333					sfwrite(stkp,argp->argval,last-argp->argval);
1334					ap=(struct argnod*)stkfreeze(stkp,1);
1335					ap->argflag = ARG_RAW;
1336					ap->argchn.ap = 0;
1337				}
1338				*argtail = ap;
1339				argtail = &(ap->argnxt.ap);
1340				if(argno>=0)
1341					argno++;
1342			}
1343			else /* alias substitutions allowed */
1344				lexp->aliasok = 1;
1345		}
1346		else
1347		{
1348			if(!(argp->argflag&ARG_RAW))
1349			{
1350				if(argno>0)
1351					argmax = argno;
1352				argno = -1;
1353			}
1354			if(argno>=0 && argno++==cmdarg && !(flag&SH_ARRAY) && *argp->argval!='/')
1355			{
1356				/* check for builtin command */
1357				Namval_t *np=nv_bfsearch(argp->argval,lexp->sh->fun_tree, (Namval_t**)&t->comnamq,(char**)0);
1358				if(cmdarg==0)
1359					t->comnamp = (void*)np;
1360				if(np && is_abuiltin(np))
1361				{
1362					if(nv_isattr(np,BLT_DCL))
1363					{
1364						assignment = 1+(*argp->argval=='a');
1365						if(np==SYSTYPESET)
1366							lexp->intypeset = 1;
1367						key_on = 1;
1368					}
1369					else if(np==SYSCOMMAND)
1370						cmdarg++;
1371					else if(np==SYSEXEC)
1372						lexp->inexec = 1;
1373					else if(np->nvalue.bfp==b_getopts)
1374						opt_get |= FOPTGET;
1375				}
1376			}
1377			*argtail = argp;
1378			argtail = &(argp->argnxt.ap);
1379			if(!(lexp->assignok=key_on)  && !(flag&SH_NOIO) && sh_isoption(SH_NOEXEC))
1380				lexp->assignok = SH_COMPASSIGN;
1381			lexp->aliasok = 0;
1382		}
1383	retry:
1384		tok = sh_lex(lexp);
1385		if(tok==LABLSYM && (flag&SH_ASSIGN))
1386			lexp->token = tok = 0;
1387#if SHOPT_DEVFD
1388		if((tok==IPROCSYM || tok==OPROCSYM))
1389		{
1390			argp = process_sub(lexp,tok);
1391			argmax = 0;
1392			argno = -1;
1393			*argtail = argp;
1394			argtail = &(argp->argnxt.ap);
1395			goto retry;
1396		}
1397#endif	/* SHOPT_DEVFD */
1398		if(tok==LPAREN)
1399		{
1400			if(argp->argflag&ARG_ASSIGN)
1401			{
1402				int intypeset = lexp->intypeset;
1403				int tdef = 0;
1404				lexp->intypeset = 0;
1405				if(t->comnamp==SYSTYPESET && t->comarg->argnxt.ap && strcmp(t->comarg->argnxt.ap->argval,"-T")==0)
1406					tdef = 1;
1407				argp = assign(lexp,argp,tdef);
1408				lexp->intypeset = intypeset;
1409				if(associative)
1410					lexp->assignok |= SH_ASSIGN;
1411				goto retry;
1412			}
1413			else if(argno==1 && !t->comset)
1414			{
1415				/* SVR2 style function */
1416				if(sh_lex(lexp) == RPAREN)
1417				{
1418					lexp->arg = argp;
1419					return(funct(lexp));
1420				}
1421				lexp->token = LPAREN;
1422			}
1423		}
1424		else if(flag&SH_ASSIGN)
1425		{
1426			if(tok==RPAREN)
1427				break;
1428			else if(tok==NL && (flag&SH_ARRAY))
1429			{
1430				lexp->comp_assign = 2;
1431				goto retry;
1432			}
1433
1434		}
1435		if(!(flag&SH_NOIO))
1436		{
1437			if(io)
1438			{
1439				while(io->ionxt)
1440					io = io->ionxt;
1441				io->ionxt = inout(lexp,(struct ionod*)0,0);
1442			}
1443			else
1444				t->comio = io = inout(lexp,(struct ionod*)0,0);
1445		}
1446	}
1447	*argtail = 0;
1448	if(argno>0)
1449		argmax = argno;
1450	t->comtyp = TCOM;
1451#if SHOPT_KIA
1452	if(lexp->kiafile && !(flag&SH_NOIO))
1453	{
1454		register Namval_t *np=(Namval_t*)t->comnamp;
1455		unsigned long r=0;
1456		int line = t->comline;
1457		argp = t->comarg;
1458		if(np)
1459			r = kiaentity(lexp,nv_name(np),-1,'p',-1,0,lexp->unknown,'b',0,"");
1460		else if(argp)
1461			r = kiaentity(lexp,sh_argstr(argp),-1,'p',-1,0,lexp->unknown,'c',0,"");
1462		if(r>0)
1463			sfprintf(lexp->kiatmp,"p;%..64d;p;%..64d;%d;%d;c;\n",lexp->current,r,line,line);
1464		if(t->comset && argno==0)
1465			writedefs(lexp,t->comset,line,'v',t->comarg);
1466		else if(np && nv_isattr(np,BLT_DCL))
1467			writedefs(lexp,argp,line,0,NIL(struct argnod*));
1468		else if(argp && strcmp(argp->argval,"read")==0)
1469			writedefs(lexp,argp,line,0,NIL(struct argnod*));
1470#if 0
1471		else if(argp && strcmp(argp->argval,"unset")==0)
1472			writedefs(lexp,argp,line,'u',NIL(struct argnod*));
1473#endif
1474		else if(argp && *argp->argval=='.' && argp->argval[1]==0 && (argp=argp->argnxt.ap))
1475		{
1476			r = kiaentity(lexp,sh_argstr(argp),-1,'p',0,0,lexp->script,'d',0,"");
1477			sfprintf(lexp->kiatmp,"p;%..64d;p;%..64d;%d;%d;d;\n",lexp->current,r,line,line);
1478		}
1479	}
1480#endif /* SHOPT_KIA */
1481	if(t->comnamp && (argp=t->comarg->argnxt.ap))
1482	{
1483		Namval_t *np=(Namval_t*)t->comnamp;
1484		if((np==SYSBREAK || np==SYSCONT) && (argp->argflag&ARG_RAW) && !isdigit(*argp->argval))
1485		{
1486			register char *cp = argp->argval;
1487			/* convert break/continue labels to numbers */
1488			tok = 0;
1489			for(argp=label_list;argp!=label_last;argp=argp->argnxt.ap)
1490			{
1491				if(strcmp(cp,argp->argval))
1492					continue;
1493				tok = loop_level-argp->argflag;
1494				if(tok>=1)
1495				{
1496					argp = t->comarg->argnxt.ap;
1497					if(tok>9)
1498					{
1499						argp->argval[1] = '0'+tok%10;
1500						argp->argval[2] = 0;
1501						tok /= 10;
1502					}
1503					else
1504						argp->argval[1] = 0;
1505					*argp->argval = '0'+tok;
1506				}
1507				break;
1508			}
1509			if(sh_isoption(SH_NOEXEC) && tok==0)
1510				errormsg(SH_DICT,ERROR_warn(0),e_lexlabunknown,lexp->sh->inlineno-(lexp->token=='\n'),cp);
1511		}
1512		else if(sh_isoption(SH_NOEXEC) && np==SYSSET && ((tok= *argp->argval)=='-'||tok=='+') &&
1513			(argp->argval[1]==0||strchr(argp->argval,'k')))
1514			errormsg(SH_DICT,ERROR_warn(0),e_lexobsolete5,lexp->sh->inlineno-(lexp->token=='\n'),argp->argval);
1515	}
1516	/* expand argument list if possible */
1517	if(argno>0)
1518		t->comarg = qscan(t,argno);
1519	else if(t->comarg)
1520		t->comtyp |= COMSCAN;
1521	lexp->aliasok = 0;
1522	return((Shnode_t*)t);
1523}
1524
1525/*
1526 * skip past newlines but issue prompt if interactive
1527 */
1528static int	skipnl(Lex_t *lexp,int flag)
1529{
1530	register int token;
1531	while((token=sh_lex(lexp))==NL);
1532	if(token==';' && !(flag&SH_SEMI))
1533		sh_syntax(lexp);
1534	return(token);
1535}
1536
1537/*
1538 * check for and process and i/o redirections
1539 * if flag>0 then an alias can be in the next word
1540 * if flag<0 only one redirection will be processed
1541 */
1542static struct ionod	*inout(Lex_t *lexp,struct ionod *lastio,int flag)
1543{
1544	register int 		iof = lexp->digits, token=lexp->token;
1545	register struct ionod	*iop;
1546	Stk_t			*stkp = lexp->sh->stk;
1547	char *iovname=0;
1548	register int		errout=0;
1549	if(token==IOVNAME)
1550	{
1551		iovname=lexp->arg->argval+1;
1552		token= sh_lex(lexp);
1553		iof = 0;
1554	}
1555	switch(token&0xff)
1556	{
1557	    case '<':
1558		if(token==IODOCSYM)
1559			iof |= (IODOC|IORAW);
1560		else if(token==IOMOV0SYM)
1561			iof |= IOMOV;
1562		else if(token==IORDWRSYMT)
1563			iof |= IORDW|IOREWRITE;
1564		else if(token==IORDWRSYM)
1565			iof |= IORDW;
1566		else if((token&SYMSHARP) == SYMSHARP)
1567		{
1568			int n;
1569			iof |= IOLSEEK;
1570			if(fcgetc(n)=='#')
1571				iof |= IOCOPY;
1572			else if(n>0)
1573				fcseek(-1);
1574		}
1575		break;
1576
1577	    case '>':
1578		if(iof<0)
1579		{
1580			errout = 1;
1581			iof = 1;
1582		}
1583		iof |= IOPUT;
1584		if(token==IOAPPSYM)
1585			iof |= IOAPP;
1586		else if(token==IOMOV1SYM)
1587			iof |= IOMOV;
1588		else if(token==IOCLOBSYM)
1589			iof |= IOCLOB;
1590		else if((token&SYMSHARP) == SYMSHARP)
1591			iof |= IOLSEEK;
1592		else if((token&SYMSEMI) == SYMSEMI)
1593			iof |= IOREWRITE;
1594		break;
1595
1596	    default:
1597		return(lastio);
1598	}
1599	lexp->digits=0;
1600	iop=(struct ionod*) stkalloc(stkp,sizeof(struct ionod));
1601	iop->iodelim = 0;
1602	if(token=sh_lex(lexp))
1603	{
1604		if(token==RPAREN && (iof&IOLSEEK) && lexp->comsub)
1605		{
1606			lexp->arg = (struct argnod*)stkalloc(stkp,sizeof(struct argnod)+3);
1607			strcpy(lexp->arg->argval,"CUR");
1608			lexp->arg->argflag = ARG_RAW;
1609			iof |= IOARITH;
1610			fcseek(-1);
1611		}
1612		else if(token==EXPRSYM && (iof&IOLSEEK))
1613			iof |= IOARITH;
1614		else if(((token==IPROCSYM && !(iof&IOPUT)) || (token==OPROCSYM && (iof&IOPUT))) && !(iof&(IOLSEEK|IOREWRITE|IOMOV|IODOC)))
1615		{
1616			lexp->arg = process_sub(lexp,token);
1617			iof |= IOPROCSUB;
1618		}
1619		else
1620			sh_syntax(lexp);
1621	}
1622	if( (iof&IOPROCSUB) && !(iof&IOLSEEK))
1623		iop->ioname= (char*)lexp->arg->argchn.ap;
1624	else
1625		iop->ioname=lexp->arg->argval;
1626	iop->iovname = iovname;
1627	if(iof&IODOC)
1628	{
1629		if(lexp->digits==2)
1630		{
1631			iof |= IOSTRG;
1632			if(!(lexp->arg->argflag&ARG_RAW))
1633				iof &= ~IORAW;
1634		}
1635		else
1636		{
1637			if(!lexp->sh->heredocs)
1638				lexp->sh->heredocs = sftmp(HERE_MEM);
1639			iop->iolst=lexp->heredoc;
1640			lexp->heredoc=iop;
1641			if(lexp->arg->argflag&ARG_QUOTED)
1642				iof |= IOQUOTE;
1643			if(lexp->digits==3)
1644				iof |= IOLSEEK;
1645			if(lexp->digits)
1646				iof |= IOSTRIP;
1647		}
1648	}
1649	else
1650	{
1651		iop->iolst = 0;
1652		if(lexp->arg->argflag&ARG_RAW)
1653			iof |= IORAW;
1654	}
1655	iop->iofile=iof;
1656	if(flag>0)
1657		/* allow alias substitutions and parameter assignments */
1658		lexp->aliasok = lexp->assignok = 1;
1659#if SHOPT_KIA
1660	if(lexp->kiafile)
1661	{
1662		int n = lexp->sh->inlineno-(lexp->token=='\n');
1663		if(!(iof&IOMOV))
1664		{
1665			unsigned long r=kiaentity(lexp,(iof&IORAW)?sh_fmtq(iop->ioname):iop->ioname,-1,'f',0,0,lexp->script,'f',0,"");
1666			sfprintf(lexp->kiatmp,"p;%..64d;f;%..64d;%d;%d;%c;%d\n",lexp->current,r,n,n,(iof&IOPUT)?((iof&IOAPP)?'a':'w'):((iof&IODOC)?'h':'r'),iof&IOUFD);
1667		}
1668	}
1669#endif /* SHOPT_KIA */
1670	if(flag>=0)
1671	{
1672		struct ionod *ioq=iop;
1673		sh_lex(lexp);
1674		if(errout)
1675		{
1676			/* redirect standard output to standard error */
1677			ioq = (struct ionod*)stkalloc(stkp,sizeof(struct ionod));
1678			memset(ioq,0,sizeof(*ioq));
1679			ioq->ioname = "1";
1680			ioq->iolst = 0;
1681			ioq->iodelim = 0;
1682			ioq->iofile = IORAW|IOPUT|IOMOV|2;
1683			iop->ionxt=ioq;
1684		}
1685		ioq->ionxt=inout(lexp,lastio,flag);
1686	}
1687	else
1688		iop->ionxt=0;
1689	return(iop);
1690}
1691
1692/*
1693 * convert argument chain to argument list when no special arguments
1694 */
1695
1696static struct argnod *qscan(struct comnod *ac,int argn)
1697{
1698	register char **cp;
1699	register struct argnod *ap;
1700	register struct dolnod* dp;
1701	register int special=0;
1702	/* special hack for test -t compatibility */
1703	if((Namval_t*)ac->comnamp==SYSTEST)
1704		special = 2;
1705	else if(*(ac->comarg->argval)=='[' && ac->comarg->argval[1]==0)
1706		special = 3;
1707	if(special)
1708	{
1709		ap = ac->comarg->argnxt.ap;
1710		if(argn==(special+1) && ap->argval[1]==0 && *ap->argval=='!')
1711			ap = ap->argnxt.ap;
1712		else if(argn!=special)
1713			special=0;
1714	}
1715	if(special)
1716	{
1717		const char *message;
1718		if(strcmp(ap->argval,"-t"))
1719		{
1720			message = "line %d: Invariant test";
1721			special=0;
1722		}
1723		else
1724		{
1725			message = "line %d: -t requires argument";
1726			argn++;
1727		}
1728		if(sh_isoption(SH_NOEXEC))
1729			errormsg(SH_DICT,ERROR_warn(0),message,ac->comline);
1730	}
1731	/* leave space for an extra argument at the front */
1732	dp = (struct dolnod*)stakalloc((unsigned)sizeof(struct dolnod) + ARG_SPARE*sizeof(char*) + argn*sizeof(char*));
1733	cp = dp->dolval+ARG_SPARE;
1734	dp->dolnum = argn;
1735	dp->dolbot = ARG_SPARE;
1736	ap = ac->comarg;
1737	while(ap)
1738	{
1739		*cp++ = ap->argval;
1740		ap = ap->argnxt.ap;
1741	}
1742	if(special==3)
1743	{
1744		cp[0] = cp[-1];
1745		cp[-1] = "1";
1746		cp++;
1747	}
1748	else if(special)
1749		*cp++ = "1";
1750	*cp = 0;
1751	return((struct argnod*)dp);
1752}
1753
1754static Shnode_t *test_expr(Lex_t *lp,int sym)
1755{
1756	register Shnode_t *t = test_or(lp);
1757	if(lp->token!=sym)
1758		sh_syntax(lp);
1759	return(t);
1760}
1761
1762static Shnode_t *test_or(Lex_t *lp)
1763{
1764	register Shnode_t *t = test_and(lp);
1765	while(lp->token==ORFSYM)
1766		t = makelist(lp,TORF|TTEST,t,test_and(lp));
1767	return(t);
1768}
1769
1770static Shnode_t *test_and(Lex_t *lp)
1771{
1772	register Shnode_t *t = test_primary(lp);
1773	while(lp->token==ANDFSYM)
1774		t = makelist(lp,TAND|TTEST,t,test_primary(lp));
1775	return(t);
1776}
1777
1778/*
1779 * convert =~ into == ~(E)
1780 */
1781static void ere_match(void)
1782{
1783	Sfio_t *base, *iop = sfopen((Sfio_t*)0," ~(E)","s");
1784	register int c;
1785	while( fcgetc(c),(c==' ' || c=='\t'));
1786	if(c)
1787		fcseek(-1);
1788	if(!(base=fcfile()))
1789		base = sfopen(NIL(Sfio_t*),fcseek(0),"s");
1790	fcclose();
1791        sfstack(base,iop);
1792        fcfopen(base);
1793}
1794
1795static Shnode_t *test_primary(Lex_t *lexp)
1796{
1797	register struct argnod *arg;
1798	register Shnode_t *t;
1799	register int num,token;
1800	token = skipnl(lexp,0);
1801	num = lexp->digits;
1802	switch(token)
1803	{
1804	    case '(':
1805		t = test_expr(lexp,')');
1806		t = makelist(lexp,TTST|TTEST|TPAREN ,t, (Shnode_t*)pointerof(lexp->sh->inlineno));
1807		break;
1808	    case '!':
1809		if(!(t = test_primary(lexp)))
1810			sh_syntax(lexp);
1811		t->tre.tretyp |= TNEGATE;
1812		return(t);
1813	    case TESTUNOP:
1814		if(sh_lex(lexp))
1815			sh_syntax(lexp);
1816#if SHOPT_KIA
1817		if(lexp->kiafile && !strchr("sntzoOG",num))
1818		{
1819			int line = lexp->sh->inlineno- (lexp->token==NL);
1820			unsigned long r;
1821			r=kiaentity(lexp,sh_argstr(lexp->arg),-1,'f',0,0,lexp->script,'t',0,"");
1822			sfprintf(lexp->kiatmp,"p;%..64d;f;%..64d;%d;%d;t;\n",lexp->current,r,line,line);
1823		}
1824#endif /* SHOPT_KIA */
1825		t = makelist(lexp,TTST|TTEST|TUNARY|(num<<TSHIFT),
1826			(Shnode_t*)lexp->arg,(Shnode_t*)lexp->arg);
1827		t->tst.tstline =  lexp->sh->inlineno;
1828		break;
1829	    /* binary test operators */
1830	    case 0:
1831		arg = lexp->arg;
1832		if((token=sh_lex(lexp))==TESTBINOP)
1833		{
1834			num = lexp->digits;
1835			if(num==TEST_REP)
1836			{
1837				ere_match();
1838				num = TEST_PEQ;
1839			}
1840		}
1841		else if(token=='<')
1842			num = TEST_SLT;
1843		else if(token=='>')
1844			num = TEST_SGT;
1845		else if(token==ANDFSYM||token==ORFSYM||token==ETESTSYM||token==RPAREN)
1846		{
1847			t = makelist(lexp,TTST|TTEST|TUNARY|('n'<<TSHIFT),
1848				(Shnode_t*)arg,(Shnode_t*)arg);
1849			t->tst.tstline =  lexp->sh->inlineno;
1850			return(t);
1851		}
1852		else
1853			sh_syntax(lexp);
1854#if SHOPT_KIA
1855		if(lexp->kiafile && (num==TEST_EF||num==TEST_NT||num==TEST_OT))
1856		{
1857			int line = lexp->sh->inlineno- (lexp->token==NL);
1858			unsigned long r;
1859			r=kiaentity(lexp,sh_argstr(lexp->arg),-1,'f',0,0,lexp->current,'t',0,"");
1860			sfprintf(lexp->kiatmp,"p;%..64d;f;%..64d;%d;%d;t;\n",lexp->current,r,line,line);
1861		}
1862#endif /* SHOPT_KIA */
1863		if(sh_lex(lexp))
1864			sh_syntax(lexp);
1865		if(num&TEST_PATTERN)
1866		{
1867			if(lexp->arg->argflag&(ARG_EXP|ARG_MAC))
1868				num &= ~TEST_PATTERN;
1869		}
1870		t = getnode(tstnod);
1871		t->lst.lsttyp = TTST|TTEST|TBINARY|(num<<TSHIFT);
1872		t->lst.lstlef = (Shnode_t*)arg;
1873		t->lst.lstrit = (Shnode_t*)lexp->arg;
1874		t->tst.tstline =  lexp->sh->inlineno;
1875#if SHOPT_KIA
1876		if(lexp->kiafile && (num==TEST_EF||num==TEST_NT||num==TEST_OT))
1877		{
1878			int line = lexp->sh->inlineno-(lexp->token==NL);
1879			unsigned long r;
1880			r=kiaentity(lexp,sh_argstr(lexp->arg),-1,'f',0,0,lexp->current,'t',0,"");
1881			sfprintf(lexp->kiatmp,"p;%..64d;f;%..64d;%d;%d;t;\n",lexp->current,r,line,line);
1882		}
1883#endif /* SHOPT_KIA */
1884		break;
1885	    default:
1886		return(0);
1887	}
1888	skipnl(lexp,0);
1889	return(t);
1890}
1891
1892#if SHOPT_KIA
1893/*
1894 * return an entity checksum
1895 * The entity is created if it doesn't exist
1896 */
1897unsigned long kiaentity(Lex_t *lexp,const char *name,int len,int type,int first,int last,unsigned long parent, int pkind, int width, const char *attr)
1898{
1899	Stk_t	*stkp = lexp->sh->stk;
1900	Namval_t *np;
1901	long offset = stktell(stkp);
1902	sfputc(stkp,type);
1903	if(len>0)
1904		sfwrite(stkp,name,len);
1905	else
1906	{
1907		if(type=='p')
1908			sfputr(stkp,path_basename(name),0);
1909		else
1910			sfputr(stkp,name,0);
1911	}
1912	np = nv_search(stakptr(offset),lexp->entity_tree,NV_ADD);
1913	stkseek(stkp,offset);
1914	np->nvalue.i = pkind;
1915	nv_setsize(np,width);
1916	if(!nv_isattr(np,NV_TAGGED) && first>=0)
1917	{
1918		nv_onattr(np,NV_TAGGED);
1919		if(!pkind)
1920			pkind = '0';
1921		if(len>0)
1922			sfprintf(lexp->kiafile,"%..64d;%c;%.*s;%d;%d;%..64d;%..64d;%c;%d;%s\n",np->hash,type,len,name,first,last,parent,lexp->fscript,pkind,width,attr);
1923		else
1924			sfprintf(lexp->kiafile,"%..64d;%c;%s;%d;%d;%..64d;%..64d;%c;%d;%s\n",np->hash,type,name,first,last,parent,lexp->fscript,pkind,width,attr);
1925	}
1926	return(np->hash);
1927}
1928
1929static void kia_add(register Namval_t *np, void *data)
1930{
1931	char *name = nv_name(np);
1932	Lex_t	*lp = (Lex_t*)data;
1933	NOT_USED(data);
1934	kiaentity(lp,name+1,-1,*name,0,-1,(*name=='p'?lp->unknown:lp->script),np->nvalue.i,nv_size(np),"");
1935}
1936
1937int kiaclose(Lex_t *lexp)
1938{
1939	register off_t off1,off2;
1940	register int n;
1941	if(lexp->kiafile)
1942	{
1943		unsigned long r = kiaentity(lexp,lexp->scriptname,-1,'p',-1,lexp->sh->inlineno-1,0,'s',0,"");
1944		kiaentity(lexp,lexp->scriptname,-1,'p',1,lexp->sh->inlineno-1,r,'s',0,"");
1945		kiaentity(lexp,lexp->scriptname,-1,'f',1,lexp->sh->inlineno-1,r,'s',0,"");
1946		nv_scan(lexp->entity_tree,kia_add,(void*)lexp,NV_TAGGED,0);
1947		off1 = sfseek(lexp->kiafile,(off_t)0,SEEK_END);
1948		sfseek(lexp->kiatmp,(off_t)0,SEEK_SET);
1949		sfmove(lexp->kiatmp,lexp->kiafile,SF_UNBOUND,-1);
1950		off2 = sfseek(lexp->kiafile,(off_t)0,SEEK_END);
1951#ifdef SF_BUFCONST
1952		if(off2==off1)
1953			n= sfprintf(lexp->kiafile,"DIRECTORY\nENTITY;%lld;%d\nDIRECTORY;",(Sflong_t)lexp->kiabegin,(size_t)(off1-lexp->kiabegin));
1954		else
1955			n= sfprintf(lexp->kiafile,"DIRECTORY\nENTITY;%lld;%d\nRELATIONSHIP;%lld;%d\nDIRECTORY;",(Sflong_t)lexp->kiabegin,(size_t)(off1-lexp->kiabegin),(Sflong_t)off1,(size_t)(off2-off1));
1956		if(off2 >= INT_MAX)
1957			off2 = -(n+12);
1958		sfprintf(lexp->kiafile,"%010.10lld;%010d\n",(Sflong_t)off2+10, n+12);
1959#else
1960		if(off2==off1)
1961			n= sfprintf(lexp->kiafile,"DIRECTORY\nENTITY;%d;%d\nDIRECTORY;",lexp->kiabegin,off1-lexp->kiabegin);
1962		else
1963			n= sfprintf(lexp->kiafile,"DIRECTORY\nENTITY;%d;%d\nRELATIONSHIP;%d;%d\nDIRECTORY;",lexp->kiabegin,off1-lexp->kiabegin,off1,off2-off1);
1964		sfprintf(lexp->kiafile,"%010d;%010d\n",off2+10, n+12);
1965#endif
1966	}
1967	return(sfclose(lexp->kiafile));
1968}
1969#endif /* SHOPT_KIA */
1970