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 = getsval(fsloc);
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         x = gettemp();
1391         x->tval = NUM;
1392         x->fval = n;
1393         return(x);
1394 }
1395
1396 Cell *condexpr(Node **a, int n) /* a[0] ? a[1] : a[2] */
1397 {
1398         Cell *x;
1399
1400         x = execute(a[0]);
1401         if (istrue(x)) {
1402                 tempfree(x);
1403                 x = execute(a[1]);
1404         } else {
1405                 tempfree(x);
1406                 x = execute(a[2]);
1407         }
1408         return(x);
1409 }
1410
1411 Cell *ifstat(Node **a, int n)   /* if (a[0]) a[1]; else a[2] */
1412 {
1413         Cell *x;
1414
1415         x = execute(a[0]);
1416         if (istrue(x)) {
1417                 tempfree(x);
1418                 x = execute(a[1]);
1419         } else if (a[2] != NULL) {
1420                 tempfree(x);
1421                 x = execute(a[2]);
1422         }
1423         return(x);
1424 }
1425
1426 Cell *whilestat(Node **a, int n)        /* while (a[0]) a[1] */
1427 {
1428         Cell *x;
1429
1430         for (;;) {
1431                 x = execute(a[0]);
1432                 if (!istrue(x))
1433                         return(x);
1434                 tempfree(x);
1435                 x = execute(a[1]);
1436                 if (isbreak(x)) {
1437                         x = True;
1438                         return(x);
1439                 }
1440                 if (isnext(x) || isexit(x) || isret(x))
1441                         return(x);
1442                 tempfree(x);
1443         }
1444 }
1445
1446 Cell *dostat(Node **a, int n)   /* do a[0]; while(a[1]) */
1447 {
1448         Cell *x;
1449
1450         for (;;) {
1451                 x = execute(a[0]);
1452                 if (isbreak(x))
1453                         return True;
1454                 if (isnext(x) || isexit(x) || isret(x))
1455                         return(x);
1456                 tempfree(x);
1457                 x = execute(a[1]);
1458                 if (!istrue(x))
1459                         return(x);
1460                 tempfree(x);
1461         }
1462 }
1463
1464 Cell *forstat(Node **a, int n)  /* for (a[0]; a[1]; a[2]) a[3] */
1465 {
1466         Cell *x;
1467
1468         x = execute(a[0]);
1469         tempfree(x);
1470         for (;;) {
1471                 if (a[1]!=NULL) {
1472                         x = execute(a[1]);
1473                         if (!istrue(x)) return(x);
1474                         else tempfree(x);
1475                 }
1476                 x = execute(a[3]);
1477                 if (isbreak(x))         /* turn off break */
1478                         return True;
1479                 if (isnext(x) || isexit(x) || isret(x))
1480                         return(x);
1481                 tempfree(x);
1482                 x = execute(a[2]);
1483                 tempfree(x);
1484         }
1485 }
1486
1487 Cell *instat(Node **a, int n)   /* for (a[0] in a[1]) a[2] */
1488 {
1489         Cell *x, *vp, *arrayp, *cp, *ncp;
1490         Array *tp;
1491         int i;
1492
1493         vp = execute(a[0]);
1494         arrayp = execute(a[1]);
1495         if (!isarr(arrayp)) {
1496                 return True;
1497         }
1498         tp = (Array *) arrayp->sval;
1499         tempfree(arrayp);
1500         for (i = 0; i < tp->size; i++) {        /* this routine knows too much */
1501                 for (cp = tp->tab[i]; cp != NULL; cp = ncp) {
1502                         setsval(vp, cp->nval);
1503                         ncp = cp->cnext;
1504                         x = execute(a[2]);
1505                         if (isbreak(x)) {
1506                                 tempfree(vp);
1507                                 return True;
1508                         }
1509                         if (isnext(x) || isexit(x) || isret(x)) {
1510                                 tempfree(vp);
1511                                 return(x);
1512                         }
1513                         tempfree(x);
1514                 }
1515         }
1516         return True;
1517 }
1518
1519 Cell *bltin(Node **a, int n)    /* builtin functions. a[0] is type, a[1] is arg list */
1520 {
1521         Cell *x, *y;
1522         Awkfloat u;
1523         int t, i;
1524         Awkfloat tmp;
1525         char *p, *buf;
1526         Node *nextarg;
1527         FILE *fp;
1528         void flush_all(void);
1529         int status = 0;
1530
1531         t = ptoi(a[0]);
1532         x = execute(a[1]);
1533         nextarg = a[1]->nnext;
1534         switch (t) {
1535         case FLENGTH:
1536                 if (isarr(x))
1537                         u = ((Array *) x->sval)->nelem; /* GROT.  should be function*/
1538                 else
1539                         u = strlen(getsval(x));
1540                 break;
1541         case FLOG:
1542                 u = errcheck(log(getfval(x)), "log"); break;
1543         case FINT:
1544                 modf(getfval(x), &u); break;
1545         case FEXP:
1546                 u = errcheck(exp(getfval(x)), "exp"); break;
1547         case FSQRT:
1548                 u = errcheck(sqrt(getfval(x)), "sqrt"); break;
1549         case FSIN:
1550                 u = sin(getfval(x)); break;
1551         case FCOS:
1552                 u = cos(getfval(x)); break;
1553         case FATAN:
1554                 if (nextarg == NULL) {
1555                         WARNING("atan2 requires two arguments; returning 1.0");
1556                         u = 1.0;
1557                 } else {
1558                         y = execute(a[1]->nnext);
1559                         u = atan2(getfval(x), getfval(y));
1560                         tempfree(y);
1561                         nextarg = nextarg->nnext;
1562                 }
1563                 break;
1564         case FCOMPL:
1565                 u = ~((int)getfval(x));
1566                 break;
1567         case FAND:
1568                 if (nextarg == NULL) {
1569                         WARNING("and requires two arguments; returning 0");
1570                         u = 0;
1571                         break;
1572                 }
1573                 i = ((int)getfval(x));
1574                 while (nextarg != NULL) {
1575                         y = execute(nextarg);
1576                         i &= (int)getfval(y);
1577                         tempfree(y);
1578                         nextarg = nextarg->nnext;
1579                 }
1580                 u = i;
1581                 break;
1582         case FFOR:
1583                 if (nextarg == NULL) {
1584                         WARNING("or requires two arguments; returning 0");
1585                         u = 0;
1586                         break;
1587                 }
1588                 i = ((int)getfval(x));
1589                 while (nextarg != NULL) {
1590                         y = execute(nextarg);
1591                         i |= (int)getfval(y);
1592                         tempfree(y);
1593                         nextarg = nextarg->nnext;
1594                 }
1595                 u = i;
1596                 break;
1597         case FXOR:
1598                 if (nextarg == NULL) {
1599                         WARNING("xor requires two arguments; returning 0");
1600                         u = 0;
1601                         break;
1602                 }
1603                 i = ((int)getfval(x));
1604                 while (nextarg != NULL) {
1605                         y = execute(nextarg);
1606                         i ^= (int)getfval(y);
1607                         tempfree(y);
1608                         nextarg = nextarg->nnext;
1609                 }
1610                 u = i;
1611                 break;
1612         case FLSHIFT:
1613                 if (nextarg == NULL) {
1614                         WARNING("lshift requires two arguments; returning 0");
1615                         u = 0;
1616                         break;
1617                 }
1618                 y = execute(a[1]->nnext);
1619                 u = ((int)getfval(x)) << ((int)getfval(y));
1620                 tempfree(y);
1621                 nextarg = nextarg->nnext;
1622                 break;
1623         case FRSHIFT:
1624                 if (nextarg == NULL) {
1625                         WARNING("rshift requires two arguments; returning 0");
1626                         u = 0;
1627                         break;
1628                 }
1629                 y = execute(a[1]->nnext);
1630                 u = ((int)getfval(x)) >> ((int)getfval(y));
1631                 tempfree(y);
1632                 nextarg = nextarg->nnext;
1633                 break;
1634         case FSYSTEM:
1635                 fflush(stdout);         /* in case something is buffered already */
1636                 status = system(getsval(x));
1637                 u = status;
1638                 if (status != -1) {
1639                         if (WIFEXITED(status)) {
1640                                 u = WEXITSTATUS(status);
1641                         } else if (WIFSIGNALED(status)) {
1642                                 u = WTERMSIG(status) + 256;
1643 #ifdef WCOREDUMP
1644                                 if (WCOREDUMP(status))
1645                                         u += 256;
1646 #endif
1647                         } else  /* something else?!? */
1648                                 u = 0;
1649                 }
1650                 break;
1651         case FRAND:
1652                 /* random() returns numbers in [0..2^31-1]
1653                  * in order to get a number in [0, 1), divide it by 2^31
1654                  */
1655                 u = (Awkfloat) random() / (0x7fffffffL + 0x1UL);
1656                 break;
1657         case FSRAND:
1658                 if (isrec(x))   /* no argument provided */
1659                         u = time((time_t *)0);
1660                 else
1661                         u = getfval(x);
1662                 tmp = u;
1663                 srandom((unsigned long) u);
1664                 u = srand_seed;
1665                 srand_seed = tmp;
1666                 break;
1667         case FTOUPPER:
1668         case FTOLOWER:
1669                 buf = tostring(getsval(x));
1670                 if (t == FTOUPPER) {
1671                         for (p = buf; *p; p++)
1672                                 if (islower((uschar) *p))
1673                                         *p = toupper((uschar)*p);
1674                 } else {
1675                         for (p = buf; *p; p++)
1676                                 if (isupper((uschar) *p))
1677                                         *p = tolower((uschar)*p);
1678                 }
1679                 tempfree(x);
1680                 x = gettemp();
1681                 setsval(x, buf);
1682                 free(buf);
1683                 return x;
1684         case FFLUSH:
1685                 if (isrec(x) || strlen(getsval(x)) == 0) {
1686                         flush_all();    /* fflush() or fflush("") -> all */
1687                         u = 0;
1688                 } else if ((fp = openfile(FFLUSH, getsval(x))) == NULL)
1689                         u = EOF;
1690                 else
1691                         u = fflush(fp);
1692                 break;
1693         default:        /* can't happen */
1694                 FATAL("illegal function type %d", t);
1695                 break;
1696         }
1697         tempfree(x);
1698         x = gettemp();
1699         setfval(x, u);
1700         if (nextarg != NULL) {
1701                 WARNING("warning: function has too many arguments");
1702                 for ( ; nextarg; nextarg = nextarg->nnext)
1703                         execute(nextarg);
1704         }
1705         return(x);
1706 }
1707
1708 Cell *printstat(Node **a, int n)        /* print a[0] */
1709 {
1710         Node *x;
1711         Cell *y;
1712         FILE *fp;
1713
1714         if (a[1] == NULL)       /* a[1] is redirection operator, a[2] is file */
1715                 fp = stdout;
1716         else
1717                 fp = redirect(ptoi(a[1]), a[2]);
1718         for (x = a[0]; x != NULL; x = x->nnext) {
1719                 y = execute(x);
1720                 fputs(getpssval(y), fp);
1721                 tempfree(y);
1722                 if (x->nnext == NULL)
1723                         fputs(getsval(orsloc), fp);
1724                 else
1725                         fputs(getsval(ofsloc), fp);
1726         }
1727         if (a[1] != NULL)
1728                 fflush(fp);
1729         if (ferror(fp))
1730                 FATAL("write error on %s", filename(fp));
1731         return(True);
1732 }
1733
1734 Cell *nullproc(Node **a, int n)
1735 {
1736         return 0;
1737 }
1738
1739
1740 FILE *redirect(int a, Node *b)  /* set up all i/o redirections */
1741 {
1742         FILE *fp;
1743         Cell *x;
1744         char *fname;
1745
1746         x = execute(b);
1747         fname = getsval(x);
1748         fp = openfile(a, fname);
1749         if (fp == NULL)
1750                 FATAL("can't open file %s", fname);
1751         tempfree(x);
1752         return fp;
1753 }
1754
1755 struct files {
1756         FILE    *fp;
1757         const char      *fname;
1758         int     mode;   /* '|', 'a', 'w' => LE/LT, GT */
1759 } *files;
1760
1761 int nfiles;
1762
1763 void stdinit(void)      /* in case stdin, etc., are not constants */
1764 {
1765         nfiles = FOPEN_MAX;
1766         files = calloc(nfiles, sizeof(*files));
1767         if (files == NULL)
1768                 FATAL("can't allocate file memory for %u files", nfiles);
1769         files[0].fp = stdin;
1770         files[0].fname = "/dev/stdin";
1771         files[0].mode = LT;
1772         files[1].fp = stdout;
1773         files[1].fname = "/dev/stdout";
1774         files[1].mode = GT;
1775         files[2].fp = stderr;
1776         files[2].fname = "/dev/stderr";
1777         files[2].mode = GT;
1778 }
1779
1780 FILE *openfile(int a, const char *us)
1781 {
1782         const char *s = us;
1783         int i, m;
1784         FILE *fp = NULL;
1785
1786         if (*s == '\0')
1787                 FATAL("null file name in print or getline");
1788         for (i=0; i < nfiles; i++)
1789                 if (files[i].fname && strcmp(s, files[i].fname) == 0) {
1790                         if (a == files[i].mode || (a==APPEND && files[i].mode==GT))
1791                                 return files[i].fp;
1792                         if (a == FFLUSH)
1793                                 return files[i].fp;
1794                 }
1795         if (a == FFLUSH)        /* didn't find it, so don't create it! */
1796                 return NULL;
1797
1798         for (i=0; i < nfiles; i++)
1799                 if (files[i].fp == NULL)
1800                         break;
1801         if (i >= nfiles) {
1802                 struct files *nf;
1803                 int nnf = nfiles + FOPEN_MAX;
1804                 nf = realloc(files, nnf * sizeof(*nf));
1805                 if (nf == NULL)
1806                         FATAL("cannot grow files for %s and %d files", s, nnf);
1807                 memset(&nf[nfiles], 0, FOPEN_MAX * sizeof(*nf));
1808                 nfiles = nnf;
1809                 files = nf;
1810         }
1811         fflush(stdout); /* force a semblance of order */
1812         m = a;
1813         if (a == GT) {
1814                 fp = fopen(s, "w");
1815         } else if (a == APPEND) {
1816                 fp = fopen(s, "a");
1817                 m = GT; /* so can mix > and >> */
1818         } else if (a == '|') {  /* output pipe */
1819                 fp = popen(s, "w");
1820         } else if (a == LE) {   /* input pipe */
1821                 fp = popen(s, "r");
1822         } else if (a == LT) {   /* getline <file */
1823                 fp = strcmp(s, "-") == 0 ? stdin : fopen(s, "r");       /* "-" is stdin */
1824         } else  /* can't happen */
1825                 FATAL("illegal redirection %d", a);
1826         if (fp != NULL) {
1827                 files[i].fname = tostring(s);
1828                 files[i].fp = fp;
1829                 files[i].mode = m;
1830         }
1831         return fp;
1832 }
1833
1834 const char *filename(FILE *fp)
1835 {
1836         int i;
1837
1838         for (i = 0; i < nfiles; i++)
1839                 if (fp == files[i].fp)
1840                         return files[i].fname;
1841         return "???";
1842 }
1843
1844 Cell *closefile(Node **a, int n)
1845 {
1846         Cell *x;
1847         int i, stat;
1848
1849         x = execute(a[0]);
1850         getsval(x);
1851         stat = -1;
1852         for (i = 0; i < nfiles; i++) {
1853                 if (files[i].fname && strcmp(x->sval, files[i].fname) == 0) {
1854                         if (ferror(files[i].fp))
1855                                 WARNING( "i/o error occurred on %s", files[i].fname );
1856                         if (files[i].mode == '|' || files[i].mode == LE)
1857                                 stat = pclose(files[i].fp);
1858                         else
1859                                 stat = fclose(files[i].fp);
1860                         if (stat == EOF)
1861                                 WARNING( "i/o error occurred closing %s", files[i].fname );
1862                         if (i > 2)      /* don't do /dev/std... */
1863                                 xfree(files[i].fname);
1864                         files[i].fname = NULL;  /* watch out for ref thru this */
1865                         files[i].fp = NULL;
1866                 }
1867         }
1868         tempfree(x);
1869         x = gettemp();
1870         setfval(x, (Awkfloat) stat);
1871         return(x);
1872 }
1873
1874 void closeall(void)
1875 {
1876         int i, stat;
1877
1878         for (i = 0; i < FOPEN_MAX; i++) {
1879                 if (files[i].fp) {
1880                         if (ferror(files[i].fp))
1881                                 WARNING( "i/o error occurred on %s", files[i].fname );
1882                         if (files[i].mode == '|' || files[i].mode == LE)
1883                                 stat = pclose(files[i].fp);
1884                         else
1885                                 stat = fclose(files[i].fp);
1886                         if (stat == EOF)
1887                                 WARNING( "i/o error occurred while closing %s", files[i].fname );
1888                 }
1889         }
1890 }
1891
1892 void flush_all(void)
1893 {
1894         int i;
1895
1896         for (i = 0; i < nfiles; i++)
1897                 if (files[i].fp)
1898                         fflush(files[i].fp);
1899 }
1900
1901 void backsub(char **pb_ptr, char **sptr_ptr);
1902
1903 Cell *sub(Node **a, int nnn)    /* substitute command */
1904 {
1905         char *sptr, *pb, *q;
1906         Cell *x, *y, *result;
1907         char *t, *buf;
1908         fa *pfa;
1909         int bufsz = recsize;
1910
1911         if ((buf = (char *) malloc(bufsz)) == NULL)
1912                 FATAL("out of memory in sub");
1913         x = execute(a[3]);      /* target string */
1914         t = getsval(x);
1915         if (a[0] == NULL)       /* 0 => a[1] is already-compiled regexpr */
1916                 pfa = (fa *) a[1];      /* regular expression */
1917         else {
1918                 y = execute(a[1]);
1919                 pfa = makedfa(getsval(y), 1);
1920                 tempfree(y);
1921         }
1922         y = execute(a[2]);      /* replacement string */
1923         result = False;
1924         if (pmatch(pfa, t)) {
1925                 sptr = t;
1926                 adjbuf(&buf, &bufsz, 1+patbeg-sptr, recsize, 0, "sub");
1927                 pb = buf;
1928                 while (sptr < patbeg)
1929                         *pb++ = *sptr++;
1930                 sptr = getsval(y);
1931                 while (*sptr != 0) {
1932                         adjbuf(&buf, &bufsz, 5+pb-buf, recsize, &pb, "sub");
1933                         if (*sptr == '\\') {
1934                                 backsub(&pb, &sptr);
1935                         } else if (*sptr == '&') {
1936                                 sptr++;
1937                                 adjbuf(&buf, &bufsz, 1+patlen+pb-buf, recsize, &pb, "sub");
1938                                 for (q = patbeg; q < patbeg+patlen; )
1939                                         *pb++ = *q++;
1940                         } else
1941                                 *pb++ = *sptr++;
1942                 }
1943                 *pb = '\0';
1944                 if (pb > buf + bufsz)
1945                         FATAL("sub result1 %.30s too big; can't happen", buf);
1946                 sptr = patbeg + patlen;
1947                 if ((patlen == 0 && *patbeg) || (patlen && *(sptr-1))) {
1948                         adjbuf(&buf, &bufsz, 1+strlen(sptr)+pb-buf, 0, &pb, "sub");
1949                         while ((*pb++ = *sptr++) != 0)
1950                                 ;
1951                 }
1952                 if (pb > buf + bufsz)
1953                         FATAL("sub result2 %.30s too big; can't happen", buf);
1954                 setsval(x, buf);        /* BUG: should be able to avoid copy */
1955                 result = True;
1956         }
1957         tempfree(x);
1958         tempfree(y);
1959         free(buf);
1960         return result;
1961 }
1962
1963 Cell *gsub(Node **a, int nnn)   /* global substitute */
1964 {
1965         Cell *x, *y;
1966         char *rptr, *sptr, *t, *pb, *q;
1967         char *buf;
1968         fa *pfa;
1969         int mflag, tempstat, num;
1970         int bufsz = recsize;
1971
1972         if ((buf = (char *) malloc(bufsz)) == NULL)
1973                 FATAL("out of memory in gsub");
1974         mflag = 0;      /* if mflag == 0, can replace empty string */
1975         num = 0;
1976         x = execute(a[3]);      /* target string */
1977         t = getsval(x);
1978         if (a[0] == NULL)       /* 0 => a[1] is already-compiled regexpr */
1979                 pfa = (fa *) a[1];      /* regular expression */
1980         else {
1981                 y = execute(a[1]);
1982                 pfa = makedfa(getsval(y), 1);
1983                 tempfree(y);
1984         }
1985         y = execute(a[2]);      /* replacement string */
1986         if (pmatch(pfa, t)) {
1987                 tempstat = pfa->initstat;
1988                 pfa->initstat = 2;
1989                 pb = buf;
1990                 rptr = getsval(y);
1991                 do {
1992                         if (patlen == 0 && *patbeg != 0) {      /* matched empty string */
1993                                 if (mflag == 0) {       /* can replace empty */
1994                                         num++;
1995                                         sptr = rptr;
1996                                         while (*sptr != 0) {
1997                                                 adjbuf(&buf, &bufsz, 5+pb-buf, recsize, &pb, "gsub");
1998                                                 if (*sptr == '\\') {
1999                                                         backsub(&pb, &sptr);
2000                                                 } else if (*sptr == '&') {
2001                                                         sptr++;
2002                                                         adjbuf(&buf, &bufsz, 1+patlen+pb-buf, recsize, &pb, "gsub");
2003                                                         for (q = patbeg; q < patbeg+patlen; )
2004                                                                 *pb++ = *q++;
2005                                                 } else
2006                                                         *pb++ = *sptr++;
2007                                         }
2008                                 }
2009                                 if (*t == 0)    /* at end */
2010                                         goto done;
2011                                 adjbuf(&buf, &bufsz, 2+pb-buf, recsize, &pb, "gsub");
2012                                 *pb++ = *t++;
2013                                 if (pb > buf + bufsz)   /* BUG: not sure of this test */
2014                                         FATAL("gsub result0 %.30s too big; can't happen", buf);
2015                                 mflag = 0;
2016                         }
2017                         else {  /* matched nonempty string */
2018                                 num++;
2019                                 sptr = t;
2020                                 adjbuf(&buf, &bufsz, 1+(patbeg-sptr)+pb-buf, recsize, &pb, "gsub");
2021                                 while (sptr < patbeg)
2022                                         *pb++ = *sptr++;
2023                                 sptr = rptr;
2024                                 while (*sptr != 0) {
2025                                         adjbuf(&buf, &bufsz, 5+pb-buf, recsize, &pb, "gsub");
2026                                         if (*sptr == '\\') {
2027                                                 backsub(&pb, &sptr);
2028                                         } else if (*sptr == '&') {
2029                                                 sptr++;
2030                                                 adjbuf(&buf, &bufsz, 1+patlen+pb-buf, recsize, &pb, "gsub");
2031                                                 for (q = patbeg; q < patbeg+patlen; )
2032                                                         *pb++ = *q++;
2033                                         } else
2034                                                 *pb++ = *sptr++;
2035                                 }
2036                                 t = patbeg + patlen;
2037                                 if (patlen == 0 || *t == 0 || *(t-1) == 0)
2038                                         goto done;
2039                                 if (pb > buf + bufsz)
2040                                         FATAL("gsub result1 %.30s too big; can't happen", buf);
2041                                 mflag = 1;
2042                         }
2043                 } while (pmatch(pfa,t));
2044                 sptr = t;
2045                 adjbuf(&buf, &bufsz, 1+strlen(sptr)+pb-buf, 0, &pb, "gsub");
2046                 while ((*pb++ = *sptr++) != 0)
2047                         ;
2048         done:   if (pb < buf + bufsz)
2049                         *pb = '\0';
2050                 else if (*(pb-1) != '\0')
2051                         FATAL("gsub result2 %.30s truncated; can't happen", buf);
2052                 setsval(x, buf);        /* BUG: should be able to avoid copy + free */
2053                 pfa->initstat = tempstat;
2054         }
2055         tempfree(x);
2056         tempfree(y);
2057         x = gettemp();
2058         x->tval = NUM;
2059         x->fval = num;
2060         free(buf);
2061         return(x);
2062 }
2063
2064 void backsub(char **pb_ptr, char **sptr_ptr)    /* handle \\& variations */
2065 {                                               /* sptr[0] == '\\' */
2066         char *pb = *pb_ptr, *sptr = *sptr_ptr;
2067
2068         if (sptr[1] == '\\') {
2069                 if (sptr[2] == '\\' && sptr[3] == '&') { /* \\\& -> \& */
2070                         *pb++ = '\\';
2071                         *pb++ = '&';
2072                         sptr += 4;
2073                 } else if (sptr[2] == '&') {    /* \\& -> \ + matched */
2074                         *pb++ = '\\';
2075                         sptr += 2;
2076                 } else {                        /* \\x -> \\x */
2077                         *pb++ = *sptr++;
2078                         *pb++ = *sptr++;
2079                 }
2080         } else if (sptr[1] == '&') {    /* literal & */
2081                 sptr++;
2082                 *pb++ = *sptr++;
2083         } else                          /* literal \ */
2084                 *pb++ = *sptr++;
2085
2086         *pb_ptr = pb;
2087         *sptr_ptr = sptr;
2088 }