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 = 'd';
 907                         *++t = '\0';
 908                         break;
 909                 case 'o': case 'x': case 'X':
 910                         flag = *(s-1) == 'l' ? 2 : 3;
 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                                 sprint(p, fmt, getsval(x)[0]);
 964                         break;
 965                 }
 966                 if (istemp(x))
 967                         tfree(x);
 968                 p += strlen(p);
 969                 s++;
 970         }
 971         *p = '\0';
 972         free(fmt);
 973         for ( ; a; a = a->nnext)                /* evaluate any remaining args */
 974                 execute(a);
 975         *pbuf = buf;
 976         *pbufsize = bufsize;
 977         return p - buf;
 978 }
 979
 980 Cell *awksprintf(Node **a, int)         /* sprint(a[0]) */
 981 {
 982         Cell *x;
 983         Node *y;
 984         char *buf;
 985         int bufsz=3*recsize;
 986
 987         if ((buf = (char *) malloc(bufsz)) == nil)
 988                 FATAL("out of memory in awksprint");
 989         y = a[0]->nnext;
 990         x = execute(a[0]);
 991         if (format(&buf, &bufsz, getsval(x), y) == -1)
 992                 FATAL("sprint string %.30s... too long.  can't happen.", buf);
 993         if (istemp(x))
 994                 tfree(x);
 995         x = gettemp();
 996         x->sval = buf;
 997         x->tval = STR;
 998         return(x);
 999 }
