contrib/awk/run.c

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