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