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                 /* in principle, rand() returns something in 0..RAND_MAX */
1525                 u = (Awkfloat) (rand() % RAND_MAX) / RAND_MAX;
1526                 break;
1527         case FSRAND:
1528                 if (isrec(x))   /* no argument provided */
1529                         u = time((time_t *)0);
1530                 else
1531                         u = getfval(x);
1532                 tmp = u;
1533                 srand((unsigned int) u);
1534                 u = srand_seed;
1535                 srand_seed = tmp;
1536                 break;
1537         case FTOUPPER:
1538         case FTOLOWER:
1539                 buf = tostring(getsval(x));
1540                 if (t == FTOUPPER) {
1541                         for (p = buf; *p; p++)
1542                                 if (islower((uschar) *p))
1543                                         *p = toupper((uschar)*p);
1544                 } else {
1545                         for (p = buf; *p; p++)
1546                                 if (isupper((uschar) *p))
1547                                         *p = tolower((uschar)*p);
1548                 }
1549                 tempfree(x);
1550                 x = gettemp();
1551                 setsval(x, buf);
1552                 free(buf);
1553                 return x;
1554         case FFLUSH:
1555                 if (isrec(x) || strlen(getsval(x)) == 0) {
1556                         flush_all();    /* fflush() or fflush("") -> all */
1557                         u = 0;
1558                 } else if ((fp = openfile(FFLUSH, getsval(x))) == NULL)
1559                         u = EOF;
1560                 else
1561                         u = fflush(fp);
1562                 break;
1563         default:        /* can't happen */
1564                 FATAL("illegal function type %d", t);
1565                 break;
1566         }
1567         tempfree(x);
1568         x = gettemp();
1569         setfval(x, u);
1570         if (nextarg != 0) {
1571                 WARNING("warning: function has too many arguments");
1572                 for ( ; nextarg; nextarg = nextarg->nnext)
1573                         execute(nextarg);
1574         }
1575         return(x);
1576 }
1577
1578 Cell *printstat(Node **a, int n)        /* print a[0] */
1579 {
1580         Node *x;
1581         Cell *y;
1582         FILE *fp;
1583
1584         if (a[1] == 0)  /* a[1] is redirection operator, a[2] is file */
1585                 fp = stdout;
1586         else
1587                 fp = redirect(ptoi(a[1]), a[2]);
1588         for (x = a[0]; x != NULL; x = x->nnext) {
1589                 y = execute(x);
1590                 fputs(getpssval(y), fp);
1591                 tempfree(y);
1592                 if (x->nnext == NULL)
1593                         fputs(*ORS, fp);
1594                 else
1595                         fputs(*OFS, fp);
1596         }
1597         if (a[1] != 0)
1598                 fflush(fp);
1599         if (ferror(fp))
1600                 FATAL("write error on %s", filename(fp));
1601         return(True);
1602 }
1603
1604 Cell *nullproc(Node **a, int n)
1605 {
1606         n = n;
1607         a = a;
1608         return 0;
1609 }
1610
1611
1612 FILE *redirect(int a, Node *b)  /* set up all i/o redirections */
1613 {
1614         FILE *fp;
1615         Cell *x;
1616         char *fname;
1617
1618         x = execute(b);
1619         fname = getsval(x);
1620         fp = openfile(a, fname);
1621         if (fp == NULL)
1622                 FATAL("can't open file %s", fname);
1623         tempfree(x);
1624         return fp;
1625 }
1626
1627 struct files {
1628         FILE    *fp;
1629         const char      *fname;
1630         int     mode;   /* '|', 'a', 'w' => LE/LT, GT */
1631 } *files;
1632
1633 int nfiles;
1634
1635 void stdinit(void)      /* in case stdin, etc., are not constants */
1636 {
1637         nfiles = FOPEN_MAX;
1638         files = calloc(nfiles, sizeof(*files));
1639         if (files == NULL)
1640                 FATAL("can't allocate file memory for %u files", nfiles);
1641         files[0].fp = stdin;
1642         files[0].fname = "/dev/stdin";
1643         files[0].mode = LT;
1644         files[1].fp = stdout;
1645         files[1].fname = "/dev/stdout";
1646         files[1].mode = GT;
1647         files[2].fp = stderr;
1648         files[2].fname = "/dev/stderr";
1649         files[2].mode = GT;
1650 }
1651
1652 FILE *openfile(int a, const char *us)
1653 {
1654         const char *s = us;
1655         int i, m;
1656         FILE *fp = 0;
1657
1658         if (*s == '\0')
1659                 FATAL("null file name in print or getline");
1660         for (i=0; i < nfiles; i++)
1661                 if (files[i].fname && strcmp(s, files[i].fname) == 0) {
1662                         if (a == files[i].mode || (a==APPEND && files[i].mode==GT))
1663                                 return files[i].fp;
1664                         if (a == FFLUSH)
1665                                 return files[i].fp;
1666                 }
1667         if (a == FFLUSH)        /* didn't find it, so don't create it! */
1668                 return NULL;
1669
1670         for (i=0; i < nfiles; i++)
1671                 if (files[i].fp == 0)
1672                         break;
1673         if (i >= nfiles) {
1674                 struct files *nf;
1675                 int nnf = nfiles + FOPEN_MAX;
1676                 nf = realloc(files, nnf * sizeof(*nf));
1677                 if (nf == NULL)
1678                         FATAL("cannot grow files for %s and %d files", s, nnf);
1679                 memset(&nf[nfiles], 0, FOPEN_MAX * sizeof(*nf));
1680                 nfiles = nnf;
1681                 files = nf;
1682         }
1683         fflush(stdout); /* force a semblance of order */
1684         m = a;
1685         if (a == GT) {
1686                 fp = fopen(s, "w");
1687         } else if (a == APPEND) {
1688                 fp = fopen(s, "a");
1689                 m = GT; /* so can mix > and >> */
1690         } else if (a == '|') {  /* output pipe */
1691                 fp = popen(s, "w");
1692         } else if (a == LE) {   /* input pipe */
1693                 fp = popen(s, "r");
1694         } else if (a == LT) {   /* getline <file */
1695                 fp = strcmp(s, "-") == 0 ? stdin : fopen(s, "r");       /* "-" is stdin */
1696         } else  /* can't happen */
1697                 FATAL("illegal redirection %d", a);
1698         if (fp != NULL) {
1699                 files[i].fname = tostring(s);
1700                 files[i].fp = fp;
1701                 files[i].mode = m;
1702         }
1703         return fp;
1704 }
1705
1706 const char *filename(FILE *fp)
1707 {
1708         int i;
1709
1710         for (i = 0; i < nfiles; i++)
1711                 if (fp == files[i].fp)
1712                         return files[i].fname;
1713         return "???";
1714 }
1715
1716 Cell *closefile(Node **a, int n)
1717 {
1718         Cell *x;
1719         int i, stat;
1720
1721         n = n;
1722         x = execute(a[0]);
1723         getsval(x);
1724         stat = -1;
1725         for (i = 0; i < nfiles; i++) {
1726                 if (files[i].fname && strcmp(x->sval, files[i].fname) == 0) {
1727                         if (ferror(files[i].fp))
1728                                 WARNING( "i/o error occurred on %s", files[i].fname );
1729                         if (files[i].mode == '|' || files[i].mode == LE)
1730                                 stat = pclose(files[i].fp);
1731                         else
1732                                 stat = fclose(files[i].fp);
1733                         if (stat == EOF)
1734                                 WARNING( "i/o error occurred closing %s", files[i].fname );
1735                         if (i > 2)      /* don't do /dev/std... */
1736                                 xfree(files[i].fname);
1737                         files[i].fname = NULL;  /* watch out for ref thru this */
1738                         files[i].fp = NULL;
1739                 }
1740         }
1741         tempfree(x);
1742         x = gettemp();
1743         setfval(x, (Awkfloat) stat);
1744         return(x);
1745 }
1746
1747 void closeall(void)
1748 {
1749         int i, stat;
1750
1751         for (i = 0; i < FOPEN_MAX; i++) {
1752                 if (files[i].fp) {
1753                         if (ferror(files[i].fp))
1754                                 WARNING( "i/o error occurred on %s", files[i].fname );
1755                         if (files[i].mode == '|' || files[i].mode == LE)
1756                                 stat = pclose(files[i].fp);
1757                         else
1758                                 stat = fclose(files[i].fp);
1759                         if (stat == EOF)
1760                                 WARNING( "i/o error occurred while closing %s", files[i].fname );
1761                 }
1762         }
1763 }
1764
1765 void flush_all(void)
1766 {
1767         int i;
1768
1769         for (i = 0; i < nfiles; i++)
1770                 if (files[i].fp)
1771                         fflush(files[i].fp);
1772 }
1773
1774 void backsub(char **pb_ptr, char **sptr_ptr);
1775
1776 Cell *sub(Node **a, int nnn)    /* substitute command */
1777 {
1778         char *sptr, *pb, *q;
1779         Cell *x, *y, *result;
1780         char *t, *buf;
1781         fa *pfa;
1782         int bufsz = recsize;
1783
1784         if ((buf = (char *) malloc(bufsz)) == NULL)
1785                 FATAL("out of memory in sub");
1786         x = execute(a[3]);      /* target string */
1787         t = getsval(x);
1788         if (a[0] == 0)          /* 0 => a[1] is already-compiled regexpr */
1789                 pfa = (fa *) a[1];      /* regular expression */
1790         else {
1791                 y = execute(a[1]);
1792                 pfa = makedfa(getsval(y), 1);
1793                 tempfree(y);
1794         }
1795         y = execute(a[2]);      /* replacement string */
1796         result = False;
1797         if (pmatch(pfa, t)) {
1798                 sptr = t;
1799                 adjbuf(&buf, &bufsz, 1+patbeg-sptr, recsize, 0, "sub");
1800                 pb = buf;
1801                 while (sptr < patbeg)
1802                         *pb++ = *sptr++;
1803                 sptr = getsval(y);
1804                 while (*sptr != 0) {
1805                         adjbuf(&buf, &bufsz, 5+pb-buf, recsize, &pb, "sub");
1806                         if (*sptr == '\\') {
1807                                 backsub(&pb, &sptr);
1808                         } else if (*sptr == '&') {
1809                                 sptr++;
1810                                 adjbuf(&buf, &bufsz, 1+patlen+pb-buf, recsize, &pb, "sub");
1811                                 for (q = patbeg; q < patbeg+patlen; )
1812                                         *pb++ = *q++;
1813                         } else
1814                                 *pb++ = *sptr++;
1815                 }
1816                 *pb = '\0';
1817                 if (pb > buf + bufsz)
1818                         FATAL("sub result1 %.30s too big; can't happen", buf);
1819                 sptr = patbeg + patlen;
1820                 if ((patlen == 0 && *patbeg) || (patlen && *(sptr-1))) {
1821                         adjbuf(&buf, &bufsz, 1+strlen(sptr)+pb-buf, 0, &pb, "sub");
1822                         while ((*pb++ = *sptr++) != 0)
1823                                 ;
1824                 }
1825                 if (pb > buf + bufsz)
1826                         FATAL("sub result2 %.30s too big; can't happen", buf);
1827                 setsval(x, buf);        /* BUG: should be able to avoid copy */
1828                 result = True;;
1829         }
1830         tempfree(x);
1831         tempfree(y);
1832         free(buf);
1833         return result;
1834 }
1835
1836 Cell *gsub(Node **a, int nnn)   /* global substitute */
1837 {
1838         Cell *x, *y;
1839         char *rptr, *sptr, *t, *pb, *q;
1840         char *buf;
1841         fa *pfa;
1842         int mflag, tempstat, num;
1843         int bufsz = recsize;
1844
1845         if ((buf = (char *) malloc(bufsz)) == NULL)
1846                 FATAL("out of memory in gsub");
1847         mflag = 0;      /* if mflag == 0, can replace empty string */
1848         num = 0;
1849         x = execute(a[3]);      /* target string */
1850         t = getsval(x);
1851         if (a[0] == 0)          /* 0 => a[1] is already-compiled regexpr */
1852                 pfa = (fa *) a[1];      /* regular expression */
1853         else {
1854                 y = execute(a[1]);
1855                 pfa = makedfa(getsval(y), 1);
1856                 tempfree(y);
1857         }
1858         y = execute(a[2]);      /* replacement string */
1859         if (pmatch(pfa, t)) {
1860                 tempstat = pfa->initstat;
1861                 pfa->initstat = 2;
1862                 pb = buf;
1863                 rptr = getsval(y);
1864                 do {
1865                         if (patlen == 0 && *patbeg != 0) {      /* matched empty string */
1866                                 if (mflag == 0) {       /* can replace empty */
1867                                         num++;
1868                                         sptr = rptr;
1869                                         while (*sptr != 0) {
1870                                                 adjbuf(&buf, &bufsz, 5+pb-buf, recsize, &pb, "gsub");
1871                                                 if (*sptr == '\\') {
1872                                                         backsub(&pb, &sptr);
1873                                                 } else if (*sptr == '&') {
1874                                                         sptr++;
1875                                                         adjbuf(&buf, &bufsz, 1+patlen+pb-buf, recsize, &pb, "gsub");
1876                                                         for (q = patbeg; q < patbeg+patlen; )
1877                                                                 *pb++ = *q++;
1878                                                 } else
1879                                                         *pb++ = *sptr++;
1880                                         }
1881                                 }
1882                                 if (*t == 0)    /* at end */
1883                                         goto done;
1884                                 adjbuf(&buf, &bufsz, 2+pb-buf, recsize, &pb, "gsub");
1885                                 *pb++ = *t++;
1886                                 if (pb > buf + bufsz)   /* BUG: not sure of this test */
1887                                         FATAL("gsub result0 %.30s too big; can't happen", buf);
1888                                 mflag = 0;
1889                         }
1890                         else {  /* matched nonempty string */
1891                                 num++;
1892                                 sptr = t;
1893                                 adjbuf(&buf, &bufsz, 1+(patbeg-sptr)+pb-buf, recsize, &pb, "gsub");
1894                                 while (sptr < patbeg)
1895                                         *pb++ = *sptr++;
1896                                 sptr = rptr;
1897                                 while (*sptr != 0) {
1898                                         adjbuf(&buf, &bufsz, 5+pb-buf, recsize, &pb, "gsub");
1899                                         if (*sptr == '\\') {
1900                                                 backsub(&pb, &sptr);
1901                                         } else if (*sptr == '&') {
1902                                                 sptr++;
1903                                                 adjbuf(&buf, &bufsz, 1+patlen+pb-buf, recsize, &pb, "gsub");
1904                                                 for (q = patbeg; q < patbeg+patlen; )
1905                                                         *pb++ = *q++;
1906                                         } else
1907                                                 *pb++ = *sptr++;
1908                                 }
1909                                 t = patbeg + patlen;
1910                                 if (patlen == 0 || *t == 0 || *(t-1) == 0)
1911                                         goto done;
1912                                 if (pb > buf + bufsz)
1913                                         FATAL("gsub result1 %.30s too big; can't happen", buf);
1914                                 mflag = 1;
1915                         }
1916                 } while (pmatch(pfa,t));
1917                 sptr = t;
1918                 adjbuf(&buf, &bufsz, 1+strlen(sptr)+pb-buf, 0, &pb, "gsub");
1919                 while ((*pb++ = *sptr++) != 0)
1920                         ;
1921         done:   if (pb < buf + bufsz)
1922                         *pb = '\0';
1923                 else if (*(pb-1) != '\0')
1924                         FATAL("gsub result2 %.30s truncated; can't happen", buf);
1925                 setsval(x, buf);        /* BUG: should be able to avoid copy + free */
1926                 pfa->initstat = tempstat;
1927         }
1928         tempfree(x);
1929         tempfree(y);
1930         x = gettemp();
1931         x->tval = NUM;
1932         x->fval = num;
1933         free(buf);
1934         return(x);
1935 }
1936
1937 void backsub(char **pb_ptr, char **sptr_ptr)    /* handle \\& variations */
1938 {                                               /* sptr[0] == '\\' */
1939         char *pb = *pb_ptr, *sptr = *sptr_ptr;
1940
1941         if (sptr[1] == '\\') {
1942                 if (sptr[2] == '\\' && sptr[3] == '&') { /* \\\& -> \& */
1943                         *pb++ = '\\';
1944                         *pb++ = '&';
1945                         sptr += 4;
1946                 } else if (sptr[2] == '&') {    /* \\& -> \ + matched */
1947                         *pb++ = '\\';
1948                         sptr += 2;
1949                 } else {                        /* \\x -> \\x */
1950                         *pb++ = *sptr++;
1951                         *pb++ = *sptr++;
1952                 }
1953         } else if (sptr[1] == '&') {    /* literal & */
1954                 sptr++;
1955                 *pb++ = *sptr++;
1956         } else                          /* literal \ */
1957                 *pb++ = *sptr++;
1958
1959         *pb_ptr = pb;
1960         *sptr_ptr = sptr;
1961 }