Subversion Repositories tendra.SVN

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 7u83 1
/*
2
    		 Crown Copyright (c) 1997
3
 
4
    This TenDRA(r) Computer Program is subject to Copyright
5
    owned by the United Kingdom Secretary of State for Defence
6
    acting through the Defence Evaluation and Research Agency
7
    (DERA).  It is made available to Recipients with a
8
    royalty-free licence for its use, reproduction, transfer
9
    to other parties and amendment for any purpose not excluding
10
    product development provided that any such use et cetera
11
    shall be deemed to be acceptance of the following conditions:-
12
 
13
        (1) Its Recipients shall ensure that this Notice is
14
        reproduced upon any copies or amended versions of it;
15
 
16
        (2) Any amended version of it shall be clearly marked to
17
        show both the nature of and the organisation responsible
18
        for the relevant amendment or amendments;
19
 
20
        (3) Its onward transfer from a recipient to another
21
        party shall be deemed to be that party's acceptance of
22
        these conditions;
23
 
24
        (4) DERA gives no warranty or assurance as to its
25
        quality or suitability for any purpose and DERA accepts
26
        no liability whatsoever in relation to any use to which
27
        it may be put.
28
*/
29
 
30
 
31
#include "config.h"
32
#include "c_types.h"
33
#include "exp_ops.h"
34
#include "graph_ops.h"
35
#include "hashid_ops.h"
36
#include "id_ops.h"
37
#include "nat_ops.h"
38
#include "nspace_ops.h"
39
#include "off_ops.h"
40
#include "tok_ops.h"
41
#include "type_ops.h"
42
#include "error.h"
43
#include "catalog.h"
44
#include "option.h"
45
#include "basetype.h"
46
#include "check.h"
47
#include "chktype.h"
48
#include "constant.h"
49
#include "convert.h"
50
#include "derive.h"
51
#include "function.h"
52
#include "hash.h"
53
#include "literal.h"
54
#include "merge.h"
55
#include "namespace.h"
56
#include "syntax.h"
57
#include "tokdef.h"
58
 
59
 
60
/*
61
    ARE TWO OFFSETS EQUAL?
62
 
63
    This routine checks whether the offsets a and b are equal.  The co
64
    argument is passed through to eq_exp.
65
*/
66
 
67
int eq_offset
68
    PROTO_N ( ( a, b, co ) )
69
    PROTO_T ( OFFSET a X OFFSET b X int co )
70
{
71
    unsigned taga, tagb ;
72
 
73
    /* Check for obvious equality */
74
    if ( EQ_off ( a, b ) ) return ( 1 ) ;
75
    if ( IS_NULL_off ( a ) ) return ( 0 ) ;
76
    if ( IS_NULL_off ( b ) ) return ( 0 ) ;
77
 
78
    /* Check tags */
79
    taga = TAG_off ( a ) ;
80
    tagb = TAG_off ( b ) ;
81
    if ( taga != tagb ) return ( 0 ) ;
82
 
83
    /* Check individual cases */
84
    ASSERT ( ORDER_off == 13 ) ;
85
    switch ( TAG_off ( a ) ) {
86
	case off_zero_tag : {
87
	    /* Zero offsets */
88
	    TYPE ta = DEREF_type ( off_zero_type ( a ) ) ;
89
	    TYPE tb = DEREF_type ( off_zero_type ( b ) ) ;
90
	    return ( eq_type_offset ( ta, tb ) ) ;
91
	}
92
	case off_type_tag : {
93
	    /* Type offsets */
94
	    TYPE ta = DEREF_type ( off_type_type ( a ) ) ;
95
	    TYPE tb = DEREF_type ( off_type_type ( b ) ) ;
96
	    return ( eq_type_offset ( ta, tb ) ) ;
97
	}
98
	case off_extra_tag : {
99
	    /* Extra allocator offsets */
100
	    TYPE ta = DEREF_type ( off_extra_type ( a ) ) ;
101
	    TYPE tb = DEREF_type ( off_extra_type ( b ) ) ;
102
	    int na = DEREF_int ( off_extra_scale ( a ) ) ;
103
	    int nb = DEREF_int ( off_extra_scale ( b ) ) ;
104
	    return ( na == nb && eq_type_offset ( ta, tb ) ) ;
105
	}
106
	case off_array_tag : {
107
	    /* Array offsets */
108
	    TYPE ta = DEREF_type ( off_array_type ( a ) ) ;
109
	    TYPE tb = DEREF_type ( off_array_type ( b ) ) ;
110
	    unsigned na = DEREF_unsigned ( off_array_arg ( a ) ) ;
111
	    unsigned nb = DEREF_unsigned ( off_array_arg ( b ) ) ;
112
	    return ( na == nb && eq_type_offset ( ta, tb ) ) ;
113
	}
114
	case off_base_tag : {
115
	    /* Base class offsets */
116
	    GRAPH ga = DEREF_graph ( off_base_graph ( a ) ) ;
117
	    GRAPH gb = DEREF_graph ( off_base_graph ( b ) ) ;
118
	    return ( eq_graph ( ga, gb ) ) ;
119
	}
120
	case off_deriv_tag : {
121
	    /* Derived class offsets */
122
	    GRAPH ga = DEREF_graph ( off_deriv_graph ( a ) ) ;
123
	    GRAPH gb = DEREF_graph ( off_deriv_graph ( b ) ) ;
124
	    return ( eq_graph ( ga, gb ) ) ;
125
	}
126
	case off_member_tag : {
127
	    /* Member offsets */
128
	    IDENTIFIER ia = DEREF_id ( off_member_id ( a ) ) ;
129
	    IDENTIFIER ib = DEREF_id ( off_member_id ( b ) ) ;
130
	    return ( EQ_id ( ia, ib ) ) ;
131
	}
132
	case off_ptr_mem_tag : {
133
	    /* Pointer member offsets */
134
	    EXP xa = DEREF_exp ( off_ptr_mem_arg ( a ) ) ;
135
	    EXP xb = DEREF_exp ( off_ptr_mem_arg ( b ) ) ;
136
	    return ( eq_exp ( xa, xb, co ) ) ;
137
	}
138
	case off_negate_tag : {
139
	    /* Offset negation */
140
	    OFFSET sa = DEREF_off ( off_negate_arg ( a ) ) ;
141
	    OFFSET sb = DEREF_off ( off_negate_arg ( b ) ) ;
142
	    return ( eq_offset ( sa, sb, co ) ) ;
143
	}
144
	case off_plus_tag : {
145
	    /* Offset addition */
146
	    OFFSET sa = DEREF_off ( off_plus_arg1 ( a ) ) ;
147
	    OFFSET sb = DEREF_off ( off_plus_arg1 ( b ) ) ;
148
	    OFFSET ta = DEREF_off ( off_plus_arg2 ( a ) ) ;
149
	    OFFSET tb = DEREF_off ( off_plus_arg2 ( b ) ) ;
150
	    if ( eq_offset ( sa, sb, co ) && eq_offset ( ta, tb, co ) ) {
151
		return ( 1 ) ;
152
	    }
153
	    if ( co && eq_offset ( sa, tb, 1 ) && eq_offset ( ta, sb, 1 ) ) {
154
		return ( 1 ) ;
155
	    }
156
	    return ( 0 ) ;
157
	}
158
	case off_mult_tag : {
159
	    /* Offset multiplication */
160
	    OFFSET sa = DEREF_off ( off_mult_arg1 ( a ) ) ;
161
	    OFFSET sb = DEREF_off ( off_mult_arg1 ( b ) ) ;
162
	    EXP za = DEREF_exp ( off_mult_arg2 ( a ) ) ;
163
	    EXP zb = DEREF_exp ( off_mult_arg2 ( b ) ) ;
164
	    return ( eq_offset ( sa, sb, co ) && eq_exp ( za, zb, co ) ) ;
165
	}
166
	case off_ptr_diff_tag : {
167
	    /* Pointer difference */
168
	    EXP xa = DEREF_exp ( off_ptr_diff_ptr1 ( a ) ) ;
169
	    EXP xb = DEREF_exp ( off_ptr_diff_ptr1 ( b ) ) ;
170
	    EXP za = DEREF_exp ( off_ptr_diff_ptr2 ( a ) ) ;
171
	    EXP zb = DEREF_exp ( off_ptr_diff_ptr2 ( b ) ) ;
172
	    return ( eq_exp ( xa, xb, co ) && eq_exp ( za, zb, co ) ) ;
173
	}
174
	case off_token_tag : {
175
	    /* Token application */
176
	    IDENTIFIER ia = DEREF_id ( off_token_tok ( a ) ) ;
177
	    IDENTIFIER ib = DEREF_id ( off_token_tok ( b ) ) ;
178
	    LIST ( TOKEN ) pa = DEREF_list ( off_token_args ( a ) ) ;
179
	    LIST ( TOKEN ) pb = DEREF_list ( off_token_args ( b ) ) ;
180
	    return ( eq_token_args ( ia, ib, pa, pb ) ) ;
181
	}
182
    }
183
    return ( 0 ) ;
184
}
185
 
186
 
187
/*
188
    ARE TWO LISTS OF EXPRESSIONS EQUAL?
189
 
190
    This routine checks whether the expression lists p and q are equal,
191
    in the sense that each of their components is equal.  The co argument
192
    is passed through to eq_exp.
193
*/
194
 
195
static int eq_exp_list
196
    PROTO_N ( ( p, q, co ) )
197
    PROTO_T ( LIST ( EXP ) p X LIST ( EXP ) q X int co )
198
{
199
    unsigned np = LENGTH_list ( p ) ;
200
    unsigned nq = LENGTH_list ( q ) ;
201
    if ( np != nq ) return ( 0 ) ;
202
    while ( !IS_NULL_list ( p ) ) {
203
	EXP a = DEREF_exp ( HEAD_list ( p ) ) ;
204
	EXP b = DEREF_exp ( HEAD_list ( q ) ) ;
205
	if ( !eq_exp ( a, b, co ) ) return ( 0 ) ;
206
	p = TAIL_list ( p ) ;
207
	q = TAIL_list ( q ) ;
208
    }
209
    return ( 1 ) ;
210
}
211
 
212
 
213
/*
214
    CHECK EXPRESSION EQUALITY
215
 
216
    This is an auxiliary routine for eq_exp which checks whether the
217
    expressions a and b, which have the same tag value, are equal.
218
*/
219
 
220
static int eq_exp_aux
221
    PROTO_N ( ( a, b, co ) )
222
    PROTO_T ( EXP a X EXP b X int co )
