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