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 optimize_if: proc(pt);
39
40 dcl pt ptr;
41
42 dcl (jop,lp,next,nextlab,p3,st,target,tree,next_tree) ptr;
43 dcl (jump_code,op_code) bit(9) aligned;
44
45 dcl (cg_stat$cur_block,pl1_stat_$cur_statement) ptr ext static;
46 dcl cg_stat$cur_level fixed bin ext static;
47
48 dcl ( rel_op init("00100"b),
49 jump_op init("00101"b)
50 ) bit(5) aligned int static;
51
52 dcl (fixed,null,string,substr) builtin;
53
54 dcl create_list entry(fixed bin) returns(ptr);
55 dcl create_label entry(ptr,ptr,bit(3) aligned) returns(ptr);
56 dcl create_operator entry(bit(9) aligned,fixed bin(15)) returns(ptr);
57 dcl create_statement entry(bit(9) aligned,ptr,ptr,bit(12) aligned) returns(ptr);
58 dcl share_expression entry(ptr) returns(ptr);
59 dcl jump_op$eval_primaries entry(ptr);
60 dcl prepare_operand entry(ptr,fixed bin,bit(1) aligned) returns(ptr);
61 dcl compile_exp entry(ptr);
62
63 %include nodes;
64 %include block;
65 %include statement;
66 %include statement_types;
67 %include label;
68 %include declare_type;
69 %include list;
70 %include reference;
71 %include operator;
72 %include op_codes;
73 %include jump_complement;
74 %include machine_state;
75
76 st = pt;
77 jop = st -> statement.root;
78
79 if ^ st -> statement.checked
80 then do;
81 target = jop -> operand(1);
82
83 if target -> node.type = label_node
84 then if ^ target -> label.allocated
85 then if cg_stat$cur_level = target -> label.block_node -> block.level
86 then call jump_op$eval_primaries(target);
87 else;
88 else;
89 else do;
90
91
92
93
94
95
96 if target -> node.type = reference_node
97 then if target -> reference.symbol ^= null
98 then if target -> reference.symbol -> node.type = label_node
99 then if target -> reference.symbol -> label.block_node = cg_stat$cur_block
100 then call jump_op$eval_primaries(target);
101 end;
102
103 call check_expr((jop -> operand(2)));
104 st -> statement.checked = "1"b;
105 end;
106
107
108 do while("1"b);
109 tree = jop -> operand(2);
110
111 if tree -> node.type ^= operator_node then return;
112 if tree -> operand(1) -> reference.evaluated then return;
113 if tree -> operand(1) -> reference.c_length ^= 1 then return;
114
115 jump_code = jop -> operator.op_code;
116 op_code = tree -> operator.op_code;
117
118 if op_code = not_bits
119 then do;
120
121
122
123 jop -> operator.op_code = jump_complement(fixed(substr(jump_code,6,4),4));
124 jop -> operand(2) = tree -> operand(2);
125 end;
126
127 else if substr(op_code,1,5) = rel_op
128 then do;
129
130
131
132 if jump_code = jump_true
133 then substr(tree -> operator.op_code,1,5) = jump_op;
134 else tree -> operator.op_code = jump_complement(fixed(substr(op_code,6,4),4));
135
136 tree -> operand(1) = jop -> operand(1);
137 st -> statement.root = tree;
138 return;
139 end;
140
141 else if op_code = and_bits | op_code = or_bits
142 then do;
143
144
145
146 if machine_state.indicators = 1
147 then do;
148
149
150
151
152 p3 = tree -> operand(3);
153 if p3 -> node.type = operator_node
154 then p3 = p3 -> operand(1);
155
156 if p3 -> reference.value_in.a & p3 -> reference.allocate
157 then do;
158 p3 = tree -> operand(3);
159 tree -> operand(3) = tree -> operand(2);
160 tree -> operand(2) = p3;
161 end;
162 end;
163
164 if op_code = and_bits & jump_code = jump_false
165 | op_code = or_bits & jump_code = jump_true
166 then do;
167
168
169
170 call make();
171
172 jop -> operand(2) = tree -> operand(2);
173
174 target = jop -> operand(1);
175 if target -> node.type = label_node
176 then target -> label.statement -> statement.reference_count =
177 target -> label.statement -> statement.reference_count + 1;
178 else target = share_target_expression(target);
179 end;
180
181 else do;
182
183
184
185
186
187 next = st -> statement.next;
188
189 call make();
190
191 jop -> operand(2) = tree -> operand(2);
192
193 if jump_code = jump_true
194 then jop -> operator.op_code = jump_false;
195 else jop -> operator.op_code = jump_true;
196
197 nextlab = create_label(cg_stat$cur_block,null,(by_compiler));
198 lp = create_list(2);
199
200
201
202 jop -> operand(1) = nextlab;
203 nextlab -> label.statement = next;
204
205 lp -> element(2) = nextlab;
206 lp -> element(1) = next -> statement.labels;
207 next -> statement.labels = lp;
208
209 string(nextlab -> label.source_id) = string(next -> statement.source_id);
210
211
212
213 next -> statement.reference_count = next -> statement.reference_count + 2;
214
215
216
217
218 next -> statement.save_temps = "1"b;
219 end;
220
221 next_tree = st -> statement.next -> statement.root;
222
223 if next_tree -> operand(2) -> node.type = operator_node
224 then if ^ next_tree -> operand(2) -> operand(1) -> reference.evaluated
225 then if next_tree -> operand(2) -> operand(1) -> reference.c_length = 1
226 then call optimize_if((st -> statement.next));
227
228 end;
229
230 else return;
231
232 end;
233
234
235 make: proc();
236
237
238
239 dcl (new,op) ptr;
240
241 pl1_stat_$cur_statement = st;
242
243 new = create_statement((if_statement),st,null,(st -> statement.prefix));
244 op = create_operator((jump_code),2);
245
246 new -> statement.generated,
247 new -> statement.checked = "1"b;
248 new -> statement.root = op;
249
250 op -> operand(1) = jop -> operand(1);
251 op -> operand(2) = tree -> operand(3);
252
253 end;
254
255 share_target_expression: proc(p) returns(ptr);
256
257
258
259 Note
260
261
262
263 dcl (p,q,vector) ptr;
264 dcl i fixed bin;
265
266 if p -> reference.symbol ^= null
267 then if p -> reference.symbol -> node.type = label_node
268 then do;
269 vector = p -> reference.symbol -> label.statement;
270
271 q = vector -> element(p -> reference.c_offset + 1);
272 q -> statement.reference_count = q -> statement.reference_count + 1;
273 end;
274
275 if ^ p -> reference.shared
276 then p -> reference.ref_count = p -> reference.ref_count + 1;
277
278 return(p);
279
280 end;
281
282 check_expr: proc(pt);
283
284
285
286
287 dcl (pt,p,q) ptr;
288 dcl (i,n) fixed bin;
289 dcl atomic bit(1) aligned;
290
291 p = pt;
292 if p = null then return;
293 if p -> node.type = temporary_node then return;
294
295 if p -> node.type = list_node
296 then do;
297
298
299
300 do i = 1 to p -> list.number - 1;
301 call check_expr((p -> list.element(i)));
302 end;
303 return;
304 end;
305
306 q = p;
307
308 if p -> node.type = operator_node
309 then do;
310 if p -> operator.op_code = param_ptr | p -> operator.op_code = param_desc_ptr
311 then return;
312
313 if p -> operator.op_code = std_call
314 then n = 2;
315 else n = 1;
316
317 p = p -> operand(1);
318
319 if p -> reference.ref_count <= n
320 then do;
321 do i = q -> operator.number to 2 by -1;
322 call check_expr((q -> operand(i)));
323 end;
324 return;
325 end;
326 end;
327
328 else do;
329 if p -> reference.ref_count <= 1
330 then do;
331 if p -> reference.length ^= null
332 then call check_expr((p -> reference.length));
333 if p -> reference.qualifier ^= null
334 then call check_expr((p -> reference.qualifier));
335 if p -> reference.offset ^= null
336 then call check_expr((p -> reference.offset));
337 return;
338 end;
339 end;
340
341 p = prepare_operand(q,1,atomic);
342
343 if ^ atomic
344 then do;
345 p -> reference.ref_count = p -> reference.ref_count + 1;
346 call compile_exp(q);
347 end;
348
349 return;
350 end;
351
352 end;