morpheus-base

morpheus base system
git clone git://git.2f30.org/morpheus-base.git
Log | Files | Refs

run.c (46552B)


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