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