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 state_man$create_ms: proc (pt);
51
52 dcl pt ptr;
53
54 dcl (p, q) ptr,
55 sym ptr auto unal,
56 (erase, b19) bit (19) aligned,
57 (prev_state, found) bit (1) aligned,
58 text_pos fixed bin (18),
59 (i, j, n) fixed bin;
60
61 dcl (cg_stat$ms_list, cg_stat$m_s_p) ptr ext,
62 (cg_stat$text_pos, cg_stat$last_call) fixed bin (18) ext,
63 pl1_stat_$node_uses (18) fixed bin external static;
64
65 dcl c_a entry (fixed bin (18), fixed bin) returns (ptr),
66 expmac entry (fixed bin (15), ptr),
67 expmac$one entry (fixed bin (15), ptr, fixed bin (15)),
68 expmac$one_eis entry (fixed bin (15), ptr),
69 stack_temp$assign_block entry (ptr, fixed bin);
70
71 dcl (abs, bin, bit, fixed, index, min, mod, null, string, substr) builtin;
72
73 %include pl1_tree_areas;
74 %include cgsystem;
75 %include machine_state;
76 %include reference;
77 %include symbol;
78 %include operator;
79 %include list;
80 %include statement;
81 %include block;
82 %include nodes;
83 %include data_types;
84 %include boundary;
85 %include temporary;
86
87 call get_ms;
88 pt = m_s_p;
89
90 init: machine_state.next,
91 string_reg.variable,
92 complex_reg.variable,
93 decimal_reg.variable = null;
94
95 do i = 0 to 7;
96 index_regs (i).type = 0;
97 base_regs (i).type = 0;
98 base_regs (i).locked = 0;
99 end;
100
101 init1: machine_state.indicators,
102 a_reg.constant,
103 q_reg.constant,
104 a_reg.number_h_o,
105 q_reg.number_h_o,
106 a_reg.number,
107 q_reg.number,
108 a_reg.changed,
109 q_reg.changed = 0;
110
111 a_reg.locked,
112 q_reg.locked,
113 a_reg.instruction,
114 q_reg.instruction = "0"b;
115
116 cg_stat$last_call = cg_stat$text_pos;
117
118 return;
119
120 state_man$save_ms: entry (pt, cond);
121
122
123
124
125 dcl cond bit (1) aligned;
126
127 dcl (conditional, optimize) bit (1) aligned;
128
129 p = pt;
130 optimize = ^p -> statement.save_temps;
131
132 conditional = cond;
133
134 if conditional
135 then do;
136 call get_ms;
137 m_s_p -> machine_state = cg_stat$m_s_p -> machine_state;
138 end;
139
140 machine_state.next = p -> statement.state_list;
141 p -> statement.state_list = m_s_p;
142 p -> statement.reference_count = p -> statement.reference_count - 1;
143
144 q = p -> statement.reference_list;
145
146
147
148
149
150
151 do i = 1 to a_reg.number;
152 p = a_reg.variable (i);
153 if need_ref () then call save_temp (1);
154 if ^conditional then p -> reference.value_in.a = "0"b;
155 end;
156
157 do i = 1 to q_reg.number;
158 p = q_reg.variable (i);
159 if need_ref () then call save_temp (2);
160 if ^conditional then p -> reference.value_in.q = "0"b;
161 end;
162
163 do i = 0 to 7;
164 if index_regs (i).type >= 2
165 then do;
166 p = index_regs (i).variable;
167 if p ^= null
168 then do;
169 if need_ref () then call save_temp (0);
170 if ^conditional then p -> reference.value_in.x (i) = "0"b;
171 end;
172 end;
173 end;
174
175 do i = 1 to 6;
176 p = base_regs (i).variable;
177 n = base_regs (i).type;
178 if p = null then n = 0;
179 if n = 1
180 then do;
181 if need_ref () then call save_temp (-i);
182 if ^conditional then p -> reference.value_in.b (i) = "0"b;
183 end;
184 else if n = 2
185 then if ^conditional then p -> reference.address_in.b (i) = "0"b;
186 end;
187
188 if ^conditional
189 then do;
190
191 p = complex_reg.variable;
192 if p ^= null then p -> reference.value_in.complex_aq = "0"b;
193
194 p = string_reg.variable;
195 if p ^= null then p -> reference.value_in.string_aq = "0"b;
196
197 p = decimal_reg.variable;
198 if p ^= null then p -> reference.value_in.decimal_aq = "0"b;
199
200 cg_stat$m_s_p = null;
201 end;
202
203 cg_stat$last_call = cg_stat$text_pos;
204
205 return;
206
207 state_man$save_regs: entry (pt);
208
209
210
211
212
213
214
215
216 p = pt;
217 optimize = ^p -> statement.save_temps;
218 q = p -> statement.reference_list;
219
220 do i = 1 to a_reg.number;
221 p = a_reg.variable (i);
222 if need_ref () then call save_temp (1);
223 end;
224
225 do i = 1 to q_reg.number;
226 p = q_reg.variable (i);
227 if need_ref () then call save_temp (2);
228 end;
229
230 do i = 0 to 7;
231 if index_regs (i).type >= 2
232 then do;
233 p = index_regs (i).variable;
234 if p ^= null then if need_ref () then call save_temp (0);
235 end;
236 end;
237
238 do i = 1 to 6;
239 p = base_regs (i).variable;
240 if p ^= null then
241 if base_regs (i).type = 1 then
242 if need_ref () then call save_temp (-i);
243 end;
244
245 return;
246
247 state_man$merge_ms: entry (pt);
248
249
250
251
252 if pt -> statement.reference_count = 0
253 then erase = "0"b;
254 else erase = (19)"1"b;
255
256 p = pt -> statement.state_list;
257
258 if m_s_p = null
259 then do;
260
261
262
263 if p = null
264 then do;
265 call get_ms;
266 cg_stat$m_s_p = m_s_p;
267 goto init;
268 end;
269
270 m_s_p, cg_stat$m_s_p = p;
271 p = machine_state.next;
272 prev_state = "0"b;
273 end;
274
275 else prev_state = "1"b;
276
277 if erase
278 then machine_state.indicators = 0;
279
280 do while (p ^= null);
281
282 if machine_state.indicators ^= p -> machine_state.indicators
283 then machine_state.indicators = 0;
284 else if machine_state.indicators = -2
285 then if indicators_ref (2) ^= p -> indicators_ref (2)
286 then machine_state.indicators = 0;
287 else if indicators_ref (3) ^= p -> indicators_ref (3)
288 then machine_state.indicators = 0;
289
290 if substr (erase, 1, 1) then goto scrub_a;
291
292 if a_reg.size ^= p -> a_reg.size
293 then do;
294 erase_a: substr (erase, 1, 1) = "1"b;
295
296 scrub_a: do j = 1 to p -> a_reg.number;
297 q = p -> a_reg.variable (j);
298 if q ^= null then q -> reference.value_in.a = "0"b;
299 end;
300
301
302 goto chk_q;
303 end;
304
305 if a_reg.length ^= p -> a_reg.length then goto erase_a;
306 if a_reg.offset ^= p -> a_reg.offset then goto erase_a;
307 if a_reg.constant ^= p -> a_reg.constant then goto erase_a;
308
309 n = a_reg.number;
310 do i = 1 by 1 while (i <= n);
311
312 scan_a: q = a_reg.variable (i);
313
314 do j = 1 to p -> a_reg.number;
315 if q = p -> a_reg.variable (j)
316 then do;
317 p -> a_reg.variable (j) = null;
318 goto ok_a;
319 end;
320 end;
321
322 q -> reference.value_in.a = "0"b;
323
324 n = n - 1;
325 if n = 0 then goto erase_a;
326 if n < i then goto end_a;
327
328 do j = i to n;
329 a_reg.variable (j) = a_reg.variable (j + 1);
330 end;
331
332 goto scan_a;
333
334 ok_a: end;
335
336 end_a: a_reg.number = n;
337
338 chk_q: if substr (erase, 2, 1) then goto scrub_q;
339
340 if q_reg.size ^= p -> q_reg.size
341 then do;
342 erase_q: substr (erase, 2, 1) = "1"b;
343
344 scrub_q: do j = 1 to p -> q_reg.number;
345 q = p -> q_reg.variable (j);
346 if q ^= null then q -> reference.value_in.q = "0"b;
347 end;
348 goto chk_sr;
349 end;
350
351 if q_reg.length ^= p -> q_reg.length then goto erase_q;
352 if q_reg.offset ^= p -> q_reg.offset then goto erase_q;
353 if q_reg.constant ^= p -> q_reg.constant then goto erase_q;
354
355 n = q_reg.number;
356 do i = 1 by 1 while (i <= n);
357
358 scan_q: q = q_reg.variable (i);
359
360 do j = 1 to p -> q_reg.number;
361 if q = p -> q_reg.variable (j)
362 then do;
363 p -> q_reg.variable (j) = null;
364 goto ok_q;
365 end;
366 end;
367
368 q -> reference.value_in.q = "0"b;
369
370 n = n - 1;
371 if n = 0 then goto erase_q;
372 if n < i then goto end_q;
373
374 do j = i to n;
375 q_reg.variable (j) = q_reg.variable (j + 1);
376 end;
377
378 goto scan_q;
379
380 ok_q: end;
381
382 end_q: q_reg.number = n;
383
384 chk_sr: if substr (erase, 3, 1) then goto scrub_sr;
385
386 if string_reg.size ^= p -> string_reg.size
387 then do;
388 erase_sr: substr (erase, 3, 1) = "1"b;
389
390 scrub_sr: q = p -> string_reg.variable;
391 if q ^= null then q -> reference.value_in.string_aq = "0"b;
392 goto chk_cx;
393 end;
394
395 if string_reg.variable ^= p -> string_reg.variable then goto erase_sr;
396
397 chk_cx: if substr (erase, 4, 1) then goto scrub_cx;
398
399 if complex_reg.size ^= p -> complex_reg.size
400 then do;
401 erase_cx: substr (erase, 4, 1) = "1"b;
402
403 scrub_cx: q = p -> complex_reg.variable;
404 if q ^= null then q -> reference.value_in.complex_aq = "0"b;
405 goto chk_d;
406 end;
407
408 if complex_reg.scale ^= p -> complex_reg.scale then goto erase_cx;
409 if complex_reg.variable ^= p -> complex_reg.variable then goto erase_cx;
410
411 chk_d: if substr (erase, 5, 1) then goto scrub_d;
412
413 if decimal_reg.size ^= p -> decimal_reg.size
414 then do;
415 erase_d: substr (erase, 5, 1) = "1"b;
416
417 scrub_d: q = p -> decimal_reg.variable;
418 if q ^= null then q -> reference.value_in.decimal_aq = "0"b;
419 goto chk_xr;
420 end;
421
422 if decimal_reg.scale ^= p -> decimal_reg.scale then goto erase_d;
423 if decimal_reg.variable ^= p -> decimal_reg.variable then goto erase_d;
424
425 chk_xr: do i = 0 to 7;
426
427 if substr (erase, i + 6, 1) then goto scrub_xr;
428
429 n = index_regs (i).type;
430 if n ^= p -> index_regs (i).type
431 then do;
432 erase_xr: substr (erase, i + 6, 1) = "1"b;
433
434 scrub_xr: if p -> index_regs (i).type >= 2
435 then do;
436 q = p -> index_regs (i).variable;
437 if q ^= null then q -> reference.value_in.x (i) = "0"b;
438 end;
439
440 goto end_xr;
441 end;
442
443 if n >= 2
444 then if index_regs (i).variable ^= p -> index_regs (i).variable
445 then goto erase_xr;
446
447 if index_regs (i).constant ^= p -> index_regs (i).constant then goto erase_xr;
448
449 end_xr: end;
450
451 chk_base: do i = 1 to 6;
452
453 if substr (erase, i + 13, 1) then goto scrub_base;
454
455 n = base_regs (i).type;
456 if n ^= p -> base_regs (i).type
457 then do;
458 erase_base: substr (erase, i + 13, 1) = "1"b;
459
460 scrub_base: q = p -> base_regs (i).variable;
461
462 n = p -> base_regs (i).type;
463 if q = null then n = 0;
464 if n = 1 then q -> reference.value_in.b (i) = "0"b;
465 else if n = 2 then q -> reference.address_in.b (i) = "0"b;
466
467 goto end_base;
468 end;
469
470 if n = 0 then goto end_base;
471
472 if substr ("11000110110000"b, n, 1)
473 then if base_regs (i).variable ^= p -> base_regs (i).variable
474 then goto erase_base;
475
476 if substr ("00110001111101"b, n, 1)
477 then if base_regs (i).constant ^= p -> base_regs (i).constant
478 then goto erase_base;
479
480 end_base: end;
481
482 q = p;
483 p = p -> machine_state.next;
484
485 q -> machine_state.next = cg_stat$ms_list;
486 cg_stat$ms_list = q;
487 end;
488
489 if erase
490 then call wipe;
491
492 if prev_state | (^erase = "0"b) then return;
493
494 if a_reg.constant = 0
495 then do i = 1 to a_reg.number;
496 a_reg (i).variable -> reference.value_in.a = "1"b;
497 end;
498
499 if q_reg.constant = 0
500 then do i = 1 to q_reg.number;
501 q_reg (i).variable -> reference.value_in.q = "1"b;
502 end;
503
504 q = string_reg.variable;
505 if q ^= null then q -> reference.value_in.string_aq = "1"b;
506
507 q = complex_reg.variable;
508 if q ^= null then q -> reference.value_in.complex_aq = "1"b;
509
510 q = decimal_reg.variable;
511 if q ^= null then q -> reference.value_in.decimal_aq = "1"b;
512
513 do i = 0 to 7;
514 if index_regs (i).type >= 2
515 then if index_regs (i).constant = 0
516 then do;
517 q = index_regs (i).variable;
518 if q ^= null then q -> reference.value_in.x (i) = "1"b;
519 end;
520 end;
521
522 do i = 1 to 6;
523 q = base_regs (i).variable;
524 n = base_regs (i).type;
525 if q = null then n = 0;
526 if n = 1 then q -> reference.value_in.b (i) = "1"b;
527 else if n = 2 then q -> reference.address_in.b (i) = "1"b;
528 end;
529
530 return;
531
532 state_man$discard_ms: entry;
533
534
535
536
537 machine_state.next = cg_stat$ms_list;
538 cg_stat$ms_list = m_s_p;
539 cg_stat$m_s_p = null;
540
541
542
543 state_man$flush: entry;
544
545
546
547 machine_state.indicators = 0;
548
549
550
551 erase = ("1111100000000111111"b);
552 call wipe;
553
554
555
556 erase = (19)"1"b;
557 call wipe;
558
559 cg_stat$last_call = cg_stat$text_pos;
560 return;
561
562 state_man$flush_ref: entry (pt);
563
564
565
566
567 p = pt;
568
569 if machine_state.indicators = -2
570 then if p = indicators_ref (2)
571 then machine_state.indicators = 0;
572 else if p = indicators_ref (3)
573 then machine_state.indicators = 0;
574
575
576
577
578 n = a_reg.number;
579 do i = 1 to n;
580 if a_reg.variable (i) = p
581 then do;
582 a_reg.number = n - 1;
583
584 do i = i + 1 to n;
585 a_reg.variable (i - 1) = a_reg.variable (i);
586 end;
587
588 goto frq;
589 end;
590 end;
591
592 frq: n = q_reg.number;
593 do i = 1 to n;
594 if q_reg.variable (i) = p
595 then do;
596 q_reg.number = n - 1;
597
598 do i = i + 1 to n;
599 q_reg.variable (i - 1) = q_reg.variable (i);
600 end;
601
602 goto frsr;
603 end;
604 end;
605
606 frsr: if string_reg.variable = p then string_reg.variable = null;
607
608 if complex_reg.variable = p then complex_reg.variable = null;
609
610 if decimal_reg.variable = p then decimal_reg.variable = null;
611
612 do i = 0 to 7;
613 n = index_regs (i).type;
614 if abs (n) >= 2
615 then if index_regs (i).variable = p
616 then do;
617 index_regs (i).type = min (0, n);
618 index_regs (i).variable = null;
619 end;
620 end;
621
622 do i = 1 to 6;
623 if base_regs (i).type = 1
624 then if base_regs (i).variable = p
625 then base_regs (i).type = 0;
626 end;
627
628 string (p -> reference.value_in) = "0"b;
629 return;
630
631 state_man$flush_address: entry (pt);
632
633
634
635
636 p = pt;
637
638 do i = 1 to 6;
639 if base_regs (i).type = 2
640 then if base_regs (i).variable = p
641 then base_regs (i).type = 0;
642 end;
643
644 string (p -> reference.address_in.b) = "0"b;
645 return;
646
647 state_man$flush_sym: entry (pt);
648
649
650
651
652
653
654 sym = pt;
655
656 if machine_state.indicators = -2
657 then if sym = indicators_ref (2) -> reference.symbol
658 then machine_state.indicators = 0;
659 else if sym = indicators_ref (3) -> reference.symbol
660 then machine_state.indicators = 0;
661
662 i = 1;
663 do while (i <= a_reg.number);
664 if sym = a_reg.variable (i) -> reference.symbol
665 then do;
666 a_reg.variable (i) -> reference.value_in.a = "0"b;
667 a_reg.number = a_reg.number - 1;
668 do j = i to a_reg.number;
669 a_reg.variable (j) = a_reg.variable (j + 1);
670 end;
671 end;
672 else i = i + 1;
673 end;
674
675 i = 1;
676 do while (i <= q_reg.number);
677 if sym = q_reg.variable (i) -> reference.symbol
678 then do;
679 q_reg.variable (i) -> reference.value_in.q = "0"b;
680 q_reg.number = q_reg.number - 1;
681 do j = i to q_reg.number;
682 q_reg.variable (j) = q_reg.variable (j + 1);
683 end;
684 end;
685 else i = i + 1;
686 end;
687
688 if string_reg.variable ^= null
689 then if sym = string_reg.variable -> reference.symbol
690 then do;
691 string_reg.variable -> reference.value_in.string_aq = "0"b;
692 string_reg.variable = null;
693 end;
694
695 if complex_reg.variable ^= null
696 then if sym = complex_reg.variable -> reference.symbol
697 then do;
698 complex_reg.variable -> reference.value_in.complex_aq = "0"b;
699 complex_reg.variable = null;
700 end;
701
702 if decimal_reg.variable ^= null
703 then if sym = decimal_reg.variable -> reference.symbol
704 then do;
705 decimal_reg.variable -> reference.value_in.decimal_aq = "0"b;
706 decimal_reg.variable = null;
707 end;
708
709 do i = 0 to 7;
710 if abs (index_regs (i).type) >= 2
711 then do;
712 q = index_regs (i).variable;
713 if sym = q -> reference.symbol
714 then do;
715 q -> reference.value_in.x (i) = "0"b;
716 index_regs (i).type = 0;
717 end;
718 end;
719 end;
720
721 do i = 1 to 6;
722 if base_regs (i).type = 1
723 then do;
724 q = base_regs (i).variable;
725 if sym = q -> reference.symbol
726 then do;
727 q -> reference.value_in.b (i) = "0"b;
728 base_regs (i).type = 0;
729 end;
730 end;
731 end;
732
733 return;
734
735 state_man$update_ref: entry (pt);
736
737
738
739 p = pt;
740 if p -> reference.data_type <= real_flt_bin_2 then goto up_q;
741
742 if p -> reference.data_type <= complex_flt_bin_2
743 then do;
744
745
746
747 q = complex_reg.variable;
748 if q ^= null then q -> reference.value_in.complex_aq = "0"b;
749
750 complex_reg.variable = p;
751 p -> reference.value_in.complex_aq = "1"b;
752
753 return;
754 end;
755
756 if p -> reference.long_ref
757 then do;
758
759
760
761 q = string_reg.variable;
762 if q ^= null then q -> reference.value_in.string_aq = "0"b;
763
764 string_reg.variable = p;
765 string_reg.size = p -> reference.c_length;
766 p -> reference.value_in.string_aq = "1"b;
767
768 p -> reference.address_in.storage = "1"b;
769
770 return;
771 end;
772
773
774
775 up_a: do i = 1 to a_reg.number;
776 a_reg.variable (i) -> reference.value_in.a = "0"b;
777 end;
778
779 n = p -> reference.data_type;
780 if n = bit_string | n = char_string
781 then do;
782 a_reg.size = p -> reference.c_length * convert_size (n);
783 a_reg.offset = mod (convert_offset (p -> reference.units) * p -> reference.c_offset, bits_per_two_words);
784 if a_reg.offset + a_reg.size > bits_per_word then a_reg.length = bits_per_two_words;
785 else a_reg.length = bits_per_word;
786 end;
787 else a_reg.size, a_reg.offset = 0;
788
789 a_reg.number = 1;
790 a_reg.variable (1) = p;
791 p -> reference.value_in.a = "1"b;
792
793 return;
794
795
796
797 up_q: do i = 1 to q_reg.number;
798 q_reg.variable (i) -> reference.value_in.q = "0"b;
799 end;
800
801 q_reg.number = 1;
802 q_reg.variable (1) = p;
803 p -> reference.value_in.q = "1"b;
804
805 return;
806
807 state_man$update_reg: entry (pt, which);
808
809 dcl (which, update) bit (19) aligned;
810
811 p = pt;
812 update = which;
813
814 if substr (update, 1, 1) then goto up_a;
815 if substr (update, 2, 1) then goto up_q;
816
817 return;
818
819 state_man$erase_reg: entry (what);
820
821
822
823 dcl what bit (19) aligned;
824
825 erase = what;
826
827 if substr (erase, 1, 1)
828 then do;
829
830
831
832
833
834 if q_reg.number > 0
835 then do;
836
837 p = q_reg (1).variable;
838 n = p -> reference.data_type;
839
840 if n = real_fix_bin_2
841 | n = real_flt_bin_1
842 | n = real_flt_bin_2
843 | n = unpacked_ptr
844 then
845
846
847
848 substr (erase, 2, 1) = "1"b;
849 end;
850
851 call wipe;
852 return;
853 end;
854
855 if substr (erase, 2, 1)
856 then do;
857
858
859
860
861
862 if a_reg.number ^= 0
863 then if a_reg.size + a_reg.offset > bits_per_word
864 then substr (erase, 1, 1) = "1"b;
865 else a_reg.length = min (a_reg.length, bits_per_word);
866
867 end;
868
869 call wipe;
870 return;
871
872 state_man$erase_temps: entry;
873
874
875
876
877
878
879
880
881
882
883 erase = "0"b;
884
885 b19 = "1"b;
886 do i = 1 to a_reg.number;
887 p = a_reg (i).variable;
888 if p -> reference.temp_ref then call check_temp;
889 end;
890
891 found = "0"b;
892 do i = 1 to q_reg.number while (^found);
893 p = q_reg (i).variable;
894 n = p -> reference.data_type;
895
896 if n = real_fix_bin_2 | n = real_flt_bin_2
897 | n = real_flt_bin_1 | n = unpacked_ptr
898 then found = "1"b;
899 end;
900
901 if found
902 then do;
903 b19 = "01"b;
904 do i = 1 to q_reg.number;
905 p = q_reg (i).variable;
906 if p -> reference.temp_ref then call check_temp;
907 end;
908 end;
909
910 if erase
911 then do;
912 call wipe;
913 cg_stat$last_call = cg_stat$text_pos;
914 end;
915
916 return;
917
918 state_man$unlock: entry;
919
920
921
922 a_reg.locked, q_reg.locked = "0"b;
923 a_reg.number_h_o, q_reg.number_h_o = 0;
924
925 text_pos = cg_stat$text_pos;
926
927 do i = 0 to 7;
928 if index_regs (i).type < 0
929 then do;
930 if index_regs (i).variable ^= null
931 then index_regs (i).type = abs (index_regs (i).type);
932 else index_regs (i).type = 0;
933 index_regs (i).used = text_pos;
934 end;
935 end;
936
937 do i = 1 to 6;
938 if base_regs (i).locked ^= 0
939 then do;
940 base_regs (i).locked = 0;
941 base_regs (i).used = text_pos;
942 end;
943 end;
944
945 return;
946
947 state_man$set_aliasables: entry (pt);
948
949
950
951
952
953
954 dcl all bit (1) aligned;
955
956 p = pt;
957 all = p = null;
958
959 if machine_state.indicators = -2
960 then do;
961 q = indicators_ref (2);
962 if compare_aliasables ()
963 then machine_state.indicators = 0;
964 else do;
965 q = indicators_ref (3);
966 if compare_aliasables ()
967 then machine_state.indicators = 0;
968 end;
969 end;
970
971 n = a_reg.number;
972 i = 1;
973 do while (i <= n);
974 q = a_reg.variable (i);
975 if compare_aliasables ()
976 then do;
977 q -> reference.value_in.a = "0"b;
978 n = n - 1;
979 do j = i to n;
980 a_reg.variable (j) = a_reg.variable (j + 1);
981 end;
982 end;
983 else i = i + 1;
984 end;
985 a_reg.number = n;
986
987 n = q_reg.number;
988 i = 1;
989 do while (i <= n);
990 q = q_reg.variable (i);
991 if compare_aliasables ()
992 then do;
993 q -> reference.value_in.q = "0"b;
994 n = n - 1;
995 do j = i to n;
996 q_reg.variable (j) = q_reg.variable (j + 1);
997 end;
998 end;
999 else i = i + 1;
1000 end;
1001 q_reg.number = n;
1002
1003 q = string_reg.variable;
1004 if q ^= null
1005 then if compare_aliasables ()
1006 then do;
1007 q -> reference.value_in.string_aq = "0"b;
1008 string_reg.variable = null;
1009 end;
1010
1011 q = complex_reg.variable;
1012 if q ^= null
1013 then if compare_aliasables ()
1014 then do;
1015 q -> reference.value_in.complex_aq = "0"b;
1016 complex_reg.variable = null;
1017 end;
1018
1019 q = decimal_reg.variable;
1020 if q ^= null
1021 then if compare_aliasables ()
1022 then do;
1023 q -> reference.value_in.decimal_aq = "0"b;
1024 decimal_reg.variable = null;
1025 end;
1026
1027 do i = 0 to 7;
1028 if index_regs (i).type >= 2
1029 then do;
1030 q = index_regs (i).variable;
1031 if compare_aliasables ()
1032 then do;
1033 q -> reference.value_in.x (i) = "0"b;
1034 index_regs (i).type = 0;
1035 end;
1036 end;
1037 end;
1038
1039 do i = 1 to 6;
1040 if base_regs (i).type = 1
1041 then do;
1042 q = base_regs (i).variable;
1043 if compare_aliasables ()
1044 then do;
1045 q -> reference.value_in.b (i) = "0"b;
1046 base_regs (i).type = 0;
1047 end;
1048 end;
1049 end;
1050
1051 return;
1052
1053
1054 check_temp: proc;
1055
1056 if p -> reference.data_type ^= real_fix_bin_1 then goto back;
1057 if p -> reference.value_in.storage then goto back;
1058 if p -> reference.ref_count < 1 then goto back;
1059 if p -> reference.symbol -> symbol.c_dcl_size < bits_per_half
1060 then erase = erase | b19;
1061
1062 back: end;
1063
1064 get_ms: proc;
1065
1066 m_s_p = cg_stat$ms_list;
1067 if m_s_p ^= null then cg_stat$ms_list = machine_state.next;
1068 else do;
1069 allocate machine_state in (xeq_tree_area) set (m_s_p);
1070 m_s_p -> node.type = machine_state_node;
1071 pl1_stat_$node_uses (bin (machine_state_node, 9)) = pl1_stat_$node_uses (bin (machine_state_node, 9)) + 1;
1072 end;
1073
1074 end;
1075
1076 compare_aliasables: proc () returns (bit aligned);
1077
1078 if p ^= q
1079 then if q -> reference.shared
1080 then if all
1081 then if q -> reference.aliasable
1082 then return ("1"b);
1083 else if q -> reference.symbol -> symbol.block_node ^= null
1084 then return (q -> reference.symbol -> symbol.block_node -> block.flush_at_call);
1085 else ;
1086 else if q -> reference.aliasable
1087 then return (compare_alias ((p -> reference.symbol), (q -> reference.symbol)));
1088
1089 return ("0"b);
1090 end;
1091
1092 %include compare_alias;
1093
1094
1095 wipe: proc;
1096
1097 if substr (erase, 1, 1)
1098 then do;
1099
1100 do i = 1 to a_reg.number;
1101 p = a_reg.variable (i);
1102 call save_temp (1);
1103 p -> reference.value_in.a = "0"b;
1104 end;
1105
1106 a_reg.constant,
1107 a_reg.number = 0;
1108 end;
1109
1110 if substr (erase, 2, 1)
1111 then do;
1112
1113 do i = 1 to q_reg.number;
1114 p = q_reg.variable (i);
1115 call save_temp (2);
1116 p -> reference.value_in.q = "0"b;
1117 end;
1118
1119 q_reg.constant,
1120 q_reg.number = 0;
1121 end;
1122
1123 if substr (erase, 3, 1)
1124 then do;
1125 p = string_reg.variable;
1126 if p ^= null
1127 then do;
1128 call save_temp (3);
1129 p -> reference.value_in.string_aq = "0"b;
1130 string_reg.variable = null;
1131 end;
1132 end;
1133
1134 if substr (erase, 4, 1)
1135 then do;
1136 q = complex_reg.variable;
1137 if q ^= null
1138 then do;
1139 q -> reference.value_in.complex_aq = "0"b;
1140 complex_reg.variable = null;
1141 end;
1142 end;
1143
1144 if substr (erase, 5, 1)
1145 then do;
1146 q = decimal_reg.variable;
1147 if q ^= null
1148 then do;
1149 q -> reference.value_in.decimal_aq = "0"b;
1150 decimal_reg.variable = null;
1151 end;
1152 end;
1153
1154 do i = 0 to 7;
1155 if substr (erase, i + 6, 1)
1156 then do;
1157 if index_regs (i).type >= 2
1158 then do;
1159 p = index_regs (i).variable;
1160 if p ^= null
1161 then do;
1162 call save_temp (0);
1163 p -> reference.value_in.x (i) = "0"b;
1164 end;
1165 end;
1166
1167 index_regs (i).type = 0;
1168 end;
1169 end;
1170
1171 do i = 1 to 6;
1172 if substr (erase, i + 13, 1)
1173 then do;
1174 p = base_regs (i).variable;
1175 n = base_regs (i).type;
1176 if p = null then n = 0;
1177
1178 if n = 1
1179 then do;
1180 p -> reference.value_in.b (i) = "0"b;
1181 call save_temp (-i);
1182 end;
1183 else if n = 2
1184 then p -> reference.address_in.b (i) = "0"b;
1185
1186 base_regs (i).type = 0;
1187 end;
1188 end;
1189
1190
1191 end;
1192
1193
1194 save_temp: proc (reg);
1195
1196 dcl reg fixed bin;
1197
1198 dcl ca ptr;
1199
1200 dcl (macro, t, k) fixed bin (15);
1201
1202 dcl (stfx1 init (15),
1203 stfx2 init (16),
1204 save_string_aq init (229),
1205 sxl0 init (345),
1206 stx0 init (714),
1207 zero_mac init (308),
1208 store_base (23:24, 6) init (61, 409, 622, 623, 624, 625,
1209 630, 631, 632, 633, 634, 635),
1210 sta init (4)) fixed bin (15) int static;
1211
1212 if cg_stat$m_s_p = null then return;
1213
1214 if ^p -> reference.temp_ref then goto exit;
1215
1216 if p -> reference.ref_count <= 0 then goto exit;
1217
1218 if p -> reference.value_in.storage then goto exit;
1219
1220 if p -> reference.symbol = null then goto exit;
1221
1222 if p -> reference.dont_save then go to exit;
1223
1224 if p -> reference.aggregate then go to exit;
1225
1226 t = p -> reference.data_type;
1227
1228 if reg = 2
1229 then do;
1230 if t = unpacked_ptr
1231 then if string (p -> reference.value_in.b)
1232 then goto exit; else goto save;
1233
1234 if t = real_fix_bin_1
1235 then if p -> reference.symbol -> symbol.c_dcl_size < bits_per_half
1236 then if string (p -> reference.value_in.x)
1237 then goto exit;
1238 end;
1239
1240 save: p -> reference.store_ins = bit (cg_stat$text_pos, 18);
1241 p -> reference.ref_count = p -> reference.ref_count + 1;
1242
1243 if reg < 0
1244 then do;
1245 macro = store_base (t, abs (reg));
1246 goto gen;
1247 end;
1248
1249 if reg = 3
1250 then do;
1251 if p -> reference.allocated then go to exit;
1252 if ^p -> reference.address_in.storage then go to exit;
1253
1254 call stack_temp$assign_block (p, 2);
1255
1256
1257
1258
1259 if string (p -> reference.address_in.b)
1260 then do;
1261 k = index (string (p -> reference.address_in.b), "1"b) - 1;
1262 p -> reference.address_in.storage = "0"b;
1263 call expmac ((store_base (23, k)), p);
1264 p -> reference.address_in.storage = "1"b;
1265 end;
1266 else do;
1267 ca = c_a (p -> reference.qualifier -> temporary.location, 4);
1268 call expmac$one_eis ((save_string_aq), ca);
1269 p -> reference.ref_count = p -> reference.ref_count - 1;
1270 end;
1271
1272 go to exit;
1273 end;
1274
1275 if reg = 1
1276 then do;
1277 if t < char_string then k = 0;
1278 else k = fixed (p -> reference.c_length * convert_size (t) > bits_per_word, 1);
1279 call expmac$one ((sta), p, k);
1280
1281 if a_reg.offset ^= 0
1282 then do;
1283 p -> reference.aligned_ref = "0"b;
1284 p -> reference.c_offset = a_reg.offset;
1285 p -> reference.units = bit_;
1286 end;
1287 end;
1288 else do;
1289 if reg = 0
1290 then do;
1291 if p -> reference.symbol -> symbol.c_dcl_size < bits_per_half
1292 then do;
1293 macro = stx0 + i;
1294
1295
1296
1297
1298 p -> reference.aligned_ref = "0"b;
1299 p -> reference.c_offset = 0;
1300 p -> reference.c_length = bits_per_half;
1301 p -> reference.units = word_;
1302
1303
1304
1305
1306
1307
1308
1309
1310 p -> reference.dont_save = "1"b;
1311 end;
1312
1313 else do;
1314 macro = sxl0 + i;
1315 p -> reference.ref_count = p -> reference.ref_count + 1;
1316 call expmac ((zero_mac), p);
1317 end;
1318 end;
1319 else if t = unpacked_ptr | t = complex_flt_bin_1 then macro = stfx2;
1320 else if t = packed_ptr | t = bit_string then macro = stfx1;
1321 else macro = stfx1 - 1 + t;
1322
1323 gen: call expmac (macro, p);
1324 end;
1325
1326 p -> reference.value_in.storage = "1"b;
1327
1328 exit: end;
1329
1330 need_ref: proc returns (bit (1) aligned);
1331
1332 dcl (p1, p2) ptr;
1333
1334 if ^optimize
1335 then return ("1"b);
1336
1337 if p -> reference.temp_ref
1338 then do p1 = q repeat (p1 -> element (4)) while (p1 ^= null);
1339 p2 = p1 -> element (1);
1340
1341 if p2 -> node.type = operator_node
1342 then do;
1343 if substr (p2 -> operator.op_code, 1, 5) = "00111"b
1344 then if p2 -> operand (2) = p
1345 then return ("1"b);
1346
1347 p2 = p2 -> operand (1);
1348 end;
1349
1350 if p = p2 then return ("1"b);
1351 end;
1352
1353 return ("0"b);
1354 end;
1355
1356 end;