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 compare_declaration:          proc(pa,pb,ignore_aligned) returns(bit(1) aligned);
 12 
 13 /* Modified 780712 by PG for unsigned */
 14 
 15 dcl       (asize,bsize,pa,pb,a,b,ba,bb,as,bs) ptr;
 16 
 17 dcl       (c_asize,c_bsize) fixed bin(31);
 18 
 19 dcl       (i,ndims) fixed bin;
 20 
 21 dcl       (array_bit, a_reference, b_reference) bit(1) aligned;
 22 
 23 dcl       ignore_aligned bit(1) aligned;
 24 
 25 dcl       (null,string,unspec) builtin;
 26 ^L
 27           asize,bsize = null;
 28           c_asize,c_bsize = 0;
 29           if pa = pb then goto exit;
 30           if pa = null | pb = null then goto fail;
 31 
 32           if pa->node.type = reference_node
 33           then do;
 34 
 35                     /* we're comparing for purposes of optimizing an assignment */
 36 
 37                     a = pa->reference.symbol;
 38                     array_bit = pa->reference.array_ref;
 39                     a_reference = "1"b;
 40           end;
 41           else do;
 42 
 43                     /* we're comparing entire declaration OR we were called by compare_declaration to process a structure member */
 44 
 45                     a = pa;
 46                     array_bit = a->symbol.dimensioned;
 47                     a_reference = "0"b;
 48           end;
 49 
 50           if pb->node.type = reference_node
 51           then do;
 52                     b = pb->reference.symbol;
 53                     array_bit = array_bit | pb->reference.array_ref;
 54                     b_reference = "1"b;
 55           end;
 56           else do;
 57                     b = pb;
 58                     array_bit = array_bit | b->symbol.dimensioned & ^ a_reference;
 59                     b_reference = "0"b;
 60           end;
 61 
 62           if string(a->symbol.data_type) ^= string(b->symbol.data_type) then goto fail;
 63           if a->symbol.binary ^= b->symbol.binary then goto fail;
 64           if a->symbol.real ^= b->symbol.real then goto fail;
 65           if a->symbol.scale ^= b->symbol.scale then goto fail;
 66           if a->symbol.aligned ^= b->symbol.aligned
 67           then      if ^ ignore_aligned
 68                     then      goto fail;
 69                     else      if ^ (a->symbol.bit | a->symbol.char)
 70                               then      goto fail;
 71 
 72           if a -> symbol.unsigned ^= b -> symbol.unsigned
 73           then go to fail;
 74 
 75           if a->symbol.varying ^= b->symbol.varying then goto fail;
 76 
 77           if a->symbol.picture
 78           then      if unspec(a->symbol.general->reference.symbol->symbol.initial->picture_image)
 79                               ^=unspec(b->symbol.general->reference.symbol->symbol.initial->picture_image)
 80                     then      goto fail;
 81 
 82           asize = a->symbol.dcl_size;
 83           bsize = b->symbol.dcl_size;
 84           c_asize = a->symbol.c_dcl_size;
 85           c_bsize = b->symbol.c_dcl_size;
 86 
 87           if (a->symbol.bit|a->symbol.char) & a_reference & ^array_bit & ^a->symbol.varying
 88           then do;
 89                     asize = pa->reference.length;
 90                     c_asize = pa->reference.c_length;
 91           end;
 92 
 93           if (b->symbol.bit|b->symbol.char) & b_reference & ^array_bit & ^b->symbol.varying
 94           then do;
 95                     bsize = pb->reference.length;
 96                     c_bsize = pb->reference.c_length;
 97           end;
 98 
 99           if c_asize^=c_bsize
