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 /* program to compile min and max functions for pl/1
 12 
 13    Note:  The min and max macros generated by this program make 2 references
 14    to their input argument.  Hence, the reference count on the reference node
 15    returned by compile_exp$save must be increased by 1, and the reference
 16    counts for the 3rd thru last temporary in the case of more than 3 operands
 17    must be 3 instead of 2 as might be expected.  Since the first temporary
 18    is merely loaded, a reference count of 2 is sufficient.
 19 
 20    Initial Version:  1 April, 1969 by BLW
 21           Modified:  5 May, 1971 by BLW for Version II
 22           Modified: 25 October, 1972 by, BLW
 23           Modified: 17 October, 1973 by RAB for EIS
 24           Modified: 10 September, 1975 by RAB to fix 1416
 25           Modified: 9 December 1976 by RAB to fix pos_dif_fun bug
 26           Modified: 30 January 1977 by RAB to fix 1570
 27           Modified: 19 March 1977 by RAB to fix 1597
 28           Modified: 1 June 1977 by RAB to improve min(atm,exp)
 29           Modified: 2 June 1977 by RAB to improve register management for 2 args
 30           Modified 780830 by PG to remove pos_dif_fun
 31 */
 32 
 33 min_max:
 34           procedure (pt);
 35 
 36 /* parameters */
 37 
 38 dcl       pt ptr parameter;                                 /* points at operator node */
 39 
 40 /* automatic */
 41 
 42 dcl       (p,op_pt,p2,p3,s1,ref(128)) ptr,
 43           (i,n_rands,type(128),scale(128)) fixed bin,
 44           op_code bit(9) aligned,
 45           which fixed bin(15),
 46           (p1_fx2,b1,check_scale) bit(1) aligned,
 47           atom(128) bit(1) aligned;
 48 
 49 /* entries */
 50 
 51 dcl       compile_exp entry(ptr),
 52           compile_exp$save entry(ptr) returns(ptr),
 53           decimal_op entry(ptr,(128) ptr,(128) bit(1) aligned),
 54           compile_exp$save_fix_scaled entry(ptr,fixed bin,fixed bin) returns(ptr),
 55           adjust_ref_count entry(ptr,fixed bin),
 56           state_man$erase_reg entry(bit(19) aligned),
 57           aq_man$fix_scale entry(ptr,fixed bin,fixed bin),
 58           load entry(ptr,fixed bin),
 59           expmac entry(fixed bin(15),ptr),
 60           expmac$zero entry(fixed bin(15)),
 61           prepare_operand entry(ptr,fixed bin,bit(1) aligned) returns(ptr);
 62 
 63 /* external static */
 64 
 65 dcl       cg_stat$temp_ref ptr ext;
 66 
 67 /* internal static */
 68 
 69 dcl (     rfb1_to_rfb2        init(88),
 70           min_fx1             init(247),
 71           max_fx1             init(251)) fixed bin(15) int static;
 72 
 73 /* include files */
 74 
 75 %include operator;
 76 %include reference;
 77 %include symbol;
 78 %include machine_state;
 79 %include data_types;
 80 %include op_codes;
 81 ^L
 82 /* program */
 83 
 84           op_pt = pt;
 85 
 86           n_rands = op_pt -> operator.number;
 87           do i = 1 to n_rands;
 88                ref(i) = prepare_operand((op_pt -> operand(i)),1,b1);
 89                type(i) = ref(i) -> reference.data_type;
 90                scale(i) = ref(i) -> reference.symbol -> symbol.scale;
 91                atom(i) = b1;
 92                end;
 93 
 94           op_code = op_pt -> operator.op_code;
 95 
 96           s1 = ref(1) -> reference.symbol;
 97 
 98           if s1 -> symbol.decimal
 99           then do;
