Return to b3int.c CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bint

Annotation of 43BSD/contrib/B/src/bint/b3int.c, revision 1.1

1.1     ! root        1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
        !             2: 
        !             3: /*
        !             4:   $Header: b3int.c,v 1.4 85/08/22 16:58:27 timo Exp $
        !             5: */
        !             6: 
        !             7: /* B interpreter using theaded trees */
        !             8: 
        !             9: #include "b.h"
        !            10: #include "b0fea.h"
        !            11: #include "b1mem.h"
        !            12: #include "b1obj.h"
        !            13: #include "b2nod.h"
        !            14: #include "b3err.h"
        !            15: #include "b3sem.h"
        !            16: #include "b3env.h"
        !            17: #include "b3int.h"
        !            18: #include "b3in2.h"
        !            19: #include "b3sta.h"
        !            20: 
        !            21: 
        !            22: /* Relicts from old system: */
        !            23: 
        !            24: Visible value resval;
        !            25: Visible bool terminated;
        !            26: 
        !            27: 
        !            28: /* Shorthands: */
        !            29: 
        !            30: #define Pop2(fun) (w = pop(), v = pop(), fun(v, w), release(v), release(w))
        !            31: #define Pop1(fun) (v = pop(), fun(v), release(v))
        !            32: #define Dyop(funvw) \
        !            33:        (w = pop(), v = pop(), push(funvw), release(v), release(w))
        !            34: #define Monop(funv) (v = pop(), push(funv), release(v))
        !            35: #define Flagged() (Thread2(pc) != NilTree)
        !            36: #define LocFlagged() (Thread2(pc) != NilTree && !noloc)
        !            37: #define ValOrLoc(feval, floc) (LocFlagged() ? (floc) : (feval))
        !            38: #define Jump() (tracing && tr_jump(), next = Thread2(pc))
        !            39: #define Comp(op) (w = pop(), v = pop(), report = (compare(v, w) op 0), Comp2())
        !            40: #define Comp2() (release(v), !Flagged() ? release(w) : Comp3())
        !            41: #define Comp3() (report ? push(w) : (Jump(), release(w)))
        !            42: #define F(n) ((value)*Branch(pc, (n)))
        !            43: 
        !            44: 
        !            45: /* Execute a threaded tree until the end or until a terminating-command.
        !            46:    The boolean argument 'wantvalue' tells whether it must deliver
        !            47:    a value or not.
        !            48: */
        !            49: 
        !            50: Hidden value
        !            51: run(start, wantvalue) parsetree start; bool wantvalue; {
        !            52:        value u, v, w; int k; bool X, Y; int call_stop= call_level;
        !            53: #ifdef IBMPC
        !            54:        int loopcnt= 0;
        !            55: #endif
        !            56:        parsetree old_next= next;
        !            57:        /* While run can be used recursively, save some state info */
        !            58: 
        !            59:        next= start;
        !            60:        for (;;) {
        !            61: #ifdef IBMPC
        !            62:                if (loopcnt++ == 100) {
        !            63:                        bdos(0x2c, 0, 0);
        !            64:                        /* forcing a DOS function call (get time) */
        !            65:                        /* so that a break interrupt can be executed */
        !            66:                        loopcnt= 0;
        !            67:                }
        !            68: #endif
        !            69:                if (!still_ok) break;
        !            70:                pc= next;
        !            71:                if (pc == Halt) {
        !            72:                        error(MESS(3500, "unexpected program halt"));
        !            73:                        break;
        !            74:                }
        !            75:                if (!Is_parsetree(pc)) {
        !            76:                        if (pc == Stop) {
        !            77:                                if (call_level == call_stop) break;
        !            78:                                ret();
        !            79:                                continue;
        !            80:                        }
        !            81:                        if (!Is_number(pc)) syserr(MESS(3501, "run: bad thread"));
        !            82:                        switch (intval(pc)) {
        !            83:                        case 0:
        !            84:                                pc= Stop;
        !            85:                                break;
        !            86:                        case 1:
        !            87:                                error(
        !            88:                        MESS(3502, "none of the alternative tests of SELECT succeeds"));
        !            89:                                break;
        !            90:                        case 2:
        !            91:                                if (resexp == Rep)
        !            92:                                        error(MESS(3503, "TEST-unit reports no outcome"));
        !            93:                                else
        !            94:                                        error(MESS(3504, "YIELD-unit returns no value"));
        !            95:                                break;
        !            96:                        case 3:
        !            97:                                if (resexp == Rep)
        !            98:                                 error(MESS(3505, "test-refinement reports no outcome"));
        !            99:                                else
        !           100:                                 error(MESS(3506, "refinement returns no value"));
        !           101:                                 /* "expression-" seems superfluous here */
        !           102:                                break;
        !           103:                        default:
        !           104:                                v= convert(pc, No, No);
        !           105:                                error3(MESS(3507, "run-time error "), v, 0);
        !           106:                                release(v);
        !           107:                        }
        !           108:                        continue;
        !           109:                }
        !           110:                next = Thread(pc);
        !           111:                if (tracing) tr_node(pc);
        !           112: /* <<<<<<<<<<<<<<<< */
        !           113: switch (Nodetype(pc)) {
        !           114: 
        !           115: case HOW_TO:
        !           116: case REFINEMENT:
        !           117:        error(MESS(3508, "run: cannot execute unit-definition"));
        !           118:        break;
        !           119: 
        !           120: case YIELD:
        !           121: case TEST:
        !           122:        switch (Nodetype(F(FPR_FORMALS))) {
        !           123:        case TAG:
        !           124:                break;
        !           125:        case MONF: case MONPRD:
        !           126:                w= pop(); v= pop();
        !           127:                put(v, w); release(v); release(w);
        !           128:                break;
        !           129:        case DYAF: case DYAPRD:
        !           130:                w= pop(); v= pop(); u= pop();
        !           131:                put(u, w); release(u); release(w);
        !           132:                u= pop();
        !           133:                put(u, v); release(u); release(v);
        !           134:                break;
        !           135:        default:
        !           136:                syserr(MESS(3509, "bad FPR_FORMAL"));
        !           137:        }
        !           138:        break;
        !           139: 
        !           140: /* Commands */
        !           141: 
        !           142: case SUITE:
        !           143:        curlino = F(SUI_LINO);
        !           144:        curline = F(SUI_CMD);
        !           145:        break;
        !           146: 
        !           147: case IF:
        !           148: case AND:
        !           149: case WHILE:
        !           150: case TEST_SUITE:
        !           151:        if (!report) Jump(); break;
        !           152: 
        !           153: case OR: if (report) Jump(); break;
        !           154: 
        !           155: case FOR:
        !           156:        w= pop(); v= pop();
        !           157:        if (!in_ranger(v, &w)) { release(v); release(w); Jump(); }
        !           158:        else { push(v); push(w); }
        !           159:        break;
        !           160: 
        !           161: case PUT: Pop2(put_with_check); break;
        !           162: case INSERT: Pop2(l_insert); break;
        !           163: case REMOVE: Pop2(l_remove); break;
        !           164: case CHOOSE: Pop2(choose); break;
        !           165: case DRAW: Pop1(draw); break;
        !           166: case SET_RANDOM: Pop1(set_random); break;
        !           167: case DELETE: Pop1(l_delete); break;
        !           168: case CHECK: if (!report) checkerr(); break;
        !           169: 
        !           170: case WRITE:
        !           171:        nl(F(WRT_L_LINES));
        !           172:        if (F(WRT_EXPR)) { v = pop(); writ(v); release(v); }
        !           173:        nl(F(WRT_R_LINES));
        !           174:        break;
        !           175: 
        !           176: case READ: Pop2(read_eg); break;
        !           177: 
        !           178: case READ_RAW: Pop1(read_raw); break;
        !           179: 
        !           180: case QUIT:
        !           181:        if (resexp != Voi)
        !           182:           error(MESS(3510, "QUIT may only occur in a HOW'TO or command-refinement"));
        !           183:        if (call_level == 0 && still_ok) terminated= Yes;
        !           184:        next= Stop; break;
        !           185: case RETURN:
        !           186:        if (resexp != Ret)
        !           187:           error(MESS(3511, "RETURN may only occur in a YIELD or expression-refinement"));
        !           188:        resval = pop(); next= Stop; break;
        !           189: case REPORT:
        !           190:        if (resexp != Rep)
        !           191:           error(MESS(3512, "REPORT may only occur in a TEST-unit or test-refinement"));
        !           192:        next= Stop; break;
        !           193: case SUCCEED:
        !           194:        if (resexp != Rep)
        !           195:           error(MESS(3513, "SUCCEED may only occur in a TEST-unit or test-refinement"));
        !           196:        report = Yes; next= Stop; break;
        !           197: case FAIL:
        !           198:        if (resexp != Rep)
        !           199:           error(MESS(3514, "FAIL may only occur in a TEST-unit or test-refinement"));
        !           200:        report = No; next= Stop; break;
        !           201: 
        !           202: case USER_COMMAND:
        !           203:        x_user_command(F(UCMD_NAME), F(UCMD_ACTUALS), F(UCMD_DEF));
        !           204:        break;
        !           205: 
        !           206: case EXTENDED_COMMAND:
        !           207: #ifdef EXT_COMMAND
        !           208:        x_extended_command(F(ECMD_NAME), F(ECMD_ACTUALS));
        !           209: #endif
        !           210:        break;
        !           211: 
        !           212: /* Expressions, targets */
        !           213: 
        !           214: case COLLATERAL:
        !           215:        v = mk_compound(k= Nfields(F(COLL_SEQ)));
        !           216:        while (--k >= 0)
        !           217:                *Field(v, k) = pop();
        !           218:        push(v);
        !           219:        break;
        !           220: 
        !           221: /* Expressions, targets */
        !           222: 
        !           223: case SELECTION: Dyop(ValOrLoc(associate(v, w), tbsel_loc(v, w))); break;
        !           224: 
        !           225: case BEHEAD:
        !           226:        w= pop(); v= pop();
        !           227:        push(LocFlagged() ? trim_loc(v, w, '@') : behead(v, w));
        !           228:        release(v); release(w);
        !           229:        break;
        !           230: 
        !           231: case CURTAIL:
        !           232:        w= pop(); v= pop();
        !           233:        push(LocFlagged() ? trim_loc(v, w, '|') : curtail(v, w));
        !           234:        release(v); release(w);
        !           235:        break;
        !           236: 
        !           237: case MONF:
        !           238:        v = pop();
        !           239:        formula(Vnil, F(MON_NAME), v, F(MON_FCT));
        !           240:        release(v);
        !           241:        break;
        !           242: 
        !           243: case DYAF:
        !           244:        w = pop(); v = pop();
        !           245:        formula(v,  F(DYA_NAME), w, F(DYA_FCT));
        !           246:        release(v); release(w);
        !           247:        break;
        !           248: 
        !           249: case TEXT_LIT:
        !           250:        v= F(XLIT_TEXT);
        !           251:        if (F(XLIT_NEXT)) { w= pop(); v= concat(v, w); release(w); }
        !           252:        else copy(v);
        !           253:        push(v);
        !           254:        break;
        !           255: 
        !           256: case TEXT_CONV:
        !           257:        if (F(XCON_NEXT)) w= pop();
        !           258:        u= pop();
        !           259:        v= convert(u, Yes, Yes);
        !           260:        release(u);
        !           261:        if (F(XCON_NEXT)) {
        !           262:                v= concat(u= v, w);
        !           263:                release(u);
        !           264:                release(w);
        !           265:        }
        !           266:        push(v);
        !           267:        break;
        !           268: 
        !           269: case ELT_DIS: push(mk_elt()); break;
        !           270: 
        !           271: case LIST_DIS:
        !           272:        u = mk_elt();
        !           273:        k= Nfields(F(LDIS_SEQ));
        !           274:        while (--k >= 0) {
        !           275:                insert(v = pop(), &u);
        !           276:                release(v);
        !           277:        }
        !           278:        push(u);
        !           279:        break;
        !           280: 
        !           281: case RANGE_DIS: Dyop(mk_range(v, w)); break;
        !           282: 
        !           283: case TAB_DIS:
        !           284:        u = mk_elt();
        !           285:        k= Nfields(F(TDIS_SEQ));
        !           286:        while ((k -= 2) >= 0) {
        !           287:                w = pop(); v = pop();
        !           288:                /* Should check for same key with different associate */
        !           289:                replace(w, &u, v);
        !           290:                release(v); release(w);
        !           291:        }
        !           292:        push(u);
        !           293:        break;
        !           294: 
        !           295: /* Tests */
        !           296: 
        !           297: case NOT: report = !report; break;
        !           298: 
        !           299: /* Quantifiers can be described as follows:
        !           300:    Report X at first test which reports Y.  If no test reports Y, report !X.
        !           301:       type     X       Y
        !           302:       SOME     Yes     Yes
        !           303:       EACH     No      No
        !           304:       NO       No      Yes. */
        !           305: 
        !           306: case EACH_IN:  X= Y= No; goto quant;
        !           307: case NO_IN:    X= No; Y= Yes; goto quant;
        !           308: case SOME_IN:  X= Y= Yes;
        !           309: quant:
        !           310:        w= pop(); v= pop();
        !           311:        if (Is_compound(w) && report == Y) { report= X; Jump(); }
        !           312:        else if (!in_ranger(v, &w)) { report= !X; Jump(); }
        !           313:        else { push(v); push(w); break; }
        !           314:        release(v); release(w);
        !           315:        break;
        !           316: 
        !           317: case EACH_PARSING:     X= Y= No; goto parse;
        !           318: case NO_PARSING:       X= No; Y= Yes; goto parse;
        !           319: case SOME_PARSING:     X= Y= Yes;
        !           320: parse:
        !           321:        w= pop(); v= pop();
        !           322:        if (Is_compound(w) && report == Y) { report= X; Jump(); }
        !           323:        else if (!pa_ranger(v, &w)) { report= !X; Jump(); }
        !           324:        else { push(v); push(w); break; }
        !           325:        release(v); release(w);
        !           326:        break;
        !           327: 
        !           328: case MONPRD:
        !           329:        v = pop();
        !           330:        proposition(Vnil, F(MON_NAME), v, F(MON_FCT));
        !           331:        release(v);
        !           332:        break;
        !           333: 
        !           334: case DYAPRD:
        !           335:        w = pop(); v = pop();
        !           336:        proposition(v, F(DYA_NAME), w, F(DYA_FCT));
        !           337:        release(v); release(w);
        !           338:        break;
        !           339: 
        !           340: case LESS_THAN: Comp(<); break;
        !           341: case AT_MOST: Comp(<=); break;
        !           342: case GREATER_THAN: Comp(>); break;
        !           343: case AT_LEAST: Comp(>=); break;
        !           344: case EQUAL: Comp(==); break;
        !           345: case UNEQUAL: Comp(!=); break;
        !           346: 
        !           347: case TAGformal:
        !           348:        call_formal(F(TAG_NAME), F(TAG_ID), LocFlagged());
        !           349:        break;
        !           350: 
        !           351: case TAGlocal:
        !           352:        push(ValOrLoc(v_local(F(TAG_NAME), F(TAG_ID)), local_loc(F(TAG_ID))));
        !           353:        break;
        !           354: 
        !           355: case TAGglobal:
        !           356:        push(ValOrLoc(v_global(F(TAG_NAME)), global_loc(F(TAG_NAME))));
        !           357:        break;
        !           358: 
        !           359: case TAGmystery:
        !           360:        if (LocFlagged()) push(l_mystery(F(TAG_NAME), F(TAG_ID)));
        !           361:        else v_mystery(F(TAG_NAME), F(TAG_ID));
        !           362:        break;
        !           363: 
        !           364: case TAGrefinement:
        !           365:        call_refinement(F(TAG_NAME), F(TAG_ID), Flagged());
        !           366:        break;
        !           367: 
        !           368: case TAGzerfun:
        !           369:        formula(Vnil,  F(TAG_NAME), Vnil, F(TAG_ID));
        !           370:        break;
        !           371: 
        !           372: case TAGzerprd:
        !           373:        proposition(Vnil,  F(TAG_NAME), Vnil, F(TAG_ID));
        !           374:        break;
        !           375: 
        !           376: case NUMBER:
        !           377:        push(copy(F(NUM_VALUE)));
        !           378:        break;
        !           379: 
        !           380: default:
        !           381:        syserr(MESS(3515, "run: bad node type"));
        !           382: 
        !           383: }
        !           384: /* >>>>>>>>>>>>>>>> */
        !           385:        }
        !           386:        v = Vnil;
        !           387:        if (wantvalue && still_ok) v = pop();
        !           388:        /* Unwind stack when stopped by error: */
        !           389:        while (call_level != call_stop) ret();
        !           390:        next= old_next;
        !           391:        return v;
        !           392: }
        !           393: 
        !           394: 
        !           395: /* External interfaces: */
        !           396: 
        !           397: Visible Procedure execthread(start) parsetree start; {
        !           398:        run(start, No);
        !           399: }
        !           400: 
        !           401: Visible value evalthread(start) parsetree start; {
        !           402:        return run(start, Yes);
        !           403: }
        !           404: 
        !           405: Visible Procedure initint() {
        !           406:        /* Dummy, relict */
        !           407: }

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