1
2
3
4
5
6
7
8
9
10
11 declare_structure: proc(ps);
12
13
14
15
16 dcl (adam,base,bit_offset,allocate,ps,s,d,b,off,q) ptr;
17 dcl n fixed bin(15);
18 dcl coff fixed bin(31);
19 dcl cdesc bit(1);
20
21 dcl pl1_stat_$eis_mode bit(1) aligned ext static;
22
23 dcl (min,max,null,fixed,divide,string,substr) builtin;
24
25 %include semant;
26 %include symbol;
27 %include array;
28 %include block;
29 %include reference;
30 %include operator;
31 %include statement;
32 %include op_codes;
33 %include nodes;
34 %include statement_types;
35 %include boundary;
36 %include list;
37 %include system;
38 ^L
39 s = ps;
40 b = s->symbol.block_node;
41 adam = s;
42
43
44
45
46
47
48
49
50
51
52
53 cdesc = s->symbol.parameter | s->symbol.return_value | s->symbol.controlled;
54
55 if cdesc
56 then s->symbol.descriptor = declare_descriptor$param((s->symbol.block_node),null,s,null,"1"b);
57
58 call structure_scan(s);
59
60
61
62
63 allocate,bit_offset,base = null;
64
65 if s->symbol.auto
66 then if s->symbol.exp_extents
67 then do;
68 base = declare_pointer(b);
69 allocate = create_operator(allot_auto,2);
70 allocate->operand(1) = base;
71 end;
72
73 if s->symbol.based
74 then do;
75 base = s->symbol.reference->reference.qualifier;
76 if s->symbol.unaligned & s->symbol.packed
77 then if pl1_stat_$eis_mode
78 then s->symbol.reference->reference.fo_in_qual = "1"b;
79 else bit_offset = create_operator(bit_pointer,2);
80 end;
81
82 if s->symbol.parameter
83 then do;
84 if ^s->symbol.allocated
85 then do;
86 base = create_operator(param_ptr,3);
87 base->operand(2) = declare_constant$integer(fixed(s->symbol.location));
88 base->operand(3) = b;
89 end;
90 else base = declare_pointer(b);
91
92 if s->symbol.unaligned & s->symbol.packed
93 then if pl1_stat_$eis_mode
94 then s->symbol.reference->reference.fo_in_qual = "1"b;
95 else do;
96 bit_offset = create_operator(bit_pointer,2);
97 bit_offset->operand(2) = base;
98 end;
99 end;
100
101
102
103 s->symbol.reference->reference.qualifier = base;
104
105
106
107 if s->symbol.packed
108 then do;
109 s->symbol.reference->reference.padded_ref =
110 ^(s->symbol.based|s->symbol.parameter|s->symbol.defined);
111
112 if s->symbol.reference->reference.padded_ref
113 then s->symbol.boundary = max(s->symbol.boundary,word_);
114 end;
115
116
117
118 if bit_offset ^= null
119 then do;
120 s->symbol.reference->reference.offset = bit_offset;
121 s->symbol.reference->reference.units = bit_;
122 end;
123
124
125
126 if s -> symbol.based | s -> symbol.parameter | s -> symbol.defined | s -> symbol.external
127 then s -> symbol.aliasable = "1"b;
128
129
130
131
132
133
134
135
136
137
138
139
140 call get_structure_size(s);
141
142 s->symbol.reference->reference.c_length = 0;
143
144
145
146 if s -> symbol.c_word_size > max_words_per_variable
147 then call semantic_translator$error (357,s);
148
149
150
151
152
153
154
155 if cdesc
156 then if s->symbol.descriptor = null
157 then s->symbol.descriptor = declare_descriptor((s->symbol.block_node),null,s,null,"1"b);
158 else if s->symbol.parameter
159 then if s->symbol.descriptor->reference.symbol->symbol.descriptor = null
160 then s->symbol.descriptor = declare_descriptor((s->symbol.block_node),null,s,null,"1"b);
161
162
163
164
165 if allocate^=null
166 then do;
167 allocate->operand(2) = copy_expression(s->symbol.word_size);
168
169 q = create_statement$prologue(assignment_statement,b,null,(b->block.prefix));
170 q->statement.root = allocate;
171 end;
172
173 call initialize(s);
174
175 return;
176 ^L
177
178
179
180
181
182
183
184
185
186 structure_scan: proc(ps);
187
188 dcl (ps,d,s) ptr;
189
190 s = ps;
191
192 if s->symbol.member
193 then do;
194 s->symbol.level = s->symbol.father->symbol.level+1;
195
196 if ^(s -> symbol.aligned | s -> symbol.unaligned)
197 then do;
198 s -> symbol.aligned = s -> symbol.father -> symbol.aligned;
199 s -> symbol.unaligned = s -> symbol.father -> symbol.unaligned;
200 end;
201 end;
202
203 if s -> symbol.son = null
204 then do;
205 call validate (s);
206 if s -> symbol.member
207 then do;
208 string(s->symbol.storage_class) = string(adam->symbol.storage_class);
209 s->symbol.equivalence = adam->symbol.equivalence;
210 end;
211 call get_size(s);
212 return;
213 end;
214
215 s->symbol.structure,s->symbol.packed = "1"b;
216
217 do d = s->symbol.son repeat d->symbol.brother while(d^=null);
218 call structure_scan(d);
219 s->symbol.packed = s->symbol.packed & d->symbol.packed;
220 s->symbol.boundary = max(s->symbol.boundary,d->symbol.boundary);
221 s->symbol.refer_extents = s->symbol.refer_extents | d->symbol.refer_extents;
222 s->symbol.exp_extents = s->symbol.exp_extents |d->symbol.exp_extents;
223 s->symbol.star_extents = s->symbol.star_extents | d->symbol.star_extents;
224 end;
225
226 call validate(s);
227
228 if s -> symbol.member
229 then do;
230 string(s->symbol.storage_class) = string(adam->symbol.storage_class);
231 s->symbol.equivalence = adam->symbol.equivalence;
232 end;
233
234 if s -> symbol.aligned
235 then do;
236 s -> symbol.boundary = max(s -> symbol.boundary,word_);
237 s -> symbol.packed = "0"b;
238 end;
239
240 if s->symbol.dimensioned
241 then s->symbol.array->array.element_boundary = s->symbol.boundary;
242
243 end structure_scan;
244 ^L
245
246
247
248
249
250
251
252
253
254 get_structure_size: proc(ps);
255
256 dcl (ps,s,d,f,r,q,p,fsize,rv,t) ptr;
257 dcl (i,j,k) fixed bin(3);
258 dcl fc_size fixed bin(31);
259
260 dcl opcodes(4) bit(9) aligned initial(bit_to_char,bit_to_word,char_to_word,half_to_word);
261
262 dcl opcode_index(4,7) fixed bin(15) internal static init(0,0,1,0,2,2,2,
263 0,0,0,0,0,0,0,
264 0,0,0,0,3,3,3,
265 0,0,0,0,4,4,4);
266
267 dcl round_const(4,7) fixed bin(15) int static initial(0,0,9,0,36,36,36,
268 0,0,0,0, 0, 0, 0,
269 0,0,0,0, 4, 4, 4,
270 0,0,0,0, 2, 2, 2);
271
272 dcl mod_const(6:7) fixed bin(15) int static initial(2,4);
273
274 dcl mod_ops(6:7) bit(9) aligned initial(word_to_mod2,word_to_mod4);
275
276 dcl offset_ops(4) bit(9) aligned initial(mod_bit,""b,mod_byte,mod_half);
277
278 s = ps;
279 j = s->symbol.boundary;
280 f = s->symbol.reference;
281 fc_size = 0;
282 fsize = null;
283
284 do d = s->symbol.son repeat d->symbol.brother while(d^=null);
285 string(d->symbol.storage_class) = string(s->symbol.storage_class);
286 d->symbol.aliasable = adam->symbol.aliasable;
287 d->symbol.equivalence = adam->symbol.equivalence;
288 r = d->symbol.reference;
289 r->reference.qualifier = base;
290 if pl1_stat_$eis_mode
291 then r -> reference.fo_in_qual = adam -> symbol.reference -> reference.fo_in_qual;
292 i = d->symbol.boundary;
293
294
295
296
297
298
299 if i<=j
300 then do;
301 d->symbol.boundary = j;
302 go to get_offset;
303 end;
304
305
306
307 if j < word_
308 then do;
309 if fsize = null
310 then fc_size = divide(fc_size+round_const(j,i)-1,round_const(j,i),31,0);
311 else do;
312 q = create_operator(opcodes(opcode_index(j,i)),2);
313 q->operand(2) = fsize;
314 fsize = q;
315 end;
316 end;
317
318
319
320 if i > word_
321 then do;
322 if fsize = null
323 then fc_size = divide(fc_size+mod_const(i)-1,mod_const(i),31,0)*mod_const(i);
324 else do;
325 q = create_operator(mod_ops(i),2);
326 q->operand(2) = fsize;
327 fsize = q;
328 end;
329 end;
330
331
332
333 j = i;
334
335
336
337
338 get_offset:
339 t = f->reference.offset;
340
341 if t ^= null
342 then if t -> node.type = operator_node
343 then if substr(t -> op_code,1,5) = substr(mod_bit,1,5)
344 then t = t -> operand(3);
345
346 r->reference.offset = t;
347 r->reference.c_offset = f->reference.c_offset;
348 k,r->reference.units = f->reference.units;
349
350 off = r->reference.offset;
351 coff = r->reference.c_offset;
352
353 call offset_adder(off,coff,k,"0"b,(fsize),(fc_size),j,"0"b,r->reference.fo_in_qual);
354
355 r->reference.offset = off;
356 r->reference.c_offset = coff;
357
358 if r->reference.c_offset = 0 & r->reference.offset = null
359 then r->reference.units = 0;
360 else r->reference.units = min(k,word_);
361
362
363
364
365
366 if ^pl1_stat_$eis_mode
367 then if r->reference.offset ^= null
368 then if r->reference.units < word_
369 then do;
370 q = r->reference.offset;
371
372 if q->node.type = operator_node
373 then if q->operator.op_code ^=bit_pointer
374 then do;
375 p = create_operator(offset_ops(r->reference.units),3);
376 p->operand(3)=q;
377 r->reference.offset = p;
378 end;
379 else;
380 else do;
381 p = create_operator(offset_ops(r->reference.units),3);
382 p->operand(3) = q;
383 r->reference.offset = p;
384 end;
385 end;
386
387 if pl1_stat_$eis_mode
388 then if r->reference.units=character_
389 then if d->symbol.bit | d->symbol.binary | d->symbol.ptr
390 then do;
391 r->reference.units = bit_;
392 r->reference.c_offset = r->reference.c_offset * bits_per_character;
393
394 if r->reference.offset^=null
395 then do;
396 p = create_operator(mult,3);
397 p->operand(2) = declare_constant$integer(bits_per_character);
398 p->operand(3) = r->reference.offset;
399 r -> reference.offset = p;
400 end;
401 end;
402
403
404
405 if d->symbol.packed
406 then do;
407
408 do q = d repeat q->symbol.father while(q^=null);
409 if q->symbol.brother ^= null then go to succ;
410 end;
411 succ:
412 if q = null
413 then r->reference.padded_ref = ^(d->symbol.based|d->symbol.parameter|d->symbol.defined);
414 else r->reference.padded_ref = q->symbol.brother->symbol.aligned;
415 end;
416
417
418
419 if d->symbol.entry
420 then do;
421 if d->symbol.returns
422 then do;
423 rv = d->symbol.dcl_size;
424 rv->symbol.return_value = "1"b;
425 if rv->symbol.structure | rv->symbol.dimensioned | rv->symbol.star_extents
426 then do;
427 d->symbol.dcl_size = copy_expression(d->symbol.dcl_size);
428 call declare(rv);
429 d->symbol.dcl_size->symbol.star_extents = rv->symbol.star_extents;
430 end;
431 else call declare(rv);
432 end;
433 do q = d->symbol.general repeat q->element(2) while(q^=null);
434 q->element(1)->symbol.param_desc ="1"b;
435 call declare((q->element(1)));
436 end;
437 end;
438
439
440
441
442
443
444 if d->symbol.structure then call get_structure_size(d);
445
446
447
448 call offset_adder(fsize,fc_size,j,"0"b,(d->symbol.word_size),(d->symbol.c_word_size),
449 (r->reference.c_length),"0"b,"0"b);
450 r->reference.c_length = 0;
451
452 if (d->symbol.char|d->symbol.bit) & ^d->symbol.varying
453 then do;
454 r->reference.c_length = d->symbol.c_dcl_size;
455 r->reference.length = d->symbol.dcl_size;
456 end;
457
458 if d->symbol.picture
459 then r->reference.c_length = d->symbol.c_dcl_size;
460 end;
461
462
463
464
465 s->symbol.reference->reference.c_length = j;
466 s->symbol.word_size = fsize;
467 s->symbol.c_word_size = fc_size;
468
469
470
471
472 call get_size(s);
473
474 end get_structure_size;
475 ^L
476 initialize: proc(p);
477
478 dcl (p,q,r) ptr;
479
480 r = p;
481
482 do q = r repeat q->symbol.son while(q^=null);
483
484 if q->symbol.auto
485 & (q->symbol.initialed
486 |q->symbol.area)
487 then call expand_initial(q,null,null);
488
489 call initialize((q->symbol.brother));
490
491 end;
492
493 end initialize;
494
495 end ;