![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to b3int.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bint|
Return to b3int.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bint |
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.