223
{
224
    /* Check expressions */
225
    ASSERT ( ORDER_exp == 88 ) ;
226
    switch ( TAG_exp ( a ) ) {
227
	case exp_identifier_tag :
228
	case exp_member_tag :
229
	case exp_ambiguous_tag :
230
	case exp_undeclared_tag : {
231
	    /* Identifier expressions */
232
	    IDENTIFIER ia = DEREF_id ( exp_identifier_etc_id ( a ) ) ;
233
	    IDENTIFIER ib = DEREF_id ( exp_identifier_etc_id ( b ) ) ;
234
	    return ( EQ_id ( ia, ib ) ) ;
235
	}
236
	case exp_int_lit_tag : {
237
	    /* Integer literal expressions */
238
	    TYPE ta = DEREF_type ( exp_type ( a ) ) ;
239
	    TYPE tb = DEREF_type ( exp_type ( b ) ) ;
240
	    NAT na = DEREF_nat ( exp_int_lit_nat ( a ) ) ;
241
	    NAT nb = DEREF_nat ( exp_int_lit_nat ( b ) ) ;
242
	    if ( !eq_type ( ta, tb ) ) return ( 0 ) ;
243
	    if ( EQ_nat ( na, nb ) || eq_nat ( na, nb ) ) return ( 1 ) ;
244
	    return ( 0 ) ;
245
	}
246
	case exp_float_lit_tag : {
247
	    /* Floating literal expressions */
248
	    TYPE ta = DEREF_type ( exp_type ( a ) ) ;
249
	    TYPE tb = DEREF_type ( exp_type ( b ) ) ;
250
	    FLOAT fa = DEREF_flt ( exp_float_lit_flt ( a ) ) ;
251
	    FLOAT fb = DEREF_flt ( exp_float_lit_flt ( b ) ) ;
252
	    if ( !eq_type ( ta, tb ) ) return ( 0 ) ;
253
	    if ( EQ_flt ( fa, fb ) ) return ( 1 ) ;
254
	    return ( eq_float_lit ( fa, fb ) ) ;
255
	}
256
	case exp_char_lit_tag : {
257
	    /* Character literal expressions */
258
	    TYPE ta = DEREF_type ( exp_type ( a ) ) ;
259
	    TYPE tb = DEREF_type ( exp_type ( b ) ) ;
260
	    STRING ca = DEREF_str ( exp_char_lit_str ( a ) ) ;
261
	    STRING cb = DEREF_str ( exp_char_lit_str ( b ) ) ;
262
	    if ( !eq_type ( ta, tb ) ) return ( 0 ) ;
263
	    if ( EQ_str ( ca, cb ) ) return ( 1 ) ;
264
	    return ( eq_string_lit ( ca, cb ) ) ;
265
	}
266
	case exp_string_lit_tag : {
267
	    /* String literal expressions */
268
	    TYPE ta = DEREF_type ( exp_type ( a ) ) ;
269
	    TYPE tb = DEREF_type ( exp_type ( b ) ) ;
270
	    STRING ca = DEREF_str ( exp_string_lit_str ( a ) ) ;
271
	    STRING cb = DEREF_str ( exp_string_lit_str ( b ) ) ;
272
	    if ( !eq_type ( ta, tb ) ) return ( 0 ) ;
273
	    if ( EQ_str ( ca, cb ) ) return ( 1 ) ;
274
	    return ( eq_string_lit ( ca, cb ) ) ;
275
	}
276
	case exp_null_tag :
277
	case exp_zero_tag :
278
	case exp_value_tag : {
279
	    /* Null expressions */
280
	    TYPE ta = DEREF_type ( exp_type ( a ) ) ;
281
	    TYPE tb = DEREF_type ( exp_type ( b ) ) ;
282
	    if ( eq_type ( ta, tb ) == 1 ) return ( 1 ) ;
283
	    return ( 0 ) ;
284
	}
285
	case exp_paren_tag :
286
	case exp_copy_tag : {
287
	    /* Parenthesised expressions */
288
	    EXP sa = DEREF_exp ( exp_paren_etc_arg ( a ) ) ;
289
	    EXP sb = DEREF_exp ( exp_paren_etc_arg ( b ) ) ;
290
	    return ( eq_exp ( sa, sb, co ) ) ;
291
	}
292
	case exp_assign_tag : {
293
	    /* Assignment expressions */
294
	    EXP ra = DEREF_exp ( exp_assign_ref ( a ) ) ;
295
	    EXP rb = DEREF_exp ( exp_assign_ref ( b ) ) ;
296
	    EXP sa = DEREF_exp ( exp_assign_arg ( a ) ) ;
297
	    EXP sb = DEREF_exp ( exp_assign_arg ( b ) ) ;
298
	    return ( eq_exp ( ra, rb, co ) && eq_exp ( sa, sb, co ) ) ;
299
	}
300
	case exp_init_tag : {
301
	    /* Initialisation expressions */
302
	    IDENTIFIER ia = DEREF_id ( exp_init_id ( a ) ) ;
303
	    IDENTIFIER ib = DEREF_id ( exp_init_id ( b ) ) ;
304
	    EXP sa = DEREF_exp ( exp_init_arg ( a ) ) ;
305
	    EXP sb = DEREF_exp ( exp_init_arg ( b ) ) ;
306
	    return ( EQ_id ( ia, ib ) && eq_exp ( sa, sb, co ) ) ;
307
	}
308
	case exp_preinc_tag : {
309
	    /* Pre-increment expressions */
310
	    EXP sa = DEREF_exp ( exp_preinc_op ( a ) ) ;
311
	    EXP sb = DEREF_exp ( exp_preinc_op ( b ) ) ;
312
	    return ( eq_exp ( sa, sb, co ) ) ;
313
	}
314
	case exp_postinc_tag : {
315
	    /* Post-increment expressions */
316
	    EXP sa = DEREF_exp ( exp_postinc_op ( a ) ) ;
317
	    EXP sb = DEREF_exp ( exp_postinc_op ( b ) ) ;
318
	    return ( eq_exp ( sa, sb, co ) ) ;
319
	}
320
	case exp_indir_tag : {
321
	    /* Indirection expressions */
322
	    EXP sa = DEREF_exp ( exp_indir_ptr ( a ) ) ;
323
	    EXP sb = DEREF_exp ( exp_indir_ptr ( b ) ) ;
324
	    return ( eq_exp ( sa, sb, co ) ) ;
325
	}
326
	case exp_contents_tag : {
327
	    /* Contents expressions */
328
	    EXP sa = DEREF_exp ( exp_contents_ptr ( a ) ) ;
329
	    EXP sb = DEREF_exp ( exp_contents_ptr ( b ) ) ;
330
	    return ( eq_exp ( sa, sb, co ) ) ;
331
	}
332
	case exp_address_tag : {
333
	    /* Address expressions */
334
	    EXP sa = DEREF_exp ( exp_address_arg ( a ) ) ;
335
	    EXP sb = DEREF_exp ( exp_address_arg ( b ) ) ;
336
	    return ( eq_exp ( sa, sb, co ) ) ;
337
	}
338
	case exp_address_mem_tag : {
339
	    /* Address expressions */
340
	    EXP sa = DEREF_exp ( exp_address_mem_arg ( a ) ) ;
341
	    EXP sb = DEREF_exp ( exp_address_mem_arg ( b ) ) ;
342
	    return ( eq_exp ( sa, sb, co ) ) ;
343
	}
344
	case exp_func_tag : {
345
	    /* Function expressions */
346
	    EXP sa = DEREF_exp ( exp_func_fn ( a ) ) ;
347
	    EXP sb = DEREF_exp ( exp_func_fn ( b ) ) ;
348
	    LIST ( EXP ) pa = DEREF_list ( exp_func_args ( a ) ) ;
349
	    LIST ( EXP ) pb = DEREF_list ( exp_func_args ( b ) ) ;
350
	    return ( eq_exp ( sa, sb, co ) && eq_exp_list ( pa, pb, co ) ) ;
351
	}
352
	case exp_func_id_tag : {
353
	    /* Function expressions */
354
	    IDENTIFIER ia = DEREF_id ( exp_func_id_id ( a ) ) ;
355
	    IDENTIFIER ib = DEREF_id ( exp_func_id_id ( b ) ) ;
356
	    LIST ( EXP ) pa = DEREF_list ( exp_func_id_args ( a ) ) ;
357
	    LIST ( EXP ) pb = DEREF_list ( exp_func_id_args ( b ) ) ;
358
	    return ( EQ_id ( ia, ib ) && eq_exp_list ( pa, pb, co ) ) ;
359
	}
360
	case exp_call_tag : {
361
	    /* Member function call expressions */
362
	    EXP ra = DEREF_exp ( exp_call_ptr ( a ) ) ;
363
	    EXP rb = DEREF_exp ( exp_call_ptr ( b ) ) ;
364
	    EXP sa = DEREF_exp ( exp_call_arg ( a ) ) ;
365
	    EXP sb = DEREF_exp ( exp_call_arg ( b ) ) ;
366
	    return ( eq_exp ( ra, rb, co ) && eq_exp ( sa, sb, co ) ) ;
367
	}
368
	case exp_negate_tag :
369
	case exp_compl_tag :
370
	case exp_not_tag :
371
	case exp_abs_tag : {
372
	    /* Unary expressions */
373
	    EXP sa = DEREF_exp ( exp_negate_etc_arg ( a ) ) ;
374
	    EXP sb = DEREF_exp ( exp_negate_etc_arg ( b ) ) ;
375
	    return ( eq_exp ( sa, sb, co ) ) ;
376
	}
377
	case exp_plus_tag :
378
	case exp_mult_tag :
379
	case exp_and_tag :
380
	case exp_or_tag :
381
	case exp_xor_tag :
382
	case exp_log_and_tag :
383
	case exp_log_or_tag :
384
	case exp_max_tag :
385
	case exp_min_tag : {
386
	    /* Commutative binary expressions */
387
	    EXP ra = DEREF_exp ( exp_plus_etc_arg1 ( a ) ) ;
388
	    EXP rb = DEREF_exp ( exp_plus_etc_arg1 ( b ) ) ;
389
	    EXP sa = DEREF_exp ( exp_plus_etc_arg2 ( a ) ) ;
390
	    EXP sb = DEREF_exp ( exp_plus_etc_arg2 ( b ) ) ;
391
	    if ( eq_exp ( ra, rb, co ) && eq_exp ( sa, sb, co ) ) {
392
		return ( 1 ) ;
393
	    }
394
	    if ( co && eq_exp ( ra, sb, 1 ) && eq_exp ( sa, rb, 1 ) ) {
395
		return ( 1 ) ;
396
	    }
397
	    return ( 0 ) ;
398
	}
399
	case exp_minus_tag :
400
	case exp_div_tag :
401
	case exp_rem_tag :
402
	case exp_lshift_tag :
403
	case exp_rshift_tag : {
404
	    /* Non-commutative binary expressions */
405
	    EXP ra = DEREF_exp ( exp_plus_etc_arg1 ( a ) ) ;
406
	    EXP rb = DEREF_exp ( exp_plus_etc_arg1 ( b ) ) ;
407
	    EXP sa = DEREF_exp ( exp_plus_etc_arg2 ( a ) ) ;
408
	    EXP sb = DEREF_exp ( exp_plus_etc_arg2 ( b ) ) ;
409
	    return ( eq_exp ( ra, rb, co ) && eq_exp ( sa, sb, co ) ) ;
410
	}
411
	case exp_test_tag : {
412
	    /* Test expressions */
413
	    NTEST ca = DEREF_ntest ( exp_test_tst ( a ) ) ;
414
	    NTEST cb = DEREF_ntest ( exp_test_tst ( b ) ) ;
415
	    EXP sa = DEREF_exp ( exp_test_arg ( a ) ) ;
416
	    EXP sb = DEREF_exp ( exp_test_arg ( b ) ) ;
417
	    if ( ca != cb ) return ( 0 ) ;
418
	    return ( eq_exp ( sa, sb, co ) ) ;
419
	}
420
	case exp_compare_tag : {
421
	    /* Comparison expressions */
422
	    NTEST ca = DEREF_ntest ( exp_compare_tst ( a ) ) ;
423
	    NTEST cb = DEREF_ntest ( exp_compare_tst ( b ) ) ;
424
	    EXP ra = DEREF_exp ( exp_compare_arg1 ( a ) ) ;
425
	    EXP rb = DEREF_exp ( exp_compare_arg1 ( b ) ) ;
426
	    EXP sa = DEREF_exp ( exp_compare_arg2 ( a ) ) ;
427
	    EXP sb = DEREF_exp ( exp_compare_arg2 ( b ) ) ;
428
	    if ( ca != cb ) return ( 0 ) ;
429
	    if ( eq_exp ( ra, rb, co ) && eq_exp ( sa, sb, co ) ) {
430
		return ( 1 ) ;
431
	    }
432
	    if ( co && ( ca == ntest_eq || ca == ntest_not_eq ) ) {
433
		/* Commutative comparisons */
434
		if ( eq_exp ( ra, sb, 1 ) && eq_exp ( sa, rb, 1 ) ) {
435
		    return ( 1 ) ;
436
		}
437
	    }
438
	    return ( 0 ) ;
439
	}
440
	case exp_cast_tag : {
441
	    /* Cast expressions */
442
	    EXP sa = DEREF_exp ( exp_cast_arg ( a ) ) ;
443
	    EXP sb = DEREF_exp ( exp_cast_arg ( b ) ) ;
444
	    unsigned va = DEREF_unsigned ( exp_cast_conv ( a ) ) ;
445
	    unsigned vb = DEREF_unsigned ( exp_cast_conv ( b ) ) ;
446
	    return ( va == vb && eq_exp ( sa, sb, co ) ) ;
447
	}
448
	case exp_base_cast_tag : {
449
	    /* Base cast expressions */
450
	    EXP ra = DEREF_exp ( exp_base_cast_arg ( a ) ) ;
451
	    EXP rb = DEREF_exp ( exp_base_cast_arg ( b ) ) ;
452
	    OFFSET za = DEREF_off ( exp_base_cast_off ( a ) ) ;
453
	    OFFSET zb = DEREF_off ( exp_base_cast_off ( b ) ) ;
454
	    unsigned va = DEREF_unsigned ( exp_base_cast_conv ( a ) ) ;
455
	    unsigned vb = DEREF_unsigned ( exp_base_cast_conv ( b ) ) ;
456
	    if ( va != vb ) return ( 0 ) ;
457
	    return ( eq_exp ( ra, rb, co ) && eq_offset ( za, zb, co ) ) ;
458
	}
459
	case exp_dyn_cast_tag : {
460
	    /* Dynamic cast expressions */
461
	    EXP sa = DEREF_exp ( exp_dyn_cast_arg ( a ) ) ;
462
	    EXP sb = DEREF_exp ( exp_dyn_cast_arg ( b ) ) ;
463
	    EXP ra = DEREF_exp ( exp_dyn_cast_except ( a ) ) ;
464
	    EXP rb = DEREF_exp ( exp_dyn_cast_except ( b ) ) ;
465
	    return ( eq_exp ( sa, sb, co ) && eq_exp ( ra, rb, co ) ) ;
466
	}
467
	case exp_add_ptr_tag : {
468
	    /* Pointer addition expressions */
469
	    EXP ra = DEREF_exp ( exp_add_ptr_ptr ( a ) ) ;
470
	    EXP rb = DEREF_exp ( exp_add_ptr_ptr ( b ) ) ;
471
	    OFFSET za = DEREF_off ( exp_add_ptr_off ( a ) ) ;
472
	    OFFSET zb = DEREF_off ( exp_add_ptr_off ( b ) ) ;
473
	    return ( eq_exp ( ra, rb, co ) && eq_offset ( za, zb, co ) ) ;
474
	}
475
	case exp_offset_size_tag : {
476
	    /* Offset size expressions */
477
	    OFFSET xa = DEREF_off ( exp_offset_size_off ( a ) ) ;
478
	    OFFSET xb = DEREF_off ( exp_offset_size_off ( b ) ) ;
479
	    TYPE sa = DEREF_type ( exp_offset_size_step ( a ) ) ;
480
	    TYPE sb = DEREF_type ( exp_offset_size_step ( b ) ) ;
481
	    return ( eq_offset ( xa, xb, co ) && eq_type_offset ( sa, sb ) ) ;
482
	}
483
	case exp_constr_tag : {
484
	    /* Constructors */
485
	    EXP sa = DEREF_exp ( exp_constr_call ( a ) ) ;
486
	    EXP sb = DEREF_exp ( exp_constr_call ( b ) ) ;
487
	    return ( eq_exp ( sa, sb, co ) ) ;
488
	}
489
	case exp_destr_tag : {
490
	    /* Destructors */
491
	    EXP sa = DEREF_exp ( exp_destr_call ( a ) ) ;
492
	    EXP sb = DEREF_exp ( exp_destr_call ( b ) ) ;
493
	    return ( eq_exp ( sa, sb, co ) ) ;
494
	}
495
	case exp_alloc_tag : {
496
	    /* Allocators */
497
	    EXP sa = DEREF_exp ( exp_alloc_call ( a ) ) ;
498
	    EXP sb = DEREF_exp ( exp_alloc_call ( b ) ) ;
499
	    EXP ra = DEREF_exp ( exp_alloc_init ( a ) ) ;
500
	    EXP rb = DEREF_exp ( exp_alloc_init ( b ) ) ;
501
	    return ( eq_exp ( sa, sb, co ) && eq_exp ( ra, rb, co ) ) ;
502
	}
503
	case exp_dealloc_tag : {
504
	    /* Deallocators */
505
	    EXP sa = DEREF_exp ( exp_dealloc_call ( a ) ) ;
506
	    EXP sb = DEREF_exp ( exp_dealloc_call ( b ) ) ;
507
	    EXP ra = DEREF_exp ( exp_dealloc_term ( a ) ) ;
508
	    EXP rb = DEREF_exp ( exp_dealloc_term ( b ) ) ;
509
	    return ( eq_exp ( sa, sb, co ) && eq_exp ( ra, rb, co ) ) ;
510
	}
511
	case exp_rtti_tag : {
512
	    /* Run-time type information */
513
	    EXP sa = DEREF_exp ( exp_rtti_arg ( a ) ) ;
514
	    EXP sb = DEREF_exp ( exp_rtti_arg ( b ) ) ;
515
	    EXP ra = DEREF_exp ( exp_rtti_except ( a ) ) ;
516
	    EXP rb = DEREF_exp ( exp_rtti_except ( b ) ) ;
517
	    int ia = DEREF_int ( exp_rtti_op ( a ) ) ;
518
	    int ib = DEREF_int ( exp_rtti_op ( b ) ) ;
519
	    if ( ia != ib ) return ( 0 ) ;
520
	    return ( eq_exp ( sa, sb, co ) && eq_exp ( ra, rb, co ) ) ;
521
	}
522
	case exp_rtti_type_tag : {
523
	    /* Run-time type information */
524
	    TYPE sa = DEREF_type ( exp_rtti_type_arg ( a ) ) ;
525
	    TYPE sb = DEREF_type ( exp_rtti_type_arg ( b ) ) ;
526
	    int ia = DEREF_int ( exp_rtti_type_op ( a ) ) ;
527
	    int ib = DEREF_int ( exp_rtti_type_op ( b ) ) ;
528
	    if ( ia != ib ) return ( 0 ) ;
529
	    if ( eq_type ( sa, sb ) == 1 ) return ( 1 ) ;
530
	    return ( 0 ) ;
531
	}
532
	case exp_rtti_no_tag : {
533
	    /* Link-time type information */
534
	    TYPE sa = DEREF_type ( exp_rtti_no_arg ( a ) ) ;
535
	    TYPE sb = DEREF_type ( exp_rtti_no_arg ( b ) ) ;
536
	    if ( eq_type ( sa, sb ) == 1 ) return ( 1 ) ;
537
	    return ( 0 ) ;
538
	}
539
	case exp_dynamic_tag : {
540
	    /* Dynamic initialisers */
541
	    EXP sa = DEREF_exp ( exp_dynamic_arg ( a ) ) ;
542
	    EXP sb = DEREF_exp ( exp_dynamic_arg ( b ) ) ;
543
	    return ( eq_exp ( sa, sb, co ) ) ;
544
	}
545
	case exp_aggregate_tag : {
546
	    /* Aggregate initialisers */
547
	    LIST ( EXP ) pa = DEREF_list ( exp_aggregate_args ( a ) ) ;
548
	    LIST ( EXP ) pb = DEREF_list ( exp_aggregate_args ( b ) ) ;
549
	    return ( eq_exp_list ( pa, pb, co ) ) ;
550
	}
551
	case exp_initialiser_tag : {
552
	    /* Function style initialisers */
553
	    LIST ( EXP ) pa = DEREF_list ( exp_initialiser_args ( a ) ) ;
554
	    LIST ( EXP ) pb = DEREF_list ( exp_initialiser_args ( b ) ) ;
555
	    return ( eq_exp_list ( pa, pb, co ) ) ;
556
	}
557
	case exp_nof_tag : {
558
	    /* Array initialisers */
559
	    EXP ra = DEREF_exp ( exp_nof_start ( a ) ) ;
560
	    EXP rb = DEREF_exp ( exp_nof_start ( b ) ) ;
561
	    EXP sa = DEREF_exp ( exp_nof_pad ( a ) ) ;
562
	    EXP sb = DEREF_exp ( exp_nof_pad ( b ) ) ;
563
	    NAT na = DEREF_nat ( exp_nof_size ( a ) ) ;
564
	    NAT nb = DEREF_nat ( exp_nof_size ( b ) ) ;
565
	    EXP ua = DEREF_exp ( exp_nof_end ( a ) ) ;
566
	    EXP ub = DEREF_exp ( exp_nof_end ( b ) ) ;
567
	    if ( !EQ_nat ( na, nb ) ) {
568
		if ( !eq_nat ( na, nb ) ) return ( 0 ) ;
569
	    }
570
	    if ( !eq_exp ( sa, sb, co ) ) return ( 0 ) ;
571
	    return ( eq_exp ( ra, rb, co ) && eq_exp ( ua, ub, co ) ) ;
572
	}
573
	case exp_comma_tag : {
574
	    /* Comma expressions */
575
	    LIST ( EXP ) pa = DEREF_list ( exp_comma_args ( a ) ) ;
576
	    LIST ( EXP ) pb = DEREF_list ( exp_comma_args ( b ) ) ;
577
	    return ( eq_exp_list ( pa, pb, co ) ) ;
578
	}
579
	case exp_set_tag :
580
	case exp_unused_tag : {
581
	    /* Flow analysis expressions */
582
	    EXP sa = DEREF_exp ( exp_set_etc_arg ( a ) ) ;
583
	    EXP sb = DEREF_exp ( exp_set_etc_arg ( b ) ) ;
584
	    return ( eq_exp ( sa, sb, co ) ) ;
585
	}
586
	case exp_if_stmt_tag : {
587
	    /* Conditional expressions */
588
	    EXP ca = DEREF_exp ( exp_if_stmt_cond ( a ) ) ;
589
	    EXP cb = DEREF_exp ( exp_if_stmt_cond ( b ) ) ;
590
	    EXP ra = DEREF_exp ( exp_if_stmt_true_code ( a ) ) ;
591
	    EXP rb = DEREF_exp ( exp_if_stmt_true_code ( b ) ) ;
592
	    EXP sa = DEREF_exp ( exp_if_stmt_false_code ( a ) ) ;
593
	    EXP sb = DEREF_exp ( exp_if_stmt_false_code ( b ) ) ;
594
	    if ( !eq_exp ( ca, cb, co ) ) return ( 0 ) ;
595
	    return ( eq_exp ( ra, rb, co ) && eq_exp ( sa, sb, co ) ) ;
596
	}
597
	case exp_exception_tag : {
598
	    /* Throw expressions */
599
	    EXP sa = DEREF_exp ( exp_exception_arg ( a ) ) ;
600
	    EXP sb = DEREF_exp ( exp_exception_arg ( b ) ) ;
601
	    return ( eq_exp ( sa, sb, co ) ) ;
602
	}
603
	case exp_thrown_tag : {
604
	    /* Thrown expressions */
605
	    TYPE ta = DEREF_type ( exp_type ( a ) ) ;
606
	    TYPE tb = DEREF_type ( exp_type ( b ) ) ;
607
	    if ( eq_type ( ta, tb ) == 1 ) return ( 1 ) ;
608
	    return ( 0 ) ;
609
	}
610
	case exp_op_tag : {
611
	    /* Undetermined expressions */
612
	    int ca = DEREF_int ( exp_op_lex ( a ) ) ;
613
	    int cb = DEREF_int ( exp_op_lex ( b ) ) ;
614
	    EXP ra = DEREF_exp ( exp_op_arg1 ( a ) ) ;
615
	    EXP rb = DEREF_exp ( exp_op_arg1 ( b ) ) ;
616
	    EXP sa = DEREF_exp ( exp_op_arg2 ( a ) ) ;
617
	    EXP sb = DEREF_exp ( exp_op_arg2 ( b ) ) ;
618
	    if ( ca != cb ) return ( 0 ) ;
619
	    return ( eq_exp ( ra, rb, co ) && eq_exp ( sa, sb, co ) ) ;
620
	}
621
	case exp_opn_tag : {
622
	    /* Undetermined expressions */
623
	    int ca = DEREF_int ( exp_opn_lex ( a ) ) ;
624
	    int cb = DEREF_int ( exp_opn_lex ( b ) ) ;
625
	    LIST ( EXP ) pa = DEREF_list ( exp_opn_args ( a ) ) ;
626
	    LIST ( EXP ) pb = DEREF_list ( exp_opn_args ( b ) ) ;
627
	    if ( ca != cb ) return ( 0 ) ;
628
	    return ( eq_exp_list ( pa, pb, co ) ) ;
629
	}
630
	case exp_assembler_tag : {
631
	    /* Assembler expressions */
632
	    STRING ca = DEREF_str ( exp_assembler_op ( a ) ) ;
633
	    STRING cb = DEREF_str ( exp_assembler_op ( b ) ) ;
634
	    if ( EQ_str ( ca, cb ) || eq_string_lit ( ca, cb ) ) {
635
		LIST ( EXP ) pa = DEREF_list ( exp_assembler_args ( a ) ) ;
636
		LIST ( EXP ) pb = DEREF_list ( exp_assembler_args ( b ) ) ;
637
		return ( eq_exp_list ( pa, pb, co ) ) ;
638
	    }
639
	    break ;
640
	}
641
	case exp_location_tag : {
642
	    /* Location expressions */
643
	    EXP sa = DEREF_exp ( exp_location_arg ( a ) ) ;
644
	    EXP sb = DEREF_exp ( exp_location_arg ( b ) ) ;
645
	    return ( eq_exp ( sa, sb, co ) ) ;
646
	}
647
	case exp_token_tag : {
648
	    /* Token application */
649
	    IDENTIFIER ia = DEREF_id ( exp_token_tok ( a ) ) ;
650
	    IDENTIFIER ib = DEREF_id ( exp_token_tok ( b ) ) ;
651
	    LIST ( TOKEN ) pa = DEREF_list ( exp_token_args ( a ) ) ;
652
	    LIST ( TOKEN ) pb = DEREF_list ( exp_token_args ( b ) ) ;
653
	    return ( eq_token_args ( ia, ib, pa, pb ) ) ;
654
	}
655
	case exp_dummy_tag : {
656
	    /* Dummy expressions */
657
	    EXP sa = DEREF_exp ( exp_dummy_value ( a ) ) ;
658
	    EXP sb = DEREF_exp ( exp_dummy_value ( b ) ) ;
659
	    return ( eq_exp ( sa, sb, co ) ) ;
660
	}
661
	case exp_reach_tag :
662
	case exp_unreach_tag :
663
	case exp_sequence_tag :
664
	case exp_solve_stmt_tag :
665
	case exp_decl_stmt_tag :
666
	case exp_while_stmt_tag :
667
	case exp_do_stmt_tag :
668
	case exp_switch_stmt_tag :
669
	case exp_hash_if_tag :
670
	case exp_return_stmt_tag :
671
	case exp_goto_stmt_tag :
672
	case exp_label_stmt_tag :
673
	case exp_try_block_tag :
674
	case exp_handler_tag :
675
	case exp_uncompiled_tag :
676
	case exp_fail_tag : {
677
	    /* Statements are never equal */
678
	    return ( 0 ) ;
679
	}
680
    }
681
    return ( 0 ) ;
682
}
683
 
