1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21 e_v: proc(symb,coded_value,var,const,code,reloc);
22
23 dcl symb ptr,
24 coded_value fixed bin,
25 var ptr,
26 const fixed bin,
27 code fixed bin,
28 reloc bit(36) aligned;
29
30 dcl (cg_stat$cur_block,cg_stat$encoded_values,cg_stat$cur_statement,
31 cg_stat$ev_qual,cg_stat$last_encoded,cg_stat$text_base,
32 cg_stat$dummy_block,cg_stat$dummy_statement,cg_stat$first_ref,
33 cg_stat$next_ref) ptr ext,
34 cg_stat$in_thunk bit(1) ext,
35 (cg_stat$text_pos,cg_stat$cur_level) fixed bin(18) ext;
36
37 dcl (vp,cvp,ap,bp,rp,sp,qp,xp,s1,s2,p,arg(2)) ptr,
38 dl fixed bin(6),
39 (lab,atomic) aligned bit(1),
40 macro fixed bin(15),
41 delta fixed bin(18),
42 n fixed bin(18),
43 fb_18 fixed bin(18) based;
44
45 dcl compare_expression entry(ptr,ptr) returns(bit(1) aligned) reducible;
46 dcl (compile_exp,compile_statement) entry(ptr),
47 expmac entry(fixed bin(15),ptr),
48 expmac$zero entry(fixed bin(15)),
49 expmac$many entry(fixed bin(15),ptr,fixed bin),
50 load entry(ptr,fixed bin),
51 prepare_operand entry(ptr,fixed bin,bit(1) aligned) returns(ptr),
52 base_man$load_arg entry(fixed bin,ptr) returns(bit(3) aligned),
53 state_man$flush entry,
54 make_mod entry(fixed bin(17),fixed bin) returns(fixed bin(18)),
55 token_to_binary entry(ptr) reducible returns(fixed bin),
56 c_a entry(fixed bin,fixed bin) returns(ptr);
57
58 dcl fix_bin fixed bin based;
59
60 dcl (addr,addrel,bit,fixed,null,string) builtin;
61
62 dcl 1 value aligned based(cvp),
63 2 code unal bit(6),
64 2 n1 unal bit(6),
65 2 n2 unal bit(6),
66 2 offset unal bit(18);
67
68 dcl 1 lxl_ins aligned based,
69 2 stack_size unal bit(18),
70 2 rhs unal bit(18);
71
72 dcl ( adfx1 init(19),
73 load_pt_reg init(172),
74 end_ev_label init(322),
75 beg_ev_proc init(318),
76 end_ev_proc init(319)) fixed bin(15) int static;
77
78 %include pl1_tree_areas;
79 %include reference;
80 %include operator;
81 %include symbol;
82 %include block;
83 %include statement;
84 %include ev_node;
85 %include nodes;
86 %include op_codes;
87 %include boundary;
88 %include token;
89 %include token_types;
90 %include reloc_lower;
91
92
93
94 lab = "0"b;
95
96 start: cvp = addr(coded_value);
97 delta, coded_value = 0;
98 reloc = (36)"0"b;
99
100 s1 = var;
101 if s1 -> node.type = statement_node
102 then do;
103
104
105
106
107
108 s2 = s1;
109 do while(s2 -> statement.next ^= null);
110 s2 = s2 -> statement.next;
111 end;
112
113 vp = s2 -> statement.root;
114 s2 -> statement.root = null;
115 goto diff;
116 end;
117
118
119
120 s1 = null;
121 vp = var;
122
123 if vp -> node.type ^= operator_node then goto chk;
124
125 if vp -> op_code = bit_pointer
126 then do;
127 pf: value.code = "100011"b;
128 value.offset = bit(fixed(const + delta,18),18);
129 return;
130 end;
131
132 if vp -> op_code = add
133 then do;
134
135
136
137 xp = vp -> operand(3);
138 if xp -> node.type ^= reference_node then goto chk;
139
140 sp = xp -> reference.symbol;
141 if ^ sp -> symbol.constant then goto chk;
142
143 ap = vp -> operand(2);
144 if ap -> node.type ^= operator_node then goto chk;
145 if ap -> op_code ^= bit_pointer then goto chk;
146
147 delta = sp -> symbol.initial -> fb_18;
148 goto pf;
149 end;
150
151 if vp -> op_code = desc_size
152 then do;
153
154
155
156 xp = vp -> operand(2);
157 if xp -> node.type ^= reference_node then goto chk;
158
159 qp = xp -> reference.qualifier;
160 if qp = null
161 then do;
162
163
164
165 ap = xp -> reference.symbol;
166 if ^ ap -> symbol.arg_descriptor then goto chk;
167 if ^ ap -> symbol.controlled then goto chk;
168
169 value.code = "101101"b;
170
171 if ap -> symbol.internal then reloc = rc_a_is18;
172 else do;
173 value.n1 = "000001"b;
174 reloc = rc_a_lp18;
175 end;
176
177 vp = xp;
178 ap = ap -> symbol.descriptor;
179 goto l5;
180 end;
181
182 if qp -> node.type ^= operator_node then goto chk;
183 if qp -> op_code ^= param_desc_ptr then goto chk;
184
185 value.code = "101011"b;
186 value.n1 = bit(fixed(cg_stat$cur_level - qp -> operand(3) -> block.level,6),6);
187 value.n2 = bit(fixed(qp -> operand(2) -> reference.symbol -> symbol.initial -> fix_bin,6),6);
188 value.offset = bit(fixed(xp -> reference.c_offset,18),18);
189 return;
190 end;
191
192 goto hard;
193
194 chk: if const ^= 0 then goto hard;
195
196 if vp -> node.type = token_node
197 then if vp -> token.type = dec_integer
198 then do;
199 coded_value = token_to_binary(vp);
200 reloc = "0"b;
201 return;
202 end;
203
204
205
206
207 easy: if vp -> reference.units ^= 0
208 then if vp -> reference.units ^= word_
209 then goto hard;
210
211 if vp -> reference.offset ^= null then goto hard;
212
213 rp = vp -> reference.qualifier;
214 if rp ^= null then goto based;
215
216 ap = vp -> reference.symbol;
217
218 if vp -> reference.defined_ref then ap = ap -> symbol.initial;
219
220 if ap -> symbol.constant & ap -> symbol.internal
221 then do;
222 if ^ ap -> symbol.fixed then goto hard;
223 if ^ ap -> symbol.binary then goto hard;
224 if ^ ap -> symbol.real then goto hard;
225 if ap -> symbol.c_word_size ^= 1 then goto hard;
226
227 coded_value = ap -> symbol.initial -> fix_bin;
228 reloc = "0"b;
229 return;
230 end;
231
232 bp = ap -> symbol.block_node;
233 dl = cg_stat$cur_level - bp -> block.level;
234
235 if ap -> symbol.auto
236 then do;
237 if dl > 63 then goto hard;
238 value.n1 = bit(dl,6);
239 value.code = "100000"b;
240 l1: value.offset = bit(fixed(ap -> symbol.location + vp -> reference.c_offset,18),18);
241 value.n2 = "000000"b;
242 return;
243 end;
244
245 if ap -> symbol.parameter
246 then do;
247 if dl > 63 then goto hard;
248 if ap -> symbol.location > 63 then goto hard;
249
250 value.n1 = bit(dl,6);
251 value.n2 = bit(fixed(ap -> symbol.location,6),6);
252 value.offset = bit(fixed(vp -> reference.c_offset,18),18);
253 value.code = "101001"b;
254 return;
255 end;
256
257 if ap -> symbol.controlled
258 then do;
259 if ap -> symbol.arg_descriptor then value.code = "101110"b;
260 else value.code = "101111"b;
261
262 if ap -> symbol.internal then reloc = rc_a_is18;
263 else do;
264 value.n1 = "000001"b;
265 reloc = rc_a_lp18;
266 end;
267
268 goto l5;
269 end;
270
271 if ^ ap -> symbol.static then goto hard;
272
273 if ap -> symbol.internal
274 then do;
275 value.code = "100001"b;
276 reloc = rc_a_is18;
277 goto l1;
278 end;
279
280 value.code = "100010"b;
281 reloc = rc_a_lp18;
282
283
284
285 l5: if vp -> reference.c_offset < 0 then goto hard;
286 if vp -> reference.c_offset > 63 then goto hard;
287
288 value.n2 = bit(fixed(vp -> reference.c_offset,6),6);
289 value.offset = bit(fixed(ap -> symbol.location,18),18);
290
291 return;
292
293
294
295
296 based: if vp -> reference.c_offset < 0 then goto hard;
297 if vp -> reference.c_offset > 63 then goto hard;
298
299
300
301
302
303 if rp -> reference.qualifier = cg_stat$dummy_block -> block.context
304 then do;
305 value.code = "100111"b;
306 goto l3;
307 end;
308
309
310
311 if rp -> node.type = operator_node
312 then do;
313 if rp -> op_code = param_ptr then value.code = "101001"b;
314 else if rp -> op_code = param_desc_ptr then value.code = "101100"b;
315 else goto hard;
316
317 dl = cg_stat$cur_level - rp -> operand(3) -> block.level;
318 if dl > 63 then goto hard;
319
320 l4: value.n1 = bit(dl,6);
321 value.n2 = bit(fixed(rp -> operand(2) -> reference.symbol -> symbol.initial -> fix_bin,6),6);
322 value.offset = bit(fixed(vp -> reference.c_offset,18),18);
323 return;
324 end;
325
326
327
328 if rp -> reference.offset ^= null then goto hard;
329
330 ap = rp -> reference.qualifier;
331 if ap ^= null
332 then do;
333 if ap -> node.type ^= operator_node then goto hard;
334 if ap -> op_code ^= param_ptr then goto hard;
335 if rp -> reference.c_offset ^= 0 then goto hard;
336
337 dl = cg_stat$cur_level - ap -> operand(3) -> block.level;
338 if dl > 63 then goto hard;
339
340
341
342 value.code = "101010"b;
343 rp = ap;
344 goto l4;
345 end;
346
347 ap = rp -> reference.symbol;
348 bp = ap -> symbol.block_node;
349 dl = cg_stat$cur_level - bp -> block.level;
350
351 if ap -> symbol.auto
352 then do;
353 if dl > 63 then goto hard;
354 value.code = "100100"b;
355 value.n1 = bit(dl,6);
356
357 l2: value.offset = bit(fixed(ap -> symbol.location + rp -> reference.c_offset,18),18);
358 l3: value.n2 = bit(fixed(vp -> reference.c_offset,6),6);
359 return;
360 end;
361
362 if ^ ap -> symbol.static then goto hard;
363
364 if ap -> symbol.internal
365 then do;
366 value.code = "100101"b;
367 reloc = rc_a_is18;
368 goto l2;
369 end;
370
371
372
373 if rp -> reference.c_offset < 0 then goto hard;
374 if rp -> reference.c_offset > 63 then goto hard;
375
376 value.code = "100110"b;
377 reloc = rc_a_lp18;
378 value.n1 = bit(fixed(rp -> reference.c_offset,6),6);
379 value.offset = bit(fixed(ap -> symbol.location,18),18);
380 goto l3;
381
382
383
384
385
386
387 hard: p = cg_stat$encoded_values;
388 do while(p ^= null);
389
390 if p -> ev_node.block ^= cg_stat$cur_block then goto next;
391
392 if p -> ev_node.const ^= const then goto next;
393
394 if ^ compare_expression(p -> ev_node.exp,vp) then goto next;
395
396
397
398 allocate ev_equiv in(tree_area) set(xp);
399 xp -> ev_equiv.next = p -> ev_node.equiv;
400 p -> ev_node.equiv = xp;
401
402 if symb = null then xp -> ev_equiv.name = null;
403 else xp -> ev_equiv.name = symb -> symbol.token;
404 xp -> ev_equiv.code = code;
405
406 value.offset = bit(p -> ev_node.first,18);
407 goto hd;
408
409 next: p = p -> ev_node.next;
410 end;
411
412
413
414 diff: cg_stat$dummy_block -> block.father = cg_stat$cur_block;
415 bp, cg_stat$cur_block = cg_stat$dummy_block;
416 bp -> block.level, cg_stat$cur_level = cg_stat$cur_level + 1;
417 bp -> block.no_stack = "0"b;
418
419 call state_man$flush;
420
421 bp -> block.last_auto_loc = 64;
422
423 bp -> block.free_temps(1),
424 bp -> block.free_temps(2),
425 bp -> block.free_temps(3) = null;
426
427 value.offset = bit(cg_stat$text_pos,18);
428 ap = addrel(cg_stat$text_base,cg_stat$text_pos);
429
430 call expmac$zero((beg_ev_proc));
431
432 cg_stat$in_thunk = "1"b;
433 do while(s1 ^= null);
434 call compile_statement(s1);
435 s1 = s1 -> statement.next;
436 end;
437 cg_stat$in_thunk = "0"b;
438
439 cg_stat$cur_statement = cg_stat$dummy_statement;
440 if symb ^= null
441 then string(cg_stat$cur_statement -> statement.source_id) = string(symb -> symbol.source_id);
442
443 xp = prepare_operand(vp,1,atomic);
444
445 if lab
446 then do;
447 macro = end_ev_label;
448 call expmac((load_pt_reg),xp);
449 end;
450 else do;
451 macro = end_ev_proc;
452 if atomic then call load(xp,0);
453 else do;
454 cg_stat$cur_statement -> statement.root = vp;
455 call compile_exp(vp);
456 end;
457 end;
458
459 if const ^= 0 then call expmac((adfx1),c_a(const,2));
460
461 xp = c_a(4,4);
462 xp -> address.base = base_man$load_arg(0,bp);
463 xp -> address.tag = "010000"b;
464 call expmac(macro,xp);
465
466 ap -> lxl_ins.stack_size = bit(make_mod(bp -> block.last_auto_loc,16),18);
467
468 allocate ev_node in(tree_area) set(xp);
469 if cg_stat$encoded_values = null
470 then cg_stat$encoded_values = xp;
471 else cg_stat$last_encoded -> ev_node.next = xp;
472 cg_stat$last_encoded = xp;
473 xp -> ev_node.next = null;
474
475 if symb = null then xp -> ev_node.name = null;
476 else xp -> ev_node.name = symb -> symbol.token;
477
478 xp -> ev_node.exp = vp;
479 xp -> ev_node.equiv = null;
480 xp -> ev_node.const = const;
481 xp -> ev_node.code = code;
482 xp -> ev_node.first = fixed(value.offset,18);
483 xp -> ev_node.last = cg_stat$text_pos;
484
485 cg_stat$next_ref = cg_stat$first_ref;
486
487 cg_stat$cur_level = cg_stat$cur_level - 1;
488 xp -> ev_node.block, cg_stat$cur_block = bp -> block.father;
489
490 hd: value.code = "101000"b;
491 reloc = rc_a_t;
492
493 return;
494
495 e_v$l_v: entry(symb,coded_value,var,const,code,reloc);
496
497
498
499 lab = "1"b;
500 goto start;
501
502 end;