100           then      goto fail;
101 
102           if asize^=bsize
103           then      if a_reference & b_reference
104                     then      if ^ compare_expression(asize,bsize)
105                               then      goto fail;
106                               else;
107                     else      goto fail;
108 
109           if array_bit
110           then      if a->symbol.dimensioned^=b->symbol.dimensioned
111                     then      if a_reference
112                               then      goto fail;
113                               else do;
114                                         if b->symbol.dimensioned
115                                         then      if b->symbol.array->array.own_number_of_dimensions ^= 0
116                                                   then      goto fail;
117                                                   else;
118                                         else      if a->symbol.array->array.own_number_of_dimensions ^= 0
119                                                   then      goto fail;
120                                         array_bit = "0"b;
121                               end;
122 
123           if array_bit
124           then do;
125                     if a->symbol.array->array.own_number_of_dimensions ^= b->symbol.array->array.own_number_of_dimensions
126                     then      goto fail;
127 
128                     if a_reference
129                     then do;
130                               if a->symbol.array->array.number_of_dimensions ^= b->symbol.array->array.number_of_dimensions
131                               then      goto fail;
132 
133                               if a->symbol.array->array.interleaved ^= b->symbol.array->array.interleaved
134                               then      goto fail;
135 
136                               ndims = b->symbol.array->array.number_of_dimensions;
137                     end;
138                     else      ndims = b->symbol.array->array.own_number_of_dimensions;
139 
140                     ba = a->symbol.array->array.bounds;
141                     bb = b->symbol.array->array.bounds;
142 
143                     do i = 1 to ndims while(ba ^= null);
144                               if a->symbol.star_extents^=b->symbol.star_extents then goto fail;
145 
146                               if ba->bound.c_lower ^= bb->bound.c_lower then goto fail;
147                               if ba->bound.c_upper ^= bb->bound.c_upper then goto fail;
148 
149                               if ba->bound.lower=null & bb->bound.lower^=null
150                               then do;
151                                         if bb->bound.lower->node.type^=reference_node
152                                         then      goto fail;
153                                         if ^bb->bound.lower->reference.symbol->symbol.constant
154                                         then      goto fail;
155                               end;                else
156 
157                               if ba->bound.lower^=null & bb->bound.lower=null
158                               then do;
159                                         if ba->bound.lower->node.type^=reference_node
160                                         then      goto fail;
161                                         if ^ba->bound.lower->reference.symbol->symbol.constant
162                                         then      goto fail;
163                               end;                else
164 
165                               if ^compare_expression((ba->bound.lower),(bb->bound.lower))
166                               then      goto fail;
167 
168                               if ba->bound.upper=null & bb->bound.upper^=null
169                               then do;
170                                         if bb->bound.upper->node.type^=reference_node
171                                         then      goto fail;
172                                         if ^bb->bound.upper->reference.symbol->symbol.constant
173                                         then      goto fail;
174                               end;                else
175 
176                               if ba->bound.upper^=null & bb->bound.upper=null
177                               then do;
178                                         if ba->bound.upper->node.type^=reference_node
179                                         then      goto fail;
180                                         if ^ba->bound.upper->reference.symbol->symbol.constant
181                                         then      goto fail;
182                               end;                else
183 
184                               if ^compare_expression((ba->bound.upper),(bb->bound.upper))
185                               then      goto fail;
186 
187                               ba = ba->bound.next;
188                               bb = bb->bound.next;
189                     end;
190           end;
191 
192           if a->symbol.structure
193           then do;
194                     as = a->symbol.son;
195                     bs = b->symbol.son;
196 
197                     do while(as ^= null);
198                               if bs=null
199                               then      goto fail;
200 
201                               if ^compare_declaration(as,bs,"0"b)
202                               then      goto fail;
203 
204                               as = as->symbol.brother;
205                               bs = bs->symbol.brother;
206                     end;
207 
208                     if bs^=null
209                     then      goto fail;
210           end;
211 
212 exit:
213           return("1"b);
214 
215 fail:
216           return("0"b);
217 ^L
218 %include semant;
219 
220 %include array;
221 %include nodes;
222 %include picture_image;
223 %include reference;
224 %include symbol;
225 
226           end compare_declaration;