1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4    *                                                         *
  5    * Copyright (c) 1972 by Massachusetts Institute of        *
  6    * Technology and Honeywell Information Systems, Inc.      *
  7    *                                                         *
  8    *********************************************************** */
  9 
 10 
 11 /* This procedure generates a jump to an out-of-line string operator,
 12    it loads         bp        with a pointer to the string
 13                     q         with size of string
 14    before generating the jump
 15 
 16    Initial Version:  2 September 1971 by BLW for Version II
 17           Modified: 15 July 1972 by BLW
 18           Modified: 15 February 1973 by RAB
 19           Modified: 11 June 1973 by RAB for EIS
 20           Modified: 26 November 1974 by RAB for long_op$one_eis
 21           Modified: 5 July 1976 by RAB to fix 1504          */
 22 
 23 long_op:  proc(pt,size,macro);
 24 
 25 dcl       pt ptr,             /* ptr to reference node */
 26           size fixed bin,     /* = 0 means use size from reference node */
 27           macro fixed bin(15); /* operator to be generated */
 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 /* load the string size if requested */
 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 /* lock the q register so that base_man doesn't accidentally flush it */
 82 
 83           call aq_man$lock(null,2);
 84 
 85           adjust = "0"b;
 86 
 87 /* If this is a string temporary, protect it from premature release */
 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 /* Load the bp with the address of the string */
 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           /* Used to make 2 operand calls to pl1_operators_.   Pointers to operands 1 and 2
168           are loaded into the bp and ab, respectively, and the lengths of the 2 operands
169           are loaded into the q and a registers, respectively. */
170 
171           ref(1) = pt;
172           ref(2) = p2;
173           mac = macro;
174 
175           /* Protect length exprs & string temps from being prematurely released, then
176              load the pointer registers with the addresses of the operands, free the
177              unneeded temps, and load the lengths */
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           /* Unlock the registers and issue the macro */
194 
195           call state_man$unlock;
196 
197           call expmac$zero(macro);
198 
199           /* Lower reference counts originally raised */
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;