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