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