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