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