1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4    *                                                         *
  5    * Copyright (c) 1972 by Massachusetts Institute of        *
  6    * Technology and Honeywell Information Systems, Inc.      *
  7    *                                                         *
  8    *********************************************************** */
  9 
 10 
 11 /* procedure to optimize an if statement
 12 
 13    Initial Version: 1 November 1975 by RAB
 14           Modified: 1 July 1976 by RAB for label array improvements
 15           Modified: 23 Jan 1977 by RAB to make recursive for combine_tests
 16           Modified: 9 Mar 1977 by RAB to remove some dead code
 17           Modified: 12 March 1977 by RAB to change handling of mod_word
 18           Modified: 9 April 1977 by RAB to remove mod_word  */
 19 
 20 /* if statements are optimized by changing boolean operations into jumps.
 21    Among the transformations performed are:
 22 
 23    jump_true(target,or_bits(a,b)) -> jump_true(target,a), jump_true(target,b)
 24 
 25    jump_true(target,and_bits(a,b)) -> jump_false(next,a), jump_true(target,b)
 26 
 27    jump_true(target,not_bits(a)) -> jump_false(target,a)
 28 
 29    jump_false(target,and_bits(a,b)) -> jump_false(target,a), jump_false(target,b)
 30 
 31    jump_false(target,or_bits(a,b)) -> jump_true(next,a), jump_false(target,b)
 32 
 33    jump_false(target,not_bits(a)) -> jump_true(target,a)
 34 
 35    These transformations are not performed if the boolean operators have already
 36    been evaluated or if their values are needed later on */
 37 
 38 optimize_if:        proc(pt);
 39 
 40 dcl       pt ptr;   /* points at statement being optimized */
 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                     /* operator_semantics has ensured that the target of a
 92                        conditional jump will not be an operator nor a reference
 93                        with expressions hanging off it, so that calling
 94                        check_expr for the target is unnecessary */
 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                     /* not - complement the type of jump */
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                     /* rel_op - change into a jump_rel and return */
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                     /* or_bits | and_bits - split into 2 statements */
145 
146                     if machine_state.indicators = 1
147                     then do;
148 
149                          /* if result of second computation is in a with
150                             indicators set, do that one first */
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                          /* simply duplicate the statement */
169 
170                          call make(/* jump_code,target,tree -> operand(3) */);
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                          /* make a second statement; reverse the form of
184                             the first statement and redirect to the next
185                             statement */
186 
187                          next = st -> statement.next;
188 
189                          call make(/* jump_code,target,tree -> operand(3) */);
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                          /* connect nextlab to next stmt */
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                          /* reference_count updated once for new reference and once for new label */
212 
213                          next -> statement.reference_count = next -> statement.reference_count + 2;
214 
215                          /* optimizer didn't know about this label, so make sure all temps
216                             are saved before anyone jumps here */
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 /* ^L */
235 make:          proc(/* op_code,target,expr */);
236 
237                /* make a new if statement */
238 
239 dcl            (new,op) ptr;
240 
241                pl1_stat_$cur_statement = st;      /* otherwise create_statement fails */
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 /*^L*/
255 share_target_expression: proc(p) returns(ptr);
256 
257                /* updates all relevant reference counts when a jump target is
258                   NOT a label (it might be a subscripted label reference)
259                   Note, however, that operator_semantics has ensured that the
260                   target of a conditional jump will not be an operator nor a
261                   reference with expressions hanging off it. */
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 /* ^L */
282 check_expr:         proc(pt);
283 
284                /* forces evaluation of any expression that could be used in
285                   more than one place */
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                     /* should appear only in arg lists */
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;