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, *origs;
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         origs = s = strdup(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 (arg3type == REGEXPR && strlen((char*)((fa*)a[2])->restr) == 0) {
1243                 /* split(s, a, //); have to arrange that it looks like empty sep */
1244                 arg3type = 0;
1245                 fs = "";
1246                 sep = 0;
1247         }
1248         if (*s != '\0' && (strlen(fs) > 1 || arg3type == REGEXPR)) {    /* reg expr */
1249                 fa *pfa;
1250                 if (arg3type == REGEXPR) {      /* it's ready already */
1251                         pfa = (fa *) a[2];
1252                 } else {
1253                         pfa = makedfa(fs, 1);
1254                 }
1255                 if (nematch(pfa,s)) {
1256                         tempstat = pfa->initstat;
1257                         pfa->initstat = 2;
1258                         do {
1259                                 n++;
1260                                 sprintf(num, "%d", n);
1261                                 temp = *patbeg;
1262                                 *patbeg = '\0';
1263                                 if (is_number(s))
1264                                         setsymtab(num, s, atof(s), STR|NUM, (Array *) ap->sval);
1265                                 else
1266                                         setsymtab(num, s, 0.0, STR, (Array *) ap->sval);
1267                                 *patbeg = temp;
1268                                 s = patbeg + patlen;
1269                                 if (*(patbeg+patlen-1) == 0 || *s == 0) {
1270                                         n++;
1271                                         sprintf(num, "%d", n);
1272                                         setsymtab(num, "", 0.0, STR, (Array *) ap->sval);
1273                                         pfa->initstat = tempstat;
1274                                         goto spdone;
1275                                 }
1276                         } while (nematch(pfa,s));
1277                         pfa->initstat = tempstat;       /* bwk: has to be here to reset */
1278                                                         /* cf gsub and refldbld */
1279                 }
1280                 n++;
1281                 sprintf(num, "%d", n);
1282                 if (is_number(s))
1283                         setsymtab(num, s, atof(s), STR|NUM, (Array *) ap->sval);
1284                 else
1285                         setsymtab(num, s, 0.0, STR, (Array *) ap->sval);
1286   spdone:
1287                 pfa = NULL;
1288         } else if (sep == ' ') {
1289                 for (n = 0; ; ) {
1290                         while (*s == ' ' || *s == '\t' || *s == '\n')
1291                                 s++;
1292                         if (*s == 0)
1293                                 break;
1294                         n++;
1295                         t = s;
1296                         do
1297                                 s++;
1298                         while (*s!=' ' && *s!='\t' && *s!='\n' && *s!='\0');
1299                         temp = *s;
1300                         *s = '\0';
1301                         sprintf(num, "%d", n);
1302                         if (is_number(t))
1303                                 setsymtab(num, t, atof(t), STR|NUM, (Array *) ap->sval);
1304                         else
1305                                 setsymtab(num, t, 0.0, STR, (Array *) ap->sval);
1306                         *s = temp;
1307                         if (*s != 0)
1308                                 s++;
1309                 }
1310         } else if (sep == 0) {  /* new: split(s, a, "") => 1 char/elem */
1311                 for (n = 0; *s != 0; s++) {
1312                         char buf[2];
1313                         n++;
1314                         sprintf(num, "%d", n);
1315                         buf[0] = *s;
1316                         buf[1] = 0;
1317                         if (isdigit((uschar)buf[0]))
1318                                 setsymtab(num, buf, atof(buf), STR|NUM, (Array *) ap->sval);
1319                         else
1320                                 setsymtab(num, buf, 0.0, STR, (Array *) ap->sval);
1321                 }
1322         } else if (*s != 0) {
1323                 for (;;) {
1324                         n++;
1325                         t = s;
1326                         while (*s != sep && *s != '\n' && *s != '\0')
1327                                 s++;
1328                         temp = *s;
1329                         *s = '\0';
1330                         sprintf(num, "%d", n);
1331                         if (is_number(t))
1332                                 setsymtab(num, t, atof(t), STR|NUM, (Array *) ap->sval);
1333                         else
1334                                 setsymtab(num, t, 0.0, STR, (Array *) ap->sval);
1335                         *s = temp;
1336                         if (*s++ == 0)
1337                                 break;
1338                 }
1339         }
1340         tempfree(ap);
1341         tempfree(y);
1342         free(origs);
1343         if (a[2] != 0 && arg3type == STRING) {
1344                 tempfree(x);
1345         }
1346         x = gettemp();
1347         x->tval = NUM;
1348         x->fval = n;
1349         return(x);
1350 }
1351
1352 Cell *condexpr(Node **a, int n) /* a[0] ? a[1] : a[2] */
1353 {
1354         Cell *x;
1355
1356         x = execute(a[0]);
1357         if (istrue(x)) {
1358                 tempfree(x);
1359                 x = execute(a[1]);
1360         } else {
1361                 tempfree(x);
1362                 x = execute(a[2]);
1363         }
1364         return(x);
1365 }
1366
1367 Cell *ifstat(Node **a, int n)   /* if (a[0]) a[1]; else a[2] */
1368 {
1369         Cell *x;
1370
1371         x = execute(a[0]);
1372         if (istrue(x)) {
1373                 tempfree(x);
1374                 x = execute(a[1]);
1375         } else if (a[2] != 0) {
1376                 tempfree(x);
1377                 x = execute(a[2]);
1378         }
1379         return(x);
1380 }
1381
1382 Cell *whilestat(Node **a, int n)        /* while (a[0]) a[1] */
1383 {
1384         Cell *x;
1385
1386         for (;;) {
1387                 x = execute(a[0]);
1388                 if (!istrue(x))
1389                         return(x);
1390                 tempfree(x);
1391                 x = execute(a[1]);
1392                 if (isbreak(x)) {
1393                         x = True;
1394                         return(x);
1395                 }
1396                 if (isnext(x) || isexit(x) || isret(x))
1397                         return(x);
1398                 tempfree(x);
1399         }
1400 }
1401
1402 Cell *dostat(Node **a, int n)   /* do a[0]; while(a[1]) */
1403 {
1404         Cell *x;
1405
1406         for (;;) {
1407                 x = execute(a[0]);
1408                 if (isbreak(x))
1409                         return True;
1410                 if (isnext(x) || isexit(x) || isret(x))
1411                         return(x);
1412                 tempfree(x);
1413                 x = execute(a[1]);
1414                 if (!istrue(x))
1415                         return(x);
1416                 tempfree(x);
1417         }
1418 }
1419
1420 Cell *forstat(Node **a, int n)  /* for (a[0]; a[1]; a[2]) a[3] */
1421 {
1422         Cell *x;
1423
1424         x = execute(a[0]);
1425         tempfree(x);
1426         for (;;) {
1427                 if (a[1]!=0) {
1428                         x = execute(a[1]);
1429                         if (!istrue(x)) return(x);
1430                         else tempfree(x);
1431                 }
1432                 x = execute(a[3]);
1433                 if (isbreak(x))         /* turn off break */
1434                         return True;
1435                 if (isnext(x) || isexit(x) || isret(x))
1436                         return(x);
1437                 tempfree(x);
1438                 x = execute(a[2]);
1439                 tempfree(x);
1440         }
1441 }
1442
1443 Cell *instat(Node **a, int n)   /* for (a[0] in a[1]) a[2] */
1444 {
1445         Cell *x, *vp, *arrayp, *cp, *ncp;
1446         Array *tp;
1447         int i;
1448
1449         vp = execute(a[0]);
1450         arrayp = execute(a[1]);
1451         if (!isarr(arrayp)) {
1452                 return True;
1453         }
1454         tp = (Array *) arrayp->sval;
1455         tempfree(arrayp);
1456         for (i = 0; i < tp->size; i++) {        /* this routine knows too much */
1457                 for (cp = tp->tab[i]; cp != NULL; cp = ncp) {
1458                         setsval(vp, cp->nval);
1459                         ncp = cp->cnext;
1460                         x = execute(a[2]);
1461                         if (isbreak(x)) {
1462                                 tempfree(vp);
1463                                 return True;
1464                         }
1465                         if (isnext(x) || isexit(x) || isret(x)) {
1466                                 tempfree(vp);
1467                                 return(x);
1468                         }
1469                         tempfree(x);
1470                 }
1471         }
1472         return True;
1473 }
1474
1475 Cell *bltin(Node **a, int n)    /* builtin functions. a[0] is type, a[1] is arg list */
1476 {
1477         Cell *x, *y;
1478         Awkfloat u;
1479         int t;
1480         Awkfloat tmp;
1481         char *p, *buf;
1482         Node *nextarg;
1483         FILE *fp;
1484         void flush_all(void);
1485
1486         t = ptoi(a[0]);
1487         x = execute(a[1]);
1488         nextarg = a[1]->nnext;
1489         switch (t) {
1490         case FLENGTH:
1491                 if (isarr(x))
1492                         u = ((Array *) x->sval)->nelem; /* GROT.  should be function*/
1493                 else
1494                         u = strlen(getsval(x));
1495                 break;
1496         case FLOG:
1497                 u = errcheck(log(getfval(x)), "log"); break;
1498         case FINT:
1499                 modf(getfval(x), &u); break;
1500         case FEXP:
1501                 u = errcheck(exp(getfval(x)), "exp"); break;
1502         case FSQRT:
1503                 u = errcheck(sqrt(getfval(x)), "sqrt"); break;
1504         case FSIN:
1505                 u = sin(getfval(x)); break;
1506         case FCOS:
1507                 u = cos(getfval(x)); break;
1508         case FATAN:
1509                 if (nextarg == 0) {
1510                         WARNING("atan2 requires two arguments; returning 1.0");
1511                         u = 1.0;
1512                 } else {
1513                         y = execute(a[1]->nnext);
1514                         u = atan2(getfval(x), getfval(y));
1515                         tempfree(y);
1516                         nextarg = nextarg->nnext;
1517                 }
1518                 break;
1519         case FSYSTEM:
1520                 fflush(stdout);         /* in case something is buffered already */
1521                 u = (Awkfloat) system(getsval(x)) / 256;   /* 256 is unix-dep */
1522                 break;
1523         case FRAND:
1524                 /* random() returns numbers in [0..2^31-1]
1525                  * in order to get a number in [0, 1), divide it by 2^31
1526                  */
1527                 u = (Awkfloat) random() / (0x7fffffffL + 0x1UL);
1528                 break;
1529         case FSRAND:
1530                 if (isrec(x))   /* no argument provided */
1531                         u = time((time_t *)0);
1532                 else
1533                         u = getfval(x);
1534                 tmp = u;
1535                 srandom((unsigned long) u);
1536                 u = srand_seed;
1537                 srand_seed = tmp;
1538                 break;
1539         case FTOUPPER:
1540         case FTOLOWER:
1541                 buf = tostring(getsval(x));
1542                 if (t == FTOUPPER) {
1543                         for (p = buf; *p; p++)
1544                                 if (islower((uschar) *p))
1545                                         *p = toupper((uschar)*p);
1546                 } else {
1547                         for (p = buf; *p; p++)
1548                                 if (isupper((uschar) *p))
1549                                         *p = tolower((uschar)*p);
1550                 }
1551                 tempfree(x);
1552                 x = gettemp();
1553                 setsval(x, buf);
1554                 free(buf);
1555                 return x;
1556         case FFLUSH:
1557                 if (isrec(x) || strlen(getsval(x)) == 0) {
1558                         flush_all();    /* fflush() or fflush("") -> all */
1559                         u = 0;
1560                 } else if ((fp = openfile(FFLUSH, getsval(x))) == NULL)
1561                         u = EOF;
1562                 else
1563                         u = fflush(fp);
1564                 break;
1565         default:        /* can't happen */
1566                 FATAL("illegal function type %d", t);
1567                 break;
1568         }
1569         tempfree(x);
1570         x = gettemp();
1571         setfval(x, u);
1572         if (nextarg != 0) {
1573                 WARNING("warning: function has too many arguments");
1574                 for ( ; nextarg; nextarg = nextarg->nnext)
1575                         execute(nextarg);
1576         }
1577         return(x);
1578 }
1579
1580 Cell *printstat(Node **a, int n)        /* print a[0] */
1581 {
1582         Node *x;
1583         Cell *y;
1584         FILE *fp;
1585
1586         if (a[1] == 0)  /* a[1] is redirection operator, a[2] is file */
1587                 fp = stdout;
1588         else
1589                 fp = redirect(ptoi(a[1]), a[2]);
1590         for (x = a[0]; x != NULL; x = x->nnext) {
1591                 y = execute(x);
1592                 fputs(getpssval(y), fp);
1593                 tempfree(y);
1594                 if (x->nnext == NULL)
1595                         fputs(*ORS, fp);
1596                 else
1597                         fputs(*OFS, fp);
1598         }
1599         if (a[1] != 0)
1600                 fflush(fp);
1601         if (ferror(fp))
1602                 FATAL("write error on %s", filename(fp));
1603         return(True);
1604 }
1605
1606 Cell *nullproc(Node **a, int n)
1607 {
1608         n = n;
1609         a = a;
1610         return 0;
1611 }
1612
1613
1614 FILE *redirect(int a, Node *b)  /* set up all i/o redirections */
1615 {
1616         FILE *fp;
1617         Cell *x;
1618         char *fname;
1619
1620         x = execute(b);
1621         fname = getsval(x);
1622         fp = openfile(a, fname);
1623         if (fp == NULL)
1624                 FATAL("can't open file %s", fname);
1625         tempfree(x);
1626         return fp;
1627 }
1628
1629 struct files {
1630         FILE    *fp;
1631         const char      *fname;
1632         int     mode;   /* '|', 'a', 'w' => LE/LT, GT */
1633 } *files;
1634
1635 int nfiles;
1636
1637 void stdinit(void)      /* in case stdin, etc., are not constants */
1638 {
1639         nfiles = FOPEN_MAX;
1640         files = calloc(nfiles, sizeof(*files));
1641         if (files == NULL)
1642                 FATAL("can't allocate file memory for %u files", nfiles);
1643         files[0].fp = stdin;
1644         files[0].fname = "/dev/stdin";
1645         files[0].mode = LT;
1646         files[1].fp = stdout;
1647         files[1].fname = "/dev/stdout";
1648         files[1].mode = GT;
1649         files[2].fp = stderr;
1650         files[2].fname = "/dev/stderr";
1651         files[2].mode = GT;
1652 }
1653
1654 FILE *openfile(int a, const char *us)
1655 {
1656         const char *s = us;
1657         int i, m;
1658         FILE *fp = 0;
1659
1660         if (*s == '\0')
1661                 FATAL("null file name in print or getline");
1662         for (i=0; i < nfiles; i++)
1663                 if (files[i].fname && strcmp(s, files[i].fname) == 0) {
1664                         if (a == files[i].mode || (a==APPEND && files[i].mode==GT))
1665                                 return files[i].fp;
1666                         if (a == FFLUSH)
1667                                 return files[i].fp;
1668                 }
1669         if (a == FFLUSH)        /* didn't find it, so don't create it! */
1670                 return NULL;
1671
1672         for (i=0; i < nfiles; i++)
1673                 if (files[i].fp == 0)
1674                         break;
1675         if (i >= nfiles) {
1676                 struct files *nf;
1677                 int nnf = nfiles + FOPEN_MAX;
1678                 nf = realloc(files, nnf * sizeof(*nf));
1679                 if (nf == NULL)
1680                         FATAL("cannot grow files for %s and %d files", s, nnf);
1681                 memset(&nf[nfiles], 0, FOPEN_MAX * sizeof(*nf));
1682                 nfiles = nnf;
1683                 files = nf;
1684         }
1685         fflush(stdout); /* force a semblance of order */
1686         m = a;
1687         if (a == GT) {
1688                 fp = fopen(s, "w");
1689         } else if (a == APPEND) {
1690                 fp = fopen(s, "a");
1691                 m = GT; /* so can mix > and >> */
1692         } else if (a == '|') {  /* output pipe */
1693                 fp = popen(s, "w");
1694         } else if (a == LE) {   /* input pipe */
1695                 fp = popen(s, "r");
1696         } else if (a == LT) {   /* getline <file */
1697                 fp = strcmp(s, "-") == 0 ? stdin : fopen(s, "r");       /* "-" is stdin */
1698         } else  /* can't happen */
1699                 FATAL("illegal redirection %d", a);
1700         if (fp != NULL) {
1701                 files[i].fname = tostring(s);
1702                 files[i].fp = fp;
1703                 files[i].mode = m;
1704         }
1705         return fp;
1706 }
1707
1708 const char *filename(FILE *fp)
1709 {
1710         int i;
1711
1712         for (i = 0; i < nfiles; i++)
1713                 if (fp == files[i].fp)
1714                         return files[i].fname;
1715         return "???";
1716 }
1717
1718 Cell *closefile(Node **a, int n)
1719 {
1720         Cell *x;
1721         int i, stat;
1722
1723         n = n;
1724         x = execute(a[0]);
1725         getsval(x);
1726         stat = -1;
1727         for (i = 0; i < nfiles; i++) {
1728                 if (files[i].fname && strcmp(x->sval, files[i].fname) == 0) {
1729                         if (ferror(files[i].fp))
1730                                 WARNING( "i/o error occurred on %s", files[i].fname );
1731                         if (files[i].mode == '|' || files[i].mode == LE)
1732                                 stat = pclose(files[i].fp);
1733                         else
1734                                 stat = fclose(files[i].fp);
1735                         if (stat == EOF)
1736                                 WARNING( "i/o error occurred closing %s", files[i].fname );
1737                         if (i > 2)      /* don't do /dev/std... */
1738                                 xfree(files[i].fname);
1739                         files[i].fname = NULL;  /* watch out for ref thru this */
1740                         files[i].fp = NULL;
1741                 }
1742         }
1743         tempfree(x);
1744         x = gettemp();
1745         setfval(x, (Awkfloat) stat);
1746         return(x);
1747 }
1748
1749 void closeall(void)
1750 {
1751         int i, stat;
1752
1753         for (i = 0; i < FOPEN_MAX; i++) {
1754                 if (files[i].fp) {
1755                         if (ferror(files[i].fp))
1756                                 WARNING( "i/o error occurred on %s", files[i].fname );
1757                         if (files[i].mode == '|' || files[i].mode == LE)
1758                                 stat = pclose(files[i].fp);
1759                         else
1760                                 stat = fclose(files[i].fp);
1761                         if (stat == EOF)
1762                                 WARNING( "i/o error occurred while closing %s", files[i].fname );
1763                 }
1764         }
1765 }
1766
1767 void flush_all(void)
1768 {
1769         int i;
1770
1771         for (i = 0; i < nfiles; i++)
1772                 if (files[i].fp)
1773                         fflush(files[i].fp);
1774 }
1775
1776 void backsub(char **pb_ptr, char **sptr_ptr);
1777
1778 Cell *sub(Node **a, int nnn)    /* substitute command */
1779 {
1780         char *sptr, *pb, *q;
1781         Cell *x, *y, *result;
1782         char *t, *buf;
1783         fa *pfa;
1784         int bufsz = recsize;
1785
1786         if ((buf = (char *) malloc(bufsz)) == NULL)
1787                 FATAL("out of memory in sub");
1788         x = execute(a[3]);      /* target string */
1789         t = getsval(x);
1790         if (a[0] == 0)          /* 0 => a[1] is already-compiled regexpr */
1791                 pfa = (fa *) a[1];      /* regular expression */
1792         else {
1793                 y = execute(a[1]);
1794                 pfa = makedfa(getsval(y), 1);
1795                 tempfree(y);
1796         }
1797         y = execute(a[2]);      /* replacement string */
1798         result = False;
1799         if (pmatch(pfa, t)) {
1800                 sptr = t;
1801                 adjbuf(&buf, &bufsz, 1+patbeg-sptr, recsize, 0, "sub");
1802                 pb = buf;
1803                 while (sptr < patbeg)
1804                         *pb++ = *sptr++;
1805                 sptr = getsval(y);
1806                 while (*sptr != 0) {
1807                         adjbuf(&buf, &bufsz, 5+pb-buf, recsize, &pb, "sub");
1808                         if (*sptr == '\\') {
1809                                 backsub(&pb, &sptr);
1810                         } else if (*sptr == '&') {
1811                                 sptr++;
1812                                 adjbuf(&buf, &bufsz, 1+patlen+pb-buf, recsize, &pb, "sub");
1813                                 for (q = patbeg; q < patbeg+patlen; )
1814                                         *pb++ = *q++;
1815                         } else
1816                                 *pb++ = *sptr++;
1817                 }
1818                 *pb = '\0';
1819                 if (pb > buf + bufsz)
1820                         FATAL("sub result1 %.30s too big; can't happen", buf);
1821                 sptr = patbeg + patlen;
1822                 if ((patlen == 0 && *patbeg) || (patlen && *(sptr-1))) {
1823                         adjbuf(&buf, &bufsz, 1+strlen(sptr)+pb-buf, 0, &pb, "sub");
1824                         while ((*pb++ = *sptr++) != 0)
1825                                 ;
1826                 }
1827                 if (pb > buf + bufsz)
1828                         FATAL("sub result2 %.30s too big; can't happen", buf);
1829                 setsval(x, buf);        /* BUG: should be able to avoid copy */
1830                 result = True;;
1831         }
1832         tempfree(x);
1833         tempfree(y);
1834         free(buf);
1835         return result;
1836 }
1837
1838 Cell *gsub(Node **a, int nnn)   /* global substitute */
1839 {
1840         Cell *x, *y;
1841         char *rptr, *sptr, *t, *pb, *q;
1842         char *buf;
1843         fa *pfa;
1844         int mflag, tempstat, num;
1845         int bufsz = recsize;
1846
1847         if ((buf = (char *) malloc(bufsz)) == NULL)
1848                 FATAL("out of memory in gsub");
1849         mflag = 0;      /* if mflag == 0, can replace empty string */
1850         num = 0;
1851         x = execute(a[3]);      /* target string */
1852         t = getsval(x);
1853         if (a[0] == 0)          /* 0 => a[1] is already-compiled regexpr */
1854                 pfa = (fa *) a[1];      /* regular expression */
1855         else {
1856                 y = execute(a[1]);
1857                 pfa = makedfa(getsval(y), 1);
1858                 tempfree(y);
1859         }
1860         y = execute(a[2]);      /* replacement string */
1861         if (pmatch(pfa, t)) {
1862                 tempstat = pfa->initstat;
1863                 pfa->initstat = 2;
1864                 pb = buf;
1865                 rptr = getsval(y);
1866                 do {
1867                         if (patlen == 0 && *patbeg != 0) {      /* matched empty string */
1868                                 if (mflag == 0) {       /* can replace empty */
1869                                         num++;
1870                                         sptr = rptr;
1871                                         while (*sptr != 0) {
1872                                                 adjbuf(&buf, &bufsz, 5+pb-buf, recsize, &pb, "gsub");
1873                                                 if (*sptr == '\\') {
1874                                                         backsub(&pb, &sptr);
1875                                                 } else if (*sptr == '&') {
1876                                                         sptr++;
1877                                                         adjbuf(&buf, &bufsz, 1+patlen+pb-buf, recsize, &pb, "gsub");
1878                                                         for (q = patbeg; q < patbeg+patlen; )
1879                                                                 *pb++ = *q++;
1880                                                 } else
1881                                                         *pb++ = *sptr++;
1882                                         }
1883                                 }
1884                                 if (*t == 0)    /* at end */
1885                                         goto done;
1886                                 adjbuf(&buf, &bufsz, 2+pb-buf, recsize, &pb, "gsub");
1887                                 *pb++ = *t++;
1888                                 if (pb > buf + bufsz)   /* BUG: not sure of this test */
1889                                         FATAL("gsub result0 %.30s too big; can't happen", buf);
1890                                 mflag = 0;
1891                         }
1892                         else {  /* matched nonempty string */
1893                                 num++;
1894                                 sptr = t;
1895                                 adjbuf(&buf, &bufsz, 1+(patbeg-sptr)+pb-buf, recsize, &pb, "gsub");
1896                                 while (sptr < patbeg)
1897                                         *pb++ = *sptr++;
1898                                 sptr = rptr;
1899                                 while (*sptr != 0) {
1900                                         adjbuf(&buf, &bufsz, 5+pb-buf, recsize, &pb, "gsub");
1901                                         if (*sptr == '\\') {
1902                                                 backsub(&pb, &sptr);
1903                                         } else if (*sptr == '&') {
1904                                                 sptr++;
1905                                                 adjbuf(&buf, &bufsz, 1+patlen+pb-buf, recsize, &pb, "gsub");
1906                                                 for (q = patbeg; q < patbeg+patlen; )
1907                                                         *pb++ = *q++;
1908                                         } else
1909                                                 *pb++ = *sptr++;
1910                                 }
1911                                 t = patbeg + patlen;
1912                                 if (patlen == 0 || *t == 0 || *(t-1) == 0)
1913                                         goto done;
1914                                 if (pb > buf + bufsz)
1915                                         FATAL("gsub result1 %.30s too big; can't happen", buf);
1916                                 mflag = 1;
1917                         }
1918                 } while (pmatch(pfa,t));
1919                 sptr = t;
1920                 adjbuf(&buf, &bufsz, 1+strlen(sptr)+pb-buf, 0, &pb, "gsub");
1921                 while ((*pb++ = *sptr++) != 0)
1922                         ;
1923         done:   if (pb < buf + bufsz)
1924                         *pb = '\0';
1925                 else if (*(pb-1) != '\0')
1926                         FATAL("gsub result2 %.30s truncated; can't happen", buf);
1927                 setsval(x, buf);        /* BUG: should be able to avoid copy + free */
1928                 pfa->initstat = tempstat;
1929         }
1930         tempfree(x);
1931         tempfree(y);
1932         x = gettemp();
1933         x->tval = NUM;
1934         x->fval = num;
1935         free(buf);
1936         return(x);
1937 }
1938
1939 void backsub(char **pb_ptr, char **sptr_ptr)    /* handle \\& variations */
1940 {                                               /* sptr[0] == '\\' */
1941         char *pb = *pb_ptr, *sptr = *sptr_ptr;
1942
1943         if (sptr[1] == '\\') {
1944                 if (sptr[2] == '\\' && sptr[3] == '&') { /* \\\& -> \& */
1945                         *pb++ = '\\';
1946                         *pb++ = '&';
1947                         sptr += 4;
1948                 } else if (sptr[2] == '&') {    /* \\& -> \ + matched */
1949                         *pb++ = '\\';
1950                         sptr += 2;
1951                 } else {                        /* \\x -> \\x */
1952                         *pb++ = *sptr++;
1953                         *pb++ = *sptr++;
1954                 }
1955         } else if (sptr[1] == '&') {    /* literal & */
1956                 sptr++;
1957                 *pb++ = *sptr++;
1958         } else                          /* literal \ */
1959                 *pb++ = *sptr++;
1960
1961         *pb_ptr = pb;
1962         *sptr_ptr = sptr;
1963 }