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