684
 
685
/*
686
    UNIFY TWO EXPRESSIONS
687
 
688
    This routine unifies the expressions a and b by defining tokens as
689
    necessary.  It returns true if a value is assigned to a token.  Note
690
    that it is necessary to consider integer constant tokens as well as
691
    expression tokens.
692
*/
693
 
694
static int unify_exp
695
    PROTO_N ( ( a, b ) )
696
    PROTO_T ( EXP a X EXP b )
697
{
698
    IDENTIFIER id ;
699
    LIST ( TOKEN ) args ;
700
    switch ( TAG_exp ( a ) ) {
701
	case exp_token_tag : {
702
	    id = DEREF_id ( exp_token_tok ( a ) ) ;
703
	    args = DEREF_list ( exp_token_args ( a ) ) ;
704
	    break ;
705
	}
706
	case exp_int_lit_tag : {
707
	    NAT n = DEREF_nat ( exp_int_lit_nat ( a ) ) ;
708
	    if ( !IS_nat_token ( n ) ) return ( 0 ) ;
709
	    id = DEREF_id ( nat_token_tok ( n ) ) ;
710
	    args = DEREF_list ( nat_token_args ( n ) ) ;
711
	    break ;
712
	}
713
	default : {
714
	    return ( 0 ) ;
715
	}
716
    }
717
    if ( IS_NULL_list ( args ) && defining_token ( id ) ) {
718
	return ( define_exp_token ( id, b, 1 ) ) ;
719
    }
720
    return ( 0 ) ;
721
}
722
 
