1
2
3
4
5
6
7
8
9
10
11
12 string_temp:
13 proc (pt, pt2, pt3) returns (ptr);
14
15
16
17
18
19
20
21
22
23
24
25
26
27 dcl pt ptr,
28 pt2 ptr,
29
30 pt3 ptr;
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;
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
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
100
101
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
121
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
132
133
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
146
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
160
161
162 if q -> reference.aggregate
163 then go to set_eis;
164
165
166
167
168
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
207
208 call long_op$extend_stack (q, alloc_char_temp + dt);
209
210
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
230
231
232
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
265
266
267
268 dcl out ptr,
269 in ptr,
270 may_overlap bit (1) aligned,
271 overlap_must_be_same_generation
272 bit (1) aligned;
273
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 ;
291
292
293 end ;
294
295 end;