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 /* Procedure to move a block of data
 12 
 13    Modified:  3 January 1973 by BLW
 14   Modified:  19 February 1973 by RAB
 15  Modified:  12 June 1973 by RAB for EIS
 16 Modified: 21 December 1974 by RAB to fix bug 1277
 17 Modified: 22 January 1975 by RAB to fix bug 1314
 18 Modified: 22 July 1975 by RAB to fix bug 1388
 19 Modified: 9 February 1976 by RAB to fix 1462 & change ref cnt for dec
 20 Modified: 26 May 1976 by RAB to improve determination of reference.even for structures
 21 Modified: 5 July 1976 by RAB to fix 1504
 22    Modified: 27 October 1977 by RAB to more efficiently move packed aggregates of words
 23    Modified: 28 October 1977 by RAB to more efficiently move an aggregate when one is on even bound
 24           and other is on unknown bound
 25    Modified 781127 by PG to fix bug 1801 (setting even bit when it wasn't), introduced one year ago, and just found today!
 26    Modified 781128 by RAB to remove PG's fix to 1801 and put it in get_array_size
 27    Modified 790523 by RAB to fix 1820 & 1836 caused by assignment to complex
 28           binary temp other than complex_flt_bin_1
 29 */
 30 
 31 move_data: proc(pt);
 32 
 33 dcl       pt ptr;             /* points at an operator node */
 34 
 35 dcl       (p,q,q1,q2,p1,p2,s,arg(2)) ptr,
 36           pd ptr defined(arg(1)),
 37           ps ptr defined(arg(2)),
 38           (adjust,atomic,big_length_hold,have_constant_length,sp_ok) bit(1) aligned,
 39           base bit(3) aligned,
 40           (case,i,n,amount) fixed bin,
 41           macro fixed bin(15);
 42 
 43 dcl       (addr,addrel,bit,divide,fixed,mod,null,substr) builtin;
 44 
 45 dcl       base_man$store_ptr_to entry(ptr,ptr),
 46           prepare_operand entry(ptr,fixed bin,bit(1) aligned) returns(ptr),
 47           state_man$erase_reg entry(bit(19) aligned),
 48           c_a entry(fixed bin,fixed bin) returns(ptr),
 49           make_both_addressable entry(ptr,ptr,bit(1) aligned),
 50           expmac$many entry(fixed bin(15),ptr,fixed bin),
 51           expmac$one entry(fixed bin(15),ptr,fixed bin),
 52           expmac$zero entry(fixed bin(15)),
 53           adjust_ref_count entry(ptr,fixed bin),
 54           generate_constant$real_fix_bin_1 entry(fixed bin) returns(ptr),
 55           load entry(ptr,fixed bin),
 56           compile_exp entry(ptr),
 57           eval_exp entry(ptr,bit(1) aligned) returns(ptr),
 58           long_op$two_eis entry(ptr,fixed bin,fixed bin(15),ptr),
 59           expmac$two_eis entry(fixed bin(15),ptr,ptr),
 60           expmac entry(fixed bin(15),ptr),
 61           base_man$load_any_var_and_lock entry(fixed bin,ptr) returns(bit(3) aligned);
 62 
 63 dcl       double_data bit(24) int static init("010111110000000111111110"b);
 64 
 65 dcl       alters(0:1) bit(19) aligned static init("1"b,"11"b);
 66 
 67 dcl (     copy_mac            init(257),
 68           set_bits            init(440),
 69           move_words          init(481),
 70           lda                 init(1),
 71           sta                 init(4),
 72           nop_mac             init(528),
 73           move_3              init(568),
 74           conv_mac(2)         init(515,26),       /* qls, dvfx1 */
 75           copy_bits           init(476)) fixed bin(15) int static;
 76 
 77 dcl       table(0:1,0:1,3:6) fixed bin(15) int static
 78           init(     /* odd, odd */      569, 570, 571, 0,
 79                     /* odd, even */     572, 573, 0, 0,
 80                     /* even, odd */     574, 575, 0, 0,
 81                     /* even, even */    576, 577, 578, 579);
 82 
 83 dcl       conv_factor(2) fixed bin int static
 84           init(2,9);          /* bits, bits_per_char */
 85 
 86 dcl       fix_bin             fixed bin based;
 87 
 88 %include reference;
 89 %include symbol;
 90 %include array;
 91 %include nodes;
 92 %include bases;
 93 %include operator;
 94 %include op_codes;
 95 %include cgsystem;
 96 %include boundary;
 97 
 98           adjust = "0"b;
 99 