723
 
724
/*
725
    ARE TWO EXPRESSIONS EQUAL?
726
 
727
    This routine checks whether the expressions a and b are equal.  If
728
    co is true then commutivity and other such relations are taken
729
    into account.
730
*/
731
 
732
int eq_exp
733
    PROTO_N ( ( a, b, co ) )
734
    PROTO_T ( EXP a X EXP b X int co )
735
{
736
    /* Check for obvious equality */
737
    unsigned ta, tb ;
738
    if ( EQ_exp ( a, b ) ) return ( 1 ) ;
739
    if ( IS_NULL_exp ( a ) ) return ( 0 ) ;
740
    if ( IS_NULL_exp ( b ) ) return ( 0 ) ;
741
 
742
    /* Allow for parentheses */
743
    ta = TAG_exp ( a ) ;
744
    while ( ta == exp_paren_tag || ta == exp_copy_tag ) {
745
	a = DEREF_exp ( exp_paren_etc_arg ( a ) ) ;
746
	ta = TAG_exp ( a ) ;
747
    }
748
    tb = TAG_exp ( b ) ;
749
    while ( tb == exp_paren_tag || tb == exp_copy_tag ) {
750
	b = DEREF_exp ( exp_paren_etc_arg ( b ) ) ;
751
	tb = TAG_exp ( b ) ;
752
    }
753
 
754
    /* Check equality of expressions */
755
    if ( ta == tb && eq_exp_aux ( a, b, co ) ) return ( 1 ) ;
756
    if ( force_tokdef || force_template || expand_tokdef ) {
757
	TYPE sa = DEREF_type ( exp_type ( a ) ) ;
758
	TYPE sb = DEREF_type ( exp_type ( b ) ) ;
759
	if ( eq_type ( sa, sb ) == 1 ) {
760
	    if ( unify_exp ( a, b ) ) return ( 1 ) ;
761
	    if ( unify_exp ( b, a ) ) return ( 1 ) ;
762
	}
763
    }
764
    return ( 0 ) ;
765
}
766
 
767
 
768
/*
769
    ARE TWO EXPRESSIONS PRECISELY EQUAL?
770
 
771
    This routine is similar to eq_exp, but it disallows token and template
772
    unification and does not allow for commutivity relations.
773
*/
774
 
775
int eq_exp_exact
776
    PROTO_N ( ( a, b ) )
777
    PROTO_T ( EXP a X EXP b )
778
{
779
    int eq ;
780
    int tok = force_tokdef ;
781
    int templ = force_template ;
782
    force_tokdef = 0 ;
783
    force_template = 0 ;
784
    eq = eq_exp ( a, b, 0 ) ;
785
    force_template = templ ;
786
    force_tokdef = tok ;
787
    return ( eq ) ;
788
}
789
 
790
 
791
/*
792
    ARE TWO TOKENS EQUAL?
793
 
794
    This routine checks whether the tokens a and b are equal.
795
*/
796
 
797
int eq_token
798
    PROTO_N ( ( a, b ) )
799
    PROTO_T ( TOKEN a X TOKEN b )
