1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24 load: proc(pt,control);
25
26 dcl pt ptr,
27 control fixed bin;
28
29 dcl (p,q) ptr,
30 (i,n,type,size,d,dt,k,aq_length,units,cfo) fixed bin,
31 offset fixed bin(8),
32 (mac,macro,shift) fixed bin(15),
33 mask bit(72) aligned,
34 (fs,ft,arith,available) bit(1) aligned,
35 for_save bit(1) aligned init("0"b),
36 cg_stat$cur_statement ptr ext static,
37 error entry(fixed bin,ptr,ptr),
38 c_a entry(fixed bin,fixed bin) returns(ptr),
39 generate_constant entry(bit(*) aligned,fixed bin) returns(ptr),
40 stack_temp$free_temp entry(ptr),
41 (long_op,long_op$c_or_b) entry(ptr,fixed bin,fixed bin(15)),
42 (xr_man$load_var,adjust_ref_count) entry(ptr,fixed bin),
43 xr_man$load_const entry(fixed bin,fixed bin),
44 aq_man$trim_aq entry(fixed bin),
45 aq_man$left_shift entry(fixed bin(8),bit(1) aligned),
46 save_value entry(ptr),
47 make_n_addressable entry(ptr,fixed bin),
48 get_reference entry() returns(ptr),
49 state_man$erase_reg entry(bit(19) aligned),
50 expmac$two_eis entry(fixed bin(15),ptr,ptr),
51 expmac$one entry(fixed bin(15),ptr,fixed bin),
52 expmac$zero entry(fixed bin(15)),
53 expmac entry(fixed bin(15),ptr);
54
55 dcl (addr,bit,fixed,mod,null,substr) builtin;
56
57 dcl ( ldfx1 init(7),
58 ldfx2 init(8),
59 negate_op(4) init(255,38,39,39),
60 testfx1 init(508),
61 test_lda init(332),
62 cana init(323),
63 lda init(1),
64 als init(134),
65 lls init(63),
66 anaq init(42),
67 lrl init(62),
68 lrs init(492),
69 unpack_fl1 init(486),
70 unpack_cfl1 init(488),
71 clear_aq init(58),
72 move_cs_load_1 init(100),
73 set_chars init(436),
74 load_logical init(380)) fixed bin(15) int static;
75
76 dcl operator_table init(262046) fixed bin(18) int static;
77
78 %include cgsystem;
79 %include cg_reference;
80 %include data_types;
81 %include machine_state;
82 %include boundary;
83 %include symbol;
84
85 p = pt;
86
87 begin: available, fs, ft = "0"b;
88
89 type = p -> reference.data_type;
90
91 l4: if type = unpacked_ptr
92 then do;
93 type = real_fix_bin_2;
94 goto chk;
95 end;
96
97 if type = packed_ptr
98 then do;
99 mac = lrl;
100 type = real_fix_bin_1;
101 goto chk;
102 end;
103
104 if type >= char_string
105 then do;
106 arith = "0"b;
107 goto string_;
108 end;
109
110 if type >= real_fix_dec
111 then do;
112 call error(374,cg_stat$cur_statement,p);
113 return;
114 end;
115
116 mac = lrs;
117 if p -> reference.symbol ^= null
118 then if p -> reference.symbol -> symbol.unsigned
119 then mac = lrl;
120
121 chk: arith = "1"b;
122
123 if control ^= 0
124 then do;
125 n = 3;
126 if p -> reference.value_in.q
127 then if type >= real_fix_bin_2 | (p -> reference.temp_ref & ^ p -> reference.value_in.storage)
128 then do;
129 call adjust_ref_count(p,-1);
130 call expmac$zero((negate_op(type)));
131 return;
132 end;
133 end;
134 else do;
135 n = -1;
136
137 if p -> reference.value_in.q
138 then do;
139 if ft
140 then if machine_state.indicators ^= 2
141 then if (p -> reference.temp_ref & ^ p -> reference.value_in.storage) | ^ p -> reference.aligned_ref
142 then do;
143 call expmac$zero(testfx1 + type - 1);
144 machine_state.indicators = 2;
145 end;
146 else go to l1;
147
148 drop: if ^ p -> reference.shared
149 then call adjust_ref_count(p,-1);
150
151 if ^ p -> reference.long_ref
152 then call sv_value;
153
154 return;
155 end;
156 end;
157
158 l1: if ^ p -> reference.aligned_ref
159 then do;
160 size = p -> reference.c_length;
161 type = bit_string;
162 if fs then goto l2; else goto str1;
163 end;
164
165 if type = complex_flt_bin_1 then macro = ldfx2;
166 else macro = ldfx1 + n + type;
167
168 call expmac(macro,p);
169
170 thru: call sv_value;
171
172 if control = 0
173 then do;
174 q_reg.variable(1) = p;
175 q_reg.number = 1;
176 machine_state.indicators = 2;
177 p -> reference.value_in.q = "1"b;
178 end;
179
180 return;
181
182
183
184 string_: if p -> reference.long_ref
185 then do;
186
187 lg: if p -> reference.value_in.string_aq
188 then goto drop;
189
190 call long_op$c_or_b(p,0,(set_chars));
191
192 string_reg.variable = p;
193 string_reg.size = p -> reference.c_length;
194
195 p -> reference.value_in.string_aq = "1"b;
196 return;
197 end;
198
199 size = p -> reference.c_length * convert_size(type);
200
201 if size = 0
202 then do;
203 caq: call expmac$zero((clear_aq));
204 goto l72;
205 end;
206
207 l2: if p -> reference.value_in.a
208 then do;
209 if ft
210 then if machine_state.indicators ^= 1
211 then goto str1;
212
213 if a_reg.size < size then goto str1;
214
215 call adjust_ref_count(p,-1);
216
217 offset = a_reg.offset;
218 if offset ^= 0
219 then do;
220 aq_length, k = offset + size;
221
222 if size ^= a_reg.size
223 then a_reg.length = k;
224 else k, aq_length = a_reg.length;
225 goto sh;
226 end;
227
228 if mod(a_reg.length,bits_per_word) ^= 0 & ^ fs then goto mask_it;
229
230 if a_reg.size = size
231 then do;
232 if mod(a_reg.length,bits_per_word) = 0
233 then call sv_value;
234 return;
235 end;
236
237 goto mask_it;
238 end;
239
240
241
242
243
244 if p -> reference.value_in.q
245 then do;
246 slide: units = p -> reference.units;
247 if units = word_ then cfo = 0;
248 else do;
249 cfo = mod(p -> reference.c_offset * convert_offset(units),
250 bits_per_word);
251 if cfo < 0 then cfo = cfo + bits_per_word;
252 end;
253
254 call adjust_ref_count(p,-1);
255
256
257
258
259
260 call state_man$erase_reg("11"b);
261
262 call expmac((lls),c_a((cfo + bits_per_word),1));
263
264 k, aq_length = size;
265
266 if fs then goto done; else goto l5;
267 end;
268
269 str1: if size > bits_per_word then d = fixed(control ^= 0,1); else d = 0;
270
271 aq_length = bits_per_word*(d + 1);
272
273 if p -> reference.aligned_ref
274 then do;
275 if ft then macro = test_lda; else macro = lda;
276 call expmac$one(macro,p,d);
277 goto done;
278 end;
279
280 call setup;
281
282 sh: if offset > 0
283 then do;
284 call aq_man$left_shift(offset, k > bits_per_word);
285 k, aq_length = a_reg.length;
286 end;
287 else if p -> reference.padded_ref then goto done;
288
289 l5: if mod(k,bits_per_word) ^= 0
290 then do;
291 mask_it: call aq_man$trim_aq(size);
292 l72: aq_length = bits_per_two_words;
293 end;
294
295 done: if arith & ^ fs
296 then do;
297
298 type = p -> reference.data_type;
299
300 if type <= real_fix_bin_2 | type = packed_ptr
301 then do;
302 k = bits_per_two_words - size;
303 em: call expmac(mac,c_a(k,1));
304 goto thru;
305 end;
306
307 if type <= real_flt_bin_2
308 then do;
309 call expmac$zero(unpack_fl1 - real_flt_bin_1 + type);
310 goto thru;
311 end;
312
313 if type = complex_flt_bin_1
314 then do;
315 k = bits_per_word - divide(size,2,17,0);
316 if k > 0
317 then do;
318 mac = unpack_cfl1;
319 goto em;
320 end;
321 end;
322
323 goto thru;
324 end;
325
326 a_reg.length = aq_length;
327 a_reg.offset = 0;
328
329 done1: a_reg.size = size;
330
331 if a_reg.offset = 0
332 then call sv_value;
333
334 a_reg.number = 1;
335 a_reg.variable(1) = p;
336 p -> reference.value_in.a = "1"b;
337
338 if fs
339 then if ^ p -> reference.aligned_ref
340 then if a_reg.offset ^= 0 | mod(a_reg.length,bits_per_word) ^= 0
341 then machine_state.indicators = 0;
342
343 back: return;
344
345 load$for_test: entry(pt,control);
346
347
348
349
350 p = pt;
351
352 if ^ p -> reference.aligned_ref
353 then if p -> reference.ref_count > 1
354 then goto begin;
355
356 ft = "1"b;
357 arith, fs, available = "0"b;
358
359 type = p -> reference.data_type;
360
361 if p -> reference.ref_count > 1 then goto l4;
362
363 if type ^= bit_string then goto l4;
364
365 if p -> reference.value_in.a
366 then do;
367 if machine_state.indicators = 1
368 then if a_reg.offset = 0
369 then if mod(a_reg.length,bits_per_word) = 0
370 then goto drop;
371
372 call adjust_ref_count(p,-1);
373 available = "1"b;
374 end;
375
376 size = p -> reference.c_length;
377
378 if p -> reference.aligned_ref & ^ available
379 then do;
380 call expmac$one((test_lda),p,control);
381 a_reg.offset = 0;
382 a_reg.length = fixed(size > bits_per_word,1) * bits_per_word + bits_per_word;
383 goto done1;
384 end;
385
386 call setup;
387
388 mask = (72)"0"b;
389 substr(mask,cfo+1,size) = (72)"1"b;
390
391 q = generate_constant(mask,d+1);
392
393 call expmac(cana+d,q);
394
395 if available then return;
396
397 done2: a_reg.offset = cfo;
398 a_reg.length = k;
399 goto done1;
400
401 load$for_store: entry(pt,control);
402
403
404
405 p = pt;
406
407 if ^ p -> reference.aligned_ref
408 then if p -> reference.ref_count > 1
409 then goto begin;
410
411 fs = "1"b;
412 arith, available, ft = "0"b;
413
414 type = p -> reference.data_type;
415
416 if type ^= char_string
417 then if type ^= bit_string
418 then goto l4;
419
420 if p -> reference.long_ref then goto lg;
421
422 size = p -> reference.c_length * convert_size(type);
423
424 if p -> reference.value_in.a
425 then if a_reg.size >= size
426 then goto drop;
427 else;
428 else if p -> reference.value_in.q
429 then goto slide;
430
431 if size = 0 then goto caq;
432
433 if p -> reference.aligned_ref then goto str1;
434
435 call setup;
436
437 goto done2;
438
439 load$short_string: entry(pt,control);
440
441
442
443
444 fs = "1"b;
445 arith, available, ft = "0"b;
446
447 p = pt;
448 type = p -> reference.data_type;
449
450 size = bits_per_word*(control+1);
451 goto l2;
452
453 load$long_string: entry(pt);
454
455
456
457
458 p = pt;
459 type = p -> reference.data_type;
460 goto lg;
461
462 load$for_save: entry(pt,control);
463
464
465
466
467 p = pt;
468 for_save = "1"b;
469 go to begin;
470
471 sv_value: proc;
472
473 if ^ p -> reference.aligned_ref
474 then if p -> reference.ref_count > 0
475 then call save_value(p);
476
477 end;
478
479 setup: proc;
480
481 dcl (p1,p2) ptr;
482
483 units = p -> reference.units;
484 if available
485 then cfo, offset = a_reg.offset;
486 else if units = word_
487 then cfo, offset = 0;
488 else do;
489 cfo = mod(p -> reference.c_offset * convert_offset(units),bits_per_word);
490 if cfo < 0 then cfo = cfo + bits_per_word;
491
492 if ^ p -> reference.hard_to_load
493 then offset = cfo;
494 else offset = 0;
495 end;
496
497 k = size + offset;
498
499 d = fixed(k > bits_per_word,1);
500
501 if available then return;
502
503
504
505
506 if p -> reference.hard_to_load
507 then do;
508 if (^ arith | mod(size,bits_per_word) = 0) & (p -> reference.ref_count > 1 | for_save)
509 & ^ p -> reference.aggregate
510 then do;
511
512
513
514
515
516 call make_n_addressable(addr(pt),1);
517
518 p2 = get_reference();
519
520 p2 -> reference = p -> reference;
521 p2 -> reference.qualifier, p2 -> reference.offset, p2 -> reference.length = null;
522 string(p2 -> reference.info) = "0"b;
523 p2 -> reference.perm_address = "1"b;
524
525 call save_value(p);
526
527 p -> reference.value_in.storage = "1"b;
528 p1 = p;
529 end;
530
531 else do;
532
533
534
535 p1 = c_a(46,4);
536 p2 = p;
537 end;
538
539 dt = type - char_string;
540
541 call expmac$two_eis(move_cs_load_1 + 2*d + dt,p1,p2);
542
543 if for_save then go to back;
544
545 call expmac$one((lda),p1,d);
546 aq_length = bits_per_word * (d + 1);
547 go to done;
548 end;
549
550
551 call expmac$one((lda),p,d);
552
553 a_reg.size = size;
554 a_reg.offset = cfo;
555 a_reg.length = k;
556
557 end;
558
559 end;