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 move_data: proc(pt);
32
33 dcl pt ptr;
34
35 dcl (p,q,q1,q2,p1,p2,s,arg(2)) ptr,
36 pd ptr defined(arg(1)),
37 ps ptr defined(arg(2)),
38 (adjust,atomic,big_length_hold,have_constant_length,sp_ok) bit(1) aligned,
39 base bit(3) aligned,
40 (case,i,n,amount) fixed bin,
41 macro fixed bin(15);
42
43 dcl (addr,addrel,bit,divide,fixed,mod,null,substr) builtin;
44
45 dcl base_man$store_ptr_to entry(ptr,ptr),
46 prepare_operand entry(ptr,fixed bin,bit(1) aligned) returns(ptr),
47 state_man$erase_reg entry(bit(19) aligned),
48 c_a entry(fixed bin,fixed bin) returns(ptr),
49 make_both_addressable entry(ptr,ptr,bit(1) aligned),
50 expmac$many entry(fixed bin(15),ptr,fixed bin),
51 expmac$one entry(fixed bin(15),ptr,fixed bin),
52 expmac$zero entry(fixed bin(15)),
53 adjust_ref_count entry(ptr,fixed bin),
54 generate_constant$real_fix_bin_1 entry(fixed bin) returns(ptr),
55 load entry(ptr,fixed bin),
56 compile_exp entry(ptr),
57 eval_exp entry(ptr,bit(1) aligned) returns(ptr),
58 long_op$two_eis entry(ptr,fixed bin,fixed bin(15),ptr),
59 expmac$two_eis entry(fixed bin(15),ptr,ptr),
60 expmac entry(fixed bin(15),ptr),
61 base_man$load_any_var_and_lock entry(fixed bin,ptr) returns(bit(3) aligned);
62
63 dcl double_data bit(24) int static init("010111110000000111111110"b);
64
65 dcl alters(0:1) bit(19) aligned static init("1"b,"11"b);
66
67 dcl ( copy_mac init(257),
68 set_bits init(440),
69 move_words init(481),
70 lda init(1),
71 sta init(4),
72 nop_mac init(528),
73 move_3 init(568),
74 conv_mac(2) init(515,26),
75 copy_bits init(476)) fixed bin(15) int static;
76
77 dcl table(0:1,0:1,3:6) fixed bin(15) int static
78 init( 569, 570, 571, 0,
79 572, 573, 0, 0,
80 574, 575, 0, 0,
81 576, 577, 578, 579);
82
83 dcl conv_factor(2) fixed bin int static
84 init(2,9);
85
86 dcl fix_bin fixed bin based;
87
88 %include reference;
89 %include symbol;
90 %include array;
91 %include nodes;
92 %include bases;
93 %include operator;
94 %include op_codes;
95 %include cgsystem;
96 %include boundary;
97
98 adjust = "0"b;
99
100 p = pt;
101
102 pd = prepare_operand((p -> operand(1)),-1,atomic);
103 ps = prepare_operand((p -> operand(2)),-1,atomic);
104
105 have_constant_length = "0"b;
106 q = p -> operand(3);
107 if q -> node.type ^= operator_node
108 then if q -> reference.symbol -> symbol.constant
109 then do;
110 have_constant_length = "1"b;
111 amount = q -> reference.symbol -> symbol.initial -> fix_bin;
112 end;
113
114 if p -> operator.op_code = copy_string
115 then do;
116
117
118
119
120 if have_constant_length
121 then if mod(amount,bits_per_word) = 0
122 & ps -> reference.units = word_ & ^ ps -> reference.fo_in_qual
123 & pd -> reference.units = word_ & ^ pd -> reference.fo_in_qual
124 then amount = divide(amount,bits_per_word,17,0);
125 else go to str;
126 else go to str;
127 end;
128
129
130
131 if pd -> reference.temp_ref
132 then pd -> reference.value_in.storage = "1"b;
133
134 if ps -> reference.varying_ref
135 then do;
136
137
138
139 adjust = "1"b;
140 ps -> reference.c_offset = ps -> reference.c_offset - 1;
141 pd -> reference.c_offset = pd -> reference.c_offset - 1;
142 end;
143
144 if have_constant_length
145 then go to const;
146
147
148
149 case = 1;
150 call make_copy;
151
152 if adjust
153 then call adjust_offset;
154
155 return;
156
157
158
159
160 const: if amount > 6 then go to long;
161
162 call state_man$erase_reg((alters(fixed(amount > 1,1))));
163
164 call make_both_addressable(pd,ps,amount > 1);
165
166 do i = 1 to 2;
167 if ^ arg(i) -> reference.even
168 then do;
169 s = arg(i) -> reference.symbol;
170 if arg(i) -> reference.data_type > 0
171 then do;
172 if substr(double_data,arg(i) -> reference.data_type,1)
173 then if ^ s -> symbol.packed
174 then arg(i) -> reference.even = "1"b;
175 end;
176 else do;
177
178
179
180 if ^ arg(i) -> reference.array_ref & s -> symbol.array ^= null
181 then if s -> symbol.array -> array.element_boundary > word_
182 then arg(i) -> reference.even = "1"b;
183 else;
184 else if s -> symbol.boundary > word_
185 then arg(i) -> reference.even = "1"b;
186 end;
187 end;
188 end;
189
190 if amount <= 2
191 then do;
192 if pd -> reference.temp_ref & ^ pd -> reference.aggregate
193 then if pd -> reference.symbol -> symbol.decimal
194 | pd -> reference.symbol -> symbol.complex
195 then pd -> reference.ref_count = pd -> reference.ref_count + 1;
196
197 amount = amount - 1;
198 call expmac$one((lda),ps,amount);
199 call expmac$one((sta),pd,amount);
200 goto done;
201 end;
202
203
204
205
206 if ^ pd -> reference.even & ^ ps -> reference.even
207 & (((pd -> address.base ^= sp & pd -> address.base ^= lp) | pd -> address.tag ^= "0"b)
208 | ((ps -> address.base ^= sp & ps -> address.base ^= lp) | ps -> address.tag ^= "0"b))
209 then do;
210
211
212
213 if amount > 3 then goto long;
214
215 macro = move_3;
216
217 move: if pd -> reference.temp_ref & ^ pd -> reference.aggregate
218 then if pd -> reference.long_ref
219 | pd -> reference.symbol -> symbol.decimal
220 | pd -> reference.symbol -> symbol.complex
221 then pd -> reference.ref_count = pd -> reference.ref_count + 1;
222
223 call expmac$many(macro,addr(arg),2);
224 done: pd -> reference.perm_address,
225 ps -> reference.perm_address = "0"b;
226
227 if adjust
228 then call adjust_offset;
229
230 return;
231 end;
232
233
234
235
236
237 if amount <= 6
238 then do;
239
240 macro = table(fixed(pd -> reference.even,1),fixed(ps -> reference.even,1),amount);
241
242 if macro ^= 0 then goto move;
243 end;
244
245
246
247
248
249 long: pd -> reference.perm_address,
250 ps -> reference.perm_address = "0"b;
251
252
253
254 n = chars_per_word * amount;
255 issue_move_mac:
256 call long_op$two_eis(pd,n,(move_words),ps);
257
258 if adjust
259 then call adjust_offset;
260
261 return;
262
263
264
265
266 str: q1 = pd;
267 q2 = ps;
268
269 if pd -> reference.temp_ref
270 then pd -> reference.value_in.storage = "1"b;
271
272 if ps -> reference.symbol -> symbol.char
273 | ps -> reference.symbol -> symbol.picture
274 | ps -> reference.symbol -> symbol.decimal
275 then do;
276
277
278
279 q = p -> operand(3);
280
281
282
283 if have_constant_length
284 then do;
285 n = divide(amount,bits_per_char,17,0);
286 go to issue_move_mac;
287 end;
288
289 case = 2;
290 call make_copy;
291 return;
292 end;
293
294 p1 = p -> operand(3);
295 p1 = eval_exp(p1,"1"b);
296
297 p2 = q2 -> reference.length;
298 q2 -> reference.length = p1;
299
300 big_length_hold = q2 -> reference.big_length;
301 if p1 -> node.type = operator_node
302 then p1 = p1 -> operand(1);
303 q2 -> reference.big_length = p1 -> reference.symbol -> symbol.c_dcl_size > max_p_xreg;
304
305 do i = 1 to 2;
306 if arg(i) -> reference.units = character_
307 then do;
308
309
310
311 if ^ arg(i) -> reference.shared
312 then arg(i) -> reference.ref_count = arg(i) -> reference.ref_count + 1;
313 base = base_man$load_any_var_and_lock(2,arg(i));
314 arg(i) -> reference.perm_address = "1"b;
315 end;
316 end;
317
318 call expmac$two_eis((copy_bits),q1,q2);
319 q2 -> reference.length = p2;
320 q2 -> reference.big_length = big_length_hold;
321
322 q1 -> reference.perm_address,
323 q2 -> reference.perm_address = "0"b;
324
325 return;
326
327 move_block: entry(dest,source,number);
328
329 dcl dest ptr,
330 source ptr,
331 number fixed bin;
332
333 pd = dest;
334 ps = source;
335 amount = number;
336
337 adjust = "0"b;
338
339 goto const;
340
341 make_copy: proc;
342
343
344
345
346
347 q = prepare_operand(q,1,atomic);
348 if atomic then call load(q,0); else call compile_exp((p -> operand(3)));
349
350
351
352 call expmac((conv_mac(case)),c_a((conv_factor(case)),case));
353
354
355
356 call expmac$two_eis((copy_mac),pd,ps);
357
358 end;
359
360
361 adjust_offset: proc;
362
363 ps -> reference.c_offset = ps -> reference.c_offset + 1;
364 pd -> reference.c_offset = pd -> reference.c_offset + 1;
365
366 end;
367
368
369
370 end;