1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73 xr_man$load_any_var: proc(var,xr,base_offset);
74
75 dcl var ptr,
76 xr fixed bin,
77 base_offset fixed bin(18);
78
79 dcl cg_stat$last_index_used fixed bin ext,
80 (cg_stat$text_pos,cg_stat$last_call) fixed bin(18) ext,
81 (cg_stat$text_base,cg_stat$cur_statement) ptr ext,
82 macro_table_$eax_array(0:15) fixed bin(15) ext static;
83
84 dcl (p,vp) ptr,
85 c fixed bin(18),
86 sta_code bit(9) int static init("111101101"b),
87 stq_code bit(9) int static init("111101110"b),
88 staq_code bit(9) int static init("111101111"b),
89 (i,j,k,type) fixed bin,
90 lock bit(1) aligned init("0"b),
91 expmac entry(fixed bin(15),ptr),
92 c_a entry(fixed bin(18),fixed bin) returns(ptr),
93 get_single_ref entry(ptr) returns(ptr),
94 stack_temp$free_temp entry(ptr),
95 adjust_ref_count entry(ptr,fixed bin),
96 m_a entry(ptr,bit(2) aligned),
97 error entry(fixed bin,ptr,ptr);
98
99 dcl (abs,addrel,bit,fixed,min,mod,null,ptr,rel,string,substr) builtin;
100
101 dcl word fixed bin based(p);
102
103 dcl full_word bit(36) aligned based(p);
104
105 dcl 1 instruction aligned based(p),
106 2 offset unal bit(18),
107 2 op_code unal bit(9),
108 2 rest unal bit(9);
109
110 dcl ( first_index init(2),
111 last_index init(7)) fixed bin int static;
112
113 dcl zero_mac init(308) fixed bin(15) int static;
114
115 %include cgsystem;
116 %include data_types;
117 %include boundary;
118 %include machine_state;
119 %include reference;
120 %include temporary;
121 %include symbol;
122 %include operator;
123 %include nodes;
124 %include "645op5";
125
126
127
128 join: vp = var;
129
130 j,k = -1;
131
132 do i = first_index to last_index;
133 type = abs(index_regs(i).type);
134 if type = 0 then k = i;
135 else if type >= 2
136 then if index_regs(i).variable = vp
137 then do;
138 j = i;
139 if index_regs(i).constant = base_offset then goto set_i_dec;
140 end;
141 end;
142
143
144
145 call when_to_m_a;
146 call get_free_index;
147 c = base_offset;
148 call load_xr_v(k);
149
150 ret_k: xr = k;
151 if lock
152 then index_regs(xr).type = -abs(index_regs(xr).type);
153 return;
154
155 set_i_dec:
156 if ^ vp -> reference.shared then call adjust_ref_count(vp,-1);
157
158 set_i: index_regs(i).used = cg_stat$text_pos;
159
160 xr = i;
161 if lock
162 then index_regs(xr).type = -abs(index_regs(xr).type);
163 return;
164
165 xr_man$load_any_const: entry(const,xr);
166
167 dcl const fixed bin(18);
168
169 k = -1;
170 do i = first_index to last_index;
171 type = abs(index_regs(i).type);
172 if type = 0 then k = i;
173 else if type = 1
174 then if index_regs(i).constant = const then goto set_i;
175 end;
176
177
178
179
180 call get_free_index;
181 call load_xr_c(k);
182 goto ret_k;
183
184 xr_man$load_var: entry(var,xr);
185
186 i = xr;
187
188 vp = var;
189
190 if index_regs(i).type < 2 then goto lv;
191 if index_regs(i).variable ^= vp then goto lv;
192 if index_regs(i).constant = 0
193 then do;
194 if ^ vp -> reference.shared
195 then call adjust_ref_count(vp,-1);
196 goto lc_used;
197 end;
198
199 lv: c = 0;
200 j,k = -1;
201 cg_stat$last_index_used = i;
202 call when_to_m_a;
203 call load_xr_v(xr);
204 return;
205
206 xr_man$load_const: entry(const,xr);
207
208 i = xr;
209 if index_regs(i).type ^= 1 then goto lc;
210
211 if index_regs(i).constant = const
212 then do;
213 lc_used: index_regs(i).used = cg_stat$text_pos;
214 return;
215 end;
216
217 lc: call load_xr_c(xr);
218 cg_stat$last_index_used = i;
219 return;
220
221
222 xr_man$lock: entry(var,xr);
223
224 i = xr;
225 var -> reference.value_in.x(i) = "1"b;
226 index_regs(i).variable = var;
227 index_regs(i).type = 3;
228 return;
229
230 xr_man$unlock: entry(ix);
231
232 dcl ix fixed bin;
233
234 index_regs(ix).type = 2;
235 return;
236
237
238 xr_man$super_lock: entry(ix);
239
240 index_regs(ix).type = -abs(index_regs(ix).type);
241 return;
242
243
244 xr_man$super_unlock: entry(ix);
245
246 index_regs(ix).type = abs(index_regs(ix).type);
247 return;
248
249
250 xr_man$add_any_const: entry(const,xr,old_xr);
251
252 dcl old_xr fixed bin;
253
254 j = old_xr;
255 c = index_regs(j).constant + const;
256
257 if index_regs(j).type >= 2
258 then do;
259 vp = index_regs(j).variable;
260
261 if ^ vp -> reference.shared
262 then vp -> reference.ref_count = vp -> reference.ref_count + 1;
263
264 call xr_man$load_any_var(vp,xr,c);
265
266 end;
267 else call xr_man$load_any_const(c,xr);
268
269 return;
270
271
272 xr_man$load_any_var_and_lock: entry(var,xr,base_offset);
273
274 lock = "1"b;
275 go to join;
276
277
278 xr_man$update_xr: entry(var,xr);
279
280 vp = var;
281 i = xr;
282
283 call flush_old(i);
284
285 vp -> reference.value_in.x(i) = "1"b;
286 index_regs(i).type = 2;
287 index_regs(i).variable = vp;
288 index_regs(i).constant = 0;
289 index_regs(i).used = cg_stat$text_pos;
290 return;
291
292
293
294
295 when_to_m_a: proc;
296 dcl p ptr;
297
298
299
300
301 if j >= 0 then return;
302 if vp->reference.value_in.a then return;
303 if vp->reference.value_in.q then return;
304 if string(vp->reference.value_in.x) then return;
305 if ^ vp -> reference.no_address
306 then if vp -> reference.perm_address
307 then return;
308
309 do p = vp->reference.offset repeat p->reference.offset while (p ^= null);
310 if p->node.type = operator_node
311 then p = p->operand(1);
312 if p->reference.ref_count > 1
313 | p -> reference.temp_ref & string(p -> reference.value_in.x) = "0"b
314 then do;
315 call m_a(vp,"0"b);
316 vp->reference.perm_address = "1"b;
317 if k >= 0
318 then if index_regs(k).type ^= 0
319 then do;
320 k = -1;
321 do i = first_index to last_index;
322 if index_regs(i).type = 0
323 then k = i;
324 end;
325 end;
326 return;
327 end;
328 end;
329 end;
330
331
332
333
334 get_free_index: proc;
335
336
337
338
339
340
341
342
343 dcl (i,j,cmin,ignore,n,type) fixed bin,
344 p ptr;
345
346 note
347
348 if k >= 0
349 then do;
350 cg_stat$last_index_used = k;
351 return;
352 end;
353
354 ignore = 3;
355
356 look: j = -1;
357 cmin = 123456;
358
359 do i = cg_stat$last_index_used + 1 to last_index, first_index to min(cg_stat$last_index_used,last_index);
360
361 type = index_regs(i).type;
362
363 if type >= 0 & type ^= ignore
364 then do;
365
366 if type = 0 | type = 1
367 then do;
368 k, cg_stat$last_index_used = i;
369 return;
370 end;
371
372 p = index_regs(i).variable;
373
374 if p -> reference.shared
375 then if p -> reference.temp_ref
376 then n = 0;
377 else n = 1;
378 else n = p -> reference.ref_count;
379
380 if n = 0
381 then do;
382 k, cg_stat$last_index_used = i;
383 return;
384 end;
385
386 if n < cmin
387 then do;
388 j = i;
389 cmin = n;
390 end;
391 else if n = cmin
392 then if index_regs(i).used < index_regs(j).used
393 then do;
394 j = i;
395 cmin = n;
396 end;
397 end;
398
399 end;
400
401 if j >= 0
402 then do;
403 k, cg_stat$last_index_used = j;
404 return;
405 end;
406
407
408
409 if ignore = 3
410 then do;
411 ignore = 2;
412 goto look;
413 end;
414
415 call error(328,cg_stat$cur_statement,vp);
416 k = 1;
417 end;
418
419
420 load_xr_v: proc(xr);
421
422 dcl xr fixed bin;
423
424 dcl (p,q,old_p,text_pt) ptr,
425 x fixed bin,
426 b18 bit(18),
427 (n,text_pos,c1,i) fixed bin(18),
428 op_code bit(9) aligned;
429
430 x = xr;
431 p, q = vp;
432
433 c1 = c;
434 if c1 < 0 then c1 = c1 + 262144;
435
436 if p -> reference.value_in.q
437 then do;
438 n = 0;
439 goto l2;
440 end;
441
442 if p -> reference.value_in.a
443 then if p -> reference.aligned_ref | a_reg.offset = 0 | a_reg.offset = 18
444 then do;
445 if ^ p -> reference.aligned_ref & a_reg.offset = 0
446 then n = 16;
447 else n = 8;
448 l2:
449 call flush_old(x);
450
451 text_pos = cg_stat$text_pos;
452 cg_stat$text_pos = cg_stat$text_pos + 1;
453 goto l3;
454 end;
455
456 if j >= 0
457 then do;
458
459
460
461
462
463 call flush_old(x);
464
465 old_p = c_a((j),8);
466 c1 = c - index_regs(j).constant;
467 if c1 < 0 then c1 = c1 + 262144;
468 substr(string(old_p -> reference.address),1,18) = bit(c1,18);
469 call expmac(eax0+x,old_p);
470 if ^p -> reference.shared
471 then call adjust_ref_count(p,-1);
472 goto l4;
473 end;
474
475 if p -> reference.value_in.storage then goto test;
476
477 if ^ p -> reference.temp_ref then goto gen_lxl;
478
479 if p -> reference.aggregate then goto gen_lxl;
480
481 call error(315,cg_stat$cur_statement,p);
482
483 test: if p -> reference.symbol -> symbol.c_dcl_size >= bits_per_half then goto gen_lxl;
484
485 text_pos = fixed(p -> reference.store_ins,18);
486 if text_pos < cg_stat$last_call then goto gen_lxl;
487
488 if c ^= 0
489 then if ^ p -> reference.dont_save
490 then go to gen_lxl;
491
492 if index_regs(x).used >= text_pos
493 then do;
494 gen_lxl: if p -> reference.data_type = real_fix_bin_2
495 then q = get_single_ref(p);
496
497 n = lxl0;
498 if ^ p -> reference.aligned_ref
499 then if p -> reference.units = word_
500 then n = ldx0;
501
502 if ^ q -> reference.perm_address
503 then do;
504 call m_a(q,"00"b);
505 q -> reference.perm_address = "1"b;
506 end;
507
508 call flush_old(x);
509
510 call expmac(n+x,q);
511 if c ^= 0
512 then do;
513 old_p = c_a(c,1);
514 old_p -> reference.tag = "001"b || bit(fixed(x,3),3);
515 call expmac(eax0+x,old_p);
516 end;
517 end;
518
519 else do;
520
521
522
523
524
525
526 text_pt = addrel(cg_stat$text_base,text_pos);
527 op_code = text_pt -> instruction.op_code;
528
529 if op_code = sta_code then n = 8;
530 else if op_code = stq_code then n = 0;
531 else if op_code = staq_code then n = 0;
532 else goto gen_lxl;
533
534
535
536
537
538
539
540
541
542
543
544 b18 = "110"b || bit(fixed(mod(p -> reference.qualifier -> temporary.location,16384),15),15);
545 do i = text_pos + 1 to cg_stat$text_pos - 1;
546 if b18 = addrel(cg_stat$text_base,i) -> instruction.offset then goto gen_lxl;
547 end;
548
549 call flush_old(x);
550
551 call stack_temp$free_temp(p);
552 p -> reference.allocated = "0"b;
553 p -> reference.store_ins = "0"b;
554 p -> reference.value_in.storage = "0"b;
555
556 l3: index_regs(x).changed = text_pos;
557 text_pt = addrel(cg_stat$text_base,text_pos);
558
559 text_pt -> word = macro_table_$eax_array(n+x);
560
561 if c ^= 0
562 then do;
563 if c > 0
564 then c1 = c;
565 else c1 = c + 262144;
566 text_pt -> instruction.offset = bit(c1,18);
567 end;
568
569 index_regs(x).instruction = text_pt -> full_word;
570
571 if ^p -> reference.shared
572 then call adjust_ref_count(p,-1);
573 end;
574
575 l4:
576 index_regs(x).variable = p;
577 if c = 0
578 then p -> reference.value_in.x(x) = "1"b;
579
580 if p -> reference.symbol ^= null then p -> reference.perm_address = "0"b;
581
582 index_regs(x).type = 2;
583 index_regs(x).constant = c;
584 index_regs(x).used = cg_stat$text_pos;
585 end;
586
587
588
589
590 load_xr_c: proc(xr);
591
592 dcl (x,xr) fixed bin;
593
594 x = xr;
595
596 call flush_old(x);
597
598 index_regs(x).used = cg_stat$text_pos;
599 call expmac(lxl0+x,c_a(const,2));
600 index_regs(x).type = 1;
601 index_regs(x).constant = const;
602 end;
603
604
605
606 flush_old: proc(xr);
607
608 dcl (xr,x) fixed bin;
609 dcl old_p pointer;
610 dcl macro fixed bin(15);
611
612 x = xr;
613
614 if index_regs(x).type < 2
615 then return;
616
617
618
619
620 old_p = index_regs(x).variable;
621 old_p -> reference.value_in.x(x) = "0"b;
622
623 if ^ old_p -> reference.temp_ref
624 | old_p -> reference.value_in.storage
625 | index_regs(x).constant ^= 0
626 then return;
627
628 if old_p -> reference.ref_count > 0
629 then do;
630 if old_p -> reference.symbol -> symbol.c_dcl_size >= bits_per_half
631 then do;
632 old_p -> reference.ref_count = old_p -> reference.ref_count + 2;
633 call expmac((zero_mac),old_p);
634 macro = sxl0 + x;
635 end;
636
637 else do;
638 old_p -> reference.ref_count = old_p -> reference.ref_count + 1;
639
640
641
642
643 old_p -> reference.aligned_ref = "0"b;
644 old_p -> reference.c_offset = 0;
645 old_p -> reference.c_length = bits_per_half;
646 old_p -> reference.units = word_;
647
648
649
650
651
652
653
654
655 old_p -> reference.dont_save = "1"b;
656 macro = stx0 + x;
657 end;
658
659 call expmac(macro,old_p);
660 old_p -> reference.value_in.storage = "1"b;
661
662 index_regs(x).used = cg_stat$text_pos;
663 end;
664 end;
665
666
667 end;