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 /* format: style3 */
 12 string_temp:
 13      proc (pt, pt2, pt3) returns (ptr);
 14 
 15 /* Program to standardize the allocation of long string temps for string_op and cat_op */
 16 
 17 /*        Written:  by Richard A. Barnes for EIS compiler
 18           Modified: 21 August 1978 by RAB to tighten restrictions in need_temp
 19           Modified: 1 April 1979 by RAB to improve code generated for equal
 20                     expression lengths
 21           Modified: 15 April 1979 by RAB to make the determination in need_temp
 22                     more precise by checking if generation overlaps are exact
 23           Modified: 30 March 1980 by RAB for reference.aligned_for_store_ref.
 24                     See prepare_operand for details.
 25 */
 26 
 27 dcl       pt                  ptr,                          /* operator node */
 28           pt2                 ptr,                          /* reference node of source to be optionally moved into temp.
 29                                  the space for the source may be reused for the temp */
 30           pt3                 ptr;                          /* reference node of other operand */
 31 
 32 dcl       (
 33           op,
 34           p1,
 35           p                   (2:3),
 36           q
 37           )                   ptr;
 38 dcl       (dt, icat, k, size, type)
 39                               fixed bin;
 40 dcl       dont_move           bit (1) aligned;              /* ON if p(2) should NOT be moved into the new temp */
 41 
 42 dcl       cg_stat$eis_temp    ptr ext;
 43 dcl       cg_stat$for_test_called
 44                               bit (1) aligned ext;
 45 
 46 dcl       (
 47           realloc_char_temp   (0:1) init (92, 200),
 48           alloc_char_temp     init (89),
 49           zero_mac            (0:1) init (308, 307),
 50           move_chars          (0:1) init (98, 218)
 51           )                   fixed bin (15) int static;
 52 
 53 dcl       adjust_ref_count    entry (ptr, fixed bin);
 54 dcl       copy_temp           entry (ptr) returns (ptr);
 55 dcl       long_op$eis         entry (ptr, fixed bin, fixed bin (15));
 56 dcl       expmac              entry (fixed bin (15), ptr);
 57 dcl       get_reference       entry () returns (ptr);
 58 dcl       long_op$extend_stack
 59                               entry (ptr, fixed bin (15));
 60 dcl       share_expression    entry (ptr) returns (ptr);
 61 dcl       stack_temp$assign_temp
 62                               entry (ptr);
 63 dcl       state_man$update_ref
 64                               entry (ptr);
 65 dcl       base_man$update_base
 66                               entry (fixed bin, ptr, fixed bin);
 67 
 68 dcl       (fixed, min, mod, null)
 69                               builtin;
 70 
 71 %include operator;
 72 %include op_codes;
 73 %include reference;
 74 %include symbol;
 75 %include data_types;
 76 %include boundary;
 77 %include cgsystem;
 78 
 79           op = pt;
 80           p (3) = pt3;
 81           p (2) = pt2;
 82 
 83           p1 = op -> operand (1);
 84           type = p1 -> reference.data_type;
 85           dt = type - char_string;
 86           icat = fixed (op -> operator.op_code = cat_string, 1);
 87           dont_move = p (3) = null;
 88 
 89 /* If for_test_called, we don't need a temporary */
 90 
 91           if cg_stat$for_test_called
 92           then do;
 93                     cg_stat$eis_temp = p (2);
 94                     if ^p (2) -> reference.shared
 95                     then p (2) -> reference.ref_count = p (2) -> reference.ref_count + 1;
 96                     return (p1);
 97                end;
 98 
 99 /* If operand(1) is a nontemporary, we must either create a temporary to work in,
100    or use operand(1) as the output if it does not appear as an input operand
101    in such a way as to destroy its value before it is used. */
102 
103           q = p1;
104 
105           if ^p1 -> reference.temp_ref
106           then if need_temp ()
107                then do;
108                          q = get_reference ();
109                          q -> reference.data_type = p1 -> reference.data_type;
110                          q -> reference.units = word_;
111                          q -> reference.aligned_ref, q -> reference.aligned_for_store_ref, q -> reference.temp_ref = "1"b;
112                          q -> reference.long_ref = p1 -> reference.long_ref;
113                          q -> reference.c_length = p1 -> reference.c_length;
114                          if p1 -> reference.length ^= null
115                          then q -> reference.length = share_expression ((p1 -> reference.length));
116                     end;
117                else if q -> reference.length ^= null
118                then go to set_eis;
119 
120 /* If the temporary is short, make sure it is unshared and has its allocate bit
121    on so that storage may be associated with it */
122 
123           if ^q -> reference.long_ref
124           then if ^q -> reference.allocate
125                then do;
126                          q = copy_temp (q);
127                          if p1 -> reference.temp_ref
128                          then op -> operand (1) = q;
129                     end;
130 
131 /* If the temporary has a constant length and is used more than once (or has allocate bit
132    on), then we will now give it a spot in the stack rather than making a stack
133    extension for it */
134 
135           if q -> reference.length = null
136           then if q -> reference.allocate
137                then do;
138                          if ^q -> reference.allocated
139                          then if q -> reference.temp_ref
140                               then call stack_temp$assign_temp (q);
141                          if ^q -> reference.long_ref
142                          then if dt >= 0
143                               then do;
144 
145 /* if operand(1) is an aligned ref, but its size does not fill out
146                                  the word(s), zero out (last) word                                */
147 
148                                         q -> reference.value_in.storage = "1"b;
149                                         size = q -> reference.c_length * convert_size (type);
150                                         if mod (size, bits_per_word) ^= 0 & q -> reference.aligned_for_store_ref
151                                         then do;
152                                                   q -> reference.ref_count = q -> reference.ref_count + 1;
153                                                   call expmac ((zero_mac (fixed (size > bits_per_word, 1))), q);
154                                              end;
155                                    end;
156                          go to set_eis;
157                     end;
158 
159 /* Aggregate temporaries have already been allocated, so it is wrong to
160    allocate them again. */
161 
162           if q -> reference.aggregate
163           then go to set_eis;
164 
165 /* If we get here, we want to use a stack extension for the temporary, but we can still
166    check to see if we can reuse a previously made extension or if we can extend it.
167    This can be done if the relationship between the operand lengths is known
168    at compile time. */
169 
170           if icat > 0
171           then if p (2) -> reference.value_in.string_aq
172                then go to re_alloc;
173                else ;
174           else if p (2) -> reference.value_in.string_aq
175           then if q -> reference.length ^= null
176                then if dont_move
177                     then go to reuse;
178                     else if ^p (3) -> reference.varying_ref
179                               & (^p (3) -> reference.long_ref
180                               | (p (2) -> reference.length = p (3) -> reference.length & ^p (2) -> reference.varying_ref))
181                     then go to reuse;
182                     else ;
183 
184                else do;
185                          if q -> reference.c_length > p (2) -> reference.c_length
186                          then do;
187 re_alloc:
188                                    call long_op$extend_stack (q, realloc_char_temp (icat) + dt);
189                               end;
190 
191                          else do;
192 reuse:
193                                    call state_man$update_ref (q);
194                                    if ^dont_move & p (2) -> reference.address_in.b (1)
195                                    then call base_man$update_base (2, q, 1);
196                               end;
197 
198                          if ^dont_move
199                          then if ^p (2) -> reference.shared
200                               then call adjust_ref_count (p (2), -1);
201                          cg_stat$eis_temp = q;
202                          return (q);
203                     end;
204           else ;
205 
206 /* We must get a new stack extension */
207 
208           call long_op$extend_stack (q, alloc_char_temp + dt);
209 
210 /* Update cg_stat$eis_temp and move in source operand */
211 
212 set_eis:
213           cg_stat$eis_temp = q;
214 
215           if ^dont_move
216           then do;
217                     if op -> operator.op_code = and_bits
218                     then k = min (p (2) -> reference.c_length, p (3) -> reference.c_length);
219                     else k = 0;
220                     call long_op$eis (p (2), k, move_chars (icat) + dt);
221                end;
222 
223           return (q);
224 
225 
226 need_temp:
227      proc returns (bit (1) aligned);
228 
229 /* need_temp is called when operand(1) is not a temporary to determine if
230    string_temp should replace operand(1) with a temporary in order to compile
231    the expression.  need_temp tries to determine whether the generations of
232    storage of operand(1) and the other operands overlap. */
233 
234 dcl       alias               bit (1) aligned;
235 dcl       (i, n)              fixed bin;
236 dcl       (may_overlap, overlap_must_be_same_generation)
237                               bit (1) aligned;
238 
239           if q -> reference.defined_ref
240           then return ("1"b);
241 
242           alias = q -> reference.aliasable;
243           if dont_move
244           then n = 2;
245           else n = 3;
246 
247           do i = 2 to n;
248                call check_overlap (q, (p (i)), may_overlap, overlap_must_be_same_generation);
249 
250                if may_overlap
251                then if ^overlap_must_be_same_generation | icat > 0 | i > 2
252                     then return ("1"b);
253           end;
254 
255           if ^dont_move
256           then if ^q -> reference.shared
257                then q -> reference.ref_count = q -> reference.ref_count + 1;
258           return ("0"b);
259 
260 
261 check_overlap:
262      proc (out, in, may_overlap, overlap_must_be_same_generation);
263 
264 /* check_overlap determines if two operands may overlap, and, if they may, if
265    the operands describe the same generation if they actually do
266    overlap. */
267 
268 dcl       out                 ptr,                          /* -> target reference node */
269           in                  ptr,                          /* -> input reference node */
270           may_overlap         bit (1) aligned,              /* ON if references may have overlapping storage (output) */
271           overlap_must_be_same_generation
272                               bit (1) aligned;              /* ON -- if references overlap at all, they must
273                                            describe the same generation of storage (output) */
274 
275           may_overlap, overlap_must_be_same_generation = "0"b;
276 
277           if out -> reference.symbol = in -> reference.symbol
278           then may_overlap = "1"b;
279           else if alias
280           then if in -> reference.aliasable
281                then if out -> reference.symbol -> symbol.aligned = in -> reference.symbol -> symbol.aligned
282                     then if out -> reference.symbol -> symbol.varying = in -> reference.symbol -> symbol.varying
283                          then may_overlap = "1"b;
284 
285           if may_overlap
286           then if ^in -> reference.substr & ^out -> reference.substr
287                     & (out -> reference.symbol -> symbol.aligned | out -> reference.symbol -> symbol.varying)
288                then overlap_must_be_same_generation = "1"b;
289 
290      end /* check_overlap */;
291 
292 
293      end /* need_temp */;
294 
295      end;