100                call decimal_op(op_pt,ref,atom);
101                goto done;
102                end;
103 
104           check_scale = "0"b;
105           p1_fx2 = type(1) = real_fix_bin_2;
106 
107           if s1 -> symbol.fixed
108           then do i = 2 to n_rands;
109                     if scale(i) ^= scale(1)
110                     then do;
111                          atom(i) = "0"b;
112                          check_scale = "1"b;
113                          end;
114 
115                     if p1_fx2
116                     then if n_rands > 3
117                          then if type(i) = real_fix_bin_1
118                               then atom(i) = "0"b;
119                     end;
120 
121           if op_code = min_fun then which = min_fx1;
122           else which = max_fx1;
123 
124           if n_rands > 3 then goto mm_long;
125 
126           p2 = op_pt -> operand(2);
127           p3 = op_pt -> operand(3);
128 
129           /* if both operands are the same, compile one & decrement ref_count */
130 
131           if p2 = p3
132           then do;
133                call compile_exp(p2);
134                if ^ ref(3) -> reference.shared
135                     then call adjust_ref_count(ref(3),-1);
136 
137                /* since compile_exp will call state_man$update_ref,
138                   we must flush the q if we are putting in a temp */
139 
140                if ref(2) -> reference.temp_ref
141                     then call state_man$erase_reg("01"b);
142                goto done;
143                end;
144 
145           /* put longer of two operands on right */
146 
147           if type(2) > type(3)
148                then call flip_rands;
149 
150           if atom(2)
151           then do;
152                if atom(3) then goto mm_aa;
153 
154                /* have f(atm,exp) */
155 
156                if type(2) >= type(3)
157                then do;
158                     call flip_rands;
159                     go to mm_ea;
160                     end;
161 
162                if check_scale & scale(1) ^= scale(3)
163                then do;
164                     ref(3) = compile_exp$save_fix_scaled(p3,scale(1),type(1));
165                     type(3) = type(1);
166                     end;
167                else ref(3) = compile_exp$save(p3);
168 
169                /* have f(atm,atm) */
170 
171 mm_aa:         if ref(3) -> reference.value_in.q
172                then if type(2) >= type(3)
173                     then call flip_rands;
174 
175                call load(ref(2),0);
176                end;
177           else do;
178                if atom(3) then goto mm_ea;
179 
180                /* have f(exp,exp) */
181 
182                if check_scale & scale(1) ^= scale(3)
183                then do;
184                     ref(3) = compile_exp$save_fix_scaled(p3,scale(1),type(1));
185                     type(3) = type(1);
186                     end;
187                else ref(3) = compile_exp$save(p3);
188 
189                /* have f(exp,atm) */
190 
191 mm_ea:         call compile_exp(p2);
192 
193                if check_scale & scale(1) ^= scale(2)
194                then do;
195                     call aq_man$fix_scale(ref(2),scale(1),type(1));
196                     type(2) = type(1);
197                     end;
198 
199                end;
200 
201           if p1_fx2 then if type(2) = real_fix_bin_1
202           then call expmac$zero((rfb1_to_rfb2));
203 
204           call expmac(which + type(3) - real_fix_bin_1,ref(3));
205           goto done;
206 
207           /* f(a1,a2,...,an).  evaluate all expressions and if
208              type of result is real_fix_bin_2, convert all single
209              precision fixed to double */
210 
211 mm_long:  do i = 2 to n_rands;
212                if ^ atom(i)
213                then if (check_scale & scale(1) ^= scale(i)) | (p1_fx2 & type(i) = real_fix_bin_1)
214                     then do;
215                          ref(i) = compile_exp$save_fix_scaled((op_pt -> operand(i)),scale(1),type(1));
216                          type(i) = type(1);
217                          end;
218                     else ref(i) = compile_exp$save((op_pt -> operand(i)));
219 
220                end;
221 
222           call load(ref(2),0);
223 
224           do i = 3 to n_rands;
225                call expmac(which + type(i) - real_fix_bin_1,ref(i));
226                end;
227 
228 done:     cg_stat$temp_ref = ref(1);
229 
230           /* set indicators to reflect the fact that the machine indicators
231              do not correspond to the value of the min|max function */
232 
233           machine_state.indicators = -1;
234           return;
235 
236 
237 flip_rands:         proc;
238 
239                /* flips operands for case of 2 operands */
240 
241                p = ref(2);
242                ref(2) = ref(3);
243                ref(3) = p;
244 
245                p = p2;
246                p2 = p3;
247                p3 = p;
248 
249                b1 = atom(2);
250                atom(2) = atom(3);
251                atom(3) = b1;
252 
253                i = type(2);
254                type(2) = type(3);
255                type(3) = i;
256 
257                i = scale(2);
258                scale(2) = scale(3);
259                scale(3) = i;
260 
261                end;
262           end;