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