hbase

heirloom base
git clone git://git.2f30.org/hbase
Log | Files | Refs | README

run.c (46325B)


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