1000
1001 Cell *awkprintf(Node **a, int)          /* printf */
1002 {       /* a[0] is list of args, starting with format string */
1003         /* a[1] is redirection operator, a[2] is redirection file */
1004         Biobuf *fp;
1005         Cell *x;
1006         Node *y;
1007         char *buf;
1008         int len;
1009         int bufsz=3*recsize;
1010
1011         if ((buf = (char *) malloc(bufsz)) == nil)
1012                 FATAL("out of memory in awkprintf");
1013         y = a[0]->nnext;
1014         x = execute(a[0]);
1015         if ((len = format(&buf, &bufsz, getsval(x), y)) == -1)
1016                 FATAL("printf string %.30s... too long.  can't happen.", buf);
1017         if (istemp(x))
1018                 tfree(x);
1019         if (a[1] == nil) {
1020                 /* fputs(buf, stdout); */
1021                 if (Bwrite(&stdout, buf, len) < 0)
1022                         FATAL("write error on stdout");
1023                 Bflush(&stdout);
1024         } else {
1025                 fp = redirect(ptoi(a[1]), a[2]);
1026                 /* fputs(buf, fp); */
1027                 if(Bwrite(fp, buf, len) < 0)
1028                         FATAL("write error on %s", filename(fp));
1029                 Bflush(fp);
1030         }
1031         free(buf);
1032         return(True);
1033 }
1034
1035 Cell *arith(Node **a, int n)    /* a[0] + a[1], etc.  also -a[0] */
1036 {
1037         Awkfloat i, j = 0;
1038         double v;
1039         Cell *x, *y, *z;
1040
1041         x = execute(a[0]);
1042         i = getfval(x);
1043         if (istemp(x))
1044                 tfree(x);
1045         if (n != UMINUS) {
1046                 y = execute(a[1]);
1047                 j = getfval(y);
1048                 if (istemp(y))
1049                         tfree(y);
1050         }
1051         z = gettemp();
1052         switch (n) {
1053         case ADD:
1054                 i += j;
1055                 break;
1056         case MINUS:
1057                 i -= j;
1058                 break;
1059         case MULT:
1060                 i *= j;
1061                 break;
1062         case DIVIDE:
1063                 if (j == 0)
1064                         FATAL("division by zero");
1065                 i /= j;
1066                 break;
1067         case MOD:
1068                 if (j == 0)
1069                         FATAL("division by zero in mod");
1070                 modf(i/j, &v);
1071                 i = i - j * v;
1072                 break;
1073         case UMINUS:
1074                 i = -i;
1075                 break;
1076         case POWER:
1077                 if (j >= 0 && modf(j, &v) == 0.0)       /* pos integer exponent */
1078                         i = ipow(i, (int) j);
1079                 else
1080                         i = errcheck(pow(i, j), "pow");
1081                 break;
1082         default:        /* can't happen */
1083                 FATAL("illegal arithmetic operator %d", n);
1084         }
1085         setfval(z, i);
1086         return(z);
1087 }
1088
1089 double ipow(double x, int n)    /* x**n.  ought to be done by pow, but isn't always */
1090 {
1091         double v;
1092
1093         if (n <= 0)
1094                 return 1;
1095         v = ipow(x, n/2);
1096         if (n % 2 == 0)
1097                 return v * v;
1098         else
1099                 return x * v * v;
1100 }
1101
1102 Cell *incrdecr(Node **a, int n)         /* a[0]++, etc. */
1103 {
1104         Cell *x, *z;
1105         int k;
1106         Awkfloat xf;
1107
1108         x = execute(a[0]);
1109         xf = getfval(x);
1110         k = (n == PREINCR || n == POSTINCR) ? 1 : -1;
1111         if (n == PREINCR || n == PREDECR) {
1112                 setfval(x, xf + k);
1113                 return(x);
1114         }
1115         z = gettemp();
1116         setfval(z, xf);
1117         setfval(x, xf + k);
1118         if (istemp(x))
1119                 tfree(x);
1120         return(z);
1121 }
1122
1123 Cell *assign(Node **a, int n)   /* a[0] = a[1], a[0] += a[1], etc. */
1124 {               /* this is subtle; don't muck with it. */
1125         Cell *x, *y;
1126         Awkfloat xf, yf;
1127         double v;
1128
1129         y = execute(a[1]);
1130         x = execute(a[0]);
1131         if (n == ASSIGN) {      /* ordinary assignment */
1132                 if (x == y && !(x->tval & (FLD|REC)))   /* self-assignment: */
1133                         goto Free;              /* leave alone unless it's a field */
1134                 if ((y->tval & (STR|NUM)) == (STR|NUM)) {
1135                         setsval(x, getsval(y));
1136                         x->fval = getfval(y);
1137                         x->tval |= NUM;
1138                 }
1139                 else if (isstr(y))
1140                         setsval(x, getsval(y));
1141                 else if (isnum(y))
1142                         setfval(x, getfval(y));
1143                 else
1144                         funnyvar(y, "read value of");
1145 Free:
1146                 if (istemp(y))
1147                         tfree(y);
1148                 return(x);
1149         }
1150         xf = getfval(x);
1151         yf = getfval(y);
1152         switch (n) {
1153         case ADDEQ:
1154                 xf += yf;
1155                 break;
1156         case SUBEQ:
1157                 xf -= yf;
1158                 break;
1159         case MULTEQ:
1160                 xf *= yf;
1161                 break;
1162         case DIVEQ:
1163                 if (yf == 0)
1164                         FATAL("division by zero in /=");
1165                 xf /= yf;
1166                 break;
1167         case MODEQ:
1168                 if (yf == 0)
1169                         FATAL("division by zero in %%=");
1170                 modf(xf/yf, &v);
1171                 xf = xf - yf * v;
1172                 break;
1173         case POWEQ:
1174                 if (yf >= 0 && modf(yf, &v) == 0.0)     /* pos integer exponent */
1175                         xf = ipow(xf, (int) yf);
1176                 else
1177                         xf = errcheck(pow(xf, yf), "pow");
1178                 break;
1179         default:
1180                 FATAL("illegal assignment operator %d", n);
1181                 break;
1182         }
1183         if (istemp(y))
1184                 tfree(y);
1185         setfval(x, xf);
1186         return(x);
1187 }
1188
1189 Cell *cat(Node **a, int)        /* a[0] cat a[1] */
1190 {
1191         Cell *x, *y, *z;
1192         int n1, n2;
1193         char *s;
1194
1195         x = execute(a[0]);
1196         y = execute(a[1]);
1197         getsval(x);
1198         getsval(y);
1199         n1 = strlen(x->sval);
1200         n2 = strlen(y->sval);
1201         s = (char *) malloc(n1 + n2 + 1);
1202         if (s == nil)
1203                 FATAL("out of space concatenating %.15s... and %.15s...",
1204                         x->sval, y->sval);
1205         strcpy(s, x->sval);
1206         strcpy(s+n1, y->sval);
1207         if (istemp(y))
1208                 tfree(y);
1209         z = gettemp();
1210         z->sval = s;
1211         z->tval = STR;
1212         if (istemp(x))
1213                 tfree(x);
1214         return(z);
1215 }
1216
1217 Cell *pastat(Node **a, int)     /* a[0] { a[1] } */
1218 {
1219         Cell *x;
1220
1221         if (a[0] == 0)
1222                 x = execute(a[1]);
1223         else {
1224                 x = execute(a[0]);
1225                 if (istrue(x)) {
1226                         if (istemp(x))
1227                                 tfree(x);
1228                         x = execute(a[1]);
1229                 }
1230         }
1231         return x;
1232 }
1233
1234 Cell *dopa2(Node **a, int)      /* a[0], a[1] { a[2] } */
1235 {
1236         Cell *x;
1237         int pair;
1238
1239         pair = ptoi(a[3]);
1240         if (pairstack[pair] == 0) {
1241                 x = execute(a[0]);
1242                 if (istrue(x))
1243                         pairstack[pair] = 1;
1244                 if (istemp(x))
1245                         tfree(x);
1246         }
1247         if (pairstack[pair] == 1) {
1248                 x = execute(a[1]);
1249                 if (istrue(x))
1250                         pairstack[pair] = 0;
1251                 if (istemp(x))
1252                         tfree(x);
1253                 x = execute(a[2]);
1254                 return(x);
1255         }
1256         return(False);
1257 }
1258
1259 Cell *split(Node **a, int)      /* split(a[0], a[1], a[2]); a[3] is type */
1260 {
1261         Cell *x = 0, *y, *ap;
1262         char *s, *t, *fs = 0;
1263         char temp, num[50];
1264         int n, nb, sep, arg3type;
1265
1266         y = execute(a[0]);      /* source string */
1267         s = getsval(y);
1268         arg3type = ptoi(a[3]);
1269         if (a[2] == 0)          /* fs string */
1270                 fs = *FS;
1271         else if (arg3type == STRING) {  /* split(str,arr,"string") */
1272                 x = execute(a[2]);
1273                 fs = getsval(x);
1274         } else if (arg3type == REGEXPR)
1275                 fs = "(regexpr)";       /* split(str,arr,/regexpr/) */
1276         else
1277                 FATAL("illegal type of split");
1278         sep = *fs;
1279         ap = execute(a[1]);     /* array name */
1280         n = y->tval;
1281         y->tval |= DONTFREE;    /* split(a[x], a); */
1282         freesymtab(ap);
1283         y->tval = n;
1284            dprint( ("split: s=|%s|, a=%s, sep=|%s|\n", s, ap->nval, fs) );
1285         ap->tval &= ~STR;
1286         ap->tval |= ARR;
1287         ap->sval = (char *) makesymtab(NSYMTAB);
1288
1289         n = 0;
1290         if ((*s != '\0' && strlen(fs) > 1) || arg3type == REGEXPR) {    /* reg expr */
1291                 void *p;
1292                 if (arg3type == REGEXPR) {      /* it's ready already */
1293                         p = (void *) a[2];
1294                 } else {
1295                         p = compre(fs);
1296                 }
1297                 t = s;
1298                 if (nematch(p,s,t)) {
1299                         do {
1300                                 n++;
1301                                 sprint(num, "%d", n);
1302                                 temp = *patbeg;
1303                                 *patbeg = '\0';
1304                                 if (is_number(t))
1305                                         setsymtab(num, t, atof(t), STR|NUM, (Array *) ap->sval);
1306                                 else
1307                                         setsymtab(num, t, 0.0, STR, (Array *) ap->sval);
1308                                 *patbeg = temp;
1309                                 t = patbeg + patlen;
1310                                 if (t[-1] == 0 || *t == 0) {
1311                                         n++;
1312                                         sprint(num, "%d", n);
1313                                         setsymtab(num, "", 0.0, STR, (Array *) ap->sval);
1314                                         goto spdone;
1315                                 }
1316                         } while (nematch(p,s,t));
1317                 }
1318                 n++;
1319                 sprint(num, "%d", n);
1320                 if (is_number(t))
1321                         setsymtab(num, t, atof(t), STR|NUM, (Array *) ap->sval);
1322                 else
1323                         setsymtab(num, t, 0.0, STR, (Array *) ap->sval);
1324   spdone:
1325                 p = nil;
1326                 USED(p);
1327         } else if (sep == ' ') {
1328                 for (n = 0; ; ) {
1329                         while (*s == ' ' || *s == '\t' || *s == '\n')
1330                                 s++;
1331                         if (*s == 0)
1332                                 break;
1333                         n++;
1334                         t = s;
1335                         do
1336                                 s++;
1337                         while (*s!=' ' && *s!='\t' && *s!='\n' && *s!='\0');
1338                         temp = *s;
1339                         *s = '\0';
1340                         sprint(num, "%d", n);
1341                         if (is_number(t))
1342                                 setsymtab(num, t, atof(t), STR|NUM, (Array *) ap->sval);
1343                         else
1344                                 setsymtab(num, t, 0.0, STR, (Array *) ap->sval);
1345                         *s = temp;
1346                         if (*s != 0)
1347                                 s++;
1348                 }
1349         } else if (sep == 0) {  /* new: split(s, a, "") => 1 char/elem */
1350                 for (n = 0; *s != 0; s += nb) {
1351                         Rune r;
1352                         char buf[UTFmax+1];
1353
1354                         n++;
1355                         snprint(num, sizeof num, "%d", n);
1356                         nb = chartorune(&r, s);
1357                         memmove(buf, s, nb);
1358                         buf[nb] = '\0';
1359                         if (isdigit(buf[0]))
1360                                 setsymtab(num, buf, atof(buf), STR|NUM, (Array *) ap->sval);
1361                         else
1362                                 setsymtab(num, buf, 0.0, STR, (Array *) ap->sval);
1363                 }
1364         } else if (*s != 0) {
1365                 for (;;) {
1366                         n++;
1367                         t = s;
1368                         while (*s != sep && *s != '\n' && *s != '\0')
1369                                 s++;
1370                         temp = *s;
1371                         *s = '\0';
1372                         sprint(num, "%d", n);
1373                         if (is_number(t))
1374                                 setsymtab(num, t, atof(t), STR|NUM, (Array *) ap->sval);
1375                         else
1376                                 setsymtab(num, t, 0.0, STR, (Array *) ap->sval);
1377                         *s = temp;
1378                         if (*s++ == 0)
1379                                 break;
1380                 }
1381         }
1382         if (istemp(ap))
1383                 tfree(ap);
1384         if (istemp(y))
1385                 tfree(y);
1386         if (a[2] != 0 && arg3type == STRING)
1387                 if (istemp(x))
1388                         tfree(x);
1389         x = gettemp();
1390         x->tval = NUM;
1391         x->fval = n;
1392         return(x);
1393 }
1394
1395 Cell *condexpr(Node **a, int)   /* a[0] ? a[1] : a[2] */
1396 {
1397         Cell *x;
1398
1399         x = execute(a[0]);
1400         if (istrue(x)) {
1401                 if (istemp(x))
1402                         tfree(x);
1403                 x = execute(a[1]);
1404         } else {
1405                 if (istemp(x))
1406                         tfree(x);
1407                 x = execute(a[2]);
1408         }
1409         return(x);
1410 }
1411
1412 Cell *ifstat(Node **a, int)     /* if (a[0]) a[1]; else a[2] */
1413 {
1414         Cell *x;
1415
1416         x = execute(a[0]);
1417         if (istrue(x)) {
1418                 if (istemp(x))
1419                         tfree(x);
1420                 x = execute(a[1]);
1421         } else if (a[2] != 0) {
1422                 if (istemp(x))
1423                         tfree(x);
1424                 x = execute(a[2]);
1425         }
1426         return(x);
1427 }
1428
1429 Cell *whilestat(Node **a, int)  /* while (a[0]) a[1] */
1430 {
1431         Cell *x;
1432
1433         for (;;) {
1434                 x = execute(a[0]);
1435                 if (!istrue(x))
1436                         return(x);
1437                 if (istemp(x))
1438                         tfree(x);
1439                 x = execute(a[1]);
1440                 if (isbreak(x)) {
1441                         x = True;
1442                         return(x);
1443                 }
1444                 if (isnext(x) || isexit(x) || isret(x))
1445                         return(x);
1446                 if (istemp(x))
1447                         tfree(x);
1448         }
1449 }
1450
1451 Cell *dostat(Node **a, int)     /* do a[0]; while(a[1]) */
1452 {
1453         Cell *x;
1454
1455         for (;;) {
1456                 x = execute(a[0]);
1457                 if (isbreak(x))
1458                         return True;
1459                 if (isnext(x) || isnextfile(x) || isexit(x) || isret(x))
1460                         return(x);
1461                 if (istemp(x))
1462                         tfree(x);
1463                 x = execute(a[1]);
1464                 if (!istrue(x))
1465                         return(x);
1466                 if (istemp(x))
1467                         tfree(x);
1468         }
1469 }
1470
1471 Cell *forstat(Node **a, int)    /* for (a[0]; a[1]; a[2]) a[3] */
1472 {
1473         Cell *x;
1474
1475         x = execute(a[0]);
1476         if (istemp(x))
1477                 tfree(x);
1478         for (;;) {
1479                 if (a[1]!=0) {
1480                         x = execute(a[1]);
1481                         if (!istrue(x))
1482                                 return(x);
1483                         else if (istemp(x))
1484                                 tfree(x);
1485                 }
1486                 x = execute(a[3]);
1487                 if (isbreak(x))         /* turn off break */
1488                         return True;
1489                 if (isnext(x) || isexit(x) || isret(x))
1490                         return(x);
1491                 if (istemp(x))
1492                         tfree(x);
1493                 x = execute(a[2]);
1494                 if (istemp(x))
1495                         tfree(x);
1496         }
1497 }
1498
1499 Cell *instat(Node **a, int)     /* for (a[0] in a[1]) a[2] */
1500 {
1501         Cell *x, *vp, *arrayp, *cp, *ncp;
1502         Array *tp;
1503         int i;
1504
1505         vp = execute(a[0]);
1506         arrayp = execute(a[1]);
1507         if (!isarr(arrayp)) {
1508                 return True;
1509         }
1510         tp = (Array *) arrayp->sval;
1511         if (istemp(arrayp))
1512                 tfree(arrayp);
1513         for (i = 0; i < tp->size; i++) {        /* this routine knows too much */
1514                 for (cp = tp->tab[i]; cp != nil; cp = ncp) {
1515                         setsval(vp, cp->nval);
1516                         ncp = cp->cnext;
1517                         x = execute(a[2]);
1518                         if (isbreak(x)) {
1519                                 if (istemp(vp))
1520                                         tfree(vp);
1521                                 return True;
1522                         }
1523                         if (isnext(x) || isexit(x) || isret(x)) {
1524                                 if (istemp(vp))
1525                                         tfree(vp);
1526                                 return(x);
1527                         }
1528                         if (istemp(x))
1529                                 tfree(x);
1530                 }
1531         }
1532         return True;
1533 }
1534
1535 Cell *bltin(Node **a, int)      /* builtin functions. a[0] is type, a[1] is arg list */
1536 {
1537         Cell *x, *y;
1538         Awkfloat u;
1539         int t;
1540         Rune wc;
1541         char *p, *buf;
1542         char mbc[50];
1543         Node *nextarg;
1544         Biobuf *fp;
1545         void flush_all(void);
1546
1547         t = ptoi(a[0]);
1548         x = execute(a[1]);
1549         nextarg = a[1]->nnext;
1550         switch (t) {
1551         case FLENGTH:
1552                 if (isarr(x))
1553                         u = ((Array *) x->sval)->nelemt;        /* GROT. should be function*/
1554                 else {
1555                         p = getsval(x);
1556                         u = (Awkfloat) utfnlen(p, strlen(p));
1557                 }
1558                 break;
1559         case FLOG:
1560                 u = errcheck(log(getfval(x)), "log"); break;
1561         case FINT:
1562                 modf(getfval(x), &u); break;
1563         case FEXP:
1564                 u = errcheck(exp(getfval(x)), "exp"); break;
1565         case FSQRT:
1566                 u = errcheck(sqrt(getfval(x)), "sqrt"); break;
1567         case FSIN:
1568                 u = sin(getfval(x)); break;
1569         case FCOS:
1570                 u = cos(getfval(x)); break;
1571         case FATAN:
1572                 if (nextarg == 0) {
1573                         WARNING("atan2 requires two arguments; returning 1.0");
1574                         u = 1.0;
1575                 } else {
1576                         y = execute(a[1]->nnext);
1577                         u = atan2(getfval(x), getfval(y));
1578                         if (istemp(y))
1579                                 tfree(y);
1580                         nextarg = nextarg->nnext;
1581                 }
1582                 break;
1583         case FSYSTEM:
1584                 Bflush(&stdout);                /* in case something is buffered already */
1585                 u = (Awkfloat) system(getsval(x)) / 256;   /* 256 is unix-dep */
1586                 break;
1587         case FRAND:
1588                 /* in principle, rand() returns something in 0..RAND_MAX */
1589                 u = (Awkfloat) (rand() % RAND_MAX) / RAND_MAX;
1590                 break;
1591         case FSRAND:
1592                 if (isrec(x))   /* no argument provided */
1593                         u = time(nil);
1594                 else
1595                         u = getfval(x);
1596                 srand((unsigned int) u);
1597                 break;
1598         case FTOUPPER:
1599         case FTOLOWER:
1600                 buf = tostring(getsval(x));
1601                 if (t == FTOUPPER) {
1602                         for (p = buf; *p; p++)
1603                                 if (islower(*p))
1604                                         *p = toupper(*p);
1605                 } else {
1606                         for (p = buf; *p; p++)
1607                                 if (isupper(*p))
1608                                         *p = tolower(*p);
1609                 }
1610                 if (istemp(x))
1611                         tfree(x);
1612                 x = gettemp();
1613                 setsval(x, buf);
1614                 free(buf);
1615                 return x;
1616         case FFLUSH:
1617                 if (isrec(x) || strlen(getsval(x)) == 0) {
1618                         flush_all();    /* fflush() or fflush("") -> all */
1619                         u = 0;
1620                 } else if ((fp = openfile(FFLUSH, getsval(x))) == nil)
1621                         u = EOF;
1622                 else
1623                         u = Bflush(fp);
1624                 break;
1625         case FUTF:
1626                 wc = (int)getfval(x);
1627                 mbc[runetochar(mbc, &wc)] = 0;
1628                 if (istemp(x))
1629                         tfree(x);
1630                 x = gettemp();
1631                 setsval(x, mbc);
1632                 return x;
1633         default:        /* can't happen */
1634                 FATAL("illegal function type %d", t);
1635                 break;
1636         }
1637         if (istemp(x))
1638                 tfree(x);
1639         x = gettemp();
1640         setfval(x, u);
1641         if (nextarg != 0) {
1642                 WARNING("warning: function has too many arguments");
1643                 for ( ; nextarg; nextarg = nextarg->nnext)
1644                         execute(nextarg);
1645         }
1646         return(x);
1647 }
1648
1649 Cell *printstat(Node **a, int)  /* print a[0] */
1650 {
1651         int r;
1652         Node *x;
1653         Cell *y;
1654         Biobuf *fp;
1655
1656         if (a[1] == 0)  /* a[1] is redirection operator, a[2] is file */
1657                 fp = &stdout;
1658         else
1659                 fp = redirect(ptoi(a[1]), a[2]);
1660         for (x = a[0]; x != nil; x = x->nnext) {
1661                 y = execute(x);
1662                 Bwrite(fp, getsval(y), strlen(getsval(y)));
1663                 if (istemp(y))
1664                         tfree(y);
1665                 if (x->nnext == nil)
1666                         r = Bprint(fp, "%s", *ORS);
1667                 else
1668                         r = Bprint(fp, "%s", *OFS);
1669                 if (r < 0)
1670                         FATAL("write error on %s", filename(fp));
1671         }
1672         if (Bflush(fp) < 0)
1673                 FATAL("write error on %s", filename(fp));
1674         return(True);
1675 }
1676
1677 Cell *nullproc(Node **, int)
1678 {
1679         return 0;
1680 }
1681
1682
1683 Biobuf *redirect(int a, Node *b)        /* set up all i/o redirections */
1684 {
1685         Biobuf *fp;
1686         Cell *x;
1687         char *fname;
1688
1689         x = execute(b);
1690         fname = getsval(x);
1691         fp = openfile(a, fname);
1692         if (fp == nil)
1693                 FATAL("can't open file %s", fname);
1694         if (istemp(x))
1695                 tfree(x);
1696         return fp;
1697 }
1698
1699 struct files {
1700         Biobuf  *fp;
1701         char    *fname;
1702         int     mode;   /* '|', 'a', 'w' => LE/LT, GT */
1703 } files[FOPEN_MAX] ={
1704         { nil,  "/dev/stdin",  LT },    /* watch out: don't free this! */
1705         { nil, "/dev/stdout", GT },
1706         { nil, "/dev/stderr", GT }
1707 };
1708
1709 void stdinit(void)      /* in case stdin, etc., are not constants */
1710 {
1711         files[0].fp = &stdin;
1712         files[1].fp = &stdout;
1713         files[2].fp = &stderr;
1714 }
1715
1716 Biobuf *openfile(int a, char *us)
1717 {
1718         char *s = us;
1719         int i, m;
1720         Biobuf *fp = nil;
1721
1722         if (*s == '\0')
1723                 FATAL("null file name in print or getline");
1724         for (i=0; i < FOPEN_MAX; i++)
1725                 if (files[i].fname && strcmp(s, files[i].fname) == 0) {
1726                         if (a == files[i].mode || (a==APPEND && files[i].mode==GT))
1727                                 return files[i].fp;
1728                         if (a == FFLUSH)
1729                                 return files[i].fp;
1730                 }
1731         if (a == FFLUSH)        /* didn't find it, so don't create it! */
1732                 return nil;
1733
1734         for (i=0; i < FOPEN_MAX; i++)
1735                 if (files[i].fp == 0)
1736                         break;
1737         if (i >= FOPEN_MAX)
1738                 FATAL("%s makes too many open files", s);
1739         Bflush(&stdout);        /* force a semblance of order */
1740         m = a;
1741         if (a == GT) {
1742                 fp = Bopen(s, OWRITE);
1743         } else if (a == APPEND) {
1744                 fp = Bopen(s, OWRITE);
1745                 Bseek(fp, 0LL, 2);
1746                 m = GT; /* so can mix > and >> */
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 == EOF)
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 }