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

   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

Defined variables

Defined macros