contrib/one-true-awk/run.c

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