800
{
801
    unsigned na, nb ;
802
    if ( EQ_tok ( a, b ) ) return ( 1 ) ;
803
    if ( IS_NULL_tok ( a ) ) return ( 0 ) ;
804
    if ( IS_NULL_tok ( b ) ) return ( 0 ) ;
805
    na = TAG_tok ( a ) ;
806
    nb = TAG_tok ( b ) ;
807
    if ( na != nb ) return ( 0 ) ;
808
    switch ( na ) {
809
	case tok_exp_tag : {
810
	    EXP va = DEREF_exp ( tok_exp_value ( a ) ) ;
811
	    EXP vb = DEREF_exp ( tok_exp_value ( b ) ) ;
812
	    return ( eq_exp ( va, vb, 0 ) ) ;
813
	}
814
	case tok_stmt_tag : {
815
	    EXP va = DEREF_exp ( tok_stmt_value ( a ) ) ;
816
	    EXP vb = DEREF_exp ( tok_stmt_value ( b ) ) ;
817
	    return ( eq_exp ( va, vb, 0 ) ) ;
818
	}
819
	case tok_nat_tag :
820
	case tok_snat_tag : {
821
	    NAT va = DEREF_nat ( tok_nat_etc_value ( a ) ) ;
822
	    NAT vb = DEREF_nat ( tok_nat_etc_value ( b ) ) ;
823
	    if ( compare_nat ( va, vb ) == 0 ) return ( 1 ) ;
824
	    break ;
825
	}
826
	case tok_type_tag : {
827
	    TYPE va = DEREF_type ( tok_type_value ( a ) ) ;
828
	    TYPE vb = DEREF_type ( tok_type_value ( b ) ) ;
829
	    if ( eq_type ( va, vb ) == 1 ) return ( 1 ) ;
830
	    return ( 0 ) ;
831
	}
832
	case tok_member_tag : {
833
	    OFFSET va = DEREF_off ( tok_member_value ( a ) ) ;
834
	    OFFSET vb = DEREF_off ( tok_member_value ( b ) ) ;
835
	    return ( eq_offset ( va, vb, 0 ) ) ;
836
	}
837
	case tok_class_tag : {
838
	    IDENTIFIER ia = DEREF_id ( tok_class_value ( a ) ) ;
839
	    IDENTIFIER ib = DEREF_id ( tok_class_value ( b ) ) ;
840
	    return ( EQ_id ( ia, ib ) ) ;
841
	}
842
    }
843
    return ( 0 ) ;
844
}
845
 
846
 
847
/*
848
    ARE TWO TOKEN APPLICATIONS EQUAL?
849
 
850
    This routine checks whether the token applications ia ( pa ) and
851
    ib ( pb ) are equal.
852
*/
853
 
854
int eq_token_args
855
    PROTO_N ( ( ia, ib, pa, pb ) )
856
    PROTO_T ( IDENTIFIER ia X IDENTIFIER ib X
857
	      LIST ( TOKEN ) pa X LIST ( TOKEN ) pb )
858
{
859
    if ( !EQ_id ( ia, ib ) ) {
860
	/* Check that tokens are the same */
861
	ia = DEREF_id ( id_alias ( ia ) ) ;
862
	ib = DEREF_id ( id_alias ( ib ) ) ;
863
	if ( !EQ_id ( ia, ib ) ) {
864
	    if ( !force_merge || !merge_type ( ia, ib ) ) {
865
		return ( 0 ) ;
866
	    }
867
	}
868
    }
869
    if ( EQ_list ( pa, pb ) ) return ( 1 ) ;
870
    if ( LENGTH_list ( pa ) != LENGTH_list ( pb ) ) return ( 0 ) ;
871
    while ( !IS_NULL_list ( pa ) ) {
872
	TOKEN a, b ;
873
	if ( EQ_list ( pa, pb ) ) return ( 1 ) ;
874
	a = DEREF_tok ( HEAD_list ( pa ) ) ;
875
	b = DEREF_tok ( HEAD_list ( pb ) ) ;
876
	if ( !eq_token ( a, b ) ) return ( 0 ) ;
877
	pb = TAIL_list ( pb ) ;
878
	pa = TAIL_list ( pa ) ;
879
    }
880
    return ( 1 ) ;
881
}
882
 
883
 
884
/*
885
    IS A TOKEN APPLICATION A CONSTANT?
886
 
887
    This routine checks whether the token id applied to the arguments args
888
    is a constant.
889
*/
890
 
891
static int is_const_token
892
    PROTO_N ( ( id, args, c ) )
893
    PROTO_T ( IDENTIFIER id X LIST ( TOKEN ) args X int c )
894
{
895
    TOKEN tok = DEREF_tok ( id_token_sort ( id ) ) ;
896
    if ( IS_tok_proc ( tok ) ) {
897
	/* Allow for procedure tokens */
898
	tok = DEREF_tok ( tok_proc_res ( tok ) ) ;
899
    }
900
    switch ( TAG_tok ( tok ) ) {
901
	case tok_exp_tag : {
902
	    /* Check for constant expression tokens */
903
	    int cn = DEREF_int ( tok_exp_constant ( tok ) ) ;
904
	    if ( cn ) {
905
		/* Constant token */
906
		return ( 1 ) ;
907
	    }
908
	    if ( c >= 0 ) {
909
		/* Constant expression expected */
910
		report ( crt_loc, ERR_token_const ( id ) ) ;
911
	    }
912
	    if ( option ( OPT_token_const ) == OPTION_DISALLOW ) {
913
		/* Non-constant tokens not allowed */
914
		return ( 0 ) ;
915
	    }
916
	    break ;
917
	}
918
	case tok_nat_tag : {
919
	    /* Integer constants */
920
	    return ( 1 ) ;
921
	}
922
	case tok_stmt_tag : {
923
	    /* Statements are not constant */
924
	    return ( 0 ) ;
925
	}
926
    }
927
 
928
    /* Check all token arguments */
929
    while ( !IS_NULL_list ( args ) ) {
930
	TOKEN a = DEREF_tok ( HEAD_list ( args ) ) ;
931
	if ( !IS_NULL_tok ( a ) ) {
932
	    switch ( TAG_tok ( a ) ) {
933
		case tok_exp_tag : {
934
		    EXP e = DEREF_exp ( tok_exp_value ( a ) ) ;
935
		    if ( !is_const_exp ( e, c ) ) return ( 0 ) ;
936
		    break ;
937
		}
938
		case tok_stmt_tag : {
939
		    EXP e = DEREF_exp ( tok_stmt_value ( a ) ) ;
940
		    if ( !is_const_exp ( e, c ) ) return ( 0 ) ;
941
		    break ;
942
		}
943
		case tok_member_tag : {
944
		    OFFSET off = DEREF_off ( tok_member_value ( a ) ) ;
945
		    if ( !is_const_offset ( off, c, 1 ) ) return ( 0 ) ;
946
		    break ;
947
		}
948
	    }
949
	}
950
	args = TAIL_list ( args ) ;
951
    }
952
    return ( 1 ) ;
953
}
954
 
955
 
956
/*
957
    IS AN OFFSET A CONSTANT?
958
 
959
    This routine checks whether the offset off is a constant offset.  virt
960
    is true if virtual base classes are to be taken into account.
961
*/
962
 
963
int is_const_offset
964
    PROTO_N ( ( off, c, virt ) )
965
    PROTO_T ( OFFSET off X int c X int virt )
966
{
967
    ASSERT ( ORDER_off == 13 ) ;
968
    switch ( TAG_off ( off ) ) {
969
	case off_zero_tag :
970
	case off_type_tag :
971
	case off_extra_tag :
972
	case off_array_tag :
973
	case off_member_tag : {
974
	    /* Constant offsets */
975
	    return ( 1 ) ;
976
	}
977
	case off_base_tag : {
978
	    /* Base class offsets */
979
	    if ( virt ) {
980
		GRAPH gr = DEREF_graph ( off_base_graph ( off ) ) ;
981
		DECL_SPEC acc = DEREF_dspec ( graph_access ( gr ) ) ;
982
		if ( !( acc & dspec_mutable ) ) return ( 1 ) ;
983
	    } else {
984
		return ( 1 ) ;
985
	    }
986
	    break ;
987
	}
988
	case off_deriv_tag : {
989
	    /* Derived class offsets */
990
	    if ( virt ) {
991
		GRAPH gr = DEREF_graph ( off_deriv_graph ( off ) ) ;
992
		DECL_SPEC acc = DEREF_dspec ( graph_access ( gr ) ) ;
993
		if ( !( acc & dspec_mutable ) ) return ( 1 ) ;
994
	    } else {
995
		return ( 1 ) ;
996
	    }
997
	    break ;
998
	}
999
	case off_ptr_mem_tag : {
1000
	    /* Pointer member offsets */
1001
	    EXP a = DEREF_exp ( off_ptr_mem_arg ( off ) ) ;
1002
	    return ( is_const_exp ( a, c ) ) ;
1003
	}
1004
	case off_negate_tag : {
1005
	    /* Offset negation */
1006
	    OFFSET off1 = DEREF_off ( off_negate_arg ( off ) ) ;
1007
	    return ( is_const_offset ( off1, c, 1 ) ) ;
1008
	}
1009
	case off_plus_tag : {
1010
	    /* Offset addition */
1011
	    OFFSET off1 = DEREF_off ( off_plus_arg1 ( off ) ) ;
1012
	    OFFSET off2 = DEREF_off ( off_plus_arg2 ( off ) ) ;
1013
	    if ( !is_const_offset ( off1, c, 1 ) ) return ( 0 ) ;
1014
	    return ( is_const_offset ( off2, c, 1 ) ) ;
1015
	}
1016
	case off_mult_tag : {
1017
	    /* Offset multiplication */
1018
	    OFFSET off1 = DEREF_off ( off_mult_arg1 ( off ) ) ;
1019
	    EXP a = DEREF_exp ( off_mult_arg2 ( off ) ) ;
1020
	    if ( !is_const_offset ( off1, c, 1 ) ) return ( 0 ) ;
1021
	    return ( is_const_exp ( a, c ) ) ;
1022
	}
1023
	case off_ptr_diff_tag : {
1024
	    /* Pointer difference */
1025
	    EXP a = DEREF_exp ( off_ptr_diff_ptr1 ( off ) ) ;
1026
	    EXP b = DEREF_exp ( off_ptr_diff_ptr2 ( off ) ) ;
1027
	    if ( is_const_exp ( a, c ) && is_const_exp ( b, c ) ) {
1028
		/* Only allow pointers from same array */
1029
		EXP pa = NULL_exp ;
1030
		EXP pb = NULL_exp ;
1031
		IGNORE find_exp_linkage ( a, &pa, 1 ) ;
1032
		IGNORE find_exp_linkage ( b, &pb, 1 ) ;
1033
		if ( !IS_NULL_exp ( pa ) && !IS_exp_string_lit ( pa ) ) {
1034
		    return ( eq_exp ( pa, pb, 0 ) ) ;
1035
		}
1036
	    }
1037
	    break ;
1038
	}
1039
	case off_token_tag : {
1040
	    /* All member tokens are constant */
1041
	    IDENTIFIER id = DEREF_id ( off_token_tok ( off ) ) ;
1042
	    LIST ( TOKEN ) args = DEREF_list ( off_token_args ( off ) ) ;
1043
	    return ( is_const_token ( id, args, c ) ) ;
1044
	}
1045
    }
1046
    return ( 0 ) ;
1047
}
1048
 
1049
 
1050
/*
1051
    IS AN EXPRESSION AN ADDRESS CONSTANT?
1052
 
1053
    This routine checks whether the address of e is a constant expression.
1054
    c will be nonzero.
1055
*/
1056
 
1057
static int is_const_addr
1058
    PROTO_N ( ( e, c ) )
1059
    PROTO_T ( EXP e X int c )
