contrib/awk/run.c

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