|
|
1.1 root 1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
2:
3: /* $Header: b2ana.c,v 1.4 85/08/22 16:54:05 timo Exp $ */
4:
5: /* Prepare for code generation -- find out which tags are targets */
6:
7: #include "b.h"
8: #include "b1obj.h"
9: #include "b2nod.h"
10: #include "b2gen.h" /* Must be after b2nod.h */
11: #include "b3err.h"
12: #include "b3env.h"
13: #include "b3sou.h" /* For get_pname */
14:
15:
16: Visible int nextvarnumber; /* Counts local targets (including formals) */
17:
18: Visible value formals, locals, globals, mysteries, refinements;
19:
20:
21: Visible value *setup(t) parsetree t; {
22: typenode n= Nodetype(t);
23: bool in_prmnv= !Unit(n);
24: nextvarnumber= 0;
25: formals= mk_elt();
26: mysteries= mk_elt();
27: if (in_prmnv) {
28: globals= copy(prmnv->tab);
29: locals= Vnil;
30: refinements= mk_elt();
31: return Command(n) ? &globals : Pnil;
32: } else {
33: globals= mk_elt();
34: locals= mk_elt();
35: refinements=
36: copy(*Branch(t, n == HOW_TO ? HOW_R_NAMES : FPR_R_NAMES));
37: unit_context(t);
38: return &locals;
39: }
40: }
41:
42: Hidden Procedure unit_context(t) parsetree t; {
43: cntxt= In_unit;
44: release(uname); uname= get_pname(t);
45: }
46:
47: Visible Procedure cleanup() {
48: release(formals);
49: release(locals);
50: release(globals);
51: release(mysteries);
52: release(refinements);
53: }
54:
55: /* ******************************************************************** */
56:
57: /* Analyze parse tree, finding the targets and formal parameters.
58: Formal parameters of HOW'TO's are of course found in the unit heading.
59: Formal parameters of YIELDs and TESTs are treated as local targets.
60: Global targets are also easily found: they are mentioned in a SHARE command.
61: Local targets appear on their own or in collateral forms after PUT IN,
62: DRAW or CHOOSE, or as bound tags after FOR, SOME, EACH or NO.
63: Note that DELETE x, REMOVE e FROM x, or PUT e IN x[k] (etc.) don't
64: introduce local targets, because in all these cases x must have been
65: initialized first. This speeds up our task of finding targets,
66: since we don't have to visit all nodes: only nodes that may contain
67: commands or tests, and the positions mentioned here, need be visited.
68: (And of course unit headings).
69: We don't have to look for refinements since these are already known
70: from the unit heading.
71: */
72:
73: Hidden Procedure a_tag(name, targs) value name; value *targs; {
74: value *aa; int varnumber;
75: if (locals != Vnil && envassoc(locals, name)) return;
76: if (envassoc(globals, name)) return;
77: if (envassoc(formals, name)) return;
78: if (envassoc(refinements, name)) {
79: if (targs != &mysteries)
80: fixerr(MESS(4600, "a refinement may not be used as a target"));
81: return;
82: }
83: if (aa= envassoc(mysteries, name)) {
84: if (targs == &mysteries) return;
85: varnumber= SmallIntVal(*aa);
86: e_delete(&mysteries, name);
87: }
88: else if (targs != &globals) varnumber= nextvarnumber++;
89: else varnumber= 0;
90: e_replace(MkSmallInt(varnumber), targs, name);
91: }
92:
93: Hidden Procedure a_fpr_formals(t) parsetree t; {
94: typenode n= Nodetype(t);
95: switch (n) {
96: case TAG:
97: break;
98: case MONF: case MONPRD:
99: analyze(*Branch(t, MON_RIGHT), &locals);
100: break;
101: case DYAF: case DYAPRD:
102: analyze(*Branch(t, DYA_LEFT), &locals);
103: analyze(*Branch(t, DYA_RIGHT), &locals);
104: break;
105: default: syserr(MESS(4601, "a_fpr_formals"));
106: }
107: }
108:
109: Visible Procedure analyze(t, targs) parsetree t; value *targs; {
110: typenode nt; string s; char c; int n, k, len; value v;
111: if (!Is_node(t) || !still_ok) return;
112: nt= Nodetype(t);
113: if (nt < 0 || nt >= NTYPES) syserr(MESS(4602, "analyze bad tree"));
114: s= gentab[nt];
115: if (s == NULL) return;
116: n= First_fieldnr;
117: while ((c= *s++) != '\0' && still_ok) {
118: switch (c) {
119: case '0':
120: case '1':
121: case '2':
122: case '3':
123: case '4':
124: case '5':
125: case '6':
126: case '7':
127: case '8':
128: case '9':
129: n= (c - '0') + First_fieldnr;
130: break;
131: case 'c':
132: v= *Branch(t, n);
133: if (v != Vnil) {
134: len= Nfields(v);
135: for (k= 0; k < len; ++k)
136: analyze(*Field(v, k), targs);
137: }
138: ++n;
139: break;
140: case '#':
141: curlino= *Branch(t, n);
142: /* Fall through */
143: case 'l':
144: case 'v':
145: ++n;
146: break;
147: case 'm':
148: analyze(*Branch(t, n), &mysteries);
149: ++n;
150: break;
151: case 'g':
152: analyze(*Branch(t, n), &globals);
153: ++n;
154: break;
155: case '!':
156: analyze(*Branch(t, n),
157: locals != Vnil ? &locals : &globals);
158: ++n;
159: break;
160: case 'x':
161: curline= *Branch(t, n);
162: /* Fall through */
163: case 'a':
164: case 'u':
165: analyze(*Branch(t, n), targs);
166: ++n;
167: break;
168: case 't':
169: analyze(*Branch(t, n), Pnil);
170: ++n;
171: break;
172: case 'f':
173: a_fpr_formals(*Branch(t, n));
174: ++n;
175: break;
176: case 'h':
177: v= *Branch(t, n);
178: if (v != Vnil && Is_text(v))
179: a_tag(v, &formals);
180: else
181: analyze(v, &formals);
182: ++n;
183: break;
184: case '=':
185: *Branch(t, n)= MkSmallInt(nextvarnumber);
186: ++n;
187: break;
188: case 'T':
189: if (targs != Pnil)
190: a_tag((value)*Branch(t, TAG_NAME), targs);
191: break;
192: }
193: }
194: }
195:
196: /* ******************************************************************** */
197:
198: /* Table describing the actions of the fixer for each node type */
199:
200:
201: /*
202: LIST OF CODES AND THEIR MEANING
203:
204: char fix n? analyze
205:
206: 0-9 n= c-'0'
207:
208: # set curlino ++n set curlino
209: = ++n set to nextvarnum
210: ! locate ++n analyze; force targs= &local
211: a locate ++n analyze
212: c collateral ++n analyze collateral
213: f fpr_formals ++n a_fpr_formals
214: g ++n global
215: h ++n how'to formal
216: l locate ++n
217: m actual param ++n mystery
218: t test ++n analyze; set targs= 0
219: u unit ++n analyze
220: v evaluate ++n
221: x execute ++n analyze
222:
223: ? special code for UNPARSED
224: C special code for comparison
225: D special code for DYAF
226: E special code for DYAPRD
227: G jumpto(l1)
228: H here(&l1)
229: I if (*Branch(t, n) != NilTree) jump2here(t)
230: J jump2here(t)
231: K hold(&st)
232: L let_go(&st)
233: M special code for MONF
234: N special code for MONPRD
235: R if (!reachable()) error("command cannot be reached")
236: S jumpto(Stop)
237: T special code for TAG
238: U special code for user-defined-command
239: V visit(t)
240: W visit2(t, seterr(1))
241: X visit(t) or lvisit(t) depending on flag
242: Y special code for YIELD/TEST
243: Z special code for refinement
244:
245: */
246:
247:
248: Visible string gentab[]= {
249:
250: /* HOW_TO */ "1h3xSu6=",
251: /* YIELD */ "2fV4xYu7=",
252: /* TEST */ "2fV4xYu7=",
253: /* REFINEMENT */ "H2xZSu",
254:
255: /* Commands */
256:
257: /* SUITE */ "#RVx3x",
258: /* PUT */ "vaV",
259: /* INSERT */ "vlV",
260: /* REMOVE */ "vlV",
261: /* CHOOSE */ "avV",
262: /* DRAW */ "aV",
263: /* SET_RANDOM */ "vV",
264: /* DELETE */ "lV",
265: /* CHECK */ "tV",
266: /* SHARE */ "g",
267:
268: /* WRITE */ "1vV",
269: /* READ */ "avV",
270: /* READ_RAW */ "aV",
271:
272: /* IF */ "tV2xJ",
273: /* WHILE */ "HtV2xGJ",
274: /* FOR */ "avHV3xGJ",
275:
276: /* SELECT */ "1x",
277: /* TEST_SUITE */ "#tW3xKIxL",
278: /* ELSE */ "#2x",
279:
280: /* QUIT */ "VS",
281: /* RETURN */ "vVS",
282: /* REPORT */ "tVS",
283: /* SUCCEED */ "VS",
284: /* FAIL */ "VS",
285:
286: /* USER_COMMAND */ "1mUV",
287: /* EXTENDED_COMMAND */ "1cV",
288:
289: /* Expressions, targets, tests */
290:
291: /* TAG */ "T",
292: /* COMPOUND */ "a",
293:
294: /* Expressions, targets */
295:
296: /* COLLATERAL */ "cX",
297: /* SELECTION */ "lvX",
298: /* BEHEAD */ "lvX",
299: /* CURTAIL */ "lvX",
300:
301: /* Expressions, tests */
302:
303: /* UNPARSED */ "?",
304:
305: /* Expressions */
306:
307: /* MONF */ "M1vV",
308: /* DYAF */ "Dv2vV",
309: /* NUMBER */ "V",
310: /* TEXT_DIS */ "1v",
311: /* TEXT_LIT */ "1vV",
312: /* TEXT_CONV */ "vvV",
313: /* ELT_DIS */ "V",
314: /* LIST_DIS */ "cV",
315: /* RANGE_DIS */ "vvV",
316: /* TAB_DIS */ "cV",
317:
318: /* Tests */
319:
320: /* AND */ "tVtJ",
321: /* OR */ "tVtJ",
322: /* NOT */ "tV",
323: /* SOME_IN */ "!vHVtGJ",
324: /* EACH_IN */ "!vHVtGJ",
325: /* NO_IN */ "!vHVtGJ",
326: /* SOME_PARSING */ "!vHVtGJ",
327: /* EACH_PARSING */ "!vHVtGJ",
328: /* NO_PARSING */ "!vHVtGJ",
329: /* MONPRD */ "N1vV",
330: /* DYAPRD */ "Ev2vV",
331: /* LESS_THAN */ "vvVC",
332: /* AT_MOST */ "vvVC",
333: /* GREATER_THAN */ "vvVC",
334: /* AT_LEAST */ "vvVC",
335: /* EQUAL */ "vvVC",
336: /* UNEQUAL */ "vvVC",
337: /* Nonode */ "",
338:
339: /* TAGformal */ "T",
340: /* TAGlocal */ "T",
341: /* TAGglobal */ "T",
342: /* TAGmystery */ "T",
343: /* TAGrefinement */ "T",
344: /* TAGzerfun */ "T",
345: /* TAGzerprd */ "T",
346:
347: /* ACTUAL */ "1mm",
348: /* FORMAL */ "1hh",
349: };
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.