1060
{
1061
    if ( IS_NULL_exp ( e ) ) return ( 1 ) ;
1062
    switch ( TAG_exp ( e ) ) {
1063
	case exp_identifier_tag : {
1064
	    /* Identifier expressions */
1065
	    IDENTIFIER id = DEREF_id ( exp_identifier_id ( e ) ) ;
1066
	    DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
1067
	    if ( !( ds & dspec_auto ) ) {
1068
		TYPE t = DEREF_type ( exp_type ( e ) ) ;
1069
		if ( !IS_type_ref ( t ) ) return ( 1 ) ;
1070
	    }
1071
	    break ;
1072
	}
1073
	case exp_indir_tag : {
1074
	    /* Indirection expressions */
1075
	    EXP a = DEREF_exp ( exp_indir_ptr ( e ) ) ;
1076
	    return ( is_const_exp ( a, c ) ) ;
1077
	}
1078
	case exp_member_tag :
1079
	case exp_string_lit_tag :
1080
	case exp_rtti_type_tag : {
1081
	    /* lvalue expressions */
1082
	    return ( 1 ) ;
1083
	}
1084
	case exp_token_tag : {
1085
	    /* Tokenised expressions */
1086
	    return ( is_const_exp ( e, c ) ) ;
1087
	}
1088
	case exp_comma_tag : {
1089
	    /* Comma expressions (not allowed) */
1090
	    if ( c < 0 ) {
1091
		LIST ( EXP ) p = DEREF_list ( exp_comma_args ( e ) ) ;
1092
		while ( !IS_NULL_list ( p ) ) {
1093
		    EXP a = DEREF_exp ( HEAD_list ( p ) ) ;
1094
		    p = TAIL_list ( p ) ;
1095
		    if ( IS_NULL_list ( p ) ) {
1096
			return ( is_const_addr ( a, c ) ) ;
1097
		    }
1098
		    if ( !is_const_exp ( a, c ) ) break ;
1099
		}
1100
	    }
1101
	    break ;
1102
	}
1103
	case exp_if_stmt_tag : {
1104
	    /* Conditional expressions */
1105
	    EXP d = DEREF_exp ( exp_if_stmt_cond ( e ) ) ;
1106
	    EXP a = DEREF_exp ( exp_if_stmt_true_code ( e ) ) ;
1107
	    EXP b = DEREF_exp ( exp_if_stmt_false_code ( e ) ) ;
1108
	    if ( !is_const_exp ( d, c ) ) break ;
1109
	    if ( !is_const_addr ( a, c ) ) break ;
1110
	    return ( is_const_addr ( b, c ) ) ;
1111
	}
1112
    }
1113
    return ( 0 ) ;
1114
}
1115
 
1116
 
1117
/*
1118
    IS AN EXPRESSION CONSTANT?
1119
 
1120
    This routine checks whether e is a constant expression.  Note that
1121
    most integer constant expressions are dealt with in a bottom-up
1122
    fashion by means of the constant evaluation routines.  Other
1123
    constants are dealt with in a top-down fashion by this routine.  If
1124
    c is 0 then only valid integer constant expressions are allowed; c
1125
    is -1 then only a check is intended.
1126
*/
1127
 
1128
int is_const_exp
1129
    PROTO_N ( ( e, c ) )
1130
    PROTO_T ( EXP e X int c )
1131
{
1132
    TYPE t ;
1133
    if ( IS_NULL_exp ( e ) ) return ( 1 ) ;
1134
    ASSERT ( ORDER_exp == 88 ) ;
1135
    switch ( TAG_exp ( e ) ) {
1136
	case exp_int_lit_tag :
1137
	case exp_char_lit_tag : {
1138
	    /* Integer literals */
1139
	    return ( 1 ) ;
1140
	}
1141
	case exp_identifier_tag : {
1142
	    /* Identifiers */
1143
	    if ( c ) {
1144
		IDENTIFIER id = DEREF_id ( exp_identifier_id ( e ) ) ;
1145
		DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
1146
		if ( !( ds & dspec_auto ) ) {
1147
		    t = DEREF_type ( exp_type ( e ) ) ;
1148
		    if ( !IS_type_ref ( t ) ) return ( 1 ) ;
1149
		}
1150
	    }
1151
	    break ;
1152
	}
1153
	case exp_string_lit_tag :
1154
	case exp_float_lit_tag :
1155
	case exp_null_tag :
1156
	case exp_zero_tag :
1157
	case exp_value_tag :
1158
	case exp_rtti_type_tag :
1159
	case exp_rtti_no_tag :
1160
	case exp_set_tag :
1161
	case exp_unused_tag : {
1162
	    /* Floating literals, null pointers etc. */
1163
	    if ( c ) return ( 1 ) ;
1164
	    break ;
1165
	}
1166
	case exp_paren_tag :
1167
	case exp_copy_tag : {
1168
	    /* Parenthesised expressions */
1169
	    EXP a = DEREF_exp ( exp_paren_etc_arg ( e ) ) ;
1170
	    return ( is_const_exp ( a, c ) ) ;
1171
	}
1172
	case exp_indir_tag : {
1173
	    /* Indirection expressions */
1174
	    if ( c ) {
1175
		EXP a = DEREF_exp ( exp_indir_ptr ( e ) ) ;
1176
		return ( is_const_exp ( a, c ) ) ;
1177
	    }
1178
	    break ;
1179
	}
1180
	case exp_address_tag : {
1181
	    /* Address expressions */
1182
	    if ( c ) {
1183
		EXP a = DEREF_exp ( exp_address_arg ( e ) ) ;
1184
		return ( is_const_addr ( a, c ) ) ;
1185
	    }
1186
	    break ;
1187
	}
1188
	case exp_address_mem_tag : {
1189
	    /* Address expressions */
1190
	    if ( c ) {
1191
		EXP a = DEREF_exp ( exp_address_mem_arg ( e ) ) ;
1192
		if ( IS_exp_member ( a ) ) return ( 1 ) ;
1193
	    }
1194
	    break ;
1195
	}
1196
	case exp_negate_tag :
1197
	case exp_compl_tag :
1198
	case exp_not_tag :
1199
	case exp_abs_tag : {
1200
	    /* Unary expressions */
1201
	    EXP a = DEREF_exp ( exp_negate_etc_arg ( e ) ) ;
1202
	    return ( is_const_exp ( a, c ) ) ;
1203
	}
1204
	case exp_plus_tag :
1205
	case exp_minus_tag :
1206
	case exp_mult_tag :
1207
	case exp_and_tag :
1208
	case exp_or_tag :
1209
	case exp_xor_tag :
1210
	case exp_log_and_tag :
1211
	case exp_log_or_tag :
1212
	case exp_lshift_tag :
1213
	case exp_rshift_tag :
1214
	case exp_max_tag :
1215
	case exp_min_tag : {
1216
	    /* Binary expressions */
1217
	    EXP a = DEREF_exp ( exp_plus_etc_arg1 ( e ) ) ;
1218
	    EXP b = DEREF_exp ( exp_plus_etc_arg2 ( e ) ) ;
1219
	    return ( is_const_exp ( a, c ) && is_const_exp ( b, c ) ) ;
1220
	}
1221
	case exp_div_tag :
1222
	case exp_rem_tag : {
1223
	    /* Division expressions */
1224
	    EXP a = DEREF_exp ( exp_plus_etc_arg1 ( e ) ) ;
1225
	    EXP b = DEREF_exp ( exp_plus_etc_arg2 ( e ) ) ;
1226
	    if ( c == 0 && is_zero_exp ( b ) ) {
1227
		/* Division by zero doesn't count */
1228
		break ;
1229
	    }
1230
	    return ( is_const_exp ( a, c ) && is_const_exp ( b, c ) ) ;
1231
	}
1232
	case exp_test_tag : {
1233
	    /* Test expressions */
1234
	    EXP a = DEREF_exp ( exp_test_arg ( e ) ) ;
1235
	    return ( is_const_exp ( a, c ) ) ;
1236
	}
1237
	case exp_compare_tag : {
1238
	    /* Comparison expressions */
1239
	    EXP a = DEREF_exp ( exp_compare_arg1 ( e ) ) ;
1240
	    EXP b = DEREF_exp ( exp_compare_arg2 ( e ) ) ;
1241
	    return ( is_const_exp ( a, c ) && is_const_exp ( b, c ) ) ;
1242
	}
1243
	case exp_cast_tag : {
1244
	    /* Cast expressions */
1245
	    EXP a = DEREF_exp ( exp_cast_arg ( e ) ) ;
1246
	    if ( !c ) {
1247
		unsigned tc ;
1248
		t = DEREF_type ( exp_type ( a ) ) ;
1249
		tc = type_category ( &t ) ;
1250
		if ( !IS_TYPE_INT ( tc ) ) break ;
1251
	    }
1252
	    return ( is_const_exp ( a, c ) ) ;
1253
	}
1254
	case exp_base_cast_tag : {
1255
	    /* Base cast expressions */
1256
	    if ( c ) {
1257
		EXP a = DEREF_exp ( exp_base_cast_arg ( e ) ) ;
1258
		OFFSET off = DEREF_off ( exp_base_cast_off ( e ) ) ;
1259
		unsigned conv = DEREF_unsigned ( exp_base_cast_conv ( e ) ) ;
1260
		if ( conv & CONV_PTR_MEM_BASE ) {
1261
		    /* Pointer to member conversions */
1262
		    if ( conv & CONV_REVERSE ) return ( 0 ) ;
1263
		} else {
1264
		    /* Pointer conversions */
1265
		    if ( !is_zero_offset ( off ) ) return ( 0 ) ;
1266
		}
1267
		return ( is_const_exp ( a, c ) ) ;
1268
	    }
1269
	    break ;
1270
	}
1271
	case exp_add_ptr_tag : {
1272
	    /* Pointer addition */
1273
	    if ( c ) {
1274
		t = DEREF_type ( exp_type ( e ) ) ;
1275
		if ( !IS_type_ref ( t ) ) {
1276
		    EXP a = DEREF_exp ( exp_add_ptr_ptr ( e ) ) ;
1277
		    OFFSET b = DEREF_off ( exp_add_ptr_off ( e ) ) ;
1278
		    int v = DEREF_int ( exp_add_ptr_virt ( e ) ) ;
1279
		    if ( !is_const_exp ( a, c ) ) return ( 0 ) ;
1280
		    return ( is_const_offset ( b, c, v ) ) ;
1281
		}
1282
	    }
1283
	    break ;
1284
	}
1285
	case exp_offset_size_tag : {
1286
	    /* Offset size */
1287
	    OFFSET a = DEREF_off ( exp_offset_size_off ( e ) ) ;
1288
	    if ( IS_off_type ( a ) ) {
1289
		/* Allow for sizeof expressions */
1290
		TYPE s = DEREF_type ( exp_offset_size_step ( e ) ) ;
1291
		if ( EQ_type ( s, type_char ) ) return ( 1 ) ;
1292
	    }
1293
	    if ( c ) return ( is_const_offset ( a, c, c ) ) ;
1294
	    break ;
1295
	}
1296
	case exp_aggregate_tag : {
1297
	    /* Aggregate initialisers */
1298
	    if ( c ) {
1299
		LIST ( EXP ) p = DEREF_list ( exp_aggregate_args ( e ) ) ;
1300
		while ( !IS_NULL_list ( p ) ) {
1301
		    EXP a = DEREF_exp ( HEAD_list ( p ) ) ;
1302
		    if ( !is_const_exp ( a, c ) ) return ( 0 ) ;
1303
		    p = TAIL_list ( p ) ;
1304
		}
1305
		return ( 1 ) ;
1306
	    }
1307
	    break ;
1308
	}
1309
	case exp_nof_tag : {
1310
	    /* Array initialisers */
1311
	    if ( c ) {
1312
		EXP a = DEREF_exp ( exp_nof_start ( e ) ) ;
1313
		EXP b = DEREF_exp ( exp_nof_pad ( e ) ) ;
1314
		EXP d = DEREF_exp ( exp_nof_end ( e ) ) ;
1315
		if ( !is_const_exp ( a, c ) ) return ( 0 ) ;
1316
		if ( !is_const_exp ( b, c ) ) return ( 0 ) ;
1317
		return ( is_const_exp ( d, c ) ) ;
1318
	    }
1319
	    break ;
1320
	}
1321
	case exp_comma_tag : {
1322
	    /* Comma expressions (not allowed) */
1323
	    if ( c < 0 ) {
1324
		LIST ( EXP ) p = DEREF_list ( exp_comma_args ( e ) ) ;
1325
		while ( !IS_NULL_list ( p ) ) {
1326
		    EXP a = DEREF_exp ( HEAD_list ( p ) ) ;
1327
		    if ( !is_const_exp ( a, c ) ) return ( 0 ) ;
1328
		    p = TAIL_list ( p ) ;
1329
		}
1330
		return ( 1 ) ;
1331
	    }
1332
	    break ;
1333
	}
1334
	case exp_if_stmt_tag : {
1335
	    /* Conditional expressions */
1336
	    if ( c ) {
1337
		EXP d = DEREF_exp ( exp_if_stmt_cond ( e ) ) ;
1338
		EXP a = DEREF_exp ( exp_if_stmt_true_code ( e ) ) ;
1339
		EXP b = DEREF_exp ( exp_if_stmt_false_code ( e ) ) ;
1340
		if ( !is_const_exp ( d, c ) ) break ;
1341
		if ( !is_const_exp ( a, c ) ) break ;
1342
		return ( is_const_exp ( b, c ) ) ;
1343
	    }
1344
	    break ;
1345
	}
1346
	case exp_op_tag : {
1347
	    /* Undetermined expressions */
1348
	    EXP a = DEREF_exp ( exp_op_arg1 ( e ) ) ;
1349
	    EXP b = DEREF_exp ( exp_op_arg2 ( e ) ) ;
1350
	    return ( is_const_exp ( a, c ) && is_const_exp ( b, c ) ) ;
1351
	}
1352
	case exp_opn_tag : {
1353
	    /* Undetermined nary expressions */
1354
	    LIST ( EXP ) p = DEREF_list ( exp_opn_args ( e ) ) ;
1355
	    while ( !IS_NULL_list ( p ) ) {
1356
		EXP a = DEREF_exp ( HEAD_list ( p ) ) ;
1357
		if ( !is_const_exp ( a, c ) ) return ( 0 ) ;
1358
		p = TAIL_list ( p ) ;
1359
	    }
1360
	    return ( 1 ) ;
1361
	}
1362
	case exp_token_tag : {
1363
	    /* Tokenised expressions (C compatibility) */
1364
	    IDENTIFIER id = DEREF_id ( exp_token_tok ( e ) ) ;
1365
	    LIST ( TOKEN ) args = DEREF_list ( exp_token_args ( e ) ) ;
1366
	    if ( !c ) {
1367
		unsigned tc ;
1368
		t = DEREF_type ( exp_type ( e ) ) ;
1369
		tc = type_category ( &t ) ;
1370
		if ( !IS_TYPE_INT ( tc ) ) break ;
1371
	    }
1372
	    return ( is_const_token ( id, args, c ) ) ;
1373
	}
1374
	case exp_location_tag : {
1375
	    /* Location expressions */
1376
	    EXP a = DEREF_exp ( exp_location_arg ( e ) ) ;
1377
	    return ( is_const_exp ( a, c ) ) ;
1378
	}
1379
	case exp_dummy_tag : {
1380
	    /* Dummy expressions */
1381
	    EXP a = DEREF_exp ( exp_dummy_value ( e ) ) ;
1382
	    return ( is_const_exp ( a, c ) ) ;
1383
	}
1384
    }
1385
 
1386
    /* Allow for errors */
1387
    t = DEREF_type ( exp_type ( e ) ) ;
1388
    if ( IS_type_error ( t ) ) return ( 1 ) ;
1389
    return ( 0 ) ;
1390
}
1391
 
