1/****************************************************************
2Copyright (C) Lucent Technologies 1997
3All Rights Reserved
4
5Permission to use, copy, modify, and distribute this software and
6its documentation for any purpose and without fee is hereby
7granted, provided that the above copyright notice appear in all
8copies and that both that the copyright notice and this
9permission notice and warranty disclaimer appear in supporting
10documentation, and that the name Lucent Technologies or any of
11its entities not be used in advertising or publicity pertaining
12to distribution of the software without specific, written prior
13permission.
14
15LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
16INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
17IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
18SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
19WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
20IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
21ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
22THIS SOFTWARE.
23****************************************************************/
24
25#define DEBUG
26#include <stdio.h>
27#include <ctype.h>
28#include <setjmp.h>
29#include <limits.h>
30#include <math.h>
31#include <string.h>
32#include <stdlib.h>
33#include <time.h>
34#include "awk.h"
35#include "ytab.h"
36
37#define tempfree(x)	if (istemp(x)) tfree(x); else
38
39/*
40#undef tempfree
41
42void tempfree(Cell *p) {
43	if (p->ctype == OCELL && (p->csub < CUNK || p->csub > CFREE)) {
44		WARNING("bad csub %d in Cell %d %s",
45			p->csub, p->ctype, p->sval);
46	}
47	if (istemp(p))
48		tfree(p);
49}
50*/
51
52/* do we really need these? */
53/* #ifdef _NFILE */
54/* #ifndef FOPEN_MAX */
55/* #define FOPEN_MAX _NFILE */
56/* #endif */
57/* #endif */
58/*  */
59/* #ifndef	FOPEN_MAX */
60/* #define	FOPEN_MAX	40 */	/* max number of open files */
61/* #endif */
62/*  */
63/* #ifndef RAND_MAX */
64/* #define RAND_MAX	32767 */	/* all that ansi guarantees */
65/* #endif */
66
67jmp_buf env;
68extern	int	pairstack[];
69
70Node	*winner = NULL;	/* root of parse tree */
71Cell	*tmps;		/* free temporary cells for execution */
72
73static Cell	truecell	={ OBOOL, BTRUE, 0, 0, 1.0, NUM };
74Cell	*True	= &truecell;
75static Cell	falsecell	={ OBOOL, BFALSE, 0, 0, 0.0, NUM };
76Cell	*False	= &falsecell;
77static Cell	breakcell	={ OJUMP, JBREAK, 0, 0, 0.0, NUM };
78Cell	*jbreak	= &breakcell;
79static Cell	contcell	={ OJUMP, JCONT, 0, 0, 0.0, NUM };
80Cell	*jcont	= &contcell;
81static Cell	nextcell	={ OJUMP, JNEXT, 0, 0, 0.0, NUM };
82Cell	*jnext	= &nextcell;
83static Cell	nextfilecell	={ OJUMP, JNEXTFILE, 0, 0, 0.0, NUM };
84Cell	*jnextfile	= &nextfilecell;
85static Cell	exitcell	={ OJUMP, JEXIT, 0, 0, 0.0, NUM };
86Cell	*jexit	= &exitcell;
87static Cell	retcell		={ OJUMP, JRET, 0, 0, 0.0, NUM };
88Cell	*jret	= &retcell;
89static Cell	tempcell	={ OCELL, CTEMP, 0, "", 0.0, NUM|STR|DONTFREE };
90
91Node	*curnode = NULL;	/* the node being executed, for debugging */
92
93static Awkfloat prev_srand, tmp_srand;
94
95/* buffer memory management */
96int adjbuf(char **pbuf, int *psiz, int minlen, int quantum, char **pbptr,
97	const char *whatrtn)
98/* pbuf:    address of pointer to buffer being managed
99 * psiz:    address of buffer size variable
100 * minlen:  minimum length of buffer needed
101 * quantum: buffer size quantum
102 * pbptr:   address of movable pointer into buffer, or 0 if none
103 * whatrtn: name of the calling routine if failure should cause fatal error
104 *
105 * return   0 for realloc failure, !=0 for success
106 */
107{
108	if (minlen > *psiz) {
109		char *tbuf;
110		int rminlen = quantum ? minlen % quantum : 0;
111		int boff = pbptr ? *pbptr - *pbuf : 0;
112		/* round up to next multiple of quantum */
113		if (rminlen)
114			minlen += quantum - rminlen;
115		tbuf = (char *) realloc(*pbuf, minlen);
116		dprintf( ("adjbuf %s: %d %d (pbuf=%p, tbuf=%p)\n", whatrtn, *psiz, minlen, *pbuf, tbuf) );
117		if (tbuf == NULL) {
118			if (whatrtn)
119				FATAL("out of memory in %s", whatrtn);
120			return 0;
121		}
122		*pbuf = tbuf;
123		*psiz = minlen;
124		if (pbptr)
125			*pbptr = tbuf + boff;
126	}
127	return 1;
128}
129
130void run(Node *a)	/* execution of parse tree starts here */
131{
132	extern void stdinit(void);
133
134	stdinit();
135	execute(a);
136	closeall();
137}
138
139Cell *execute(Node *u)	/* execute a node of the parse tree */
140{
141	Cell *(*proc)(Node **, int);
142	Cell *x;
143	Node *a;
144
145	if (u == NULL)
146		return(True);
147	for (a = u; ; a = a->nnext) {
148		curnode = a;
149		if (isvalue(a)) {
150			x = (Cell *) (a->narg[0]);
151			if (isfld(x) && !donefld)
152				fldbld();
153			else if (isrec(x) && !donerec)
154				recbld();
155			return(x);
156		}
157		if (notlegal(a->nobj))	/* probably a Cell* but too risky to print */
158			FATAL("illegal statement");
159		proc = proctab[a->nobj-FIRSTTOKEN];
160		x = (*proc)(a->narg, a->nobj);
161		if (isfld(x) && !donefld)
162			fldbld();
163		else if (isrec(x) && !donerec)
164			recbld();
165		if (isexpr(a))
166			return(x);
167		if (isjump(x))
168			return(x);
169		if (a->nnext == NULL)
170			return(x);
171		tempfree(x);
172	}
173}
174
175
176Cell *program(Node **a, int n)	/* execute an awk program */
177{				/* a[0] = BEGIN, a[1] = body, a[2] = END */
178	Cell *x;
179
180	if (setjmp(env) != 0)
181		goto ex;
182	if (a[0]) {		/* BEGIN */
183		x = execute(a[0]);
184		if (isexit(x))
185			return(True);
186		if (isjump(x))
187			FATAL("illegal break, continue, next or nextfile from BEGIN");
188		tempfree(x);
189	}
190	if (a[1] || a[2])
191		while (getrec(&record, &recsize, 1) > 0) {
192			x = execute(a[1]);
193			if (isexit(x))
194				break;
195			tempfree(x);
196		}
197  ex:
198	if (setjmp(env) != 0)	/* handles exit within END */
199		goto ex1;
200	if (a[2]) {		/* END */
201		donefld = 1;	/* avoid updating NF */
202		x = execute(a[2]);
203		if (isbreak(x) || isnext(x) || iscont(x))
204			FATAL("illegal break, continue, next or nextfile from END");
205		tempfree(x);
206	}
207  ex1:
208	return(True);
209}
210
211struct Frame {	/* stack frame for awk function calls */
212	int nargs;	/* number of arguments in this call */
213	Cell *fcncell;	/* pointer to Cell for function */
214	Cell **args;	/* pointer to array of arguments after execute */
215	Cell *retval;	/* return value */
216};
217
218#define	NARGS	50	/* max args in a call */
219
220struct Frame *frame = NULL;	/* base of stack frames; dynamically allocated */
221int	nframe = 0;		/* number of frames allocated */
222struct Frame *fp = NULL;	/* frame pointer. bottom level unused */
223
224Cell *call(Node **a, int n)	/* function call.  very kludgy and fragile */
225{
226	static Cell newcopycell = { OCELL, CCOPY, 0, "", 0.0, NUM|STR|DONTFREE };
227	int i, ncall, ndef;
228	int freed = 0; /* handles potential double freeing when fcn & param share a tempcell */
229	Node *x;
230	Cell *args[NARGS], *oargs[NARGS];	/* BUG: fixed size arrays */
231	Cell *y, *z, *fcn;
232	char *s;
233
234	fcn = execute(a[0]);	/* the function itself */
235	s = fcn->nval;
236	if (!isfcn(fcn))
237		FATAL("calling undefined function %s", s);
238	if (frame == NULL) {
239		fp = frame = (struct Frame *) calloc(nframe += 100, sizeof(struct Frame));
240		if (frame == NULL)
241			FATAL("out of space for stack frames calling %s", s);
242	}
243	for (ncall = 0, x = a[1]; x != NULL; x = x->nnext)	/* args in call */
244		ncall++;
245	ndef = (int) fcn->fval;			/* args in defn */
246	   dprintf( ("calling %s, %d args (%d in defn), fp=%d\n", s, ncall, ndef, (int) (fp-frame)) );
247	if (ncall > ndef)
248		WARNING("function %s called with %d args, uses only %d",
249			s, ncall, ndef);
250	if (ncall + ndef > NARGS)
251		FATAL("function %s has %d arguments, limit %d", s, ncall+ndef, NARGS);
252	for (i = 0, x = a[1]; x != NULL; i++, x = x->nnext) {	/* get call args */
253		   dprintf( ("evaluate args[%d], fp=%d:\n", i, (int) (fp-frame)) );
254		y = execute(x);
255		oargs[i] = y;
256		   dprintf( ("args[%d]: %s %f <%s>, t=%o\n",
257			   i, NN(y->nval), y->fval, isarr(y) ? "(array)" : NN(y->sval), y->tval) );
258		if (isfcn(y))
259			FATAL("can't use function %s as argument in %s", y->nval, s);
260		if (isarr(y))
261			args[i] = y;	/* arrays by ref */
262		else
263			args[i] = copycell(y);
264		tempfree(y);
265	}
266	for ( ; i < ndef; i++) {	/* add null args for ones not provided */
267		args[i] = gettemp();
268		*args[i] = newcopycell;
269	}
270	fp++;	/* now ok to up frame */
271	if (fp >= frame + nframe) {
272		int dfp = fp - frame;	/* old index */
273		frame = (struct Frame *)
274			realloc((char *) frame, (nframe += 100) * sizeof(struct Frame));
275		if (frame == NULL)
276			FATAL("out of space for stack frames in %s", s);
277		fp = frame + dfp;
278	}
279	fp->fcncell = fcn;
280	fp->args = args;
281	fp->nargs = ndef;	/* number defined with (excess are locals) */
282	fp->retval = gettemp();
283
284	   dprintf( ("start exec of %s, fp=%d\n", s, (int) (fp-frame)) );
285	y = execute((Node *)(fcn->sval));	/* execute body */
286	   dprintf( ("finished exec of %s, fp=%d\n", s, (int) (fp-frame)) );
287
288	for (i = 0; i < ndef; i++) {
289		Cell *t = fp->args[i];
290		if (isarr(t)) {
291			if (t->csub == CCOPY) {
292				if (i >= ncall) {
293					freesymtab(t);
294					t->csub = CTEMP;
295					tempfree(t);
296				} else {
297					oargs[i]->tval = t->tval;
298					oargs[i]->tval &= ~(STR|NUM|DONTFREE);
299					oargs[i]->sval = t->sval;
300					tempfree(t);
301				}
302			}
303		} else if (t != y) {	/* kludge to prevent freeing twice */
304			t->csub = CTEMP;
305			tempfree(t);
306		} else if (t == y && t->csub == CCOPY) {
307			t->csub = CTEMP;
308			tempfree(t);
309			freed = 1;
310		}
311	}
312	tempfree(fcn);
313	if (isexit(y) || isnext(y))
314		return y;
315	if (freed == 0) {
316		tempfree(y);	/* don't free twice! */
317	}
318	z = fp->retval;			/* return value */
319	   dprintf( ("%s returns %g |%s| %o\n", s, getfval(z), getsval(z), z->tval) );
320	fp--;
321	return(z);
322}
323
324Cell *copycell(Cell *x)	/* make a copy of a cell in a temp */
325{
326	Cell *y;
327
328	y = gettemp();
329	y->csub = CCOPY;	/* prevents freeing until call is over */
330	y->nval = x->nval;	/* BUG? */
331	if (isstr(x))
332		y->sval = tostring(x->sval);
333	y->fval = x->fval;
334	y->tval = x->tval & ~(CON|FLD|REC|DONTFREE);	/* copy is not constant or field */
335							/* is DONTFREE right? */
336	return y;
337}
338
339Cell *arg(Node **a, int n)	/* nth argument of a function */
340{
341
342	n = ptoi(a[0]);	/* argument number, counting from 0 */
343	   dprintf( ("arg(%d), fp->nargs=%d\n", n, fp->nargs) );
344	if (n+1 > fp->nargs)
345		FATAL("argument #%d of function %s was not supplied",
346			n+1, fp->fcncell->nval);
347	return fp->args[n];
348}
349
350Cell *jump(Node **a, int n)	/* break, continue, next, nextfile, return */
351{
352	Cell *y;
353
354	switch (n) {
355	case EXIT:
356		if (a[0] != NULL) {
357			y = execute(a[0]);
358			errorflag = (int) getfval(y);
359			tempfree(y);
360		}
361		longjmp(env, 1);
362	case RETURN:
363		if (a[0] != NULL) {
364			y = execute(a[0]);
365			if ((y->tval & (STR|NUM)) == (STR|NUM)) {
366				setsval(fp->retval, getsval(y));
367				fp->retval->fval = getfval(y);
368				fp->retval->tval |= NUM;
369			}
370			else if (y->tval & STR)
371				setsval(fp->retval, getsval(y));
372			else if (y->tval & NUM)
373				setfval(fp->retval, getfval(y));
374			else		/* can't happen */
375				FATAL("bad type variable %d", y->tval);
376			tempfree(y);
377		}
378		return(jret);
379	case NEXT:
380		return(jnext);
381	case NEXTFILE:
382		nextfile();
383		return(jnextfile);
384	case BREAK:
385		return(jbreak);
386	case CONTINUE:
387		return(jcont);
388	default:	/* can't happen */
389		FATAL("illegal jump type %d", n);
390	}
391	return 0;	/* not reached */
392}
393
394Cell *awk_getline(Node **a, int n)	/* get next line from specific input */
395{		/* a[0] is variable, a[1] is operator, a[2] is filename */
396	Cell *r, *x;
397	extern Cell **fldtab;
398	FILE *fp;
399	char *buf;
400	int bufsize = recsize;
401	int mode;
402
403	if ((buf = (char *) malloc(bufsize)) == NULL)
404		FATAL("out of memory in getline");
405
406	fflush(stdout);	/* in case someone is waiting for a prompt */
407	r = gettemp();
408	if (a[1] != NULL) {		/* getline < file */
409		x = execute(a[2]);		/* filename */
410		mode = ptoi(a[1]);
411		if (mode == '|')		/* input pipe */
412			mode = LE;	/* arbitrary flag */
413		fp = openfile(mode, getsval(x));
414		tempfree(x);
415		if (fp == NULL)
416			n = -1;
417		else
418			n = readrec(&buf, &bufsize, fp);
419		if (n <= 0) {
420			;
421		} else if (a[0] != NULL) {	/* getline var <file */
422			x = execute(a[0]);
423			setsval(x, buf);
424			tempfree(x);
425		} else {			/* getline <file */
426			setsval(fldtab[0], buf);
427			if (is_number(fldtab[0]->sval)) {
428				fldtab[0]->fval = atof(fldtab[0]->sval);
429				fldtab[0]->tval |= NUM;
430			}
431		}
432	} else {			/* bare getline; use current input */
433		if (a[0] == NULL)	/* getline */
434			n = getrec(&record, &recsize, 1);
435		else {			/* getline var */
436			n = getrec(&buf, &bufsize, 0);
437			x = execute(a[0]);
438			setsval(x, buf);
439			tempfree(x);
440		}
441	}
442	setfval(r, (Awkfloat) n);
443	free(buf);
444	return r;
445}
446
447Cell *getnf(Node **a, int n)	/* get NF */
448{
449	if (donefld == 0)
450		fldbld();
451	return (Cell *) a[0];
452}
453
454Cell *array(Node **a, int n)	/* a[0] is symtab, a[1] is list of subscripts */
455{
456	Cell *x, *y, *z;
457	char *s;
458	Node *np;
459	char *buf;
460	int bufsz = recsize;
461	int nsub = strlen(*SUBSEP);
462
463	if ((buf = (char *) malloc(bufsz)) == NULL)
464		FATAL("out of memory in array");
465
466	x = execute(a[0]);	/* Cell* for symbol table */
467	buf[0] = 0;
468	for (np = a[1]; np; np = np->nnext) {
469		y = execute(np);	/* subscript */
470		s = getsval(y);
471		if (!adjbuf(&buf, &bufsz, strlen(buf)+strlen(s)+nsub+1, recsize, 0, "array"))
472			FATAL("out of memory for %s[%s...]", x->nval, buf);
473		strcat(buf, s);
474		if (np->nnext)
475			strcat(buf, *SUBSEP);
476		tempfree(y);
477	}
478	if (!isarr(x)) {
479		   dprintf( ("making %s into an array\n", NN(x->nval)) );
480		if (freeable(x))
481			xfree(x->sval);
482		x->tval &= ~(STR|NUM|DONTFREE);
483		x->tval |= ARR;
484		x->sval = (char *) makesymtab(NSYMTAB);
485	}
486	z = setsymtab(buf, "", 0.0, STR|NUM, (Array *) x->sval);
487	z->ctype = OCELL;
488	z->csub = CVAR;
489	tempfree(x);
490	free(buf);
491	return(z);
492}
493
494Cell *awkdelete(Node **a, int n)	/* a[0] is symtab, a[1] is list of subscripts */
495{
496	Cell *x, *y;
497	Node *np;
498	char *s;
499	int nsub = strlen(*SUBSEP);
500
501	x = execute(a[0]);	/* Cell* for symbol table */
502	if (!isarr(x))
503		return True;
504	if (a[1] == 0) {	/* delete the elements, not the table */
505		freesymtab(x);
506		x->tval &= ~STR;
507		x->tval |= ARR;
508		x->sval = (char *) makesymtab(NSYMTAB);
509	} else {
510		int bufsz = recsize;
511		char *buf;
512		if ((buf = (char *) malloc(bufsz)) == NULL)
513			FATAL("out of memory in adelete");
514		buf[0] = 0;
515		for (np = a[1]; np; np = np->nnext) {
516			y = execute(np);	/* subscript */
517			s = getsval(y);
518			if (!adjbuf(&buf, &bufsz, strlen(buf)+strlen(s)+nsub+1, recsize, 0, "awkdelete"))
519				FATAL("out of memory deleting %s[%s...]", x->nval, buf);
520			strcat(buf, s);
521			if (np->nnext)
522				strcat(buf, *SUBSEP);
523			tempfree(y);
524		}
525		freeelem(x, buf);
526		free(buf);
527	}
528	tempfree(x);
529	return True;
530}
531
532Cell *intest(Node **a, int n)	/* a[0] is index (list), a[1] is symtab */
533{
534	Cell *x, *ap, *k;
535	Node *p;
536	char *buf;
537	char *s;
538	int bufsz = recsize;
539	int nsub = strlen(*SUBSEP);
540
541	ap = execute(a[1]);	/* array name */
542	if (!isarr(ap)) {
543		   dprintf( ("making %s into an array\n", ap->nval) );
544		if (freeable(ap))
545			xfree(ap->sval);
546		ap->tval &= ~(STR|NUM|DONTFREE);
547		ap->tval |= ARR;
548		ap->sval = (char *) makesymtab(NSYMTAB);
549	}
550	if ((buf = (char *) malloc(bufsz)) == NULL) {
551		FATAL("out of memory in intest");
552	}
553	buf[0] = 0;
554	for (p = a[0]; p; p = p->nnext) {
555		x = execute(p);	/* expr */
556		s = getsval(x);
557		if (!adjbuf(&buf, &bufsz, strlen(buf)+strlen(s)+nsub+1, recsize, 0, "intest"))
558			FATAL("out of memory deleting %s[%s...]", x->nval, buf);
559		strcat(buf, s);
560		tempfree(x);
561		if (p->nnext)
562			strcat(buf, *SUBSEP);
563	}
564	k = lookup(buf, (Array *) ap->sval);
565	tempfree(ap);
566	free(buf);
567	if (k == NULL)
568		return(False);
569	else
570		return(True);
571}
572
573
574Cell *matchop(Node **a, int n)	/* ~ and match() */
575{
576	Cell *x, *y;
577	char *s, *t;
578	int i;
579	fa *pfa;
580	int (*mf)(fa *, const char *) = match, mode = 0;
581
582	if (n == MATCHFCN) {
583		mf = pmatch;
584		mode = 1;
585	}
586	x = execute(a[1]);	/* a[1] = target text */
587	s = getsval(x);
588	if (a[0] == 0)		/* a[1] == 0: already-compiled reg expr */
589		i = (*mf)((fa *) a[2], s);
590	else {
591		y = execute(a[2]);	/* a[2] = regular expr */
592		t = getsval(y);
593		pfa = makedfa(t, mode);
594		i = (*mf)(pfa, s);
595		tempfree(y);
596	}
597	tempfree(x);
598	if (n == MATCHFCN) {
599		int start = patbeg - s + 1;
600		if (patlen < 0)
601			start = 0;
602		setfval(rstartloc, (Awkfloat) start);
603		setfval(rlengthloc, (Awkfloat) patlen);
604		x = gettemp();
605		x->tval = NUM;
606		x->fval = start;
607		return x;
608	} else if ((n == MATCH && i == 1) || (n == NOTMATCH && i == 0))
609		return(True);
610	else
611		return(False);
612}
613
614
615Cell *boolop(Node **a, int n)	/* a[0] || a[1], a[0] && a[1], !a[0] */
616{
617	Cell *x, *y;
618	int i;
619
620	x = execute(a[0]);
621	i = istrue(x);
622	tempfree(x);
623	switch (n) {
624	case BOR:
625		if (i) return(True);
626		y = execute(a[1]);
627		i = istrue(y);
628		tempfree(y);
629		if (i) return(True);
630		else return(False);
631	case AND:
632		if ( !i ) return(False);
633		y = execute(a[1]);
634		i = istrue(y);
635		tempfree(y);
636		if (i) return(True);
637		else return(False);
638	case NOT:
639		if (i) return(False);
640		else return(True);
641	default:	/* can't happen */
642		FATAL("unknown boolean operator %d", n);
643	}
644	return 0;	/*NOTREACHED*/
645}
646
647Cell *relop(Node **a, int n)	/* a[0 < a[1], etc. */
648{
649	int i;
650	Cell *x, *y;
651	Awkfloat j;
652
653	x = execute(a[0]);
654	y = execute(a[1]);
655	if (x->tval&NUM && y->tval&NUM) {
656		j = x->fval - y->fval;
657		i = j<0? -1: (j>0? 1: 0);
658	} else {
659		i = strcmp(getsval(x), getsval(y));
660	}
661	tempfree(x);
662	tempfree(y);
663	switch (n) {
664	case LT:	if (i<0) return(True);
665			else return(False);
666	case LE:	if (i<=0) return(True);
667			else return(False);
668	case NE:	if (i!=0) return(True);
669			else return(False);
670	case EQ:	if (i == 0) return(True);
671			else return(False);
672	case GE:	if (i>=0) return(True);
673			else return(False);
674	case GT:	if (i>0) return(True);
675			else return(False);
676	default:	/* can't happen */
677		FATAL("unknown relational operator %d", n);
678	}
679	return 0;	/*NOTREACHED*/
680}
681
682void tfree(Cell *a)	/* free a tempcell */
683{
684	if (freeable(a)) {
685		   dprintf( ("freeing %s %s %o\n", NN(a->nval), NN(a->sval), a->tval) );
686		xfree(a->sval);
687	}
688	if (a == tmps)
689		FATAL("tempcell list is curdled");
690	a->cnext = tmps;
691	tmps = a;
692}
693
694Cell *gettemp(void)	/* get a tempcell */
695{	int i;
696	Cell *x;
697
698	if (!tmps) {
699		tmps = (Cell *) calloc(100, sizeof(Cell));
700		if (!tmps)
701			FATAL("out of space for temporaries");
702		for(i = 1; i < 100; i++)
703			tmps[i-1].cnext = &tmps[i];
704		tmps[i-1].cnext = 0;
705	}
706	x = tmps;
707	tmps = x->cnext;
708	*x = tempcell;
709	return(x);
710}
711
712Cell *indirect(Node **a, int n)	/* $( a[0] ) */
713{
714	Awkfloat val;
715	Cell *x;
716	int m;
717	char *s;
718
719	x = execute(a[0]);
720	val = getfval(x);	/* freebsd: defend against super large field numbers */
721	if ((Awkfloat)INT_MAX < val)
722		FATAL("trying to access out of range field %s", x->nval);
723	m = (int) val;
724	if (m == 0 && !is_number(s = getsval(x)))	/* suspicion! */
725		FATAL("illegal field $(%s), name \"%s\"", s, x->nval);
726		/* BUG: can x->nval ever be null??? */
727	tempfree(x);
728	x = fieldadr(m);
729	x->ctype = OCELL;	/* BUG?  why are these needed? */
730	x->csub = CFLD;
731	return(x);
732}
733
734Cell *substr(Node **a, int nnn)		/* substr(a[0], a[1], a[2]) */
735{
736	int k, m, n;
737	char *s;
738	int temp;
739	Cell *x, *y, *z = 0;
740
741	x = execute(a[0]);
742	y = execute(a[1]);
743	if (a[2] != 0)
744		z = execute(a[2]);
745	s = getsval(x);
746	k = strlen(s) + 1;
747	if (k <= 1) {
748		tempfree(x);
749		tempfree(y);
750		if (a[2] != 0) {
751			tempfree(z);
752		}
753		x = gettemp();
754		setsval(x, "");
755		return(x);
756	}
757	m = (int) getfval(y);
758	if (m <= 0)
759		m = 1;
760	else if (m > k)
761		m = k;
762	tempfree(y);
763	if (a[2] != 0) {
764		n = (int) getfval(z);
765		tempfree(z);
766	} else
767		n = k - 1;
768	if (n < 0)
769		n = 0;
770	else if (n > k - m)
771		n = k - m;
772	   dprintf( ("substr: m=%d, n=%d, s=%s\n", m, n, s) );
773	y = gettemp();
774	temp = s[n+m-1];	/* with thanks to John Linderman */
775	s[n+m-1] = '\0';
776	setsval(y, s + m - 1);
777	s[n+m-1] = temp;
778	tempfree(x);
779	return(y);
780}
781
782Cell *sindex(Node **a, int nnn)		/* index(a[0], a[1]) */
783{
784	Cell *x, *y, *z;
785	char *s1, *s2, *p1, *p2, *q;
786	Awkfloat v = 0.0;
787
788	x = execute(a[0]);
789	s1 = getsval(x);
790	y = execute(a[1]);
791	s2 = getsval(y);
792
793	z = gettemp();
794	for (p1 = s1; *p1 != '\0'; p1++) {
795		for (q=p1, p2=s2; *p2 != '\0' && *q == *p2; q++, p2++)
796			;
797		if (*p2 == '\0') {
798			v = (Awkfloat) (p1 - s1 + 1);	/* origin 1 */
799			break;
800		}
801	}
802	tempfree(x);
803	tempfree(y);
804	setfval(z, v);
805	return(z);
806}
807
808#define	MAXNUMSIZE	50
809
810int format(char **pbuf, int *pbufsize, const char *s, Node *a)	/* printf-like conversions */
811{
812	char *fmt;
813	char *p, *t;
814	const char *os;
815	Cell *x;
816	int flag = 0, n;
817	int fmtwd; /* format width */
818	int fmtsz = recsize;
819	char *buf = *pbuf;
820	int bufsize = *pbufsize;
821
822	os = s;
823	p = buf;
824	if ((fmt = (char *) malloc(fmtsz)) == NULL)
825		FATAL("out of memory in format()");
826	while (*s) {
827		adjbuf(&buf, &bufsize, MAXNUMSIZE+1+p-buf, recsize, &p, "format1");
828		if (*s != '%') {
829			*p++ = *s++;
830			continue;
831		}
832		if (*(s+1) == '%') {
833			*p++ = '%';
834			s += 2;
835			continue;
836		}
837		/* have to be real careful in case this is a huge number, eg, %100000d */
838		fmtwd = atoi(s+1);
839		if (fmtwd < 0)
840			fmtwd = -fmtwd;
841		adjbuf(&buf, &bufsize, fmtwd+1+p-buf, recsize, &p, "format2");
842		for (t = fmt; (*t++ = *s) != '\0'; s++) {
843			if (!adjbuf(&fmt, &fmtsz, MAXNUMSIZE+1+t-fmt, recsize, &t, "format3"))
844				FATAL("format item %.30s... ran format() out of memory", os);
845			if (isalpha((uschar)*s) && *s != 'l' && *s != 'h' && *s != 'L')
846				break;	/* the ansi panoply */
847			if (*s == '*') {
848				x = execute(a);
849				a = a->nnext;
850				sprintf(t-1, "%d", fmtwd=(int) getfval(x));
851				if (fmtwd < 0)
852					fmtwd = -fmtwd;
853				adjbuf(&buf, &bufsize, fmtwd+1+p-buf, recsize, &p, "format");
854				t = fmt + strlen(fmt);
855				tempfree(x);
856			}
857		}
858		*t = '\0';
859		if (fmtwd < 0)
860			fmtwd = -fmtwd;
861		adjbuf(&buf, &bufsize, fmtwd+1+p-buf, recsize, &p, "format4");
862
863		switch (*s) {
864		case 'f': case 'e': case 'g': case 'E': case 'G':
865			flag = 'f';
866			break;
867		case 'd': case 'i':
868			flag = 'd';
869			if(*(s-1) == 'l') break;
870			*(t-1) = 'l';
871			*t = 'd';
872			*++t = '\0';
873			break;
874		case 'o': case 'x': case 'X': case 'u':
875			flag = *(s-1) == 'l' ? 'd' : 'u';
876			break;
877		case 's':
878			flag = 's';
879			break;
880		case 'c':
881			flag = 'c';
882			break;
883		default:
884			WARNING("weird printf conversion %s", fmt);
885			flag = '?';
886			break;
887		}
888		if (a == NULL)
889			FATAL("not enough args in printf(%s)", os);
890		x = execute(a);
891		a = a->nnext;
892		n = MAXNUMSIZE;
893		if (fmtwd > n)
894			n = fmtwd;
895		adjbuf(&buf, &bufsize, 1+n+p-buf, recsize, &p, "format5");
896		switch (flag) {
897		case '?':	sprintf(p, "%s", fmt);	/* unknown, so dump it too */
898			t = getsval(x);
899			n = strlen(t);
900			if (fmtwd > n)
901				n = fmtwd;
902			adjbuf(&buf, &bufsize, 1+strlen(p)+n+p-buf, recsize, &p, "format6");
903			p += strlen(p);
904			sprintf(p, "%s", t);
905			break;
906		case 'f':	sprintf(p, fmt, getfval(x)); break;
907		case 'd':	sprintf(p, fmt, (long) getfval(x)); break;
908		case 'u':	sprintf(p, fmt, (unsigned int) getfval(x)); break;
909		case 's':
910			t = getsval(x);
911			n = strlen(t);
912			if (fmtwd > n)
913				n = fmtwd;
914			if (!adjbuf(&buf, &bufsize, 1+n+p-buf, recsize, &p, "format7"))
915				FATAL("huge string/format (%d chars) in printf %.30s... ran format() out of memory", n, t);
916			sprintf(p, fmt, t);
917			break;
918		case 'c':
919			if (isnum(x)) {
920				if (getfval(x))
921					sprintf(p, fmt, (int) getfval(x));
922				else {
923					*p++ = '\0'; /* explicit null byte */
924					*p = '\0';   /* next output will start here */
925				}
926			} else
927				sprintf(p, fmt, getsval(x)[0]);
928			break;
929		default:
930			FATAL("can't happen: bad conversion %c in format()", flag);
931		}
932		tempfree(x);
933		p += strlen(p);
934		s++;
935	}
936	*p = '\0';
937	free(fmt);
938	for ( ; a; a = a->nnext)		/* evaluate any remaining args */
939		execute(a);
940	*pbuf = buf;
941	*pbufsize = bufsize;
942	return p - buf;
943}
944
945Cell *awksprintf(Node **a, int n)		/* sprintf(a[0]) */
946{
947	Cell *x;
948	Node *y;
949	char *buf;
950	int bufsz=3*recsize;
951
952	if ((buf = (char *) malloc(bufsz)) == NULL)
953		FATAL("out of memory in awksprintf");
954	y = a[0]->nnext;
955	x = execute(a[0]);
956	if (format(&buf, &bufsz, getsval(x), y) == -1)
957		FATAL("sprintf string %.30s... too long.  can't happen.", buf);
958	tempfree(x);
959	x = gettemp();
960	x->sval = buf;
961	x->tval = STR;
962	return(x);
963}
964
965Cell *awkprintf(Node **a, int n)		/* printf */
966{	/* a[0] is list of args, starting with format string */
967	/* a[1] is redirection operator, a[2] is redirection file */
968	FILE *fp;
969	Cell *x;
970	Node *y;
971	char *buf;
972	int len;
973	int bufsz=3*recsize;
974
975	if ((buf = (char *) malloc(bufsz)) == NULL)
976		FATAL("out of memory in awkprintf");
977	y = a[0]->nnext;
978	x = execute(a[0]);
979	if ((len = format(&buf, &bufsz, getsval(x), y)) == -1)
980		FATAL("printf string %.30s... too long.  can't happen.", buf);
981	tempfree(x);
982	if (a[1] == NULL) {
983		/* fputs(buf, stdout); */
984		fwrite(buf, len, 1, stdout);
985		if (ferror(stdout))
986			FATAL("write error on stdout");
987	} else {
988		fp = redirect(ptoi(a[1]), a[2]);
989		/* fputs(buf, fp); */
990		fwrite(buf, len, 1, fp);
991		fflush(fp);
992		if (ferror(fp))
993			FATAL("write error on %s", filename(fp));
994	}
995	free(buf);
996	return(True);
997}
998
999Cell *arith(Node **a, int n)	/* a[0] + a[1], etc.  also -a[0] */
1000{
1001	Awkfloat i, j = 0;
1002	double v;
1003	Cell *x, *y, *z;
1004
1005	x = execute(a[0]);
1006	i = getfval(x);
1007	tempfree(x);
1008	if (n != UMINUS) {
1009		y = execute(a[1]);
1010		j = getfval(y);
1011		tempfree(y);
1012	}
1013	z = gettemp();
1014	switch (n) {
1015	case ADD:
1016		i += j;
1017		break;
1018	case MINUS:
1019		i -= j;
1020		break;
1021	case MULT:
1022		i *= j;
1023		break;
1024	case DIVIDE:
1025		if (j == 0)
1026			FATAL("division by zero");
1027		i /= j;
1028		break;
1029	case MOD:
1030		if (j == 0)
1031			FATAL("division by zero in mod");
1032		modf(i/j, &v);
1033		i = i - j * v;
1034		break;
1035	case UMINUS:
1036		i = -i;
1037		break;
1038	case POWER:
1039		if (j >= 0 && modf(j, &v) == 0.0)	/* pos integer exponent */
1040			i = ipow(i, (int) j);
1041		else
1042			i = errcheck(pow(i, j), "pow");
1043		break;
1044	default:	/* can't happen */
1045		FATAL("illegal arithmetic operator %d", n);
1046	}
1047	setfval(z, i);
1048	return(z);
1049}
1050
1051double ipow(double x, int n)	/* x**n.  ought to be done by pow, but isn't always */
1052{
1053	double v;
1054
1055	if (n <= 0)
1056		return 1;
1057	v = ipow(x, n/2);
1058	if (n % 2 == 0)
1059		return v * v;
1060	else
1061		return x * v * v;
1062}
1063
1064Cell *incrdecr(Node **a, int n)		/* a[0]++, etc. */
1065{
1066	Cell *x, *z;
1067	int k;
1068	Awkfloat xf;
1069
1070	x = execute(a[0]);
1071	xf = getfval(x);
1072	k = (n == PREINCR || n == POSTINCR) ? 1 : -1;
1073	if (n == PREINCR || n == PREDECR) {
1074		setfval(x, xf + k);
1075		return(x);
1076	}
1077	z = gettemp();
1078	setfval(z, xf);
1079	setfval(x, xf + k);
1080	tempfree(x);
1081	return(z);
1082}
1083
1084Cell *assign(Node **a, int n)	/* a[0] = a[1], a[0] += a[1], etc. */
1085{		/* this is subtle; don't muck with it. */
1086	Cell *x, *y;
1087	Awkfloat xf, yf;
1088	double v;
1089
1090	y = execute(a[1]);
1091	x = execute(a[0]);
1092	if (n == ASSIGN) {	/* ordinary assignment */
1093		if (x == y && !(x->tval & (FLD|REC)))	/* self-assignment: */
1094			;		/* leave alone unless it's a field */
1095		else if ((y->tval & (STR|NUM)) == (STR|NUM)) {
1096			setsval(x, getsval(y));
1097			x->fval = getfval(y);
1098			x->tval |= NUM;
1099		}
1100		else if (isstr(y))
1101			setsval(x, getsval(y));
1102		else if (isnum(y))
1103			setfval(x, getfval(y));
1104		else
1105			funnyvar(y, "read value of");
1106		tempfree(y);
1107		return(x);
1108	}
1109	xf = getfval(x);
1110	yf = getfval(y);
1111	switch (n) {
1112	case ADDEQ:
1113		xf += yf;
1114		break;
1115	case SUBEQ:
1116		xf -= yf;
1117		break;
1118	case MULTEQ:
1119		xf *= yf;
1120		break;
1121	case DIVEQ:
1122		if (yf == 0)
1123			FATAL("division by zero in /=");
1124		xf /= yf;
1125		break;
1126	case MODEQ:
1127		if (yf == 0)
1128			FATAL("division by zero in %%=");
1129		modf(xf/yf, &v);
1130		xf = xf - yf * v;
1131		break;
1132	case POWEQ:
1133		if (yf >= 0 && modf(yf, &v) == 0.0)	/* pos integer exponent */
1134			xf = ipow(xf, (int) yf);
1135		else
1136			xf = errcheck(pow(xf, yf), "pow");
1137		break;
1138	default:
1139		FATAL("illegal assignment operator %d", n);
1140		break;
1141	}
1142	tempfree(y);
1143	setfval(x, xf);
1144	return(x);
1145}
1146
1147Cell *cat(Node **a, int q)	/* a[0] cat a[1] */
1148{
1149	Cell *x, *y, *z;
1150	int n1, n2;
1151	char *s;
1152
1153	x = execute(a[0]);
1154	y = execute(a[1]);
1155	getsval(x);
1156	getsval(y);
1157	n1 = strlen(x->sval);
1158	n2 = strlen(y->sval);
1159	s = (char *) malloc(n1 + n2 + 1);
1160	if (s == NULL)
1161		FATAL("out of space concatenating %.15s... and %.15s...",
1162			x->sval, y->sval);
1163	strcpy(s, x->sval);
1164	strcpy(s+n1, y->sval);
1165	tempfree(y);
1166	z = gettemp();
1167	z->sval = s;
1168	z->tval = STR;
1169	tempfree(x);
1170	return(z);
1171}
1172
1173Cell *pastat(Node **a, int n)	/* a[0] { a[1] } */
1174{
1175	Cell *x;
1176
1177	if (a[0] == 0)
1178		x = execute(a[1]);
1179	else {
1180		x = execute(a[0]);
1181		if (istrue(x)) {
1182			tempfree(x);
1183			x = execute(a[1]);
1184		}
1185	}
1186	return x;
1187}
1188
1189Cell *dopa2(Node **a, int n)	/* a[0], a[1] { a[2] } */
1190{
1191	Cell *x;
1192	int pair;
1193
1194	pair = ptoi(a[3]);
1195	if (pairstack[pair] == 0) {
1196		x = execute(a[0]);
1197		if (istrue(x))
1198			pairstack[pair] = 1;
1199		tempfree(x);
1200	}
1201	if (pairstack[pair] == 1) {
1202		x = execute(a[1]);
1203		if (istrue(x))
1204			pairstack[pair] = 0;
1205		tempfree(x);
1206		x = execute(a[2]);
1207		return(x);
1208	}
1209	return(False);
1210}
1211
1212Cell *split(Node **a, int nnn)	/* split(a[0], a[1], a[2]); a[3] is type */
1213{
1214	Cell *x = 0, *y, *ap;
1215	char *s;
1216	int sep;
1217	char *t, temp, num[50], *fs = 0;
1218	int n, tempstat, arg3type;
1219
1220	y = execute(a[0]);	/* source string */
1221	s = getsval(y);
1222	arg3type = ptoi(a[3]);
1223	if (a[2] == 0)		/* fs string */
1224		fs = *FS;
1225	else if (arg3type == STRING) {	/* split(str,arr,"string") */
1226		x = execute(a[2]);
1227		fs = getsval(x);
1228	} else if (arg3type == REGEXPR)
1229		fs = "(regexpr)";	/* split(str,arr,/regexpr/) */
1230	else
1231		FATAL("illegal type of split");
1232	sep = *fs;
1233	ap = execute(a[1]);	/* array name */
1234	freesymtab(ap);
1235	   dprintf( ("split: s=|%s|, a=%s, sep=|%s|\n", s, NN(ap->nval), fs) );
1236	ap->tval &= ~STR;
1237	ap->tval |= ARR;
1238	ap->sval = (char *) makesymtab(NSYMTAB);
1239
1240	n = 0;
1241	if (*s != '\0' && (strlen(fs) > 1 || arg3type == REGEXPR)) {	/* reg expr */
1242		fa *pfa;
1243		if (arg3type == REGEXPR) {	/* it's ready already */
1244			pfa = (fa *) a[2];
1245		} else {
1246			pfa = makedfa(fs, 1);
1247		}
1248		if (nematch(pfa,s)) {
1249			tempstat = pfa->initstat;
1250			pfa->initstat = 2;
1251			do {
1252				n++;
1253				sprintf(num, "%d", n);
1254				temp = *patbeg;
1255				*patbeg = '\0';
1256				if (is_number(s))
1257					setsymtab(num, s, atof(s), STR|NUM, (Array *) ap->sval);
1258				else
1259					setsymtab(num, s, 0.0, STR, (Array *) ap->sval);
1260				*patbeg = temp;
1261				s = patbeg + patlen;
1262				if (*(patbeg+patlen-1) == 0 || *s == 0) {
1263					n++;
1264					sprintf(num, "%d", n);
1265					setsymtab(num, "", 0.0, STR, (Array *) ap->sval);
1266					pfa->initstat = tempstat;
1267					goto spdone;
1268				}
1269			} while (nematch(pfa,s));
1270			pfa->initstat = tempstat; 	/* bwk: has to be here to reset */
1271							/* cf gsub and refldbld */
1272		}
1273		n++;
1274		sprintf(num, "%d", n);
1275		if (is_number(s))
1276			setsymtab(num, s, atof(s), STR|NUM, (Array *) ap->sval);
1277		else
1278			setsymtab(num, s, 0.0, STR, (Array *) ap->sval);
1279  spdone:
1280		pfa = NULL;
1281	} else if (sep == ' ') {
1282		for (n = 0; ; ) {
1283			while (*s == ' ' || *s == '\t' || *s == '\n')
1284				s++;
1285			if (*s == 0)
1286				break;
1287			n++;
1288			t = s;
1289			do
1290				s++;
1291			while (*s!=' ' && *s!='\t' && *s!='\n' && *s!='\0');
1292			temp = *s;
1293			*s = '\0';
1294			sprintf(num, "%d", n);
1295			if (is_number(t))
1296				setsymtab(num, t, atof(t), STR|NUM, (Array *) ap->sval);
1297			else
1298				setsymtab(num, t, 0.0, STR, (Array *) ap->sval);
1299			*s = temp;
1300			if (*s != 0)
1301				s++;
1302		}
1303	} else if (sep == 0) {	/* new: split(s, a, "") => 1 char/elem */
1304		for (n = 0; *s != 0; s++) {
1305			char buf[2];
1306			n++;
1307			sprintf(num, "%d", n);
1308			buf[0] = *s;
1309			buf[1] = 0;
1310			if (isdigit((uschar)buf[0]))
1311				setsymtab(num, buf, atof(buf), STR|NUM, (Array *) ap->sval);
1312			else
1313				setsymtab(num, buf, 0.0, STR, (Array *) ap->sval);
1314		}
1315	} else if (*s != 0) {
1316		for (;;) {
1317			n++;
1318			t = s;
1319			while (*s != sep && *s != '\n' && *s != '\0')
1320				s++;
1321			temp = *s;
1322			*s = '\0';
1323			sprintf(num, "%d", n);
1324			if (is_number(t))
1325				setsymtab(num, t, atof(t), STR|NUM, (Array *) ap->sval);
1326			else
1327				setsymtab(num, t, 0.0, STR, (Array *) ap->sval);
1328			*s = temp;
1329			if (*s++ == 0)
1330				break;
1331		}
1332	}
1333	tempfree(ap);
1334	tempfree(y);
1335	if (a[2] != 0 && arg3type == STRING) {
1336		tempfree(x);
1337	}
1338	x = gettemp();
1339	x->tval = NUM;
1340	x->fval = n;
1341	return(x);
1342}
1343
1344Cell *condexpr(Node **a, int n)	/* a[0] ? a[1] : a[2] */
1345{
1346	Cell *x;
1347
1348	x = execute(a[0]);
1349	if (istrue(x)) {
1350		tempfree(x);
1351		x = execute(a[1]);
1352	} else {
1353		tempfree(x);
1354		x = execute(a[2]);
1355	}
1356	return(x);
1357}
1358
1359Cell *ifstat(Node **a, int n)	/* if (a[0]) a[1]; else a[2] */
1360{
1361	Cell *x;
1362
1363	x = execute(a[0]);
1364	if (istrue(x)) {
1365		tempfree(x);
1366		x = execute(a[1]);
1367	} else if (a[2] != 0) {
1368		tempfree(x);
1369		x = execute(a[2]);
1370	}
1371	return(x);
1372}
1373
1374Cell *whilestat(Node **a, int n)	/* while (a[0]) a[1] */
1375{
1376	Cell *x;
1377
1378	for (;;) {
1379		x = execute(a[0]);
1380		if (!istrue(x))
1381			return(x);
1382		tempfree(x);
1383		x = execute(a[1]);
1384		if (isbreak(x)) {
1385			x = True;
1386			return(x);
1387		}
1388		if (isnext(x) || isexit(x) || isret(x))
1389			return(x);
1390		tempfree(x);
1391	}
1392}
1393
1394Cell *dostat(Node **a, int n)	/* do a[0]; while(a[1]) */
1395{
1396	Cell *x;
1397
1398	for (;;) {
1399		x = execute(a[0]);
1400		if (isbreak(x))
1401			return True;
1402		if (isnext(x) || isexit(x) || isret(x))
1403			return(x);
1404		tempfree(x);
1405		x = execute(a[1]);
1406		if (!istrue(x))
1407			return(x);
1408		tempfree(x);
1409	}
1410}
1411
1412Cell *forstat(Node **a, int n)	/* for (a[0]; a[1]; a[2]) a[3] */
1413{
1414	Cell *x;
1415
1416	x = execute(a[0]);
1417	tempfree(x);
1418	for (;;) {
1419		if (a[1]!=0) {
1420			x = execute(a[1]);
1421			if (!istrue(x)) return(x);
1422			else tempfree(x);
1423		}
1424		x = execute(a[3]);
1425		if (isbreak(x))		/* turn off break */
1426			return True;
1427		if (isnext(x) || isexit(x) || isret(x))
1428			return(x);
1429		tempfree(x);
1430		x = execute(a[2]);
1431		tempfree(x);
1432	}
1433}
1434
1435Cell *instat(Node **a, int n)	/* for (a[0] in a[1]) a[2] */
1436{
1437	Cell *x, *vp, *arrayp, *cp, *ncp;
1438	Array *tp;
1439	int i;
1440
1441	vp = execute(a[0]);
1442	arrayp = execute(a[1]);
1443	if (!isarr(arrayp)) {
1444		return True;
1445	}
1446	tp = (Array *) arrayp->sval;
1447	tempfree(arrayp);
1448	for (i = 0; i < tp->size; i++) {	/* this routine knows too much */
1449		for (cp = tp->tab[i]; cp != NULL; cp = ncp) {
1450			setsval(vp, cp->nval);
1451			ncp = cp->cnext;
1452			x = execute(a[2]);
1453			if (isbreak(x)) {
1454				tempfree(vp);
1455				return True;
1456			}
1457			if (isnext(x) || isexit(x) || isret(x)) {
1458				tempfree(vp);
1459				return(x);
1460			}
1461			tempfree(x);
1462		}
1463	}
1464	return True;
1465}
1466
1467Cell *bltin(Node **a, int n)	/* builtin functions. a[0] is type, a[1] is arg list */
1468{
1469	Cell *x, *y;
1470	Awkfloat u;
1471	int t;
1472	char *p, *buf;
1473	Node *nextarg;
1474	FILE *fp;
1475	void flush_all(void);
1476
1477	t = ptoi(a[0]);
1478	x = execute(a[1]);
1479	nextarg = a[1]->nnext;
1480	switch (t) {
1481	case FLENGTH:
1482		if (isarr(x))
1483			u = ((Array *) x->sval)->nelem;	/* GROT.  should be function*/
1484		else
1485			u = strlen(getsval(x));
1486		break;
1487	case FLOG:
1488		u = errcheck(log(getfval(x)), "log"); break;
1489	case FINT:
1490		modf(getfval(x), &u); break;
1491	case FEXP:
1492		u = errcheck(exp(getfval(x)), "exp"); break;
1493	case FSQRT:
1494		u = errcheck(sqrt(getfval(x)), "sqrt"); break;
1495	case FSIN:
1496		u = sin(getfval(x)); break;
1497	case FCOS:
1498		u = cos(getfval(x)); break;
1499	case FATAN:
1500		if (nextarg == 0) {
1501			WARNING("atan2 requires two arguments; returning 1.0");
1502			u = 1.0;
1503		} else {
1504			y = execute(a[1]->nnext);
1505			u = atan2(getfval(x), getfval(y));
1506			tempfree(y);
1507			nextarg = nextarg->nnext;
1508		}
1509		break;
1510	case FSYSTEM:
1511		fflush(stdout);		/* in case something is buffered already */
1512		u = (Awkfloat) system(getsval(x)) / 256;   /* 256 is unix-dep */
1513		break;
1514	case FRAND:
1515		/* in principle, rand() returns something in 0..RAND_MAX */
1516		u = (Awkfloat) (random() % RAND_MAX) / RAND_MAX;
1517		break;
1518	case FSRAND:
1519		if (isrec(x))	/* no argument provided */
1520			u = time((time_t *)0);
1521		else
1522			u = getfval(x);
1523		srandom((unsigned int) u);
1524		tmp_srand = u;
1525		u = prev_srand;		/* return the previous value	*/
1526		prev_srand = tmp_srand;	/* remember for next time	*/
1527		break;
1528	case FTOUPPER:
1529	case FTOLOWER:
1530		buf = tostring(getsval(x));
1531		if (t == FTOUPPER) {
1532			for (p = buf; *p; p++)
1533				if (islower((uschar) *p))
1534					*p = toupper((uschar)*p);
1535		} else {
1536			for (p = buf; *p; p++)
1537				if (isupper((uschar) *p))
1538					*p = tolower((uschar)*p);
1539		}
1540		tempfree(x);
1541		x = gettemp();
1542		setsval(x, buf);
1543		free(buf);
1544		return x;
1545	case FFLUSH:
1546		if (isrec(x) || strlen(getsval(x)) == 0) {
1547			flush_all();	/* fflush() or fflush("") -> all */
1548			u = 0;
1549		} else if ((fp = openfile(FFLUSH, getsval(x))) == NULL)
1550			u = EOF;
1551		else
1552			u = fflush(fp);
1553		break;
1554	default:	/* can't happen */
1555		FATAL("illegal function type %d", t);
1556		break;
1557	}
1558	tempfree(x);
1559	x = gettemp();
1560	setfval(x, u);
1561	if (nextarg != 0) {
1562		WARNING("warning: function has too many arguments");
1563		for ( ; nextarg; nextarg = nextarg->nnext)
1564			execute(nextarg);
1565	}
1566	return(x);
1567}
1568
1569Cell *printstat(Node **a, int n)	/* print a[0] */
1570{
1571	Node *x;
1572	Cell *y;
1573	FILE *fp;
1574
1575	if (a[1] == 0)	/* a[1] is redirection operator, a[2] is file */
1576		fp = stdout;
1577	else
1578		fp = redirect(ptoi(a[1]), a[2]);
1579	for (x = a[0]; x != NULL; x = x->nnext) {
1580		y = execute(x);
1581		fputs(getpssval(y), fp);
1582		tempfree(y);
1583		if (x->nnext == NULL)
1584			fputs(*ORS, fp);
1585		else
1586			fputs(*OFS, fp);
1587	}
1588	if (a[1] != 0)
1589		fflush(fp);
1590	if (ferror(fp))
1591		FATAL("write error on %s", filename(fp));
1592	return(True);
1593}
1594
1595Cell *nullproc(Node **a, int n)
1596{
1597	n = n;
1598	a = a;
1599	return 0;
1600}
1601
1602
1603FILE *redirect(int a, Node *b)	/* set up all i/o redirections */
1604{
1605	FILE *fp;
1606	Cell *x;
1607	char *fname;
1608
1609	x = execute(b);
1610	fname = getsval(x);
1611	fp = openfile(a, fname);
1612	if (fp == NULL)
1613		FATAL("can't open file %s", fname);
1614	tempfree(x);
1615	return fp;
1616}
1617
1618struct files {
1619	FILE	*fp;
1620	const char	*fname;
1621	int	mode;	/* '|', 'a', 'w' => LE/LT, GT */
1622} files[FOPEN_MAX] ={
1623	{ NULL,  "/dev/stdin",  LT },	/* watch out: don't free this! */
1624	{ NULL, "/dev/stdout", GT },
1625	{ NULL, "/dev/stderr", GT }
1626};
1627
1628void stdinit(void)	/* in case stdin, etc., are not constants */
1629{
1630	files[0].fp = stdin;
1631	files[1].fp = stdout;
1632	files[2].fp = stderr;
1633}
1634
1635FILE *openfile(int a, const char *us)
1636{
1637	const char *s = us;
1638	int i, m;
1639	FILE *fp = 0;
1640
1641	if (*s == '\0')
1642		FATAL("null file name in print or getline");
1643	for (i=0; i < FOPEN_MAX; i++)
1644		if (files[i].fname && strcmp(s, files[i].fname) == 0) {
1645			if (a == files[i].mode || (a==APPEND && files[i].mode==GT))
1646				return files[i].fp;
1647			if (a == FFLUSH)
1648				return files[i].fp;
1649		}
1650	if (a == FFLUSH)	/* didn't find it, so don't create it! */
1651		return NULL;
1652
1653	for (i=0; i < FOPEN_MAX; i++)
1654		if (files[i].fp == 0)
1655			break;
1656	if (i >= FOPEN_MAX)
1657		FATAL("%s makes too many open files", s);
1658	fflush(stdout);	/* force a semblance of order */
1659	m = a;
1660	if (a == GT) {
1661		fp = fopen(s, "w");
1662	} else if (a == APPEND) {
1663		fp = fopen(s, "a");
1664		m = GT;	/* so can mix > and >> */
1665	} else if (a == '|') {	/* output pipe */
1666		fp = popen(s, "w");
1667	} else if (a == LE) {	/* input pipe */
1668		fp = popen(s, "r");
1669	} else if (a == LT) {	/* getline <file */
1670		fp = strcmp(s, "-") == 0 ? stdin : fopen(s, "r");	/* "-" is stdin */
1671	} else	/* can't happen */
1672		FATAL("illegal redirection %d", a);
1673	if (fp != NULL) {
1674		files[i].fname = tostring(s);
1675		files[i].fp = fp;
1676		files[i].mode = m;
1677	}
1678	return fp;
1679}
1680
1681const char *filename(FILE *fp)
1682{
1683	int i;
1684
1685	for (i = 0; i < FOPEN_MAX; i++)
1686		if (fp == files[i].fp)
1687			return files[i].fname;
1688	return "???";
1689}
1690
1691Cell *closefile(Node **a, int n)
1692{
1693	Cell *x;
1694	int i, stat;
1695
1696	n = n;
1697	x = execute(a[0]);
1698	getsval(x);
1699	stat = -1;
1700	for (i = 0; i < FOPEN_MAX; i++) {
1701		if (files[i].fname && strcmp(x->sval, files[i].fname) == 0) {
1702			if (ferror(files[i].fp))
1703				WARNING( "i/o error occurred on %s", files[i].fname );
1704			if (files[i].mode == '|' || files[i].mode == LE)
1705				stat = pclose(files[i].fp);
1706			else
1707				stat = fclose(files[i].fp);
1708			if (stat == EOF)
1709				WARNING( "i/o error occurred closing %s", files[i].fname );
1710			if (i > 2)	/* don't do /dev/std... */
1711				xfree(files[i].fname);
1712			files[i].fname = NULL;	/* watch out for ref thru this */
1713			files[i].fp = NULL;
1714		}
1715	}
1716	tempfree(x);
1717	x = gettemp();
1718	setfval(x, (Awkfloat) stat);
1719	return(x);
1720}
1721
1722void closeall(void)
1723{
1724	int i, stat;
1725
1726	for (i = 0; i < FOPEN_MAX; i++) {
1727		if (files[i].fp) {
1728			if (ferror(files[i].fp))
1729				WARNING( "i/o error occurred on %s", files[i].fname );
1730			if (files[i].mode == '|' || files[i].mode == LE)
1731				stat = pclose(files[i].fp);
1732			else
1733				stat = fclose(files[i].fp);
1734			if (stat == EOF)
1735				WARNING( "i/o error occurred while closing %s", files[i].fname );
1736		}
1737	}
1738}
1739
1740void flush_all(void)
1741{
1742	int i;
1743
1744	for (i = 0; i < FOPEN_MAX; i++)
1745		if (files[i].fp)
1746			fflush(files[i].fp);
1747}
1748
1749void backsub(char **pb_ptr, char **sptr_ptr);
1750
1751Cell *sub(Node **a, int nnn)	/* substitute command */
1752{
1753	char *sptr, *pb, *q;
1754	Cell *x, *y, *result;
1755	char *t, *buf;
1756	fa *pfa;
1757	int bufsz = recsize;
1758
1759	if ((buf = (char *) malloc(bufsz)) == NULL)
1760		FATAL("out of memory in sub");
1761	x = execute(a[3]);	/* target string */
1762	t = getsval(x);
1763	if (a[0] == 0)		/* 0 => a[1] is already-compiled regexpr */
1764		pfa = (fa *) a[1];	/* regular expression */
1765	else {
1766		y = execute(a[1]);
1767		pfa = makedfa(getsval(y), 1);
1768		tempfree(y);
1769	}
1770	y = execute(a[2]);	/* replacement string */
1771	result = False;
1772	if (pmatch(pfa, t)) {
1773		sptr = t;
1774		adjbuf(&buf, &bufsz, 1+patbeg-sptr, recsize, 0, "sub");
1775		pb = buf;
1776		while (sptr < patbeg)
1777			*pb++ = *sptr++;
1778		sptr = getsval(y);
1779		while (*sptr != 0) {
1780			adjbuf(&buf, &bufsz, 5+pb-buf, recsize, &pb, "sub");
1781			if (*sptr == '\\') {
1782				backsub(&pb, &sptr);
1783			} else if (*sptr == '&') {
1784				sptr++;
1785				adjbuf(&buf, &bufsz, 1+patlen+pb-buf, recsize, &pb, "sub");
1786				for (q = patbeg; q < patbeg+patlen; )
1787					*pb++ = *q++;
1788			} else
1789				*pb++ = *sptr++;
1790		}
1791		*pb = '\0';
1792		if (pb > buf + bufsz)
1793			FATAL("sub result1 %.30s too big; can't happen", buf);
1794		sptr = patbeg + patlen;
1795		if ((patlen == 0 && *patbeg) || (patlen && *(sptr-1))) {
1796			adjbuf(&buf, &bufsz, 1+strlen(sptr)+pb-buf, 0, &pb, "sub");
1797			while ((*pb++ = *sptr++) != 0)
1798				;
1799		}
1800		if (pb > buf + bufsz)
1801			FATAL("sub result2 %.30s too big; can't happen", buf);
1802		setsval(x, buf);	/* BUG: should be able to avoid copy */
1803		result = True;;
1804	}
1805	tempfree(x);
1806	tempfree(y);
1807	free(buf);
1808	return result;
1809}
1810
1811Cell *gsub(Node **a, int nnn)	/* global substitute */
1812{
1813	Cell *x, *y;
1814	char *rptr, *sptr, *t, *pb, *q;
1815	char *buf;
1816	fa *pfa;
1817	int mflag, tempstat, num;
1818	int bufsz = recsize;
1819
1820	if ((buf = (char *) malloc(bufsz)) == NULL)
1821		FATAL("out of memory in gsub");
1822	mflag = 0;	/* if mflag == 0, can replace empty string */
1823	num = 0;
1824	x = execute(a[3]);	/* target string */
1825	t = getsval(x);
1826	if (a[0] == 0)		/* 0 => a[1] is already-compiled regexpr */
1827		pfa = (fa *) a[1];	/* regular expression */
1828	else {
1829		y = execute(a[1]);
1830		pfa = makedfa(getsval(y), 1);
1831		tempfree(y);
1832	}
1833	y = execute(a[2]);	/* replacement string */
1834	if (pmatch(pfa, t)) {
1835		tempstat = pfa->initstat;
1836		pfa->initstat = 2;
1837		pb = buf;
1838		rptr = getsval(y);
1839		do {
1840			if (patlen == 0 && *patbeg != 0) {	/* matched empty string */
1841				if (mflag == 0) {	/* can replace empty */
1842					num++;
1843					sptr = rptr;
1844					while (*sptr != 0) {
1845						adjbuf(&buf, &bufsz, 5+pb-buf, recsize, &pb, "gsub");
1846						if (*sptr == '\\') {
1847							backsub(&pb, &sptr);
1848						} else if (*sptr == '&') {
1849							sptr++;
1850							adjbuf(&buf, &bufsz, 1+patlen+pb-buf, recsize, &pb, "gsub");
1851							for (q = patbeg; q < patbeg+patlen; )
1852								*pb++ = *q++;
1853						} else
1854							*pb++ = *sptr++;
1855					}
1856				}
1857				if (*t == 0)	/* at end */
1858					goto done;
1859				adjbuf(&buf, &bufsz, 2+pb-buf, recsize, &pb, "gsub");
1860				*pb++ = *t++;
1861				if (pb > buf + bufsz)	/* BUG: not sure of this test */
1862					FATAL("gsub result0 %.30s too big; can't happen", buf);
1863				mflag = 0;
1864			}
1865			else {	/* matched nonempty string */
1866				num++;
1867				sptr = t;
1868				adjbuf(&buf, &bufsz, 1+(patbeg-sptr)+pb-buf, recsize, &pb, "gsub");
1869				while (sptr < patbeg)
1870					*pb++ = *sptr++;
1871				sptr = rptr;
1872				while (*sptr != 0) {
1873					adjbuf(&buf, &bufsz, 5+pb-buf, recsize, &pb, "gsub");
1874					if (*sptr == '\\') {
1875						backsub(&pb, &sptr);
1876					} else if (*sptr == '&') {
1877						sptr++;
1878						adjbuf(&buf, &bufsz, 1+patlen+pb-buf, recsize, &pb, "gsub");
1879						for (q = patbeg; q < patbeg+patlen; )
1880							*pb++ = *q++;
1881					} else
1882						*pb++ = *sptr++;
1883				}
1884				t = patbeg + patlen;
1885				if (patlen == 0 || *t == 0 || *(t-1) == 0)
1886					goto done;
1887				if (pb > buf + bufsz)
1888					FATAL("gsub result1 %.30s too big; can't happen", buf);
1889				mflag = 1;
1890			}
1891		} while (pmatch(pfa,t));
1892		sptr = t;
1893		adjbuf(&buf, &bufsz, 1+strlen(sptr)+pb-buf, 0, &pb, "gsub");
1894		while ((*pb++ = *sptr++) != 0)
1895			;
1896	done:	if (pb > buf + bufsz)
1897			FATAL("gsub result2 %.30s too big; can't happen", buf);
1898		*pb = '\0';
1899		setsval(x, buf);	/* BUG: should be able to avoid copy + free */
1900		pfa->initstat = tempstat;
1901	}
1902	tempfree(x);
1903	tempfree(y);
1904	x = gettemp();
1905	x->tval = NUM;
1906	x->fval = num;
1907	free(buf);
1908	return(x);
1909}
1910
1911void backsub(char **pb_ptr, char **sptr_ptr)	/* handle \\& variations */
1912{						/* sptr[0] == '\\' */
1913	char *pb = *pb_ptr, *sptr = *sptr_ptr;
1914
1915	if (sptr[1] == '\\') {
1916		if (sptr[2] == '\\' && sptr[3] == '&') { /* \\\& -> \& */
1917			*pb++ = '\\';
1918			*pb++ = '&';
1919			sptr += 4;
1920		} else if (sptr[2] == '&') {	/* \\& -> \ + matched */
1921			*pb++ = '\\';
1922			sptr += 2;
1923		} else {			/* \\x -> \\x */
1924			*pb++ = *sptr++;
1925			*pb++ = *sptr++;
1926		}
1927	} else if (sptr[1] == '&') {	/* literal & */
1928		sptr++;
1929		*pb++ = *sptr++;
1930	} else				/* literal \ */
1931		*pb++ = *sptr++;
1932
1933	*pb_ptr = pb;
1934	*sptr_ptr = sptr;
1935}
1936