100           p = pt;
101 
102           pd = prepare_operand((p -> operand(1)),-1,atomic);
103           ps = prepare_operand((p -> operand(2)),-1,atomic);
104 
105           have_constant_length = "0"b;
106           q = p -> operand(3);
107           if q -> node.type ^= operator_node
108           then if q -> reference.symbol -> symbol.constant
109                then do;
110                     have_constant_length = "1"b;
111                     amount = q -> reference.symbol -> symbol.initial -> fix_bin;
112                     end;
113 
114           if p -> operator.op_code = copy_string
115           then do;
116 
117                /* we have copy_string, if the move cannot be done with
118                   words, go to str */
119 
120                if have_constant_length
121                then if mod(amount,bits_per_word) = 0
122                      & ps -> reference.units = word_ & ^ ps -> reference.fo_in_qual
123                      & pd -> reference.units = word_ & ^ pd -> reference.fo_in_qual
124                     then amount = divide(amount,bits_per_word,17,0);
125                     else go to str;
126                else go to str;
127                end;
128 
129           /* have copy words case */
130 
131           if pd -> reference.temp_ref
132                then pd -> reference.value_in.storage = "1"b;
133 
134           if ps -> reference.varying_ref
135           then do;
136 
137                /* must adjust c_offset to move entire varying array */
138 
139                adjust = "1"b;
140                ps -> reference.c_offset = ps -> reference.c_offset - 1;
141                pd -> reference.c_offset = pd -> reference.c_offset - 1;
142                end;
143 
144           if have_constant_length
145                then go to const;
146 
147           /* have unknown amount of words to move */
148 
149           case = 1;
150           call make_copy;
151 
152           if adjust
153                then call adjust_offset;
154 
155           return;
156 
157           /* have constant number of words to move, do it in-line using mlr instruction
158              if more than 3 words (or word-pairs) have to be moved */
159 
160 const:    if amount > 6 then go to long;
161 
162           call state_man$erase_reg((alters(fixed(amount > 1,1))));
163 
164           call make_both_addressable(pd,ps,amount > 1);
165 
166           do i = 1 to 2;
167                if ^ arg(i) -> reference.even
168                then do;
169                     s = arg(i) -> reference.symbol;
170                     if arg(i) -> reference.data_type > 0
171                     then do;
172                          if substr(double_data,arg(i) -> reference.data_type,1)
173                          then if ^ s -> symbol.packed
174                          then arg(i) -> reference.even = "1"b;
175                          end;
176                     else do;
177 
178                          /* structure */
179 
180                          if ^ arg(i) -> reference.array_ref & s -> symbol.array ^= null
181                          then if s -> symbol.array -> array.element_boundary > word_
182                               then arg(i) -> reference.even = "1"b;
183                               else;
184                          else if s -> symbol.boundary > word_
185                               then arg(i) -> reference.even = "1"b;
186                          end;
187                     end;
188                end;
189 
190           if amount <= 2
191           then do;
192                if pd -> reference.temp_ref & ^ pd -> reference.aggregate
193                then if pd -> reference.symbol -> symbol.decimal
194                      | pd -> reference.symbol -> symbol.complex       /* fixes 1820 & 1836 */
195                     then pd -> reference.ref_count = pd -> reference.ref_count + 1;
196 
197                amount = amount - 1;
198                call expmac$one((lda),ps,amount);
199                call expmac$one((sta),pd,amount);
200                goto done;
201                end;
202 
203           /* if an address is not known to be even, it may not necessarily be known
204              to be odd, check to see if non-even addresses are really odd */
205 
206           if ^ pd -> reference.even & ^ ps -> reference.even
207            & (((pd -> address.base ^= sp & pd -> address.base ^= lp) | pd -> address.tag ^= "0"b)
208             | ((ps -> address.base ^= sp & ps -> address.base ^= lp) | ps -> address.tag ^= "0"b))
209           then do;
210 
211                /* neither address is even and one is not known to be even or odd */
212 
213                if amount > 3 then goto long;
214 
215                macro = move_3;
216 
217 move:          if pd -> reference.temp_ref & ^ pd -> reference.aggregate
218                then if pd -> reference.long_ref
219                      | pd -> reference.symbol -> symbol.decimal
220                      | pd -> reference.symbol -> symbol.complex       /* fixes 1822 & 1836 */
221                     then pd -> reference.ref_count = pd -> reference.ref_count + 1;
222 
223                call expmac$many(macro,addr(arg),2);
224 done:          pd -> reference.perm_address,
225                ps -> reference.perm_address = "0"b;
226 
227                if adjust
228                     then call adjust_offset;
229 
230                return;
231                end;
232 
233           /* either both addresses are known to be odd, or at least one address
234              is known to be even, see if we have special sequence to move specified
235              number of words */
236 
237           if amount <= 6
238           then do;
239 
240                macro = table(fixed(pd -> reference.even,1),fixed(ps -> reference.even,1),amount);
241 
242                if macro ^= 0 then goto move;
243                end;
244 
245           /* we'll have to use an EIS instruction */
246 
247 /* Turn off perm address bits because we must make rands eis addressable */
248 
249 long:     pd -> reference.perm_address,
250           ps -> reference.perm_address = "0"b;
251 
252 /* Issue move macro */
253 
254           n = chars_per_word * amount;
255 issue_move_mac:
256           call long_op$two_eis(pd,n,(move_words),ps);
257 
258           if adjust
259                then call adjust_offset;
260 
261           return;
262 
263 
264           /* have to do a string move */
265 
266 str:      q1 = pd;
267           q2 = ps;
268 
269           if pd -> reference.temp_ref
270                then pd -> reference.value_in.storage = "1"b;
271 
272           if ps -> reference.symbol -> symbol.char
273            | ps -> reference.symbol -> symbol.picture
274            | ps -> reference.symbol -> symbol.decimal
275           then do;
276 
277                /* can use MLR for characters */
278 
279                q = p -> operand(3);
280 
281                /* q is in bits */
282 
283                if have_constant_length
284                then do;
285                     n = divide(amount,bits_per_char,17,0);
286                     go to issue_move_mac;
287                     end;
288 
289                case = 2;
290                call make_copy;
291                return;
292                end;
293 
294           p1 = p -> operand(3);
295           p1 = eval_exp(p1,"1"b);
296 
297           p2 = q2 -> reference.length;
298           q2 -> reference.length = p1;
299 
300           big_length_hold = q2 -> reference.big_length;
301           if p1 -> node.type = operator_node
302                then p1 = p1 -> operand(1);
303           q2 -> reference.big_length = p1 -> reference.symbol -> symbol.c_dcl_size > max_p_xreg;
304 
305           do i = 1 to 2;
306                if arg(i) -> reference.units = character_
307                then do;
308 
309                     /* since copy_bits is a CSL, we cannot allow character offset expr's */
310 
311                     if ^ arg(i) -> reference.shared
312                     then arg(i) -> reference.ref_count = arg(i) -> reference.ref_count + 1;
313                     base = base_man$load_any_var_and_lock(2,arg(i));
314                     arg(i) -> reference.perm_address = "1"b;
315                     end;
316                end;
317 
318           call expmac$two_eis((copy_bits),q1,q2);
319           q2 -> reference.length = p2;
320           q2 -> reference.big_length = big_length_hold;
321 
322           q1 -> reference.perm_address,
323           q2 -> reference.perm_address = "0"b;
324 
325           return;
326 
327 move_block: entry(dest,source,number);
328 
329 dcl       dest ptr,                     /* points at ref of destination */
330           source ptr,                   /* points at ref of source */
331           number fixed bin;             /* number of words to move */
332 
333           pd = dest;
334           ps = source;
335           amount = number;
336 
337           adjust = "0"b;
338 
339           goto const;
340 
341 make_copy:     proc;
342 
343                /* does a copy_words or copy_string with an MLR instruction */
344 
345                /* first, load the length of the object to be moved */
346 
347                q = prepare_operand(q,1,atomic);
348                if atomic then call load(q,0); else call compile_exp((p -> operand(3)));
349 
350                /* convert the length to characters */
351 
352                call expmac((conv_mac(case)),c_a((conv_factor(case)),case));
353 
354                /* finally, issue the copy macro (an MLR instruction) */
355 
356                call expmac$two_eis((copy_mac),pd,ps);
357 
358                end;
359 
360 
361 adjust_offset:      proc;
362 
363                ps -> reference.c_offset = ps -> reference.c_offset + 1;
364                pd -> reference.c_offset = pd -> reference.c_offset + 1;
365 
366                end;
367 
368 
369 
370           end;