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