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