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 offset_adder:       proc(a,ca,ua,mwa,arg_b,arg_cb,arg_ub,arg_mwb,no_improve);
 12 
 13 /* Modified: 79/04/23 by PCK to implement 4-bit decimal */
 14 
 15 dcl       (a,arg_b,b,p,q) ptr;
 16 dcl       (ca,arg_cb,cb) fixed bin(31);
 17 dcl       (ua,arg_ub,ub) fixed bin(3);
 18 dcl       (mwa,arg_mwb,mwb) bit(1) aligned;       /* ON means units ^= word_, but variable offset in words */
 19 dcl       n fixed bin(15);
 20 dcl       bit_offset fixed bin(31);
 21 
 22 dcl       no_improve bit(1);
 23 
 24 dcl       (divide,min,mod,null,substr) builtin;
 25 
 26 dcl       c_table(7,7) fixed bin(31,1) int static initial(
 27                                                   1, 4.5, 9,18,36,36,36,
 28                                                   0,   1, 2, 4, 8, 8, 8,
 29                                                   0,   0, 1, 2, 4, 4, 4,
 30                                                   0,   0, 0, 1, 2, 2, 2,
 31                                                   0,   0, 0, 0, 1, 1, 1,
 32                                                   0,   0, 0, 0, 0, 1, 1,
 33                                                   0,   0, 0, 0, 0, 0, 1);
 34 
 35 dcl       pl1_stat_$eis_mode bit(1) aligned ext static;
 36 
 37 ^L
 38           b = arg_b; cb = arg_cb; ub = arg_ub; mwb = arg_mwb; /* value b,cb,ub,mwb; */
 39 
 40           call get_ptr(a,ua,mwa);
 41 
 42           call get_ptr(b,ub,mwb);
 43 
 44           if ua = 0
 45           then ua = ub;
 46           else if ub = 0
 47                then ub = ua;
 48                else if ua ^= ub & (ua < word_ | ub < word_)
 49                     then if ua < ub
 50                          then do;
 51                                    cb = cb * c_table (ua,ub);
 52 
 53                                    if b ^= null
 54                                    then b = convert_variable_offset (b,ua,ub);
 55 
 56                               end;
 57                          else do;
 58                                    ca = ca * c_table (ub,ua);
 59 
 60                                    if a ^= null
 61                                    then a = convert_variable_offset (a,ub,ua);
 62 
 63                               end;
 64 
 65           ua = min(ua,ub);
 66           ca = ca+cb;
 67 
 68           if a = null
 69           then do;
 70                     a = b;
 71 
 72                     if b = null
 73                     then if ^no_improve
 74                     then if ua < word_
 75                     then do;
 76                               /* improve offset units */
 77                               bit_offset = ca * c_table(bit_,ua);
 78 
 79                               do n = word_ to bit_ by -1
 80                                    while(mod(bit_offset,c_table(bit_,n)) ^= 0);
 81                               end;
 82 
 83                               if n = word_ | ^pl1_stat_$eis_mode
 84                               then do;
 85                                         ca = divide(bit_offset,c_table(bit_,n),31,0);
 86                                         ua = n;
 87                                    end;
 88                     end;
 89           end;
 90           else      if b ^= null
 91                     then do;
 92                               q = create_operator(add,3);
 93                               q->operand(2) = a;
 94                               q->operand(3) = b;
 95                               a = q;
 96                     end;
 97 
 98           if a ^= null & ca ^= 0
 99           then do;
100                     q = create_operator(add,3);
101                     q->operand(2) = a;
102                     q->operand(3) = declare_constant$integer(ca);
103                     a = q;
104                     ca = 0;
105           end;
106 
107           return;
108 ^L
109 get_ptr:  proc(pt,units,offset_is_modword);
110 
111 dcl       (pt,t,new) ptr;
112 dcl       units fixed bin(3);
113 dcl       offset_is_modword bit(1) aligned;
114 
115           if pt = null then return;
116 
117           if ^ pl1_stat_$eis_mode
118           then if pt -> node.type = operator_node
119           then if substr(pt -> operator.op_code,1,5) = substr(mod_bit,1,5)
120           then do;
121                pt = pt -> operand(3);
122                return;
123                end;
124 
125           if ^ offset_is_modword
126                then return;
127 
128           /* force pt to use "units" instead of word_ */
129 
130           t = create_operator(mult,3);
131 
132           t -> operator.processed = "0"b;
133           t -> operand(1) = null;
134           t -> operand(2) = pt;
135           t -> operand(3) = declare_constant$integer((c_table(units,word_)));
136 
137           pt = t;
138 
139           offset_is_modword = "0"b;
140 
141           end /* get_ptr */;
142 ^L
143 /* Convert a variable offset from one set of units to another set of units */
144 
145 convert_variable_offset:
146           procedure (variable_offset,to_units,from_units) returns(pointer);
147 
148 /* parameters */
149 
150 dcl  variable_offset pointer;
151 dcl  (from_units,to_units) fixed binary(3);
152 
153 /* automatic */
154 
155 dcl  converted_variable_offset pointer;
156 
157 
158           if from_units = digit_ & to_units = bit_
159           then converted_variable_offset =  create_operator (digit_to_bit,2);   /* Special case digit offset to bit offset conversion to avoid scaled multiplicaion */
160           else do;                      /* All other offset conversions are simple integer multiplications */
161                     converted_variable_offset = create_operator (mult,3);
162                     converted_variable_offset -> operand(3) = declare_constant$integer ((c_table(to_units,from_units)));
163                end;
164 
165           converted_variable_offset -> operand(2) = variable_offset;
166 
167           return (converted_variable_offset);
168 
169           end /* convert_variable_offset */;
170 ^L
171 %include semant;
172 %include operator;
173 %include reference;
174 %include nodes;
175 %include op_codes;
176 %include boundary;
177 %include system;
178 
179           end /* offset_adder */;
180