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