![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to b2gen.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 b2gen.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: /* $Header: b2gen.c,v 1.4 85/08/27 10:57:31 timo Exp $ */
4:
5: /* Code generation */
6:
7: #include "b.h"
8: #include "b0fea.h"
9: #include "b1obj.h"
10: #include "b2exp.h"
11: #include "b2nod.h"
12: #include "b2gen.h" /* Must be after b2nod.h */
13: #include "b3err.h"
14: #include "b3env.h"
15: #include "b3int.h"
16: #include "b3sem.h"
17: #include "b3sou.h"
18:
19: Visible Procedure fix_nodes(pt, code) parsetree *pt; parsetree *code; {
20: context c; value *setup(), *su;
21: sv_context(&c);
22: curline= *pt; curlino= one;
23: su= setup(*pt);
24: if (su) analyze(*pt, su);
25: curline= *pt; curlino= one;
26: inithreads();
27: fix(pt, su ? 'x' : 'v');
28: endthreads(code);
29: cleanup();
30: #ifdef TYPE_CHECK
31: if (cntxt != In_prmnv) type_check(*pt);
32: #endif
33: set_context(&c);
34: }
35:
36: /* ******************************************************************** */
37:
38: /* Utilities used by threading. */
39:
40: /* A 'threaded tree' is, in our case, a fixed(*) parse tree with extra links
41: that are used by the interpreter to determine the execution order.
42: __________
43: (*) 'Fixed' means: processed by 'fix_nodes', which removes UNPARSED
44: nodes and distinguishes TAG nodes into local, global tags etc.
45: fix_nodes also creates the threads, but this is accidental, not
46: essential. For UNPARSED nodes, the threads are actually laid
47: in a second pass through the subtree that was UNPARSED.
48: __________
49:
50: A small example: the parse tree for the expression 'a+b*c' looks like
51:
52: (DYOP,
53: (TAGlocal, "a"),
54: "+",
55: (DYOP,
56: (TAGlocal, "b"),
57: "*",
58: (TAGlocal, "c"))).
59:
60: The required execution order is here:
61:
62: 1) (TAGlocal, "a")
63: 2) (TAGlocal, "b")
64: 3) (TAGlocal, "c")
65: 4) (DYOP, ..., "*", ...)
66: 5) (DYOP, ..., "+", ...)
67:
68: Of course, the result of each operation (if it has a result) is pushed
69: on a stack, and the operands are popped from this same stack. Think of
70: reversed polish notation (well-known by owners of HP pocket calculators).
71:
72: The 'threads' are explicit links from each node to its successor in this
73: execution order. Conditional operations like IF and AND have two threads,
74: one for success and one for failure. Loops can be made by having the
75: thread from the last node of the loop body point to the head of the loop.
76:
77: Threading expressions, locations and simple-commands is easy: recursively
78: thread each of the subtrees, then lay a thread from the last threaded
79: to the current node. Nodes occurring in a 'location' context are
80: marked, so that the interpreter knows when to push a 'location' on
81: the stack.
82:
83: Tests and looping commands cause most of the complexity of the threading
84: utilities. The basic technique is 'backpatching'.
85: Nodes that need a conditional forward jump are chained together in a
86: linked list, and when their destination is reached, all nodes in the
87: chain get its 'address' patched into their secondary thread. There is
88: one such chain, called 'bpchain', which at all times contains those nodes
89: whose secondary destination would be the next generated instruction.
90: This is used by IF, WHILE, test-suites, AND and OR.
91:
92: To generate a loop, both this chain and the last normal instruction
93: (if any) are diverted to the node where the loop continues.
94:
95: For test-suites, we also need to be capable of jumping unconditionally
96: forward (over the remainder of the SELECT-command). This is done by
97: saving both the backpatch chain and the last node visited, and restoring
98: them after the remainder has been processed.
99: */
100:
101: /* Implementation tricks: in order not to show circular lists to 'release',
102: parse tree nodes are generated as compounds where there is room for two
103: more fields than their length indicates.
104: */
105:
106: #define Flag (MkSmallInt(1))
107: /* Flag used to indicate Location or TestRefinement node */
108:
109: Hidden parsetree start; /* First instruction. Picked up by endthreads() */
110:
111: Hidden parsetree last; /* Last visited node */
112:
113: Hidden parsetree bpchain; /* Backpatch chain for conditional goto's */
114: Hidden parsetree *wanthere; /* Chain of requests to return next tree */
115:
116: extern string opcodes[];
117:
118:
119: /* Start threading */
120:
121: Hidden Procedure inithreads() {
122: bpchain= NilTree;
123: wanthere= 0;
124: last= 0;
125: here(&start);
126: }
127:
128: /* Finish threading */
129:
130: Hidden Procedure endthreads(code) parsetree *code; {
131: jumpto(Stop);
132: if (!still_ok) start= NilTree;
133: *code= start;
134: }
135:
136:
137: /* Fill 't' as secondary thread for all nodes in the backpatch chain,
138: leaving the chain empty. */
139:
140: Hidden Procedure backpatch(t) parsetree t; {
141: parsetree u;
142: while (bpchain != NilTree) {
143: u= Thread2(bpchain);
144: Thread2(bpchain)= t;
145: bpchain= u;
146: }
147: }
148:
149: Visible Procedure jumpto(t) parsetree t; {
150: parsetree u;
151: if (!still_ok) return;
152: while (wanthere != 0) {
153: u= *wanthere;
154: *wanthere= t;
155: wanthere= (parsetree*)u;
156: }
157: while (last != NilTree) {
158: u= Thread(last);
159: Thread(last)= t;
160: last= u;
161: }
162: backpatch(t);
163: }
164:
165: Hidden parsetree seterr(n) int n; {
166: return (parsetree)MkSmallInt(n);
167: }
168:
169: /* Visit node 't', and set its secondary thread to 't2'. */
170:
171: Hidden Procedure visit2(t, t2) parsetree t, t2; {
172: if (!still_ok) return;
173: jumpto(t);
174: Thread2(t)= t2;
175: #ifdef DEBUG
176: fprintf(stderr, "\tvisit %s %s\n", opcodes[Nodetype(t)],
177: t2 == NilTree ? "" : "[*]");
178: #endif DEBUG
179: Thread(t)= NilTree;
180: last= t;
181: }
182:
183: /* Visit node 't' */
184:
185: Hidden Procedure visit(t) parsetree t; {
186: visit2(t, NilTree);
187: }
188:
189: /* Visit node 't' and flag it as a location (or test-refinement). */
190:
191: Hidden Procedure lvisit(t) parsetree t; {
192: visit2(t, Flag);
193: }
194:
195: #ifdef NOT_USED
196: Hidden Procedure jumphere(t) parsetree t; {
197: Thread(t)= last;
198: last= t;
199: }
200: #endif
201:
202: /* Add node 't' to the backpatch chain. */
203:
204: Hidden Procedure jump2here(t) parsetree t; {
205: if (!still_ok) return;
206: Thread2(t)= bpchain;
207: bpchain= t;
208: }
209:
210: Hidden Procedure here(pl) parsetree *pl; {
211: if (!still_ok) return;
212: *pl= (parsetree) wanthere;
213: wanthere= pl;
214: }
215:
216: Visible Procedure hold(pl) struct state *pl; {
217: if (!still_ok) return;
218: pl->h_last= last; pl->h_bpchain= bpchain; pl->h_wanthere= wanthere;
219: last= bpchain= NilTree; wanthere= 0;
220: }
221:
222: Visible Procedure let_go(pl) struct state *pl; {
223: parsetree p, *w;
224: if (!still_ok) return;
225: if (last) {
226: for (p= last; Thread(p) != NilTree; p= Thread(p))
227: ;
228: Thread(p)= pl->h_last;
229: }
230: else last= pl->h_last;
231: if (bpchain) {
232: for (p= bpchain; Thread2(p) != NilTree; p= Thread2(p))
233: ;
234: Thread2(p)= pl->h_bpchain;
235: }
236: else bpchain= pl->h_bpchain;
237: if (wanthere) {
238: for (w= wanthere; *w != 0; w= (parsetree*) *w)
239: ;
240: *w= (parsetree) pl->h_wanthere;
241: }
242: else wanthere= pl->h_wanthere;
243: }
244:
245: Hidden bool reachable() {
246: return last != NilTree || bpchain != 0 || wanthere != 0;
247: }
248:
249:
250: /* ******************************************************************** */
251: /* *********************** code generation **************************** */
252: /* ******************************************************************** */
253:
254: Forward bool is_variable();
255: Forward bool is_cmd_ref();
256: Forward value copydef();
257:
258: Visible Procedure fix(pt, flag) parsetree *pt; char flag; {
259: struct state st; value v, function; parsetree t, l1= NilTree;
260: typenode nt; string s; char c; int n, k, len;
261:
262: t= *pt;
263: if (!Is_node(t) || !still_ok) return;
264: nt= Nodetype(t);
265: if (nt < 0 || nt >= NTYPES) syserr(MESS(2200, "fix bad tree"));
266: s= gentab[nt];
267: if (s == NULL) return;
268: n= First_fieldnr;
269: if (flag == 'x') curline= t;
270: while ((c= *s++) != '\0' && still_ok) {
271: switch (c) {
272: case '0':
273: case '1':
274: case '2':
275: case '3':
276: case '4':
277: case '5':
278: case '6':
279: case '7':
280: case '8':
281: case '9':
282: n= (c - '0') + First_fieldnr;
283: break;
284: case 'c':
285: v= *Branch(t, n);
286: if (v != Vnil) {
287: len= Nfields(v);
288: for (k= 0; k < len; ++k)
289: fix(Field(v, k), flag);
290: }
291: ++n;
292: break;
293: case '#':
294: curlino= *Branch(t, n);
295: ++n;
296: break;
297: case 'g':
298: case 'h':
299: ++n;
300: break;
301: case 'a':
302: case 'l':
303: if (flag == 'v' || flag == 't')
304: c= flag;
305: /* Fall through */
306: case '!':
307: case 't':
308: case 'u':
309: case 'v':
310: case 'x':
311: fix(Branch(t, n), c);
312: ++n;
313: break;
314: case 'f':
315: f_fpr_formals(*Branch(t, n));
316: ++n;
317: break;
318:
319: case '?':
320: if (flag == 'v')
321: f_eunparsed(pt);
322: else if (flag == 't')
323: f_cunparsed(pt);
324: else
325: syserr(MESS(2201, "fix unparsed with bad flag"));
326: fix(pt, flag);
327: break;
328: case 'C':
329: v= *Branch(t, REL_LEFT);
330: if (Comparison(Nodetype(v)))
331: jump2here(v);
332: break;
333: case 'D':
334: v= (value)*Branch(t, DYA_NAME);
335: if (!is_dyafun(v, &function))
336: fixerr2(v, MESS(2202, " isn't a dyadic function"));
337: else
338: *Branch(t, DYA_FCT)= copydef(function);
339: break;
340: case 'E':
341: v= (value)*Branch(t, DYA_NAME);
342: if (!is_dyaprd(v, &function))
343: fixerr2(v, MESS(2203, " isn't a dyadic predicate"));
344: else
345: *Branch(t, DYA_FCT)= copydef(function);
346: break;
347: case 'G':
348: jumpto(l1);
349: break;
350: case 'H':
351: here(&l1);
352: break;
353: case 'I':
354: if (*Branch(t, n) == NilTree)
355: break;
356: /* Else fall through */
357: case 'J':
358: jump2here(t);
359: break;
360: case 'K':
361: hold(&st);
362: break;
363: case 'L':
364: let_go(&st);
365: break;
366: case 'M':
367: v= (value)*Branch(t, MON_NAME);
368: if (is_variable(v) || !is_monfun(v, &function))
369: fixerr2(v, MESS(2204, " isn't a monadic function"));
370: else
371: *Branch(t, MON_FCT)= copydef(function);
372: break;
373: case 'N':
374: v= (value)*Branch(t, MON_NAME);
375: if (is_variable(v) || !is_monprd(v, &function))
376: fixerr2(v, MESS(2205, " isn't a monadic predicate"));
377: else
378: *Branch(t, MON_FCT)= copydef(function);
379: break;
380: #ifdef REACH
381: case 'R':
382: if (*Branch(t, n) != NilTree && !reachable())
383: fixerr(MESS(2206, "command cannot be reached"));
384: break;
385: #endif
386: case 'S':
387: jumpto(Stop);
388: break;
389: case 'T':
390: if (flag == 't')
391: f_ctag(pt);
392: else if (flag == 'v' || flag == 'x')
393: f_etag(pt);
394: else
395: f_ttag(pt);
396: break;
397: case 'U':
398: f_ucommand(pt);
399: break;
400: case 'V':
401: visit(t);
402: break;
403: case 'X':
404: if (flag == 'a' || flag == 'l' || flag == '!')
405: lvisit(t);
406: else
407: visit(t);
408: break;
409: case 'W':
410: /*!*/ visit2(t, seterr(1));
411: break;
412: case 'Y':
413: if (still_ok && reachable()) {
414: if (nt == YIELD)
415: fixerr(MESS(2207, "YIELD-unit returns no value"));
416: else
417: fixerr(MESS(2208, "TEST-unit reports no outcome"));
418: }
419: break;
420: case 'Z':
421: if (!is_cmd_ref(t) && still_ok && reachable())
422: fixerr(MESS(2209, "refinement returns no value c.q. reports no outcome"));
423: *Branch(t, REF_START)= copy(l1);
424: break;
425: }
426: }
427: }
428:
429: /* ******************************************************************** */
430:
431: Hidden bool is_cmd_ref(t) parsetree t; { /* HACK */
432: value name= *Branch(t, REF_NAME);
433: string s= strval(name);
434: /* return isupper(*s); */
435: return *s <= 'Z' && *s >= 'A';
436: }
437:
438: Visible value copydef(f) value f; {
439: funprd *fpr= Funprd(f);
440: if (fpr->pre == Use) return Vnil;
441: return copy(f);
442: }
443:
444: Hidden bool is_basic_target(v) value v; {
445: return envassoc(formals, v) ||
446: locals != Vnil && envassoc(locals, v) ||
447: envassoc(globals, v) ||
448: envassoc(mysteries, v);
449: }
450:
451: Hidden bool is_variable(v) value v; {
452: value f;
453: return is_basic_target(v) ||
454: envassoc(refinements, v) ||
455: is_zerfun(v, &f);
456: }
457:
458: Hidden bool is_target(p) parsetree p; {
459: value v= *Branch(p, First_fieldnr); int k, len;
460: switch (Nodetype(p)) {
461:
462: case TAG:
463: return is_basic_target(v);
464:
465: case SELECTION:
466: case BEHEAD:
467: case CURTAIL:
468: case COMPOUND:
469: return is_target(v);
470:
471: case COLLATERAL:
472: len= Nfields(v);
473: k_Overfields {
474: if (!is_target(*Field(v, k))) return No;
475: }
476: return Yes;
477:
478: default:
479: return No;
480:
481: }
482: }
483:
484: /* ******************************************************************** */
485:
486: Hidden Procedure f_actuals(formals, pactuals) parsetree formals, *pactuals; {
487: /* name, actual, next */
488: value actuals= *pactuals, act, form, next_a, next_f, kw, *pact;
489: kw= *Branch(actuals, ACT_KEYW);
490: pact= Branch(actuals, ACT_EXPR); act= *pact;
491: form= *Branch(formals, FML_TAG);
492: next_a= *Branch(actuals, ACT_NEXT); next_f= *Branch(formals, FML_NEXT);
493: if (compare(*Branch(formals, FML_KEYW), kw) != 0)
494: fixerr3(MESS(2210, "wrong keyword "), kw, 0);
495: else if (act == Vnil && form != Vnil)
496: fixerr3(MESS(2211, "missing actual after "), kw, 0);
497: else if (next_a == Vnil && next_f != Vnil)
498: fixerr3(MESS(2212, "can't find expected "),
499: *Branch(next_f, FML_KEYW), 0);
500: else if (act != Vnil && form == Vnil)
501: fixerr3(MESS(2213, "unexpected actual after "), kw, 0);
502: else if (next_a != Vnil && next_f == Vnil)
503: fixerr3(MESS(2214, "unexpected keyword "),
504: *Branch(next_a, ACT_KEYW), 0);
505: else {
506: if (act != Vnil) {
507: parsetree st; struct state save;
508: hold(&save); here(&st);
509: if (is_target(act)) f_targ(pact);
510: else f_expr(pact);
511: jumpto(Stop); let_go(&save);
512: *Branch(actuals, ACT_START)= copy(st);
513: }
514: if (still_ok && next_a != Vnil)
515: f_actuals(next_f, Branch(actuals, ACT_NEXT));
516: }
517: }
518:
519: Hidden Procedure f_ucommand(pt) parsetree *pt; {
520: value t= *pt, *aa;
521: parsetree u, *f1= Branch(t, UCMD_NAME), *f2= Branch(t, UCMD_ACTUALS);
522: release(*Branch(t, UCMD_DEF));
523: *Branch(t, UCMD_DEF)= Vnil;
524: if ((aa= envassoc(refinements, *f1)) != Pnil) {
525: if (*Branch(*f2, ACT_EXPR) != Vnil
526: || *Branch(*f2, ACT_NEXT) != Vnil)
527: fixerr(MESS(2215, "refinement with parameters"));
528: else *Branch(t, UCMD_DEF)= copy(*aa);
529: }
530: else if (is_unit(*f1, How, &aa)) {
531: u= How_to(*aa)->unit;
532: f_actuals(*Branch(u, HOW_FORMALS), f2);
533: }
534: else if (still_ok)
535: fixerr3(MESS(2216, "you haven't told me HOW'TO "), *f1, 0);
536: }
537:
538: Hidden Procedure f_fpr_formals(t) parsetree t; {
539: switch (Nodetype(t)) {
540: case TAG:
541: break;
542: case MONF: case MONPRD:
543: f_targ(Branch(t, MON_RIGHT));
544: break;
545: case DYAF: case DYAPRD:
546: f_targ(Branch(t, DYA_LEFT));
547: f_targ(Branch(t, DYA_RIGHT));
548: break;
549: default:
550: syserr(MESS(2217, "f_fpr_formals"));
551: }
552: }
553:
554: Visible bool modify_tag(name, tag) parsetree *tag; value name; {
555: value *aa, function;
556: *tag= NilTree;
557: if (aa= envassoc(formals, name))
558: *tag= node3(TAGformal, name, copy(*aa));
559: else if (locals != Vnil && (aa= envassoc(locals, name)))
560: *tag= node3(TAGlocal, name, copy(*aa));
561: else if (aa= envassoc(globals, name))
562: *tag= node2(TAGglobal, name);
563: else if (aa= envassoc(mysteries, name))
564: *tag= node3(TAGmystery, name, copy(*aa));
565: else if (aa= envassoc(refinements, name))
566: *tag= node3(TAGrefinement, name, copy(*aa));
567: else if (is_zerfun(name, &function))
568: *tag= node3(TAGzerfun, name, copydef(function));
569: else if (is_zerprd(name, &function))
570: *tag= node3(TAGzerprd, name, copydef(function));
571: else return No;
572: return Yes;
573: }
574:
575: Hidden Procedure f_etag(pt) parsetree *pt; {
576: parsetree t= *pt; value name= copy(*Branch(t, TAG_NAME));
577: if (modify_tag(name, &t)) {
578: release(*pt);
579: *pt= t;
580: if (Nodetype(t) == TAGzerprd)
581: fixerr2(name, MESS(2218, " cannot be used in an expression"));
582: else
583: visit(t);
584: } else {
585: fixerr2(name, MESS(2219, " has not yet received a value"));
586: release(name);
587: }
588: }
589:
590: Hidden Procedure f_ttag(pt) parsetree *pt; {
591: parsetree t= *pt; value name= copy(*Branch(t, TAG_NAME));
592: if (modify_tag(name, &t)) {
593: release(*pt);
594: *pt= t;
595: switch (Nodetype(t)) {
596: case TAGrefinement:
597: fixerr(MESS(2220, "a refinement may not be used as a target"));
598: break;
599: case TAGzerfun:
600: case TAGzerprd:
601: fixerr2(name, MESS(2221, " hasn't been initialised or defined"));
602: break;
603: default:
604: lvisit(t);
605: break;
606: }
607: } else {
608: fixerr2(name, MESS(2222, " hasn't been initialised or defined"));
609: release(name);
610: }
611: }
612:
613: Hidden Procedure f_ctag(pt) parsetree *pt; {
614: parsetree t= *pt; value name= copy(*Branch(t, TAG_NAME));
615: if (modify_tag(name, &t)) {
616: release(*pt);
617: *pt= t;
618: switch (Nodetype(t)) {
619: case TAGrefinement:
620: lvisit(t); /* 'Loc' flag here means 'Test' */
621: break;
622: case TAGzerprd:
623: visit(t);
624: break;
625: default:
626: fixerr2(name, MESS(2223, " is neither a refined test nor a zeroadic predicate"));
627: break;
628: }
629: } else {
630: fixerr2(name, MESS(2224, " is neither a refined test nor a zeroadic predicate"));
631: release(name);
632: }
633: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.