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