Return to code.c CVS log

Up to [Research Unix] / researchv10no / cmd / hoc

Annotation of researchv10no/cmd/hoc/code.c, revision 1.1

1.1     ! root        1: #include "hoc.h"
        !             2: #include "y.tab.h"
        !             3: #include <stdio.h>
        !             4: 
        !             5: #define        NSTACK  256
        !             6: 
        !             7: static Datum stack[NSTACK];    /* the stack */
        !             8: static Datum *stackp;          /* next free spot on stack */
        !             9: 
        !            10: #define        NPROG   2000
        !            11: Inst   prog[NPROG];    /* the machine */
        !            12: Inst   *progp;         /* next free spot for code generation */
        !            13: Inst   *pc;            /* program counter during execution */
        !            14: Inst   *progbase = prog; /* start of current subprogram */
        !            15: int    returning;      /* 1 if return stmt seen */
        !            16: 
        !            17: typedef struct Frame { /* proc/func call stack frame */
        !            18:        Symbol  *sp;    /* symbol table entry */
        !            19:        Inst    *retpc; /* where to resume after return */
        !            20:        Datum   *argn;  /* n-th argument on stack */
        !            21:        int     nargs;  /* number of arguments */
        !            22: } Frame;
        !            23: #define        NFRAME  100
        !            24: Frame  frame[NFRAME];
        !            25: Frame  *fp;            /* frame pointer */
        !            26: 
        !            27: initcode() {
        !            28:        progp = progbase;
        !            29:        stackp = stack;
        !            30:        fp = frame;
        !            31:        returning = 0;
        !            32: }
        !            33: 
        !            34: push(d)
        !            35:        Datum d;
        !            36: {
        !            37:        if (stackp >= &stack[NSTACK])
        !            38:                execerror("stack too deep", (char *)0);
        !            39:        *stackp++ = d;
        !            40: }
        !            41: 
        !            42: Datum pop()
        !            43: {
        !            44:        if (stackp == stack)
        !            45:                execerror("stack underflow", (char *)0);
        !            46:        return *--stackp;
        !            47: }
        !            48: 
        !            49: xpop() /* for when no value is wanted */
        !            50: {
        !            51:        if (stackp == stack)
        !            52:                execerror("stack underflow", (char *)0);
        !            53:        --stackp;
        !            54: }
        !            55: 
        !            56: constpush()
        !            57: {
        !            58:        Datum d;
        !            59:        d.val = ((Symbol *)*pc++)->u.val;
        !            60:        push(d);
        !            61: }
        !            62: 
        !            63: varpush()
        !            64: {
        !            65:        Datum d;
        !            66:        d.sym = (Symbol *)(*pc++);
        !            67:        push(d);
        !            68: }
        !            69: 
        !            70: whilecode()
        !            71: {
        !            72:        Datum d;
        !            73:        Inst *savepc = pc;
        !            74: 
        !            75:        execute(savepc+2);      /* condition */
        !            76:        d = pop();
        !            77:        while (d.val) {
        !            78:                execute(*((Inst **)(savepc)));  /* body */
        !            79:                if (returning)
        !            80:                        break;
        !            81:                execute(savepc+2);      /* condition */
        !            82:                d = pop();
        !            83:        }
        !            84:        if (!returning)
        !            85:                pc = *((Inst **)(savepc+1)); /* next stmt */
        !            86: }
        !            87: 
        !            88: forcode()
        !            89: {
        !            90:        Datum d;
        !            91:        Inst *savepc = pc;
        !            92: 
        !            93:        execute(savepc+4);              /* precharge */
        !            94:        (void) pop();
        !            95:        execute(*((Inst **)(savepc)));  /* condition */
        !            96:        d = pop();
        !            97:        while (d.val) {
        !            98:                execute(*((Inst **)(savepc+2)));        /* body */
        !            99:                if (returning)
        !           100:                        break;
        !           101:                execute(*((Inst **)(savepc+1)));        /* post loop */
        !           102:                (void) pop();
        !           103:                execute(*((Inst **)(savepc)));  /* condition */
        !           104:                d = pop();
        !           105:        }
        !           106:        if (!returning)
        !           107:                pc = *((Inst **)(savepc+3)); /* next stmt */
        !           108: }
        !           109: ifcode() 
        !           110: {
        !           111:        Datum d;
        !           112:        Inst *savepc = pc;      /* then part */
        !           113: 
        !           114:        execute(savepc+3);      /* condition */
        !           115:        d = pop();
        !           116:        if (d.val)
        !           117:                execute(*((Inst **)(savepc)));  
        !           118:        else if (*((Inst **)(savepc+1))) /* else part? */
        !           119:                execute(*((Inst **)(savepc+1)));
        !           120:        if (!returning)
        !           121:                pc = *((Inst **)(savepc+2)); /* next stmt */
        !           122: }
        !           123: 
        !           124: define(sp)     /* put func/proc in symbol table */
        !           125:        Symbol *sp;
        !           126: {
        !           127:        sp->u.defn = progbase;  /* start of code */
        !           128:        progbase = progp;       /* next code starts here */
        !           129: }
        !           130: 
        !           131: call()                 /* call a function */
        !           132: {
        !           133:        Symbol *sp = (Symbol *)pc[0]; /* symbol table entry */
        !           134:                                      /* for function */
        !           135:        if (fp++ >= &frame[NFRAME-1])
        !           136:                execerror(sp->name, "call nested too deeply");
        !           137:        fp->sp = sp;
        !           138:        fp->nargs = (int)pc[1];
        !           139:        fp->retpc = pc + 2;
        !           140:        fp->argn = stackp - 1;  /* last argument */
        !           141:        execute(sp->u.defn);
        !           142:        returning = 0;
        !           143: }
        !           144: 
        !           145: ret()          /* common return from func or proc */
        !           146: {
        !           147:        int i;
        !           148:        for (i = 0; i < fp->nargs; i++)
        !           149:                pop();  /* pop arguments */
        !           150:        pc = (Inst *)fp->retpc;
        !           151:        --fp;
        !           152:        returning = 1;
        !           153: }
        !           154: 
        !           155: funcret()      /* return from a function */
        !           156: {
        !           157:        Datum d;
        !           158:        if (fp->sp->type == PROCEDURE)
        !           159:                execerror(fp->sp->name, "(proc) returns value");
        !           160:        d = pop();      /* preserve function return value */
        !           161:        ret();
        !           162:        push(d);
        !           163: }
        !           164: 
        !           165: procret()      /* return from a procedure */
        !           166: {
        !           167:        if (fp->sp->type == FUNCTION)
        !           168:                execerror(fp->sp->name,
        !           169:                        "(func) returns no value");
        !           170:        ret();
        !           171: }
        !           172: 
        !           173: double *getarg()       /* return pointer to argument */
        !           174: {
        !           175:        int nargs = (int) *pc++;
        !           176:        if (nargs > fp->nargs)
        !           177:            execerror(fp->sp->name, "not enough arguments");
        !           178:        return &fp->argn[nargs - fp->nargs].val;
        !           179: }
        !           180: 
        !           181: arg()  /* push argument onto stack */
        !           182: {
        !           183:        Datum d;
        !           184:        d.val = *getarg();
        !           185:        push(d);
        !           186: }
        !           187: 
        !           188: argassign()    /* store top of stack in argument */
        !           189: {
        !           190:        Datum d;
        !           191:        d = pop();
        !           192:        push(d);        /* leave value on stack */
        !           193:        *getarg() = d.val;
        !           194: }
        !           195: 
        !           196: argaddeq()     /* store top of stack in argument */
        !           197: {
        !           198:        Datum d;
        !           199:        d = pop();
        !           200:        d.val = *getarg() += d.val;
        !           201:        push(d);        /* leave value on stack */
        !           202: }
        !           203: 
        !           204: argsubeq()     /* store top of stack in argument */
        !           205: {
        !           206:        Datum d;
        !           207:        d = pop();
        !           208:        d.val = *getarg() -= d.val;
        !           209:        push(d);        /* leave value on stack */
        !           210: }
        !           211: 
        !           212: argmuleq()     /* store top of stack in argument */
        !           213: {
        !           214:        Datum d;
        !           215:        d = pop();
        !           216:        d.val = *getarg() *= d.val;
        !           217:        push(d);        /* leave value on stack */
        !           218: }
        !           219: 
        !           220: argdiveq()     /* store top of stack in argument */
        !           221: {
        !           222:        Datum d;
        !           223:        d = pop();
        !           224:        d.val = *getarg() /= d.val;
        !           225:        push(d);        /* leave value on stack */
        !           226: }
        !           227: 
        !           228: argmodeq()     /* store top of stack in argument */
        !           229: {
        !           230:        Datum d;
        !           231:        double *x;
        !           232:        long y;
        !           233:        d = pop();
        !           234:        /* d.val = *getarg() %= d.val; */
        !           235:        x = getarg();
        !           236:        y = *x;
        !           237:        d.val = *x = y %= (long) d.val;
        !           238:        push(d);        /* leave value on stack */
        !           239: }
        !           240: 
        !           241: bltin() 
        !           242: {
        !           243: 
        !           244:        Datum d;
        !           245:        d = pop();
        !           246:        d.val = (*(double (*)())*pc++)(d.val);
        !           247:        push(d);
        !           248: }
        !           249: 
        !           250: add()
        !           251: {
        !           252:        Datum d1, d2;
        !           253:        d2 = pop();
        !           254:        d1 = pop();
        !           255:        d1.val += d2.val;
        !           256:        push(d1);
        !           257: }
        !           258: 
        !           259: sub()
        !           260: {
        !           261:        Datum d1, d2;
        !           262:        d2 = pop();
        !           263:        d1 = pop();
        !           264:        d1.val -= d2.val;
        !           265:        push(d1);
        !           266: }
        !           267: 
        !           268: mul()
        !           269: {
        !           270:        Datum d1, d2;
        !           271:        d2 = pop();
        !           272:        d1 = pop();
        !           273:        d1.val *= d2.val;
        !           274:        push(d1);
        !           275: }
        !           276: 
        !           277: div()
        !           278: {
        !           279:        Datum d1, d2;
        !           280:        d2 = pop();
        !           281:        if (d2.val == 0.0)
        !           282:                execerror("division by zero", (char *)0);
        !           283:        d1 = pop();
        !           284:        d1.val /= d2.val;
        !           285:        push(d1);
        !           286: }
        !           287: 
        !           288: mod()
        !           289: {
        !           290:        Datum d1, d2;
        !           291:        long x;
        !           292:        d2 = pop();
        !           293:        if (d2.val == 0.0)
        !           294:                execerror("division by zero", (char *)0);
        !           295:        d1 = pop();
        !           296:        /* d1.val %= d2.val; */
        !           297:        x = d1.val;
        !           298:        x %= (long) d2.val;
        !           299:        d1.val = d2.val = x;
        !           300:        push(d1);
        !           301: }
        !           302: 
        !           303: negate()
        !           304: {
        !           305:        Datum d;
        !           306:        d = pop();
        !           307:        d.val = -d.val;
        !           308:        push(d);
        !           309: }
        !           310: 
        !           311: verify(s)
        !           312:        Symbol *s;
        !           313: {
        !           314:        if (s->type != VAR && s->type != UNDEF)
        !           315:                execerror("attempt to evaluate non-variable", s->name);
        !           316:        if (s->type == UNDEF)
        !           317:                execerror("undefined variable", s->name);
        !           318: }
        !           319: 
        !           320: eval()         /* evaluate variable on stack */
        !           321: {
        !           322:        Datum d;
        !           323:        d = pop();
        !           324:        verify(d.sym);
        !           325:        d.val = d.sym->u.val;
        !           326:        push(d);
        !           327: }
        !           328: 
        !           329: preinc()
        !           330: {
        !           331:        Datum d;
        !           332:        d.sym = (Symbol *)(*pc++);
        !           333:        verify(d.sym);
        !           334:        d.val = d.sym->u.val += 1.0;
        !           335:        push(d);
        !           336: }
        !           337: 
        !           338: predec()
        !           339: {
        !           340:        Datum d;
        !           341:        d.sym = (Symbol *)(*pc++);
        !           342:        verify(d.sym);
        !           343:        d.val = d.sym->u.val -= 1.0;
        !           344:        push(d);
        !           345: }
        !           346: 
        !           347: postinc()
        !           348: {
        !           349:        Datum d;
        !           350:        double v;
        !           351:        d.sym = (Symbol *)(*pc++);
        !           352:        verify(d.sym);
        !           353:        v = d.sym->u.val;
        !           354:        d.sym->u.val += 1.0;
        !           355:        d.val = v;
        !           356:        push(d);
        !           357: }
        !           358: 
        !           359: postdec()
        !           360: {
        !           361:        Datum d;
        !           362:        double v;
        !           363:        d.sym = (Symbol *)(*pc++);
        !           364:        verify(d.sym);
        !           365:        v = d.sym->u.val;
        !           366:        d.sym->u.val -= 1.0;
        !           367:        d.val = v;
        !           368:        push(d);
        !           369: }
        !           370: 
        !           371: gt()
        !           372: {
        !           373:        Datum d1, d2;
        !           374:        d2 = pop();
        !           375:        d1 = pop();
        !           376:        d1.val = (double)(d1.val > d2.val);
        !           377:        push(d1);
        !           378: }
        !           379: 
        !           380: lt()
        !           381: {
        !           382:        Datum d1, d2;
        !           383:        d2 = pop();
        !           384:        d1 = pop();
        !           385:        d1.val = (double)(d1.val < d2.val);
        !           386:        push(d1);
        !           387: }
        !           388: 
        !           389: ge()
        !           390: {
        !           391:        Datum d1, d2;
        !           392:        d2 = pop();
        !           393:        d1 = pop();
        !           394:        d1.val = (double)(d1.val >= d2.val);
        !           395:        push(d1);
        !           396: }
        !           397: 
        !           398: le()
        !           399: {
        !           400:        Datum d1, d2;
        !           401:        d2 = pop();
        !           402:        d1 = pop();
        !           403:        d1.val = (double)(d1.val <= d2.val);
        !           404:        push(d1);
        !           405: }
        !           406: 
        !           407: eq()
        !           408: {
        !           409:        Datum d1, d2;
        !           410:        d2 = pop();
        !           411:        d1 = pop();
        !           412:        d1.val = (double)(d1.val == d2.val);
        !           413:        push(d1);
        !           414: }
        !           415: 
        !           416: ne()
        !           417: {
        !           418:        Datum d1, d2;
        !           419:        d2 = pop();
        !           420:        d1 = pop();
        !           421:        d1.val = (double)(d1.val != d2.val);
        !           422:        push(d1);
        !           423: }
        !           424: 
        !           425: and()
        !           426: {
        !           427:        Datum d1, d2;
        !           428:        d2 = pop();
        !           429:        d1 = pop();
        !           430:        d1.val = (double)(d1.val != 0.0 && d2.val != 0.0);
        !           431:        push(d1);
        !           432: }
        !           433: 
        !           434: or()
        !           435: {
        !           436:        Datum d1, d2;
        !           437:        d2 = pop();
        !           438:        d1 = pop();
        !           439:        d1.val = (double)(d1.val != 0.0 || d2.val != 0.0);
        !           440:        push(d1);
        !           441: }
        !           442: 
        !           443: not()
        !           444: {
        !           445:        Datum d;
        !           446:        d = pop();
        !           447:        d.val = (double)(d.val == 0.0);
        !           448:        push(d);
        !           449: }
        !           450: 
        !           451: power()
        !           452: {
        !           453:        Datum d1, d2;
        !           454:        extern double Pow();
        !           455:        d2 = pop();
        !           456:        d1 = pop();
        !           457:        d1.val = Pow(d1.val, d2.val);
        !           458:        push(d1);
        !           459: }
        !           460: 
        !           461: assign()
        !           462: {
        !           463:        Datum d1, d2;
        !           464:        d1 = pop();
        !           465:        d2 = pop();
        !           466:        if (d1.sym->type != VAR && d1.sym->type != UNDEF)
        !           467:                execerror("assignment to non-variable",
        !           468:                        d1.sym->name);
        !           469:        d1.sym->u.val = d2.val;
        !           470:        d1.sym->type = VAR;
        !           471:        push(d2);
        !           472: }
        !           473: 
        !           474: addeq()
        !           475: {
        !           476:        Datum d1, d2;
        !           477:        d1 = pop();
        !           478:        d2 = pop();
        !           479:        if (d1.sym->type != VAR && d1.sym->type != UNDEF)
        !           480:                execerror("assignment to non-variable",
        !           481:                        d1.sym->name);
        !           482:        d2.val = d1.sym->u.val += d2.val;
        !           483:        d1.sym->type = VAR;
        !           484:        push(d2);
        !           485: }
        !           486: 
        !           487: subeq()
        !           488: {
        !           489:        Datum d1, d2;
        !           490:        d1 = pop();
        !           491:        d2 = pop();
        !           492:        if (d1.sym->type != VAR && d1.sym->type != UNDEF)
        !           493:                execerror("assignment to non-variable",
        !           494:                        d1.sym->name);
        !           495:        d2.val = d1.sym->u.val -= d2.val;
        !           496:        d1.sym->type = VAR;
        !           497:        push(d2);
        !           498: }
        !           499: 
        !           500: muleq()
        !           501: {
        !           502:        Datum d1, d2;
        !           503:        d1 = pop();
        !           504:        d2 = pop();
        !           505:        if (d1.sym->type != VAR && d1.sym->type != UNDEF)
        !           506:                execerror("assignment to non-variable",
        !           507:                        d1.sym->name);
        !           508:        d2.val = d1.sym->u.val *= d2.val;
        !           509:        d1.sym->type = VAR;
        !           510:        push(d2);
        !           511: }
        !           512: 
        !           513: diveq()
        !           514: {
        !           515:        Datum d1, d2;
        !           516:        d1 = pop();
        !           517:        d2 = pop();
        !           518:        if (d1.sym->type != VAR && d1.sym->type != UNDEF)
        !           519:                execerror("assignment to non-variable",
        !           520:                        d1.sym->name);
        !           521:        d2.val = d1.sym->u.val /= d2.val;
        !           522:        d1.sym->type = VAR;
        !           523:        push(d2);
        !           524: }
        !           525: 
        !           526: modeq()
        !           527: {
        !           528:        Datum d1, d2;
        !           529:        long x;
        !           530:        d1 = pop();
        !           531:        d2 = pop();
        !           532:        if (d1.sym->type != VAR && d1.sym->type != UNDEF)
        !           533:                execerror("assignment to non-variable",
        !           534:                        d1.sym->name);
        !           535:        /* d2.val = d1.sym->u.val %= d2.val; */
        !           536:        x = d1.sym->u.val;
        !           537:        x %= (long) d2.val;
        !           538:        d2.val = d1.sym->u.val = x;
        !           539:        d1.sym->type = VAR;
        !           540:        push(d2);
        !           541: }
        !           542: 
        !           543: print()        /* pop top value from stack, print it */
        !           544: {
        !           545:        Datum d;
        !           546:        static Symbol *s;       /* last value computed */
        !           547:        if (s == NULL)
        !           548:                s = install("_", VAR, 0.0);
        !           549:        d = pop();
        !           550:        printf("%.*g\n", (int)lookup("PREC")->u.val, d.val);
        !           551:        s->u.val = d.val;
        !           552: }
        !           553: 
        !           554: prexpr()       /* print numeric value */
        !           555: {
        !           556:        Datum d;
        !           557:        d = pop();
        !           558:        printf("%.*g ", (int)lookup("PREC")->u.val, d.val);
        !           559: }
        !           560: 
        !           561: prstr()                /* print string value */ 
        !           562: {
        !           563:        printf("%s", (char *) *pc++);
        !           564: }
        !           565: 
        !           566: varread()      /* read into variable */
        !           567: {
        !           568:        Datum d;
        !           569:        extern FILE *fin;
        !           570:        Symbol *var = (Symbol *) *pc++;
        !           571:   Again:
        !           572:        switch (fscanf(fin, "%lf", &var->u.val)) {
        !           573:        case EOF:
        !           574:                if (moreinput())
        !           575:                        goto Again;
        !           576:                d.val = var->u.val = 0.0;
        !           577:                break;
        !           578:        case 0:
        !           579:                execerror("non-number read into", var->name);
        !           580:                break;
        !           581:        default:
        !           582:                d.val = 1.0;
        !           583:                break;
        !           584:        }
        !           585:        var->type = VAR;
        !           586:        push(d);
        !           587: }
        !           588: 
        !           589: Inst *code(f)  /* install one instruction or operand */
        !           590:        Inst f;
        !           591: {
        !           592:        Inst *oprogp = progp;
        !           593:        if (progp >= &prog[NPROG])
        !           594:                execerror("program too big", (char *)0);
        !           595:        *progp++ = f;
        !           596:        return oprogp;
        !           597: }
        !           598: 
        !           599: /*
        !           600: This one blows up if the increment of pc is done after the function is called.
        !           601: Sigh.
        !           602:  *execute(p)
        !           603:  *     Inst *p;
        !           604:  *{
        !           605:  *     for (pc = p; *pc != STOP && !returning; )
        !           606:  *             (*(*pc++))();
        !           607:  *}
        !           608:  */
        !           609: 
        !           610: execute(p)
        !           611:        Inst *p;
        !           612: {
        !           613:        Inst *fp;
        !           614: 
        !           615:        for (pc = p; *pc != STOP && !returning; ) {
        !           616:                fp = pc++;
        !           617:                (*(*fp))();
        !           618:        }
        !           619: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.