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 version of simplify_offset assumes that mod_bit, mod_byte,
 12    mod_half, and bit_pointer operators do not appear in the tree */
 13 
 14 /*        Modified: 10 April 1977 by RAB to eliminate use of mod_word operator
 15           Modified: 26 November 1977 by RAB to fix 1690
 16           Modified: 10 February 1978 by RAB to fix 1691
 17           Modified: 25 August 1978 by RAB to help fix 1780
 18           Modified: 5 September 1978 by RAB to fix 1782
 19           Modified: 17 Jan 1979 by RAB to fix 1816 (fault with aligned unsigned subscript)
 20           Modified: 23 April 1979 by PCK to implement 4-bit decimal
 21           Modified: 23 May 1979 by RAB to fix 1820 (large lower bound in word
 22                     array causes bad code)
 23 */
 24 
 25 simplify_offset: proc(pt,context);
 26 
 27 dcl       pt ptr;             /* points at a reference node */
 28 
 29 dcl       (f,p1,p2,p3,p4,r,s,s1,s2,s3,s4,sym,q,symref) ptr,
 30           i fixed bin,
 31           sign fixed bin(1),
 32           (has_offset, ok_to_free) bit(1) aligned,
 33           multiple fixed bin(31),
 34           (bit_offset,c_bit_offset,factor) fixed bin(24),
 35           (orig_c_offset,start_gen_storage,start_generation) fixed bin(24),
 36           (n,fix_precision,lower_precision) fixed bin(24),
 37           op_code bit(9) aligned,
 38           (called_fix_exp, fractional_offset_to_be_added) bit(1) aligned,
 39           fix_bin fixed bin based;
 40 
 41 dcl       convert_offset(0:5) init(36,1,4.5,9,18,36) fixed bin(7,1) int static options(constant);
 42 dcl       units_per_word(0:5) init(1,36,8,4,2,1) fixed bin(6) int static;
 43 
 44 dcl       (divide,max,min,mod,null,substr) builtin;
 45 
 46 %include semant;
 47 
 48 %include operator;
 49 %include reference;
 50 %include symbol;
 51 %include array;
 52 %include op_codes;
 53 %include nodes;
 54 %include system;
 55 %include boundary;
 56 %include semantic_bits;
 57 
 58                               /*   ^L   */
 59 
 60           q = pt;
 61 
 62           s = q -> reference.symbol;
 63 
 64           has_offset, ok_to_free = "1"b;
 65 
 66           /* following code attempts to reduce precision of length
 67              expression; it checks if index register can be used
 68              to hold length */
 69 
 70           p1 = q -> reference.length;
 71           if p1 ^= null
 72           then if p1 -> node.type = operator_node
 73           then do;
 74                if s -> symbol.dcl_size ^= null
 75                then fix_precision = max_length_precision;
 76                else if s -> symbol.c_dcl_size >= max_index_register_value
 77                     then fix_precision = max_length_precision;
 78                     else fix_precision = max_signed_xreg_precision;
 79 
 80                /* ok to reduce precision of expression */
 81 
 82                if fix_precision = max_signed_xreg_precision
 83                 | p1 -> operand(1) -> reference.symbol -> symbol.c_dcl_size > max_p_fix_bin_1
 84                then if p1 -> operator.op_code = assign
 85                then do;
 86                     p2 = fix_exp((p1 -> operand(2)));
 87 
 88                     if fb_value(p2)
 89                     then if p2 -> symbol.c_dcl_size <= fix_precision
 90                          then if p2 -> symbol.scale = 0
 91                               then do;
 92                                    q -> reference.length = p1 -> operand(2);
 93                                    call free_op(p1);
 94                                    end;
 95                     end;
 96                else p2 = fix_exp(p1);
 97                end;
 98 
 99           /* following code uses modword_in_offset to discover if no further processing
100              of offset expression is possible */
101 
102           if q -> reference.modword_in_offset
103                then return;
104           /* following code attempts to simplify offset expressions of the form
105 
106                     c
107                     exp + c
108                     exp - c
109                     c + exp
110 
111                     c1 * c2
112                     c1 * (exp + c2)
113                     c1 * (exp - c2)
114                     c1 * (c2 + exp)
115                                                             */
116 
117           p1 = q -> reference.offset;
118           if p1 = null
119           then do;
120                call check_addr;
121                goto ret;
122                end;
123 
124           /* The following block of code is necessary because the 6180 will not allow
125              variable fractional offsets to be negative */
126 
127           orig_c_offset = q -> reference.c_offset;
128 
129           fractional_offset_to_be_added = def_context.f_offset_to_be_added;
130 
131           if q -> reference.units < word_ | fractional_offset_to_be_added
132           then do;
133                p2 = s -> symbol.reference;
134                if q -> reference.units = p2 -> reference.units
135                     then start_gen_storage = p2 -> reference.c_offset;
136                     else start_gen_storage = divide(convert_offset(p2 -> reference.units) * p2 -> reference.c_offset,
137                               convert_offset(q -> reference.units),31,0);
138                orig_c_offset = max(start_gen_storage,orig_c_offset);
139                end;
140 
141           /* *********************************************************************** */
142 
143           called_fix_exp = "0"b;
144 
145 simplify: if p1 -> node.type ^= operator_node
146           then do;
147 
148                s1 = p1 -> reference.symbol;
149 
150                if fb1_const(s1)
151                then do;
152                     q -> reference.offset = null;
153                     q -> reference.c_offset = q -> reference.c_offset + s1 -> symbol.initial -> fix_bin;
154                     call check_addr;
155                     goto ret;
156                     end;
157 
158                goto ret;
159                end;
160 
161           op_code = p1 -> operator.op_code;
162 
163           if op_code = add
164           then do;
165                sign = 1;
166                goto l1;
167                end;
168 
169           if op_code = sub
170           then do;
171                sign = -1;
172 
173 l1:            p2 = p1 -> operand(3);
174                if p2 -> node.type ^= reference_node then goto simp1;
175 
176                s2 = p2 -> reference.symbol;
177 
178                if fb1_const(s2)
179                then do;
180 
181                     /* eliminate the add or sub operator and absorb the constant */
182 
183                     q -> reference.offset = check_exp((p1 -> operand(2)));
184 
185 absorb:             call free_op(p1);
186                     p1 = q -> reference.offset;
187 
188                     q -> reference.c_offset = q -> reference.c_offset + sign *
189                      s2 -> symbol.initial -> fix_bin;
190                     goto simplify;
191                     end;
192 
193 simp1:         if sign < 0 then goto check_sub;
194 
195                p2 = p1 -> operand(2);
196                if p2 -> node.type ^= reference_node
197                then do;
198 
199                     /* The following code tries to improve the precision of the
200                        offset expression to 17, 18, or 24 depending on the offset
201                        units and the size of the variable   */
202 
203 replace:
204                     if called_fix_exp then goto rep;
205 
206                     lower_precision = max_signed_xreg_precision;
207 
208                     if q -> reference.units < word_  & ^ q -> reference.modword_in_offset
209                      | fractional_offset_to_be_added
210                     then do;
211                          fix_precision = max_offset_precision;
212                          if s -> symbol.dcl_size ^= null then goto set_bit;
213                          if s -> symbol.c_dcl_size > max_index_register_value then goto set_bit;
214                          if s -> symbol.c_dcl_size > max_signed_index_register_value
215                           & fractional_offset_to_be_added
216                               then lower_precision = max_uns_xreg_precision;
217 
218                          r = q;
219                          sym = s;
220                          start_generation = start_gen_storage;
221 
222 check_again:
223                          f = sym;
224 
225                          if sym -> symbol.member
226                          then do;
227 
228                               /* can't reduce precision if member has offset
229                                  expression */
230 
231                               if sym -> symbol.reference -> reference.offset ^= null
232                               then goto set_bit;
233 
234                               if sym -> symbol.dimensioned
235                               then do f = sym repeat f -> symbol.father
236                                         while(f -> symbol.array -> array.own_number_of_dimensions
237                                               ^= f -> symbol.array -> array.number_of_dimensions);
238                                         end;
239                               end;
240 
241                          if f -> symbol.bit_size ^= null then go to set_bit;
242 
243                          /* the next block of code determines if the maximum
244                             variable offset will fit in an index register.
245                             The maximum offset is calculated in n.    */
246 
247                          n = f -> symbol.c_bit_size;
248                          n = divide(n, convert_offset(q -> reference.units), 24, 0);
249 
250                          n = n + start_generation - q -> reference.c_offset;
251 
252                          if n >= max_index_register_value then goto set_bit;
253                          if n >= max_signed_index_register_value
254                           & fractional_offset_to_be_added
255                               then lower_precision = max_uns_xreg_precision;
256 
257                          if sym -> symbol.defined
258                          then do;
259 
260                               /* have to do same check on all those we are
261                                  defined on */
262 
263                               r = r -> reference.qualifier;
264                               if r -> node.type = operator_node
265                                    then r = r -> operand(1);
266                               sym = r -> reference.symbol;
267                               symref = sym -> symbol.reference;
268 
269                               if symref -> reference.c_offset ^= 0
270                               then do;
271                                    if q -> reference.units = symref -> reference.units
272                                         then start_generation = symref -> reference.c_offset;
273                                         else start_generation =
274                                              divide(convert_offset(symref->reference.units) * symref->reference.c_offset,
275                                                   convert_offset(q->reference.units), 31, 0);
276                                    end;
277                               else start_generation = 0;
278                               go to check_again;
279                               end;
280                          end;
281 
282                     fix_precision = lower_precision;
283 
284 set_bit:            called_fix_exp = "1"b;
285 
286                     if fix_precision = max_length_precision
287                     then if p1 -> operand(1) -> reference.symbol -> symbol.c_dcl_size <= max_p_fix_bin_1
288                          then go to rep;
289 
290                     if p1 -> operator.op_code = assign
291                     then do;
292                          p2 = fix_exp((p1 -> operand(2)));
293                          if fb_value(p2)
294                          then if p2 -> symbol.c_dcl_size <= fix_precision
295                               then if p2 -> symbol.scale = 0
296                                    then do;
297                                         p2 = p1 -> operand(2);
298                                         call free_op(p1);
299                                         p1, q -> reference.offset = p2;
300                                         goto simplify;
301                                         end;
302                          end;
303                     else do;
304                          if substr(p1 -> operator.op_code,1,5) = substr(mod_bit,1,5)
305                          then p2 = p1 -> operand(3); else p2 = p1;
306                          p2 = fix_exp(p2);
307                          end;
308 
309                     goto rep;
310                     end;
311 
312                s2 = p2 -> reference.symbol;
313 
314                if fb1_const(s2)
315                then do;
316                     q -> reference.offset = check_exp((p1 -> operand(3)));
317                     goto absorb;
318                     end;
319 
320                goto replace;
321 
322                /* the following code tries to catch
323                               exp - exp
324                   which gets eliminated,
325                               (exp1 + exp2) - exp1
326                   which gets simplified, and
327                               exp1 * exp2 - exp1
328                   which gets converted to
329                               (exp2 - 1) * exp1
330                  with obvious simplifcation when exp2 is a constant */
331 
332 check_sub:
333                if compare_expression((p1 -> operand(2)),(p1 -> operand(3)))
334                then do;
335                     call free_exp(p1);
336                     p1 = null;
337                     call check_addr;
338                     goto rep;
339                     end;
340 
341                p2 = p1 -> operand(2);
342                if p2 -> node.type ^= operator_node then goto replace;
343 
344                if p2 -> operator.op_code = add
345                then do;
346                     if compare_expression((p2 -> operand(2)),(p1 -> operand(3)))
347                     then do;
348                          q -> reference.offset = check_exp((p2 -> operand(3)));
349 elim_sub:
350                          call free_op(p1);
351                          p2 = check_exp(p2);
352                          call free_op(p2);
353                          p1 = q -> reference.offset;
354                          go to simplify;
355                          end;
356 
357                     if compare_expression((p2 -> operand(3)),(p1 -> operand(3)))
358                     then do;
359                          q -> reference.offset = check_exp((p2 -> operand(2)));
360                          go to elim_sub;
361                          end;
362 
363                     go to replace;
364                     end;
365 
366                if p2 -> operator.op_code ^= mult then goto replace;
367 
368                if ^ compare_expression((p2 -> operand(2)),(p1 -> operand(3))) then goto replace;
369 
370                p3 = p2 -> operand(3);
371                if p3 -> node.type ^= reference_node
372                then do;
373 switch:             p1 -> operator.op_code = mult;
374                     p2 -> operator.op_code = sub;
375                     p2 -> operand(2) = p3;
376                     p2 -> operand(3) = declare_constant$integer(1);
377 
378                     p3 = p1 -> operand(1);
379                     p1 -> operand(1) = p2 -> operand(1);
380                     p2 -> operand(1) = p3;
381                     goto replace;
382                     end;
383 
384                s3 = p3 -> reference.symbol;
385                if ^ fb1_const(s3) then goto switch;
386 
387                p1 -> operand(2) = declare_constant$integer(s3 -> symbol.initial -> fix_bin - 1);
388                p1 -> operand(1) = p2 -> operand(1);
389                p1 -> operator.op_code = mult;
390 
391                goto replace;
392                end;
393 
394           if op_code ^= mult then goto replace;
395 
396           p2 = p1 -> operand(2);
397           if p2 -> node.type ^= reference_node then goto check_mb;
398 
399           s2 = p2 -> reference.symbol;
400           if ^ fb1_const(s2) then goto check_mb;
401 
402 again:    p3 = p1 -> operand(3);
403           if p3->node.type^=operator_node
404           then do;
405                s3 = p3->reference.symbol;
406 
407                if fb1_const(s3)
408                then do;
409                     q -> reference.offset = null;
410                     q -> reference.c_offset = q -> reference.c_offset + s2 -> symbol.initial -> fix_bin * s3 -> symbol.initial -> fix_bin;
411                     call free_op(p1);
412                     call check_addr;
413                     goto ret;
414                     end;
415                else goto check_mb;
416                end;
417 
418           if p3 -> operator.op_code = add then sign = 1;
419           else if p3 -> operator.op_code = sub then sign = -1;
420                else goto check_mb;
421 
422           p4 = p3 -> operand(3);
423           if p4 -> node.type ^= reference_node then goto check_mb;
424 
425           s4 = p4 -> reference.symbol;
426           if fb1_const(s4)
427           then do;
428                p1 -> operand(3) = p3 -> operand(2);
429 alter:         call free_op(p3);
430                q -> reference.c_offset = q -> reference.c_offset + sign *
431                 s2 -> symbol.initial -> fix_bin * s4 -> symbol.initial -> fix_bin;
432                goto again;
433                end;
434 
435           if sign < 0 then goto check_mb;
436 
437           p4 = p3 -> operand(2);
438           if p4 -> node.type ^= reference_node then goto check_mb;
439 
440           s4 = p4 -> reference.symbol;
441 
442           if fb1_const(s4)
443           then do;
444                p1 -> operand(3) = p3 -> operand(3);
445                goto alter;
446                end;
447 
448 check_mb: if q -> reference.fo_in_qual then goto replace;
449 
450           /* following code attempts to recognize references to items
451              which have a constant bit offset and a variable word offset;
452              the offset expression for this type of reference is
453                     mult(t4,exp,multiple_of_bits_per_word)  */
454 
455           if q -> reference.units >= word_  then goto replace;
456 
457           if q -> reference.length ^= null then goto replace;
458           if s -> symbol.decimal then goto replace;
459           if s -> symbol.bit
460           then if q -> reference.c_length > bits_per_double
461                then goto replace;
462                else;
463           else if s -> symbol.char | s -> symbol.picture
464                then if q -> reference.c_length > characters_per_double
465                     then goto replace;
466 
467           if q -> reference.units = bit_ then factor = 1;
468           else factor = bits_per_character;
469 
470           p3 = p1 -> operand(3);
471           if p3 -> node.type ^= reference_node then goto replace;
472 
473           s3 = p3 -> reference.symbol;
474           if ^ fb1_const(s3) then goto replace;
475 
476           bit_offset = s3 -> symbol.initial -> fix_bin * factor;
477           if mod(bit_offset,bits_per_word) ^= 0 then goto replace;
478 
479           /* found it, mark the reference and eliminate
480              or change mult operator */
481 
482           multiple = divide(bit_offset,bits_per_word,31,0);
483           c_bit_offset = q -> reference.c_offset * factor;
484 
485           if mod(c_bit_offset,bits_per_word) ^= 0
486           then do;
487 
488                if multiple = 1
489                then do;
490                     q -> reference.offset = check_exp((p1 -> operand(2)));
491                     call free_op(p1);
492                     p1 = q -> reference.offset;
493                     end;
494 
495                else p1 -> operand(3) = declare_constant$integer(multiple);
496 
497                q -> reference.modword_in_offset = "1"b;
498                has_offset = "0"b;
499                end;
500 
501           else do;
502 
503                /* we probably shouldn't have gotten here,
504                   but we'll improve units to word_ and
505                   forget about marking the reference */
506 
507                q -> reference.c_offset = divide(c_bit_offset,bits_per_word,24,0);
508                q -> reference.units = word_;
509 
510                if multiple = 1
511                then do;
512                     q -> reference.offset = check_exp((p1 -> operand(2)));
513                     call free_op(p1);
514                     p1 = q -> reference.offset;
515                     go to simplify;
516                     end;
517                else p1 -> operand(3) = declare_constant$integer(multiple);
518                end;
519 
520           if p1 -> node.type = operator_node
521                then goto replace;
522 
523 rep:
524           q->reference.offset = p1;
525 
526 ret:
527           if q -> reference.units = 0
528           then      return;
529 
530           if q -> reference.units = word_
531           then do;
532                     if has_offset
533                     then      if abs(q -> reference.c_offset) > max_index_register_value
534                               then      call restore_orig_c_offset;
535                     return;
536                end;
537 
538           if q->reference.units = bit_
539           then if ^ s -> symbol.bit
540           then if s->symbol.char
541                |  s->symbol.decimal
542                |  s->symbol.picture
543           then do;
544                     q->reference.units = character_;
545                     q->reference.c_offset = divide(q->reference.c_offset,bits_per_character,17,0);
546                     orig_c_offset = divide(orig_c_offset,bits_per_character,31,0);
547 
548                     p1 = q->reference.offset;
549                     if p1=null
550                     then      go to check_neg;
551 
552                     if q->reference.modword_in_offset
553                     then      goto check_neg;
554 
555                     if p1->node.type=operator_node
556                     then do;
557                               if p1->operator.op_code=mult
558                               then do i = 2 to 3;
559                                         p3 = p1->operand(i);
560 
561                                         if p3->node.type=reference_node
562                                         then do;
563                                                   s3 = p3->reference.symbol;
564 
565                                                   if fb1_const(s3)
566                                                   then do;
567                                                             bit_offset = s3->symbol.initial->fix_bin;
568                                                             if bit_offset=bits_per_character
569                                                             then do;
570                                                                       q->reference.offset = check_exp((p1->operand(5-i)));
571                                                                       call free_op(p1);
572                                                                       p1 = q->reference.offset;
573 
574                                                                       goto simplify;
575                                                             end;
576                                                             else if mod(bit_offset,bits_per_character) = 0
577                                                                  then if p1->operand(1)->reference.ref_count <= 1
578                                                                  then do;
579                                                                       multiple = divide(bit_offset,bits_per_character,31,0);
580                                                                       p1->operand(i) = declare_constant$integer(multiple);
581                                                                       go to check_neg;
582                                                                       end;
583                                                   end;
584                                         end;
585                               end;
586 
587                               s1 = p1->operand(1)->reference.symbol;
588                     end;
589                     else      s1 = p1->reference.symbol;
590 
591                     p2 = create_operator((div),3);
592                     p2->operand(1) = declare_temporary((integer_type),(s1->symbol.c_dcl_size),0,null);
593                     p2->operand(2) = p1;
594                     p2->operand(3) = declare_constant$integer((bits_per_character));
595                     p2->operator.processed = "1"b;
596 
597                     q->reference.offset = p2;
598 
599           end;
600 
601           /* The following block of code is necessary because the 6180 will not allow
602              variable fractional offsets to be negative.  To be specific,
603              negative character offsets may only appear in the a or q, and
604              negative bit offsets may not appear at all.  We must protect
605              against negative variable offsets and against negative constant
606              offsets that are so large as to exceed the 15-bit constant address
607              portion of the instruction word.     */
608 
609 check_neg:
610           if q -> reference.units = character_ & s -> symbol.decimal & s -> symbol.unaligned
611           then do;
612                     call double_offset;
613                     orig_c_offset = 2 * orig_c_offset;
614                end;
615 
616           if has_offset
617           then if q -> reference.c_offset > orig_c_offset
618                 | divide(q -> reference.c_offset,units_per_word(q->reference.units),19,0) <= -16383
619           then do;
620                if q -> reference.units = character_ | q -> reference.units = digit_
621                then do;
622                     q -> reference.big_offset = "1"b;
623                     return;
624                     end;
625 
626                call restore_orig_c_offset;
627                end;
628 
629           /* ************************************************************* */
630 
631 
632           return;
633 ^L
634 check_addr:    proc;
635                /* this code tries to improve addr(x) -> y_unaligned */
636 
637                has_offset = "0"b;
638                p2 = q -> reference.qualifier;
639                if p2 = null then return;
640 
641                if p2 -> node.type ^= operator_node then return;
642 
643                if p2 -> operator.op_code = addr_fun
644                then do;
645                     q -> reference.fo_in_qual = "0"b;
646                     p1, q -> reference.offset = null;
647                     return;
648                     end;
649 
650                if p2 -> operator.op_code ^= addr_fun_bits then return;
651 
652                /* if qual is unshared, someone else is also using it,
653                   so altering it is unsafe. */
654 
655                if ^ p2 -> operand(1) -> reference.shared then return;
656 
657                /* if the reference is an aggregate, simplify_offset may be
658                   undone, so altering qualifier is unsafe. */
659 
660                if q -> reference.array_ref then return;
661 
662                if s -> node.type = symbol_node
663                then if s -> symbol.structure
664                     then return;
665 
666                p3 = p2 -> operand(2);
667 
668                if q -> reference.c_offset ^= 0
669                then if q -> reference.units ^= p3 -> reference.units
670                     then return;
671 
672                p1, q -> reference.offset = p3 -> reference.offset;
673                q -> reference.c_offset = q -> reference.c_offset + p3 -> reference.c_offset;
674                q -> reference.units = p3 -> reference.units;
675                q -> reference.fo_in_qual = p3 -> reference.fo_in_qual;
676                q -> reference.modword_in_offset = p3 -> reference.modword_in_offset;
677 
678                if p3->reference.symbol->symbol.reference = p3
679                then p3, p2->operand(2) = copy_expression((p3));
680 
681                p3 -> reference.offset = null;
682                p3 -> reference.c_offset, p3 -> reference.units = 0;
683                p3 -> reference.modword_in_offset = "0"b;
684 
685                p2 -> operator.op_code = addr_fun;
686 
687                call check_char_units;
688 
689                end;
690 ^L
691 check_exp:     proc(off) returns(ptr);
692 
693                /* check_exp is called when off is to replace the current q->reference.offset.
694                   off is assumed to be contained in q->reference.offset.  If q->reference.offset
695                   is also contained in q->reference.length, then off's ref count must be
696                   incremented. */
697 
698 dcl            off ptr;
699 
700 dcl            p ptr;
701 
702                p = off;
703 
704                if p ^= null
705                then do;
706                     if q -> reference.length ^= null
707                     then if in_expression((q -> reference.offset),(q -> reference.length))
708                          then p = share_expression(p);
709 
710                     if p -> node.type = reference_node
711                     then if p -> reference.symbol -> symbol.packed
712                          then p = convert$to_integer(p,(integer_type));
713                     end;
714 
715                return(p);
716 
717                end;
718 
719 
720 in_expression: proc(p,pt) reducible returns(bit(1) aligned);
721 
722 dcl            (p,pt) ptr,
723                k fixed binary;
724 
725                if p=pt then goto yes;
726 
727                if pt -> node.type ^= operator_node then goto no;
728 
729                do k = 1 to pt -> operator.number;
730                     if pt -> operand(k) ^= null
731                     then if in_expression(p,(pt -> operand(k)))
732                          then go to yes;
733                     end;
734 
735 no:            return("0"b);
736 
737 yes:           return("1"b);
738                end;
739 ^L
740 fb1_const:     proc(pt) reducible returns(bit(1) aligned);
741 
742 dcl            (p,pt) ptr;
743 
744                p = pt;
745                if ^ p -> symbol.constant then goto no;
746                if ^ p -> symbol.fixed then goto no;
747                if ^ p -> symbol.binary then goto no;
748 
749                if p -> symbol.c_word_size = words_per_fix_bin_1 then return("1"b);
750 
751 no:            return("0"b);
752                end;
753 ^L
754 fb_value:      proc(pt) reducible returns(bit(1) aligned);
755 
756 dcl            (p,pt) ptr;
757 
758                p = pt;
759                if p = null then goto no;
760 
761                if ^ p -> symbol.fixed then goto no;
762                if ^ p -> symbol.binary then goto no;
763                if ^ p -> symbol.real then goto no;
764 
765                if p -> symbol.aligned | p -> symbol.constant then return("1"b);
766 
767 no:            return("0"b);
768                end;
769 ^L
770 fix_exp:       proc(pt) returns(ptr);
771 
772 dcl            pt ptr;
773 
774 dcl            (p,s1,s2,s3,t) ptr;
775 
776                p = pt;
777                if p -> node.type = reference_node then return(p -> reference.symbol);
778 
779                t = p -> operand(1);
780                if t ^= null
781                then do;
782                     s1 = t -> reference.symbol;
783                     if ^ t -> reference.shared then goto back;
784                     if ^ fb_value(s1) then goto back;
785                     if s1 -> symbol.c_dcl_size <= fix_precision then goto back;
786                     end;
787 
788                /* output is fixed bin, but precision is too large.  see if we can
789                   reduce precision */
790 
791                if p -> operator.op_code = assign then goto ck2;
792 
793                if p -> operator.op_code > mult then goto back;
794 
795                s3 = fix_exp((p -> operand(3)));
796 
797                if ^ fb_value(s3) then goto back;
798                if s3 -> symbol.c_dcl_size > max_p_fix_bin_1 then goto back;
799 
800 ck2:           s2 = fix_exp((p -> operand(2)));
801 
802                if ^ fb_value(s2) then goto back;
803                if s2 -> symbol.c_dcl_size > max_p_fix_bin_1 then goto back;
804 
805                /* both operands are fix single, reduce precision */
806 
807                p -> operator.processed = "1"b;
808                p -> operand(1) = declare_temporary((integer_type),(fix_precision),
809                 0,null);
810                s1 = p -> operand(1) -> reference.symbol;
811 
812 back:          return(s1);
813                end;
814 ^L
815 free_op:       proc(pt);
816 
817 dcl            (pt,r1) ptr;
818 
819                r1 = pt -> operand(1);
820                if r1 -> reference.ref_count < 2
821                then if ok_to_free
822                     then call free_node(pt);
823                     else;
824                else do;
825                     r1 -> reference.ref_count = r1 -> reference.ref_count - 1;
826                     ok_to_free = "0"b;
827                     end;
828 
829                end;
830 ^L
831 free_exp:      proc(exp);
832 
833 dcl            (exp,px,py) ptr,
834                j fixed bin;
835 
836                px = exp;
837                do j = 1 to px -> operator.number;
838                     py = px -> operand(j);
839                     if py ^= null
840                     then do;
841                          if j = 1
842                          then if py -> reference.ref_count > 1
843                               then do;
844                                    py -> reference.ref_count = py -> reference.ref_count - 1;
845                                    return;
846                                    end;
847 
848                          if py -> node.type = operator_node
849                          then call free_exp(py);
850                          end;
851                     end;
852 
853                call free_node(px);
854                end;
855 ^L
856 check_char_units:   proc;
857 
858 dcl            (new,o,s1) ptr;
859 
860                if q -> reference.units = character_
861                then if ^ s -> symbol.char
862                then if ^ s -> symbol.decimal
863                then if ^ s -> symbol.picture
864                then do;
865                     q -> reference.units = bit_;
866                     q -> reference.c_offset = q -> reference.c_offset * bits_per_character;
867 
868                     if q -> reference.offset ^= null
869                     then if ^ q -> reference.modword_in_offset
870                     then do;
871                          o = q -> reference.offset;
872                          if o -> node.type = operator_node
873                               then s1 = o -> operand(1) -> reference.symbol;
874                               else s1 = o -> reference.symbol;
875 
876                          new = create_operator((mult),3);
877                          new -> operand(1) = declare_temporary((integer_type),s1 -> symbol.c_dcl_size + 4,0,null);
878                          new -> operand(2) = declare_constant$integer((bits_per_character));
879                          new -> operand(3) = o;
880                          new -> operator.processed = "1"b;
881                          p1, q -> reference.offset = new;
882                          end;
883                     end;
884 
885                end;
886 ^L
887 /* Convert off set from character_ to digit_ units for unaligned decimal variables */
888 
889 double_offset:
890           procedure;
891 
892 declare   (new,o,s1) pointer;
893 
894           q -> reference.units = digit_;
895           q -> reference.c_offset = q -> reference.c_offset * packed_digits_per_character;
896 
897           if q -> reference.offset ^= null
898           then if ^ q -> reference.modword_in_offset
899                then do;
900                          o = q -> reference.offset;
901 
902                          if o -> node.type = operator_node
903                          then s1 = o -> operand(1) -> reference.symbol;
904                          else s1 = o -> reference.symbol;
905 
906                          new = create_operator((mult),3);
907                          new -> operand(1) = declare_temporary((integer_type),s1 -> symbol.c_dcl_size + 1,0,null);
908 
909                          new -> operand(2) = declare_constant$integer((packed_digits_per_character));
910                          new -> operand(3) = o;
911                          new -> operator.processed = "1"b;
912                          p1, q -> reference.offset = new;
913                     end;
914 
915           end /* double_offset */;
916 ^L
917 /* makes orig_c_offset the new q -> reference.c_offset */
918 
919 restore_orig_c_offset:        proc;
920 
921 dcl       (p1,p2,p3,p4) ptr;
922 dcl       difference fixed bin(31);
923 dcl       (prec2,prec3) fixed bin(24);
924 
925           p2 = q -> reference.offset;
926 
927           if p2 -> node.type = operator_node
928                then p4 = p2 -> operand(1);
929                else p4 = p2;
930           prec2 = p4 -> reference.symbol -> symbol.c_dcl_size;
931 
932           difference = q -> reference.c_offset - orig_c_offset;
933           q -> reference.c_offset = orig_c_offset;
934 
935           p1 = create_operator(add,3);
936           p1 -> operand(2) = p2;
937           p3, p1 -> operand(3) = declare_constant$integer(difference);
938           prec3 = p3 -> reference.symbol -> symbol.c_dcl_size;
939           p1 -> operand(1) = declare_temporary((integer_type),
940                     min(max_p_fix_bin_1,max(prec2,prec3)  + 1),0,null);
941           p1 -> operator.processed = "1"b;
942 
943           q -> reference.offset = p1;
944 
945           end /* restore_orig_c_offset */;
946 
947 
948           end;