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 evaluates an expression used as a size or offset.
 12    If the operator node does not have a reference count on its temporary,
 13   a copy is made of the temporary with a reference count of 2 to
 14   replace the original temporary.
 15 
 16    Initial Version:  5 September 1971 by BLW
 17           Modified: 15 July 1972 by BLW
 18           Modified: 2 August 1973 by RAB to eliminate operator copying
 19           Modified: 15 October 1975 by RAB to use xrs for some assignments
 20           Modified: 26 July 1976 by RAB to fix 1505
 21           Modified: 9 March 1977 by RAB to eliminate mod_bit, etc. dead code
 22           Modified: 9 April 1977 by RAB to eliminate mod_word
 23           Modified: 14 February 1978 by RAB to extend power of use_xr
 24           Modified: 4 August 1978 by RAB to account for unsigned binary in use_xr         */
 25 
 26 eval_exp: proc(pt,no_xr) returns(ptr) ;
 27 
 28 dcl       pt ptr,                       /* points at the expression */
 29           no_xr bit(1) aligned;         /* "1"b  - don't use xrs for assignments */
 30 
 31 dcl       (cg_stat$first_op,cg_stat$next_op,cg_stat$cur_block,cg_stat$cur_statement) ptr ext;
 32 
 33 dcl       cg_stat$optimize bit(1) aligned ext static;
 34 
 35 dcl       (sp,tp,xp) ptr,
 36           (atomic,copy) bit(1) aligned,
 37           op_code bit(9) aligned,
 38           xr fixed bin;
 39 
 40 dcl       (copy_temp,check_o_and_s) entry(ptr) returns(ptr),
 41           create_list entry(fixed bin) returns(ptr),
 42           error entry(fixed bin,ptr,ptr),
 43           compile_exp entry(ptr),
 44           call_op entry(ptr) returns(ptr),
 45           length_op entry(ptr) returns(ptr),
 46           assign_desc_op entry(ptr) returns(ptr),
 47           prepare_operand entry(ptr,fixed bin,bit(1) aligned) returns(ptr),
 48           xr_man$load_any_var entry(ptr,fixed bin,fixed bin),
 49           xr_man$update_xr entry(ptr,fixed bin);
 50 
 51 dcl       (fixed,mod,null,substr) builtin;
 52 
 53 %include reference;
 54 %include symbol;
 55 %include operator;
 56 %include nodes;
 57 %include op_codes;
 58 %include cgsystem;
 59 %include boundary;
 60 %include data_types;
 61 
 62           xp = pt;
 63 
 64           if xp = null then goto done;
 65 
 66           if xp -> node.type = operator_node
 67           then do;
 68                op_code = xp -> operator.op_code;
 69 
 70                if op_code = std_call
 71                then do;
 72                     if ^ xp -> operand(1) -> reference.evaluated
 73                     then do;
 74                          tp = call_op(xp);
 75                          tp -> reference.value_in.storage = "1"b;
 76                          end;
 77 done:               return(xp);
 78                     end;
 79 
 80                if op_code = desc_size
 81                then do;
 82                     tp = check_o_and_s(xp);
 83                     if tp ^= null
 84                     then do;
 85                          return(tp);
 86                          end;
 87                     end;
 88 
 89                tp = xp -> operand(1);
 90                if tp = null
 91                then do;
 92                     call error(317,cg_stat$cur_statement,null);
 93                     goto done;
 94                     end;
 95 
 96                if tp -> reference.evaluated
 97                     then go to done;
 98 
 99                if op_code = assign
100                then do;
101                     sp = xp -> operand(2);
102                     if sp -> node.type = reference_node
103                     then if sp -> reference.symbol -> symbol.arg_descriptor
104                          then if tp -> reference.symbol -> symbol.temporary
105                               then do;
106 
107                                    /* eliminate assignment of descriptor to temporary */
108 
109                                    xp = assign_desc_op(xp);
110                                    go to done;
111                                    end;
112                               else;
113                          else if cg_stat$optimize
114                               then if sp -> reference.symbol -> symbol.packed
115                               then if ^ no_xr
116                               then if sp -> reference.ref_count <= 1 | sp -> reference.aligned_ref
117                               then if use_xr()
118                                    then go to done;
119                     end;
120 
121                if op_code = length_fun
122                then do;
123                     xp = length_op(xp);
124                     go to done;
125                     end;
126 
127                if tp -> reference.shared
128                then do;
129                     xp -> operand(1), tp = copy_temp(tp);
130                     tp -> reference.ref_count = 2;
131                     end;
132                else if tp -> reference.temp_ref
133                     then tp -> reference.ref_count = tp -> reference.ref_count + 1;
134 
135                call compile_exp(xp);
136 
137                end;
138 
139           else xp = prepare_operand(xp,1,atomic);
140 
141 
142           goto done;
143 
144 
145 use_xr:        proc returns(bit(1) aligned);
146 
147                sp = prepare_operand(sp,1,atomic);
148 
149                if sp -> reference.c_length = bits_per_half | sp -> reference.aligned_ref
150                then if ^ sp -> reference.hard_to_load
151                then if sp -> reference.data_type = real_fix_bin_1
152                        & (tp->reference.symbol->symbol.c_dcl_size = default_fix_bin_p + fixed(sp->reference.symbol->symbol.unsigned,1)
153                          | sp -> reference.aligned_ref)
154                      | sp -> reference.data_type = bit_string
155                        & ^ sp -> reference.aligned_ref
156                        & tp -> reference.symbol -> symbol.c_dcl_size = bits_per_half
157                then if sp -> reference.units = word_ | mod(sp -> reference.c_offset,bits_per_half) = 0
158                then do;
159                     tp = prepare_operand(tp,1,atomic);
160                     if tp -> reference.shared
161                          then xp -> operand(1), tp = copy_temp(tp);
162                     call xr_man$load_any_var(sp,xr,0);
163                     call xr_man$update_xr(tp,xr);
164                     tp -> reference.evaluated = "1"b;
165                     return("1"b);
166                     end;
167 
168                return("0"b);
169                end;
170 
171 
172           end;