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