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