9base

revived minimalist port of Plan 9 userland to Unix
git clone git://git.suckless.org/9base
Log | Files | Refs | README | LICENSE

run.c (42786B)


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