1
2
3
4
5
6
7
8
9
10
11
12
13
14
15 declare_constant:
16 procedure (value, bv_input_type, size, scale) returns (ptr);
17
18
19
20 dcl value bit (*) aligned;
21 dcl bv_input_type bit (36) aligned;
22 dcl (size, scale) fixed bin (31);
23
24
25
26 dcl (p, q, p1, ref, pv, last, save) ptr;
27 dcl (boundary, i, j, word_size, bit_size, value_size) fixed bin(31);
28 dcl copy bit(18432);
29 dcl 1 ctype like type;
30 dcl 1 itype like type;
31
32
33
34 dcl const_value bit(value_size) aligned based;
35 dcl new_value bit(value_size) aligned based(pv);
36 dcl space bit(value_size) aligned based;
37
38
39
40 dcl (addr, bit, divide, hbound, index, max, null, string, substr) builtin;
41
42
43
44 dcl pl1_stat_$constant_list ptr external static;
45
46
47
48 dcl zero bit(36) int static init("0"b);
49
50
51
52 %include language_utility;
53 %include symbol;
54 %include pl1_symbol_type;
55 %include reference;
56 %include system;
57 %include mask;
58 %include boundary;
59 %include declare_type;
60 ^L
61
62
63 string (itype) = bv_input_type;
64 string (ctype) = string (itype) & declare_constant_mask;
65 if ctype.ptr then do;
66 boundary = mod2_;
67 bit_size = bits_per_word*2;
68 go to search;
69 end;
70 if ctype.offset then do;
71 boundary = word_;
72 bit_size = bits_per_word;
73 go to search;
74 end;
75 if ctype.decimal then do;
76 boundary = character_;
77 ctype.unaligned = itype.unaligned;
78 if ctype.unaligned
79 then do;
80 if ctype.float
81 then bit_size = size + 3;
82 else bit_size = size + 1;
83
84 bit_size = bit_size + mod(bit_size,2);
85 bit_size = divide(bit_size,packed_digits_per_character,24,0) * bits_per_character;
86 end;
87 else do;
88 if ctype.float
89 then bit_size = size + 2;
90 else bit_size = size + 1;
91
92 bit_size = bit_size * bits_per_character;
93 end;
94 if ctype.complex
95 then bit_size = bit_size * 2;
96 go to search;
97 end;
98 if ctype.char then do;
99 boundary = character_;
100 bit_size = size*bits_per_character;
101 go to search;
102 end;
103 if ctype.bit | ctype.arg_descriptor
104 then do;
105 boundary = bit_;
106 bit_size = size;
107 go to search;
108 end;
109
110
111
112 if ctype.fixed
113 then if itype.unaligned
114 then if itype.unsigned
115 then bit_size = size;
116 else bit_size = size + 1;
117 else if size>max_p_fix_bin_1
118 then bit_size = bits_per_word*2;
119 else bit_size = bits_per_word;
120
121 else if itype.unaligned
122 then bit_size = size+bits_per_binary_exponent+1;
123 else if size>max_p_flt_bin_1
124 then bit_size = bits_per_word*2;
125 else bit_size = bits_per_word;
126
127 if ctype.complex then bit_size = bit_size*2;
128 if bit_size > bits_per_word
129 then boundary = mod2_;
130 else boundary = word_;
131
132 ctype.unaligned = itype.unaligned;
133 ctype.unsigned = itype.unsigned;
134
135
136
137
138 search:
139 word_size = divide(bit_size+bits_per_word-1,bits_per_word,31,0);
140 value_size = word_size * bits_per_word;
141
142 substr(copy,1,value_size) = substr(value,1,bit_size);
143
144 pv = addr(copy);
145
146 save ,
147 last = null;
148 p = pl1_stat_$constant_list;
149
150 do while(p^=null);
151 if p->symbol.c_word_size >= word_size
152 then if p->symbol.initial->const_value = new_value
153 then do;
154 if word_size = 0
155 then if word_size ^= p -> symbol.c_word_size
156 then go to again;
157
158 save = p;
159
160 if p->symbol.c_bit_size^=bit_size then goto new_symbol;
161 if substr (string (p -> symbol.attributes), 1, 36) ^= string (ctype) then go to again;
162 if p->symbol.c_dcl_size ^= size then goto again;
163 if p->symbol.scale ^= scale then goto again;
164
165 return(p->symbol.reference);
166 end;
167 else;
168 else last = p;
169
170 again:
171 p = p->symbol.multi_use;
172 end;
173
174
175
176 new_symbol:
177 q = create_symbol(null,null,by_compiler);
178 q -> symbol.boundary = boundary;
179 substr (string (q -> symbol.attributes), 1, 36) = string (ctype);
180 q->symbol.c_dcl_size = size;
181 q->symbol.scale = scale;
182 q->symbol.c_word_size = word_size;
183 q->symbol.c_bit_size = bit_size;
184 q->symbol.internal,
185 q->symbol.constant = "1"b;
186
187 q->symbol.packed = q->symbol.unaligned;
188
189 q->symbol.allocate = save=null;
190 ref = q->symbol.reference;
191 if ctype.bit | ctype.char then ref->reference.c_length = size;
192 ref->reference.padded_ref = "1"b;
193
194
195
196
197 if save^=null
198 then do;
199 if save->symbol.equivalence = null
200 then q->symbol.equivalence = save;
201 else q->symbol.equivalence = save->symbol.equivalence;
202
203 do p1 = q -> symbol.equivalence repeat p1 -> symbol.equivalence while(p1 -> symbol.equivalence ^= null);
204 end;
205 p1 -> symbol.boundary = max(boundary,p1 -> symbol.boundary);
206
207 q->symbol.initial = save->symbol.initial;
208 end;
209 else do;
210 if word_size > 0
211 then do;
212 q->symbol.initial,p1 = create_storage((word_size));
213 p1->space = substr(copy,1,bit_size);
214 end;
215 else q -> symbol.initial = addr(zero);
216 end;
217
218
219
220 if last=null
221 then do;
222 q->symbol.multi_use=pl1_stat_$constant_list;
223 pl1_stat_$constant_list=q;
224 end;
225 else do;
226 q->symbol.multi_use=last->symbol.multi_use;
227 last->symbol.multi_use=q;
228 end;
229
230 return(ref);
231 ^L
232
233
234 dcl integer fixed bin(31);
235 dcl integer_image bit(bits_per_word) aligned based(addr(integer));
236 dcl bits aligned bit(*);
237 dcl char aligned char(*);
238 dcl char_image aligned bit(length(char)*bits_per_character) based(addr(char));
239
240 dcl length builtin;
241
242
243
244
245
246
247
248 dcl prectab(0:10) fixed binary static init(0,5,8,11,15,18,21,25,28,31,35);
249
250 integer: entry(integer) returns(ptr);
251
252 i = index(bit(integer,31),"1"b);
253 if i = 0 then i = 1; else i = 31 - i + 1;
254
255 do j = 0 to hbound(prectab,1)-1;
256 if i = prectab(j) then goto ok;
257 if i ^> prectab(j+1)
258 then do;
259 i = prectab(j+1);
260 goto ok;
261 end;
262 end;
263
264 i = max_p_fix_bin_1;
265
266 ok: return(declare_constant(integer_image,integer_type,i,0));
267
268 desc: entry(bits) returns(ptr);
269
270 return(declare_constant(bits,arg_desc_type,length(bits),0));
271
272 bit: entry(bits) returns(ptr);
273
274 return(declare_constant(bits,bit_type,length(bits),0));
275
276 char: entry(char) returns(ptr);
277
278 return(declare_constant(char_image,char_type,length(char),0));
279
280 end;