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