1392
 
1393
/*
1394
    DOES AN EXPRESSION CONTAIN AN OVERFLOW?
1395
 
1396
    Certain evaluations on integer constant expressions are only valid
1397
    if it can be shown that the operands cannot raise an exception.
1398
    For example, 'a - a' can only safely be replaced by zero if the
1399
    evaluation of a does not overflow.  This routine returns true if
1400
    the evaluation of the expression a may raise an overflow exception
1401
    or contains some other side effect.
1402
*/
1403
 
1404
int overflow_exp
1405
    PROTO_N ( ( a ) )
1406
    PROTO_T ( EXP a )
1407
{
1408
    if ( IS_NULL_exp ( a ) ) return ( 0 ) ;
1409
    switch ( TAG_exp ( a ) ) {
1410
	case exp_int_lit_tag : {
1411
	    /* Check integer constant expressions */
1412
	    NAT n = DEREF_nat ( exp_int_lit_nat ( a ) ) ;
1413
	    unsigned etag = DEREF_unsigned ( exp_int_lit_etag ( a ) ) ;
1414
	    switch ( etag ) {
1415
		case exp_char_lit_tag :
1416
		case exp_offset_size_tag : {
1417
		    /* These never overflow */
1418
		    return ( 0 ) ;
1419
		}
1420
	    }
1421
	    return ( is_calc_nat ( n ) ) ;
1422
	}
1423
	case exp_identifier_tag :
1424
	case exp_member_tag :
1425
	case exp_char_lit_tag :
1426
	case exp_value_tag :
1427
	case exp_null_tag :
1428
	case exp_zero_tag : {
1429
	    return ( 0 ) ;
1430
	}
1431
	case exp_string_lit_tag : {
1432
	    /* String literals deliberately excluded */
1433
	    return ( 1 ) ;
1434
	}
1435
	case exp_paren_tag :
1436
	case exp_copy_tag : {
1437
	    EXP b = DEREF_exp ( exp_paren_etc_arg ( a ) ) ;
1438
	    return ( overflow_exp ( b ) ) ;
1439
	}
1440
	case exp_address_tag : {
1441
	    EXP b = DEREF_exp ( exp_address_arg ( a ) ) ;
1442
	    return ( overflow_exp ( b ) ) ;
1443
	}
1444
	case exp_address_mem_tag : {
1445
	    EXP b = DEREF_exp ( exp_address_mem_arg ( a ) ) ;
1446
	    return ( overflow_exp ( b ) ) ;
1447
	}
1448
	case exp_cast_tag : {
1449
	    /* Cast expressions */
1450
	    unsigned c = DEREF_unsigned ( exp_cast_conv ( a ) ) ;
1451
	    if ( c == CONV_ELLIPSIS ) {
1452
		EXP b = DEREF_exp ( exp_cast_arg ( a ) ) ;
1453
		return ( overflow_exp ( b ) ) ;
1454
	    }
1455
	    break ;
1456
	}
1457
	case exp_comma_tag : {
1458
	    LIST ( EXP ) p = DEREF_list ( exp_comma_args ( a ) ) ;
1459
	    while ( !IS_NULL_list ( p ) ) {
1460
		EXP b = DEREF_exp ( HEAD_list ( p ) ) ;
1461
		if ( overflow_exp ( b ) ) return ( 1 ) ;
1462
		p = TAIL_list ( p ) ;
1463
	    }
1464
	    return ( 0 ) ;
1465
	}
1466
	case exp_aggregate_tag : {
1467
	    LIST ( EXP ) p = DEREF_list ( exp_aggregate_args ( a ) ) ;
1468
	    while ( !IS_NULL_list ( p ) ) {
1469
		EXP b = DEREF_exp ( HEAD_list ( p ) ) ;
1470
		if ( overflow_exp ( b ) ) return ( 1 ) ;
1471
		p = TAIL_list ( p ) ;
1472
	    }
1473
	    return ( 0 ) ;
1474
	}
1475
	case exp_nof_tag : {
1476
	    EXP b = DEREF_exp ( exp_nof_start ( a ) ) ;
1477
	    EXP c = DEREF_exp ( exp_nof_pad ( a ) ) ;
1478
	    EXP d = DEREF_exp ( exp_nof_end ( a ) ) ;
1479
	    NAT n = DEREF_nat ( exp_nof_size ( a ) ) ;
1480
	    if ( overflow_exp ( b ) ) return ( 1 ) ;
1481
	    if ( overflow_exp ( c ) ) return ( 1 ) ;
1482
	    if ( overflow_exp ( d ) ) return ( 1 ) ;
1483
	    return ( is_calc_nat ( n ) ) ;
1484
	}
1485
    }
1486
    return ( 1 ) ;
1487
}
1488
 
1489
 
1490
/*
1491
    FIND THE LINKAGE OF AN EXPRESSION
1492
 
1493
    This routine checks the linkage of the expression a.  If vol is true
1494
    then the result is or-ed with dspec_implicit if a is derived from
1495
    an implicitly volatile external identifier and or-ed with dspec_pure
1496
    if a is derived from an implicitly const string literal.  The
1497
    component of a which determines the linkage is returned via pa.
1498
*/
1499
 
1500
DECL_SPEC find_exp_linkage
1501
    PROTO_N ( ( e, pa, vol ) )
1502
    PROTO_T ( EXP e X EXP *pa X int vol )
