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