1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23 long_op: proc(pt,size,macro);
24
25 dcl pt ptr,
26 size fixed bin,
27 macro fixed bin(15);
28
29 dcl cg_stat$extended_stack bit(1) ext;
30 dcl cg_stat$text_pos fixed bin(18) ext;
31
32 dcl (p,q) ptr,
33 mac fixed bin(15),
34 (no_size,have_arg,flush,adjust) bit(1),
35 (i,n,cfo) fixed bin;
36
37 dcl odd_bases bit(19) aligned int static init("0000000000000001111"b);
38
39 dcl xr_man$load_var entry(ptr,fixed bin),
40 xr_man$load_const entry(fixed bin,fixed bin),
41 base_man$load_var entry(fixed bin,ptr,fixed bin),
42 load_size entry(ptr),
43 generate_constant$real_fix_bin_1 entry(fixed bin) returns(ptr),
44 load entry(ptr,fixed bin),
45 aq_man$lock entry(ptr,fixed bin),
46 state_man$erase_reg entry(bit(19) aligned),
47 state_man$unlock entry,
48 need_temp entry(ptr,bit(2) aligned),
49 expmac$zero entry(fixed bin(15)),
50 (expmac,expmac$eis,expmac$one_eis) entry(fixed bin(15),ptr),
51 adjust_ref_count entry(ptr,fixed bin),
52 state_man$update_ref entry(ptr),
53 base_man$update_base entry(fixed bin,ptr,fixed bin),
54 c_a entry(fixed bin,fixed bin) returns(ptr);
55
56 dcl mac_prog entry(fixed bin(15),ptr) variable;
57
58 dcl (abs,mod,null) builtin;
59
60 dcl ldfx1 fixed bin(15) int static init(7);
61
62 %include cgsystem;
63 %include reference;
64 %include data_types;
65
66 p = pt;
67 mac = macro;
68 flush, no_size, have_arg = "0"b;
69
70 common:
71 l1:
72
73
74
75
76 if ^no_size
77 then if size = 0
78 then call load_size(p);
79 else call load(generate_constant$real_fix_bin_1(abs(size)),0);
80
81
82
83 call aq_man$lock(null,2);
84
85 adjust = "0"b;
86
87
88
89 if p -> reference.temp_ref
90 then if p -> reference.ref_count = 1
91 then do;
92 adjust = "1"b;
93 p -> reference.ref_count = 2;
94 call need_temp(p,"11"b);
95 end;
96
97
98
99 call base_man$load_var(2,p,1);
100
101 if flush then call state_man$erase_reg((odd_bases));
102
103 if have_arg then call expmac(mac,arg);
104 else call expmac$zero(mac);
105
106 call state_man$unlock;
107
108 if adjust
109 then call adjust_ref_count(p,-1);
110
111 return;
112
113 long_op$c_or_b: entry(pt,size,macro);
114
115 p = pt;
116 mac = macro;
117 flush, no_size, have_arg = "0"b;
118
119 if p -> reference.data_type = bit_string then mac = mac + 1;
120
121 goto common;
122
123 long_op$extend_stack: entry(pt,op);
124
125 dcl op fixed bin(15);
126
127 p = pt;
128 call load_size(p);
129 call expmac$zero(op);
130 cg_stat$extended_stack = "1"b;
131 call state_man$update_ref(p);
132 call base_man$update_base(2,p,1);
133 return;
134
135 long_op$no_size: entry(pt,op);
136
137 flush = "0"b;
138 n_size:
139 p = pt;
140 mac = op;
141 no_size = "1"b;
142 have_arg = "0"b;
143 goto common;
144
145 long_op$with_arg: entry(pt,size,macro,arg);
146
147 dcl arg ptr;
148
149 p = pt;
150 mac = macro;
151 flush, no_size = "0"b;
152 have_arg = "1"b;
153 goto common;
154
155 long_op$io: entry(pt,op);
156
157 flush = "1"b;
158 go to n_size;
159
160 long_op$eis_operator: entry(pt,p2,macro);
161
162 dcl (p2,ref(2)) ptr;
163 dcl check bit(1) aligned;
164 dcl base_man$load_var_and_lock entry(fixed bin,ptr,fixed bin);
165 dcl load_size$a_or_q entry(ptr,fixed bin);
166
167
168
169
170
171 ref(1) = pt;
172 ref(2) = p2;
173 mac = macro;
174
175
176
177
178
179 do i = 1 to 2;
180 if ^ ref(i) -> reference.shared
181 then do;
182 n, ref(i) -> reference.ref_count = ref(i) -> reference.ref_count + 1;
183 check = n = 2;
184 end;
185 else check = "0"b;
186 call base_man$load_var_and_lock(2,ref(i),2*i-1);
187 if check then call need_temp(ref(i),"11"b);
188 call load_size$a_or_q(ref(i),3-i);
189 if i = 1
190 then call aq_man$lock(null,2);
191 end;
192
193
194
195 call state_man$unlock;
196
197 call expmac$zero(macro);
198
199
200
201 do i = 1 to 2;
202 if ^ ref(i) -> reference.shared then call adjust_ref_count(ref(i),-1);
203 end;
204
205 return;
206
207 long_op$eis: entry(pt,size,macro);
208
209 dcl size_hold fixed bin(24);
210 dcl length_hold ptr unal;
211 dcl big_length_hold bit(1) aligned;
212
213 mac_prog = expmac$eis;
214 go to eis_join;
215
216 long_op$one_eis: entry(pt,size,macro);
217
218 mac_prog = expmac$one_eis;
219
220 eis_join:
221 p = pt;
222 mac = macro;
223
224 if size = 0
225 then call mac_prog(mac,p);
226 else do;
227 call save_length;
228 call mac_prog(mac,p);
229 call restore_length;
230 end;
231
232 return;
233
234 long_op$two_eis: entry(pt,size,macro,pt2);
235
236 dcl pt2 ptr;
237 dcl expmac$two_eis entry(fixed bin(15),ptr,ptr);
238
239 p = pt2;
240
241 if size = 0
242 then call expmac$two_eis(macro,pt,p);
243 else do;
244 call save_length;
245
246 call expmac$two_eis(macro,pt,p);
247
248 call restore_length;
249 end;
250
251 return;
252
253 save_length: proc;
254
255 size_hold = p -> reference.c_length;
256 length_hold = p -> reference.length;
257 big_length_hold = p -> reference.big_length;
258 p -> reference.c_length = size;
259 p -> reference.big_length = size > max_index_register_value;
260 p -> reference.length = null;
261
262 end;
263
264 restore_length: proc;
265
266 p -> reference.big_length = big_length_hold;
267 p -> reference.c_length = size_hold;
268 p -> reference.length = length_hold;
269 if length_hold ^= null
270 then if p -> reference.ref_count = 0
271 then call adjust_ref_count((length_hold),-1);
272
273 end;
274
275 end;