1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20 stack_temp$assign_temp: proc(ref_pt) ;
21
22
23
24 dcl ref_pt ptr parameter;
25
26
27
28 dcl (cg_stat$cur_block,cg_stat$cur_statement,cg_stat$agg_temps) ptr ext,
29 cg_stat$max_stack_size fixed bin ext,
30 cg_stat$text_pos fixed bin(18) ext,
31 cg_stat$extended_stack bit(1) ext,
32 pl1_stat_$node_uses (18) fixed bin external static;
33
34
35
36 dcl (p,r,s,o) ptr,
37 atomic bit(1) aligned,
38 (size,bit_length) fixed bin;
39
40
41
42 dcl error entry(fixed bin,ptr,ptr),
43 cg_error entry(fixed bin,fixed bin),
44 prepare_operand entry(ptr,fixed bin,bit(1) aligned) returns(ptr),
45 compile_exp entry(ptr),
46 expmac$zero entry(fixed bin(15)),
47 expmac entry(fixed bin(15),ptr),
48 c_a entry(fixed bin(18),fixed bin) returns(ptr);
49
50
51
52 dcl ( alloc_words init(91),
53 store_bp init(61)) fixed bin(15) int static;
54
55
56
57 dcl (bin, divide, mod, null) builtin;
58
59
60
61 %include pl1_tree_areas;
62 %include temporary;
63 %include nodes;
64 %include block;
65 %include reference;
66 %include symbol;
67 %include machine_state;
68 %include cgsystem;
69 %include data_types;
70 ^L
71
72
73 r = ref_pt;
74 s = r -> reference.symbol;
75
76 if r -> reference.aggregate
77 then do;
78
79
80
81
82 r -> reference.allocated = "1"b;
83
84 do p = s repeat(p -> symbol.father) while(p -> symbol.father ^= null);
85 end;
86
87 if p -> symbol.initial = null then goto agg; else return;
88 end;
89
90 if s = null
91 then if r -> reference.data_type = 0
92 then size = r -> reference.c_length;
93 else go to get_length;
94 else if s -> symbol.temporary
95 then size = s -> symbol.c_word_size;
96 else do;
97 get_length: bit_length = r -> reference.c_length;
98 if r -> reference.data_type = char_string
99 then bit_length = bit_length * bits_per_char;
100 size = divide(bit_length+bits_per_word-1,bits_per_word,17,0);
101 end;
102
103 common: r -> reference.qualifier = get_temp(size);
104 r -> reference.qualifier -> temporary.ref_count = 1;
105 r -> reference.allocated = "1"b;
106
107 if ^ r -> reference.address_in.storage
108 then if r -> reference.varying_ref
109 then r -> reference.c_offset = r -> reference.c_offset + 1;
110
111 return;
112
113 stack_temp$assign_block: entry(ref_pt,amount);
114
115 dcl amount fixed bin;
116
117 r = ref_pt;
118 size = amount;
119 goto common;
120
121 stack_temp$free_temp: entry(ref_pt);
122
123 r = ref_pt;
124
125 s = r -> reference.qualifier;
126 if s = null then return;
127
128 if s -> node.type ^= temporary_node then return;
129
130 if (r -> reference.ref_count < 0) | (s -> temporary.ref_count < 0)
131 then do;
132 call error(314,cg_stat$cur_statement,r);
133 return;
134 end;
135
136 r -> reference.qualifier = null;
137
138 call put_temp(s);
139 return;
140
141 stack_temp$assign_return_value: entry(sym_pt);
142
143 p = sym_pt;
144
145 r = get_temp(2);
146 p -> symbol.initial = r;
147
148 go to chain_agg;
149
150 stack_temp$assign_aggregate: entry(sym_pt);
151
152 dcl sym_pt ptr;
153
154 p = sym_pt;
155
156 agg: if p -> symbol.word_size = null then size = p -> symbol.c_word_size;
157 else do;
158 o = p -> symbol.word_size;
159 r = prepare_operand(o,1,atomic);
160 call compile_exp(o);
161 call expmac$zero((alloc_words));
162 cg_stat$extended_stack = "1"b;
163 size = 2;
164 end;
165
166 r = get_temp(size);
167 p -> symbol.initial = r;
168
169 if p -> symbol.word_size ^= null
170 then do;
171 call expmac((store_bp),c_a(r -> temporary.location,4));
172 base_regs(1).type = 3;
173 base_regs(1).constant = r -> temporary.location;
174 end;
175
176 chain_agg:
177 r -> temporary.symbol = p;
178 r -> temporary.next = cg_stat$agg_temps;
179 cg_stat$agg_temps = r;
180
181 return;
182
183 stack_temp$free_aggregates: entry;
184
185 p = cg_stat$agg_temps;
186 do while(p ^= null);
187 p -> temporary.symbol -> symbol.initial = null;
188 r = p -> temporary.next;
189 call put_temp(p);
190 p = r;
191 end;
192
193 cg_stat$agg_temps = null;
194 return;
195
196 get_temp: proc(amount) returns(ptr);
197
198 dcl (amount,amt,loc,i) fixed bin,
199 (cb,s,prev,p) ptr;
200
201 cb = cg_stat$cur_block;
202 loc = cb -> block.last_auto_loc;
203
204 amt = amount;
205 if amt >= 3 then goto big;
206
207 if amt = 0 then amt = 1;
208
209 i = amt;
210 p = cb -> block.free_temps(i);
211
212 if p ^= null
213 then do;
214 l0: cb -> block.free_temps(i) = p -> temporary.next;
215 l1: return(p);
216 end;
217
218 if i = 1
219 then do;
220 l3: p = create_temp(amt);
221 cb -> block.last_auto_loc = loc + amt;
222
223 if cb -> block.last_auto_loc > cg_stat$max_stack_size
224 then call cg_error(308,cg_stat$max_stack_size);
225
226 goto l1;
227 end;
228
229 l4: if mod(loc,2) = 0 then goto l3;
230
231 p = create_temp(1);
232 p -> temporary.next = cb -> block.free_temps(1);
233 cb -> block.free_temps(1) = p;
234 loc = loc + 1;
235 goto l3;
236
237 big: prev = null;
238 i = 3;
239 p = cb -> block.free_temps(3);
240
241 do while(p ^= null);
242
243 if p -> temporary.size >= amt
244 then do;
245 if prev = null then goto l0;
246 prev -> temporary.next = p -> temporary.next;
247 goto l1;
248 end;
249
250 prev = p;
251 p = p -> temporary.next;
252 end;
253
254 goto l4;
255
256 put_temp: entry(temp);
257
258 dcl temp ptr;
259
260 cb = cg_stat$cur_block;
261
262 s = temp;
263 s -> temporary.last_freed = cg_stat$text_pos;
264 i, amt = s -> temporary.size;
265
266 if i < 3
267 then do;
268 l5: s -> temporary.next = cb -> block.free_temps(i);
269 cb -> block.free_temps(i) = s;
270 return;
271 end;
272
273 prev = null;
274 i = 3;
275 p = cb -> block.free_temps(3);
276
277 do while(p ^= null);
278
279 if amt < p -> temporary.size
280 then do;
281 l6: if prev = null then goto l5;
282 s -> temporary.next = prev -> temporary.next;
283 prev -> temporary.next = s;
284 return;
285 end;
286
287 prev = p;
288 p = p -> temporary.next;
289 end;
290
291 goto l6;
292
293 create_temp: proc(number) returns(ptr);
294
295 dcl number fixed bin,
296 q ptr;
297
298 allocate temporary in(xeq_tree_area) set(q);
299 pl1_stat_$node_uses (bin (temporary_node, 9)) = pl1_stat_$node_uses (bin (temporary_node, 9)) + 1;
300 q -> temporary.node_type = temporary_node;
301 q -> temporary.location = loc;
302 q -> temporary.size = number;
303 return(q);
304
305 end;
306
307 end;
308
309 end;