1
2
3
4
5
6
7
8
9
10
11 compare_declaration: proc(pa,pb,ignore_aligned) returns(bit(1) aligned);
12
13
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
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
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;