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