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