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