[BACK]Return to run.c CVS log [TXT][DIR] Up to [local] / src / usr.bin / awk

Annotation of src/usr.bin/awk/run.c, Revision 1.16

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