1503
{
1504
    if ( !IS_NULL_exp ( e ) ) {
1505
	ASSERT ( ORDER_exp == 88 ) ;
1506
	switch ( TAG_exp ( e ) ) {
1507
	    case exp_identifier_tag :
1508
	    case exp_member_tag : {
1509
		/* Identifier expressions */
1510
		IDENTIFIER id = DEREF_id ( exp_identifier_etc_id ( e ) ) ;
1511
		DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
1512
		ds &= ( dspec_storage | dspec_temp ) ;
1513
		if ( vol && IS_id_variable_etc ( id ) ) {
1514
		    TYPE t = DEREF_type ( id_variable_etc_type ( id ) ) ;
1515
		    CV_SPEC cv = find_cv_qual ( t ) ;
1516
		    if ( !( cv & cv_volatile ) ) ds |= dspec_implicit ;
1517
		}
1518
		*pa = e ;
1519
		return ( ds ) ;
1520
	    }
1521
	    case exp_string_lit_tag : {
1522
		/* String literals have internal linkage */
1523
		*pa = e ;
1524
		return ( dspec_static | dspec_pure ) ;
1525
	    }
1526
	    case exp_paren_tag :
1527
	    case exp_copy_tag : {
1528
		/* Parenthesised expressions */
1529
		EXP a = DEREF_exp ( exp_paren_etc_arg ( e ) ) ;
1530
		return ( find_exp_linkage ( a, pa, vol ) ) ;
1531
	    }
1532
	    case exp_indir_tag : {
1533
		/* Indirection expressions */
1534
		EXP a = DEREF_exp ( exp_indir_ptr ( e ) ) ;
1535
		return ( find_exp_linkage ( a, pa, vol ) ) ;
1536
	    }
1537
	    case exp_address_tag : {
1538
		/* Address expressions */
1539
		EXP a = DEREF_exp ( exp_address_arg ( e ) ) ;
1540
		return ( find_exp_linkage ( a, pa, vol ) ) ;
1541
	    }
1542
	    case exp_address_mem_tag : {
1543
		/* Address expressions */
1544
		EXP a = DEREF_exp ( exp_address_mem_arg ( e ) ) ;
1545
		if ( IS_exp_member ( a ) ) {
1546
		    return ( find_exp_linkage ( a, pa, vol ) ) ;
1547
		}
1548
		break ;
1549
	    }
1550
	    case exp_cast_tag : {
1551
		/* Cast expressions */
1552
		EXP a = DEREF_exp ( exp_cast_arg ( e ) ) ;
1553
		DECL_SPEC ds = find_exp_linkage ( a, pa, vol ) ;
1554
		ds &= ~( dspec_implicit | dspec_pure ) ;
1555
		return ( ds ) ;
1556
	    }
1557
	    case exp_add_ptr_tag : {
1558
		/* Pointer offset expressions */
1559
		EXP a = DEREF_exp ( exp_add_ptr_ptr ( e ) ) ;
1560
		DECL_SPEC ds = find_exp_linkage ( a, pa, vol ) ;
1561
		OFFSET off = DEREF_off ( exp_add_ptr_off ( e ) ) ;
1562
		if ( vol ) {
1563
		    /* Check for volatile members */
1564
		    while ( IS_off_plus ( off ) ) {
1565
			off = DEREF_off ( off_plus_arg2 ( off ) ) ;
1566
		    }
1567
		    if ( IS_off_member ( off ) ) {
1568
			TYPE t ;
1569
			CV_SPEC cv ;
1570
			IDENTIFIER id ;
1571
			id = DEREF_id ( off_member_id ( off ) ) ;
1572
			t = DEREF_type ( id_member_type ( id ) ) ;
1573
			cv = find_cv_qual ( t ) ;
1574
			if ( cv & cv_volatile ) ds &= ~dspec_implicit ;
1575
		    }
1576
		} else {
1577
		    /* Only base class conversions allowed */
1578
		    if ( !IS_off_base ( off ) && !IS_off_deriv ( off ) ) {
1579
			ds = dspec_none ;
1580
		    }
1581
		}
1582
		return ( ds ) ;
1583
	    }
1584
	    case exp_base_cast_tag : {
1585
		/* Base cast expressions */
1586
		EXP a = DEREF_exp ( exp_base_cast_arg ( e ) ) ;
1587
		return ( find_exp_linkage ( a, pa, vol ) ) ;
1588
	    }
1589
	    case exp_location_tag : {
1590
		/* Location expressions */
1591
		EXP a = DEREF_exp ( exp_location_arg ( e ) ) ;
1592
		return ( find_exp_linkage ( a, pa, vol ) ) ;
1593
	    }
1594
	    case exp_int_lit_tag :
1595
	    case exp_char_lit_tag :
1596
	    case exp_null_tag :
1597
	    case exp_zero_tag :
1598
	    case exp_value_tag :
1599
	    case exp_token_tag : {
1600
		/* These count as external linkage */
1601
		*pa = e ;
1602
		return ( dspec_extern ) ;
1603
	    }
1604
	}
1605
    }
1606
    return ( dspec_none ) ;
1607
}
1608
 
1609
 
1610
/*
1611
    IS AN OFFSET ZERO?
1612
 
1613
    This routine checks whether the offset off is zero.  The only
1614
    non-trivial case is for base class offsets where the single
1615
    inheritance (zero offset) cases are marked using dspec_ignore.
1616
*/
1617
 
1618
int is_zero_offset
1619
    PROTO_N ( ( off ) )
1620
    PROTO_T ( OFFSET off )
1621
{
1622
    if ( IS_NULL_off ( off ) ) return ( 1 ) ;
1623
    ASSERT ( ORDER_off == 13 ) ;
1624
    switch ( TAG_off ( off ) ) {
1625
	case off_zero_tag : {
1626
	    /* Zero offsets */
1627
	    return ( 1 ) ;
1628
	}
1629
	case off_array_tag : {
1630
	    /* Array offsets */
1631
	    unsigned n = DEREF_unsigned ( off_array_arg ( off ) ) ;
1632
	    if ( n == 0 ) return ( 1 ) ;
1633
	    break ;
1634
	}
1635
	case off_base_tag : {
1636
	    /* Base class offsets */
1637
	    GRAPH gr = DEREF_graph ( off_base_graph ( off ) ) ;
1638
	    DECL_SPEC acc = DEREF_dspec ( graph_access ( gr ) ) ;
1639
	    if ( acc & dspec_ignore ) return ( 1 ) ;
1640
	    break ;
1641
	}
1642
	case off_deriv_tag : {
1643
	    /* Derived class offsets */
1644
	    GRAPH gr = DEREF_graph ( off_deriv_graph ( off ) ) ;
1645
	    DECL_SPEC acc = DEREF_dspec ( graph_access ( gr ) ) ;
1646
	    if ( acc & dspec_ignore ) return ( 1 ) ;
1647
	    break ;
1648
	}
1649
	case off_negate_tag : {
1650
	    /* Offset negations */
1651
	    OFFSET a = DEREF_off ( off_negate_arg ( off ) ) ;
1652
	    return ( is_zero_offset ( a ) ) ;
1653
	}
1654
	case off_plus_tag : {
1655
	    /* Offset additions */
1656
	    OFFSET a = DEREF_off ( off_plus_arg1 ( off ) ) ;
1657
	    OFFSET b = DEREF_off ( off_plus_arg2 ( off ) ) ;
1658
	    return ( is_zero_offset ( a ) && is_zero_offset ( b ) ) ;
1659
	}
1660
	case off_mult_tag : {
1661
	    /* Offset multiplications */
1662
	    OFFSET a = DEREF_off ( off_mult_arg1 ( off ) ) ;
1663
	    return ( is_zero_offset ( a ) ) ;
1664
	}
1665
    }
1666
    return ( 0 ) ;
1667
}
1668
 
1669
 
1670
/*
1671
    IS THE TYPE OF AN OFFSET STATICALLY DETERMINED?
1672
 
1673
    This routine checks whether the type of a pointer plus the offset off
1674
    can be statically determined.  It returns 2 if the type is known
1675
    independent of the value of the pointer, 1 if it is known if the
1676
    type of the pointer is known, and 0 otherwise.
1677
*/
1678
 
1679
static int know_offset
1680
    PROTO_N ( ( off ) )
1681
    PROTO_T ( OFFSET off )
1682
{
1683
    if ( !IS_NULL_off ( off ) ) {
1684
	switch ( TAG_off ( off ) ) {
1685
	    case off_base_tag :
1686
	    case off_deriv_tag :
1687
	    case off_ptr_mem_tag : {
1688
		/* Base class offsets */
1689
		return ( 0 ) ;
1690
	    }
1691
	    case off_member_tag : {
1692
		/* Member offsets */
1693
		return ( 2 ) ;
1694
	    }
1695
	    case off_plus_tag : {
1696
		/* Check for derived member offsets */
1697
		off = DEREF_off ( off_plus_arg2 ( off ) ) ;
1698
		if ( IS_off_member ( off ) ) return ( 2 ) ;
1699
		break ;
1700
	    }
1701
	}
1702
    }
1703
    return ( 1 ) ;
1704
}
1705
 
1706
 
1707
/*
1708
    IS THE TYPE OF AN EXPRESSION STATICALLY DETERMINED?
1709
 
1710
    This routine checks whether the expression of class type or pointer to
1711
    class type, e, is derived from an object so that its type can be
1712
    statically determined.  It is used to check whether the virtual call
1713
    mechanism and virtual base class conversions can be bypassed for e.
1714
    A value of 2 is returned for non-obvious known types.
1715
*/
1716
 
1717
int know_type
1718
    PROTO_N ( ( e ) )
1719
    PROTO_T ( EXP e )
1720
{
1721
    if ( !IS_NULL_exp ( e ) ) {
1722
	unsigned tag = TAG_exp ( e ) ;
1723
	switch ( tag ) {
1724
	    case exp_address_tag : {
1725
		EXP a = DEREF_exp ( exp_address_arg ( e ) ) ;
1726
		tag = TAG_exp ( a ) ;
1727
		if ( tag == exp_identifier_tag ) {
1728
		    return ( 1 ) ;
1729
		}
1730
		if ( tag == exp_indir_tag ) {
1731
		    EXP b = DEREF_exp ( exp_indir_ptr ( a ) ) ;
1732
		    return ( know_type ( b ) ) ;
1733
		}
1734
		if ( tag == exp_dummy_tag ) {
1735
		    EXP b = DEREF_exp ( exp_dummy_value ( a ) ) ;
1736
		    if ( IS_NULL_exp ( b ) ) {
1737
			int v = DEREF_int ( exp_dummy_virt ( a ) ) ;
1738
			if ( !v ) return ( 1 ) ;
1739
		    }
1740
		}
1741
		break ;
1742
	    }
1743
	    case exp_indir_tag : {
1744
		EXP a = DEREF_exp ( exp_indir_ptr ( e ) ) ;
1745
		return ( know_type ( a ) ) ;
1746
	    }
1747
	    case exp_add_ptr_tag : {
1748
		OFFSET off = DEREF_off ( exp_add_ptr_off ( e ) ) ;
1749
		int k = know_offset ( off ) ;
1750
		if ( k == 2 ) {
1751
		    return ( 1 ) ;
1752
		}
1753
		if ( k == 1 ) {
1754
		    EXP a = DEREF_exp ( exp_add_ptr_ptr ( e ) ) ;
1755
		    return ( know_type ( a ) ) ;
1756
		}
1757
		break ;
1758
	    }
1759
	    case exp_contents_tag : {
1760
		e = DEREF_exp ( exp_contents_ptr ( e ) ) ;
1761
		if ( IS_exp_identifier ( e ) ) goto identifier_lab ;
1762
		break ;
1763
	    }
1764
	    case exp_identifier_tag :
1765
	    identifier_lab : {
1766
		IDENTIFIER id = DEREF_id ( exp_identifier_id ( e ) ) ;
1767
		HASHID nm = DEREF_hashid ( id_name ( id ) ) ;
1768
		if ( EQ_KEYWORD ( nm, lex_this_Hname ) ) {
1769
		    /* A 'this' expression */
1770
		    NAMESPACE ns = DEREF_nspace ( id_parent ( id ) ) ;
1771
		    id = DEREF_id ( nspace_name ( ns ) ) ;
1772
		    nm = DEREF_hashid ( id_name ( id ) ) ;
1773
		    if ( IS_hashid_constr ( nm ) ) {
1774
			/* Function is a constructor */
1775
			return ( 2 ) ;
1776
		    }
1777
		    if ( IS_hashid_destr ( nm ) ) {
1778
			/* Function is a destructor */
1779
			return ( 2 ) ;
1780
		    }
1781
		}
1782
		break ;
1783
	    }
1784
	}
1785
    }
1786
    return ( 0 ) ;
1787
}