# 2.11BSD#431 - /usr/src/new/PORT/B/src/bint/b3int.c

##### Functions

    evalthread        X
    execthread        X
    initint           X
    run               X

##### Variables

    resval            X
    terminated        X

##### Macros

    Comp              X
    Comp2             X
    Comp3             X
    Dyop              X
    F                 X
    Flagged           X
    Jump              X
    LocFlagged        X
    Monop             X
    Pop1              X
    Pop2              X
    ValOrLoc          X

       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: }

#### Defined functions

evalthread defined in line 401; used 5 times

- in /usr/src/new/PORT/B/src/bint/b3int.h line 9
- in /usr/src/new/PORT/B/src/bint/b3mai.c line 25, 289
- in /usr/src/new/PORT/B/src/bint/b3scr.c line 409
- in /usr/src/new/PORT/B/src/bint/b3sou.c line 746

execthread defined in line 397; used 1 times

- in /usr/src/new/PORT/B/src/bint/b3mai.c line 304

initint defined in line 405; used 1 times

- in /usr/src/new/PORT/B/src/bint/b3mai.c line 206

run defined in line 50; used 2 times

- in line 398-402(2)

#### Defined variables

resval defined in line 24; used 1 times

- in line 188

terminated defined in line 25; used 1 times

- in line 183

#### Defined macros

Comp defined in line 39; used 6 times

- in line 340-345(6)

Comp2 defined in line 40; used 1 times

- in line 39

Comp3 defined in line 41; used 1 times

- in line 40

Dyop defined in line 32; used 2 times

- in line 223, 281

F defined in line 42; used 44 times

- in line 122, 143-144(2), 171-173(3), 203-208(5), 215, 239(2), 245-251(4), 257-261(2), 273, 285, 330(2), 336(2), 348-377(18)

Flagged defined in line 35; used 2 times

- in line 40, 365

Jump defined in line 38; used 8 times

- in line 41, 151-157(3), 311-312(2), 322-323(2)

LocFlagged defined in line 36; used 5 times

- in line 37, 227, 233, 348, 360

Monop defined in line 34; never used
Pop1 defined in line 31; used 4 times

- in line 165-167(3), 178

Pop2 defined in line 30; used 5 times

- in line 161-164(4), 176

ValOrLoc defined in line 37; used 3 times

- in line 223, 352-356(2)

Last modified: 1985-08-27 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 1312 |