Annotation of rpl/rplawk/run.c, revision 1.1

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

CVSweb interface <joel.bertrand@systella.fr>