Subversion Repositories tendra.SVN

Rev

Rev 2 | Details | Compare with Previous | 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 "ctype_ops.h"
34
#include "etype_ops.h"
35
#include "exp_ops.h"
36
#include "hashid_ops.h"
37
#include "id_ops.h"
38
#include "itype_ops.h"
39
#include "member_ops.h"
40
#include "nat_ops.h"
41
#include "nspace_ops.h"
42
#include "off_ops.h"
43
#include "type_ops.h"
44
#include "error.h"
45
#include "catalog.h"
46
#include "option.h"
47
#include "access.h"
48
#include "allocate.h"
49
#include "basetype.h"
50
#include "cast.h"
51
#include "check.h"
52
#include "chktype.h"
53
#include "constant.h"
54
#include "construct.h"
55
#include "convert.h"
56
#include "copy.h"
57
#include "declare.h"
58
#include "derive.h"
59
#include "destroy.h"
60
#include "dump.h"
61
#include "exception.h"
62
#include "expression.h"
63
#include "file.h"
64
#include "function.h"
65
#include "hash.h"
66
#include "identifier.h"
67
#include "initialise.h"
68
#include "lex.h"
69
#include "namespace.h"
70
#include "overload.h"
71
#include "predict.h"
72
#include "statement.h"
73
#include "syntax.h"
74
#include "template.h"
75
#include "typeid.h"
76
 
77
 
78
/*
79
    PERFORM AN ARITHMETIC OPERATION ON AN ARRAY DIMENSION
80
 
81
    This routine calculates the simple arithmetic operation 'a op b'.  Any
82
    conversion errors are suppressed.
83
*/
84
 
85
static EXP make_dim_exp
86
    PROTO_N ( ( op, a, b ) )
87
    PROTO_T ( int op X EXP a X EXP b )
88
{
89
    EXP e ;
90
    int et ;
91
    if ( IS_NULL_exp ( a ) ) return ( b ) ;
92
    if ( IS_NULL_exp ( b ) ) return ( a ) ;
93
    et = error_threshold ;
94
    error_threshold = ERROR_SERIOUS ;
95
    if ( op == lex_plus ) {
96
	e = make_plus_exp ( a, b ) ;
97
    } else {
98
	e = make_mult_exp ( op, a, b ) ;
99
    }
100
    error_threshold = et ;
101
    return ( e ) ;
102
}
103
 
104
 
105
/*
106
    ALLOCATION ROUTINES
107
 
108
    The memory allocation and deallocation routines are only contained in
109
    the C++ producer.
110
*/
111
 
112
#if LANGUAGE_CPP
113
 
114
 
115
/*
116
    BAD ALLOCATION EXCEPTION TYPE
117
 
118
    The variable type_bad_alloc is used to represent the standard exception
119
    type 'std::bad_alloc' thrown when an allocation function fails.  The
120
    list alloc_types is used to record all the function types for simple
121
    allocation functions.
122
*/
123
 
124
static TYPE type_bad_alloc = NULL_type ;
125
static LIST ( TYPE ) alloc_types = NULL_list ( TYPE ) ;
126
 
127
 
128
/*
129
    SET THE BAD ALLOCATION EXCEPTION TYPE
130
 
131
    This routine sets type_bad_alloc to be t, updating the exception
132
    specifiers of any simple allocation functions previously declared.
133
*/
134
 
135
static void set_bad_alloc
136
    PROTO_N ( ( t ) )
137
    PROTO_T ( TYPE t )
138
{
139
    if ( !IS_NULL_type ( t ) ) {
140
	LIST ( TYPE ) p = alloc_types ;
141
	while ( !IS_NULL_list ( p ) ) {
142
	    TYPE s = DEREF_type ( HEAD_list ( p ) ) ;
143
	    LIST ( TYPE ) e = DEREF_list ( type_func_except ( s ) ) ;
144
	    if ( !IS_NULL_list ( e ) && !EQ_list ( e, univ_type_set ) ) {
145
		/* Change 'throw ( X )' to 'throw ( std::bad_alloc )' */
146
		e = TAIL_list ( e ) ;
147
		CONS_type ( t, e, e ) ;
148
		COPY_list ( type_func_except ( s ), e ) ;
149
	    }
150
	    p = TAIL_list ( p ) ;
151
	}
152
	type_bad_alloc = t ;
153
    }
154
    return ;
155
}
156
 
157
 
158
/*
159
    CHECK AN ALLOCATION FUNCTION
160
 
161
    This routine checks whether the function type t is a suitable
162
    declaration for the allocation or deallocation function given by id.
163
    mem is true for member functions.  The basic forms allowed are:
164
 
165
	void *operator new ( size_t, [further parameters] ) ;
166
	void *operator new[] ( size_t, [further parameters] ) ;
167
	void operator delete ( void *, [further parameters] ) ;
168
	void operator delete[] ( void *, [further parameters] ) ;
169
 
170
    Before the introduction of placement delete the only further parameters
171
    allowed in a deallocation function was a single 'size_t' for member
172
    functions.  Note that template functions are allowed (indicated by
173
    templ), but they must have the form above and at least one further
174
    parameter.
175
*/
176
 
177
TYPE check_allocator
178
    PROTO_N ( ( t, id, mem, templ ) )
179
    PROTO_T ( TYPE t X IDENTIFIER id X int mem X int templ )
180
{
181
    if ( IS_type_templ ( t ) ) {
182
	/* Allow for template types */
183
	TYPE s = DEREF_type ( type_templ_defn ( t ) ) ;
184
	s = check_allocator ( s, id, mem, templ + 1 ) ;
185
	COPY_type ( type_templ_defn ( t ), s ) ;
186
 
187
    } else {
188
	/* Find the operator */
189
	HASHID nm = DEREF_hashid ( id_name ( id ) ) ;
190
	int op = DEREF_int ( hashid_op_lex ( nm ) ) ;
191
 
192
	/* Decompose function type */
193
	TYPE s ;
194
	TYPE r = DEREF_type ( type_func_ret ( t ) ) ;
195
	LIST ( TYPE ) p = DEREF_list ( type_func_ptypes ( t ) ) ;
196
	LIST ( IDENTIFIER ) q = DEREF_list ( type_func_pids ( t ) ) ;
197
	int ell = DEREF_int ( type_func_ellipsis ( t ) ) ;
198
	if ( !IS_NULL_list ( p ) ) {
199
	    s = DEREF_type ( HEAD_list ( p ) ) ;
200
	    p = TAIL_list ( p ) ;
201
	} else {
202
	    s = type_void ;
203
	}
204
 
205
	if ( op == lex_new || op == lex_new_Harray ) {
206
	    /* Allocator should return 'void *' */
207
	    TYPE u = type_void_star ;
208
	    if ( !eq_type ( r, u ) ) {
209
		report ( crt_loc, ERR_basic_stc_alloc_ret ( nm, u ) ) ;
210
	    }
211
 
212
	    /* First parameter should be 'size_t' */
213
	    u = type_size_t ;
214
	    if ( !eq_type ( s, u ) ) {
215
		report ( crt_loc, ERR_basic_stc_alloc_p1 ( nm, u ) ) ;
216
	    }
217
 
218
	    /* First parameter can't have a default argument */
219
	    if ( !IS_NULL_list ( q ) ) {
220
		IDENTIFIER pid = DEREF_id ( HEAD_list ( q ) ) ;
221
		EXP darg = DEREF_exp ( id_parameter_init ( pid ) ) ;
222
		if ( !IS_NULL_exp ( darg ) ) {
223
		    report ( crt_loc, ERR_basic_stc_alloc_d1 ( nm ) ) ;
224
		}
225
	    }
226
 
227
	    /* Template functions should have another parameter */
228
	    if ( templ && IS_NULL_list ( p ) ) {
229
		report ( crt_loc, ERR_basic_stc_alloc_templ ( nm ) ) ;
230
	    }
231
 
232
	} else {
233
	    /* Deallocator should return 'void' */
234
	    TYPE u = type_void ;
235
	    if ( !eq_type ( r, u ) ) {
236
		report ( crt_loc, ERR_basic_stc_alloc_ret ( nm, u ) ) ;
237
	    }
238
 
239
	    /* First argument should be 'void *' */
240
	    u = type_void_star ;
241
	    if ( !eq_type ( s, u ) ) {
242
		report ( crt_loc, ERR_basic_stc_alloc_p1 ( nm, u ) ) ;
243
	    }
244
 
245
	    /* Template functions should have another parameter */
246
	    if ( templ && IS_NULL_list ( p ) ) {
247
		report ( crt_loc, ERR_basic_stc_alloc_templ ( nm ) ) ;
248
	    }
249
 
250
	    /* Second argument may be 'size_t' (old form) */
251
	    if ( mem && !IS_NULL_list ( p ) ) {
252
		u = type_size_t ;
253
		s = DEREF_type ( HEAD_list ( p ) ) ;
254
		if ( !eq_type ( s, u ) ) {
255
		    report ( crt_loc, ERR_basic_stc_alloc_p2 ( nm, u ) ) ;
256
		}
257
		p = TAIL_list ( p ) ;
258
	    }
259
 
260
	    /* No further arguments allowed (old form) */
261
	    if ( !IS_NULL_list ( p ) || ell ) {
262
		report ( crt_loc, ERR_basic_stc_alloc_pn ( nm ) ) ;
263
	    }
264
	}
265
 
266
	/* Look up 'std::bad_alloc' */
267
	s = type_bad_alloc ;
268
	if ( IS_NULL_type ( s ) ) {
269
	    s = find_std_type ( "bad_alloc", 1, 0 ) ;
270
	    set_bad_alloc ( s ) ;
271
	}
272
    }
273
    return ( t ) ;
274
}
275
 
276
 
277
/*
278
    CHECK AN ALLOCATOR DECLARATION
279
 
280
    This routine checks the allocator declaration id.  This should either
281
    be a class member or a member of the global namespace with external
282
    linkage.  alloc is 1 for allocator functions and 2 for deallocation
283
    functions.
284
*/
285
 
286
void recheck_allocator
287
    PROTO_N ( ( id, alloc ) )
288
    PROTO_T ( IDENTIFIER id X int alloc )
289
{
290
    NAMESPACE ns = DEREF_nspace ( id_parent ( id ) ) ;
291
    if ( alloc == 2 ) {
292
	IDENTIFIER over = DEREF_id ( id_function_etc_over ( id ) ) ;
293
	if ( !IS_NULL_id ( over ) ) {
294
	    /* Can't overload 'operator delete' (old form) */
295
	    report ( crt_loc, ERR_basic_stc_dealloc_over ( over ) ) ;
296
	}
297
    }
298
    if ( !IS_NULL_nspace ( ns ) ) {
299
	switch ( TAG_nspace ( ns ) ) {
300
	    case nspace_global_tag : {
301
		/* Declared in global namespace */
302
		DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
303
		if ( ds & dspec_static ) {
304
		    report ( crt_loc, ERR_basic_stc_alloc_link ( id ) ) ;
305
		}
306
		if ( alloc == 1 && crt_file_type == 1 ) {
307
		    /* Check for built-in allocation functions */
308
		    TYPE t = DEREF_type ( id_function_type ( id ) ) ;
309
		    if ( IS_type_func ( t ) ) {
310
			LIST ( TYPE ) p ;
311
			p = DEREF_list ( type_func_ptypes ( t ) ) ;
312
			if ( LENGTH_list ( p ) == 1 ) {
313
			    CONS_type ( t, alloc_types, alloc_types ) ;
314
			}
315
		    }
316
		}
317
		break ;
318
	    }
319
	    case nspace_ctype_tag : {
320
		/* Declared in class namespace */
321
		break ;
322
	    }
323
	    default : {
324
		/* Declared in other namespace */
325
		report ( crt_loc, ERR_basic_stc_alloc_nspace ( id ) ) ;
326
		break ;
327
	    }
328
	}
329
    }
330
    return ;
331
}
332
 
333
 
334
/*
335
    FIND A DEALLOCATION FUNCTION
336
 
337
    This routine selects a deallocation function from the set of overloaded
338
    functions id.  If pid is not the null identifier then it is an
339
    allocation function for which a matching placement delete is required.
340
    mem is true for member functions.
341
*/
342
 
343
static IDENTIFIER resolve_delete
344
    PROTO_N ( ( id, pid, mem ) )
345
    PROTO_T ( IDENTIFIER id X IDENTIFIER pid X int mem )
346
{
347
    int eq = 0 ;
348
    IDENTIFIER rid ;
349
    LIST ( TYPE ) p ;
350
    TYPE fn = type_temp_func ;
351
    LIST ( IDENTIFIER ) pids = NULL_list ( IDENTIFIER ) ;
352
    COPY_type ( type_func_ret ( fn ), type_void ) ;
353
    COPY_cv ( type_func_mqual ( fn ), cv_none ) ;
354
 
355
    /* Try placement delete */
356
    if ( !IS_NULL_id ( pid ) ) {
357
	TYPE t = DEREF_type ( id_function_etc_type ( pid ) ) ;
358
	if ( IS_type_func ( t ) ) {
359
	    p = DEREF_list ( type_func_ptypes ( t ) ) ;
360
	    if ( !IS_NULL_list ( p ) ) p = TAIL_list ( p ) ;
361
	    CONS_type ( type_void_star, p, p ) ;
362
	    COPY_list ( type_func_ptypes ( fn ), p ) ;
363
	    COPY_list ( type_func_mtypes ( fn ), p ) ;
364
	    rid = resolve_func ( id, fn, 1, 1, pids, &eq ) ;
365
	    COPY_list ( type_func_ptypes ( fn ), NULL_list ( TYPE ) ) ;
366
	    COPY_list ( type_func_mtypes ( fn ), NULL_list ( TYPE ) ) ;
367
	    DESTROY_CONS_type ( destroy, t, p, p ) ;
368
	    UNUSED ( p ) ;
369
	    UNUSED ( t ) ;
370
	    if ( !IS_NULL_id ( rid ) ) return ( rid ) ;
371
	}
372
	return ( NULL_id ) ;
373
    }
374
 
375
    /* Try 'void ( void * )' */
376
    CONS_type ( type_void_star, NULL_list ( TYPE ), p ) ;
377
    COPY_list ( type_func_ptypes ( fn ), p ) ;
378
    COPY_list ( type_func_mtypes ( fn ), p ) ;
379
    rid = resolve_func ( id, fn, 0, 1, pids, &eq ) ;
380
    COPY_list ( type_func_ptypes ( fn ), NULL_list ( TYPE ) ) ;
381
    COPY_list ( type_func_mtypes ( fn ), NULL_list ( TYPE ) ) ;
382
    DESTROY_list ( p, SIZE_type ) ;
383
    if ( !IS_NULL_id ( rid ) ) return ( rid ) ;
384
 
385
    /* Try 'void ( void *, size_t )' */
386
    if ( mem ) {
387
	CONS_type ( type_size_t, NULL_list ( TYPE ), p ) ;
388
	CONS_type ( type_void_star, p, p ) ;
389
	COPY_list ( type_func_ptypes ( fn ), p ) ;
390
	COPY_list ( type_func_mtypes ( fn ), p ) ;
391
	rid = resolve_func ( id, fn, 0, 1, pids, &eq ) ;
392
	COPY_list ( type_func_ptypes ( fn ), NULL_list ( TYPE ) ) ;
393
	COPY_list ( type_func_mtypes ( fn ), NULL_list ( TYPE ) ) ;
394
	DESTROY_list ( p, SIZE_type ) ;
395
	if ( !IS_NULL_id ( rid ) ) return ( rid ) ;
396
    }
397
    return ( NULL_id ) ;
398
}
399
 
400
 
401
/*
402
    LOOK UP AN ALLOCATOR FUNCTION
403
 
404
    This routine looks up the allocator function 'operator op'.  If b is
405
    true then the global namespace is checked first, otherwise if t is a
406
    class type then the members of t are checked, finally the allocator
407
    currently in scope is checked.  If option new_array is false and op
408
    is an array allocator, then the corresponding object allocator is
409
    returned, except if t is a class which has 'operator op' declared.
410
*/
411
 
412
IDENTIFIER find_allocator
413
    PROTO_N ( ( t, op, b, pid ) )
414
    PROTO_T ( TYPE t X int op X int b X IDENTIFIER pid )
415
{
416
    int dealloc = 0 ;
417
    IDENTIFIER id = NULL_id ;
418
    HASHID nm = lookup_op ( op ) ;
419
    HASHID nm_real = nm ;
420
 
421
    /* Allow for pre-ISO dialect */
422
    switch ( op ) {
423
	case lex_new : {
424
	    break ;
425
	}
426
	case lex_new_Harray : {
427
	    if ( !option ( OPT_new_array ) ) {
428
		nm = lookup_op ( lex_new ) ;
429
		t = type_error ;
430
	    }
431
	    break ;
432
	}
433
	case lex_delete : {
434
	    dealloc = 1 ;
435
	    break ;
436
	}
437
	case lex_delete_Harray : {
438
	    if ( !option ( OPT_new_array ) ) {
439
		nm = lookup_op ( lex_delete ) ;
440
		t = type_error ;
441
	    }
442
	    dealloc = 1 ;
443
	    break ;
444
	}
445
    }
446
 
447
    if ( b ) {
448
	/* Try global scope ... */
449
	NAMESPACE ns = global_namespace ;
450
	MEMBER mem = search_member ( ns, nm, 0 ) ;
451
	if ( !IS_NULL_member ( mem ) ) {
452
	    id = DEREF_id ( member_id ( mem ) ) ;
453
	    if ( !IS_NULL_id ( id ) && dealloc ) {
454
		id = resolve_delete ( id, pid, 0 ) ;
455
	    }
456
	}
457
 
458
    } else {
459
	/* Try class members ... */
460
	if ( IS_type_compound ( t ) ) {
461
	    CLASS_TYPE ct = DEREF_ctype ( type_compound_defn ( t ) ) ;
462
	    NAMESPACE ns = DEREF_nspace ( ctype_member ( ct ) ) ;
463
	    id = search_field ( ns, nm_real, 0, 0 ) ;
464
	    if ( IS_NULL_id ( id ) && !EQ_hashid ( nm, nm_real ) ) {
465
		id = search_field ( ns, nm, 0, 0 ) ;
466
	    }
467
	    if ( !IS_NULL_id ( id ) && IS_id_ambig ( id ) ) {
468
		id = report_ambiguous ( id, 0, 1, 1 ) ;
469
	    }
470
	    if ( !IS_NULL_id ( id ) && dealloc ) {
471
		id = resolve_delete ( id, pid, 1 ) ;
472
	    }
473
	}
474
 
475
	/* Try current scope ... */
476
	if ( IS_NULL_id ( id ) ) {
477
	    id = find_op_id ( nm ) ;
478
	    if ( !IS_NULL_id ( id ) && dealloc ) {
479
		id = resolve_delete ( id, pid, 0 ) ;
480
	    }
481
	}
482
    }
483
 
484
    /* Return function */
485
    if ( !IS_NULL_id ( id ) ) {
486
	if ( IS_id_function_etc ( id ) ) {
487
	    /* Function found */
488
	    return ( id ) ;
489
	}
490
	if ( is_ambiguous_func ( id ) ) {
491
	    if ( dealloc ) {
492
		/* Can't do overload resolution on delete */
493
		id = report_ambiguous ( id, 0, 1, 1 ) ;
494
		return ( id ) ;
495
	    }
496
	    return ( id ) ;
497
	}
498
	if ( !IS_id_dummy ( id ) ) {
499
	    /* Result is not a function */
500
	    report ( crt_loc, ERR_over_oper_func ( id ) ) ;
501
	}
502
    }
503
    if ( IS_NULL_id ( pid ) ) {
504
	/* Allocation functions not declared */
505
	report ( crt_loc, ERR_lib_builtin ( NULL_string, nm ) ) ;
506
    }
507
    return ( NULL_id ) ;
508
}
509
 
510
 
511
/*
512
    CONSTRUCT A TEMPLATE DEPENDENT DELETE EXPRESSION
513
 
514
    This routine constructs a delete expression in the case where the
515
    expression type depends on a template parameter.
516
*/
517
 
518
static EXP make_templ_delete
519
    PROTO_N ( ( op, b, a ) )
520
    PROTO_T ( int op X int b X EXP a )
521
{
522
    EXP e ;
523
    if ( b ) {
524
	/* Allow for '::delete' */
525
	if ( op == lex_delete ) {
526
	    op = lex_delete_Hfull ;
527
	} else {
528
	    op = lex_delete_Harray_Hfull ;
529
	}
530
    }
531
    MAKE_exp_op ( type_void, op, a, NULL_exp, e ) ;
532
    return ( e ) ;
533
}
534
 
535
 
536
/*
537
    CONSTRUCT A PLACEMENT DELETE EXPRESSION
538
 
539
    This routine constructs the expressions 'delete a' and 'delete [] a'
540
    (as indicated by op).  b indicates whether the expression was actually
541
    '::delete'.  pid is used in placement delete expressions to give the
542
    corresponding allocation function (place then gives the extra
543
    arguments), otherwise it is the null identifier.
544
*/
545
 
546
static EXP placement_delete
547
    PROTO_N ( ( op, b, a, pid, place ) )
548
    PROTO_T ( int op X int b X EXP a X IDENTIFIER pid X LIST ( EXP ) place )
549
{
550
    int i ;
551
    EXP e, c ;
552
    TYPE t, p ;
553
    IDENTIFIER id ;
554
    unsigned npids ;
555
    EXP d = NULL_exp ;
556
    int need_cast = 1 ;
557
    int v = EXTRA_DESTR ;
558
    ERROR err = NULL_err ;
559
    LIST ( EXP ) args = NULL_list ( EXP ) ;
560
 
561
    /* Do operand conversion */
562
    a = convert_reference ( a, REF_NORMAL ) ;
563
    t = DEREF_type ( exp_type ( a ) ) ;
564
    if ( IS_type_compound ( t ) ) {
565
	/* Conversion of class to pointer */
566
	c = convert_gen ( CTYPE_PTR, a, &err ) ;
567
	if ( !IS_NULL_exp ( c ) ) {
568
	    if ( !IS_NULL_err ( err ) ) {
569
		err = concat_error ( err, ERR_expr_delete_conv ( op ) ) ;
570
		report ( crt_loc, err ) ;
571
	    }
572
	    a = c ;
573
	}
574
    }
575
 
576
    /* Check operand type */
577
    a = convert_lvalue ( a ) ;
578
    t = DEREF_type ( exp_type ( a ) ) ;
579
    if ( IS_type_ptr ( t ) ) {
580
	CV_SPEC cv ;
581
	int arr = 0 ;
582
	p = DEREF_type ( type_ptr_sub ( t ) ) ;
583
	if ( is_templ_depend ( p ) ) {
584
	    e = make_templ_delete ( op, b, a ) ;
585
	    return ( e ) ;
586
	}
587
	if ( IS_type_top_etc ( p ) ) {
588
	    /* Check for 'void *' */
589
	    report ( crt_loc, ERR_expr_delete_void ( op, t ) ) ;
590
	    need_cast = 0 ;
591
	} else {
592
	    /* Check for incomplete types */
593
	    err = check_object ( p ) ;
594
	    if ( !IS_NULL_err ( err ) ) {
595
		err = concat_error ( err, ERR_expr_delete_obj ( op ) ) ;
596
		report ( crt_loc, err ) ;
597
	    }
598
	    err = check_incomplete ( p ) ;
599
	    if ( !IS_NULL_err ( err ) ) {
600
		err = concat_error ( err, ERR_expr_delete_incompl ( op ) ) ;
601
		report ( crt_loc, err ) ;
602
		if ( IS_type_compound ( p ) ) {
603
		    /* Mark incomplete class types */
604
		    CLASS_TYPE ct = DEREF_ctype ( type_compound_defn ( p ) ) ;
605
		    CLASS_USAGE cu = DEREF_cusage ( ctype_usage ( ct ) ) ;
606
		    cu |= cusage_destr ;
607
		    if ( b == 0 ) {
608
			if ( op == lex_delete ) {
609
			    cu |= cusage_delete ;
610
			} else {
611
			    cu |= cusage_delete_array ;
612
			}
613
		    }
614
		    COPY_cusage ( ctype_usage ( ct ), cu ) ;
615
		}
616
	    }
617
	}
618
	while ( IS_type_array ( p ) ) {
619
	    /* Allow for multi-dimensional arrays */
620
	    arr = 1 ;
621
	    p = DEREF_type ( type_array_sub ( p ) ) ;
622
	}
623
	if ( arr ) MAKE_type_ptr ( cv_none, p, t ) ;
624
	cv = DEREF_cv ( type_qual ( p ) ) ;
625
	if ( cv & cv_const ) {
626
	    /* Check for deleting const objects */
627
	    report ( crt_loc, ERR_expr_delete_const ( cv ) ) ;
628
	}
629
    } else {
630
	/* Operand should be a pointer */
631
	if ( is_templ_type ( t ) ) {
632
	    e = make_templ_delete ( op, b, a ) ;
633
	    return ( e ) ;
634
	}
635
	if ( !IS_type_error ( t ) ) {
636
	    report ( crt_loc, ERR_expr_delete_ptr ( op, t ) ) ;
637
	}
638
	MAKE_exp_value ( type_void, e ) ;
639
	return ( e ) ;
640
    }
641
 
642
    /* Find destructors */
643
    err = NULL_err ;
644
    i = ( know_type ( a ) == 1 ? DEFAULT_DESTR : DEFAULT_DELETE ) ;
645
    if ( op == lex_delete && b == 0 && IS_NULL_id ( pid ) ) {
646
	/* delete may be called via the destructor */
647
	v = ( EXTRA_DESTR | EXTRA_DELETE ) ;
648
    }
649
    d = init_default ( p, &d, i, v, &err ) ;
650
    if ( !IS_NULL_err ( err ) ) report ( crt_loc, err ) ;
651
    if ( IS_NULL_exp ( d ) ) v = EXTRA_DESTR ;
652
 
653
    /* Find deallocation function */
654
    id = find_allocator ( p, op, b, pid ) ;
655
    if ( !IS_NULL_id ( id ) ) {
656
	LIST ( IDENTIFIER ) pids ;
657
	TYPE fn = DEREF_type ( id_function_etc_type ( id ) ) ;
658
	while ( IS_type_templ ( fn ) ) {
659
	    fn = DEREF_type ( type_templ_defn ( fn ) ) ;
660
	}
661
	pids = DEREF_list ( type_func_pids ( fn ) ) ;
662
	npids = LENGTH_list ( pids ) ;
663
    } else {
664
	npids = 0 ;
665
    }
666
 
667
    /* Create dummy expression for first argument */
668
    MAKE_exp_dummy ( t, a, LINK_NONE, NULL_off, 1, a ) ;
669
 
670
    /* Create size variables if necessary */
671
    if ( op == lex_delete || !IS_type_compound ( p ) ) {
672
	c = NULL_exp ;
673
	e = a ;
674
    } else {
675
	OFFSET off ;
676
	TYPE s = type_size_t ;
677
	if ( npids == 1 && IS_NULL_exp ( d ) ) {
678
	    MAKE_exp_null ( s, c ) ;
679
	} else {
680
	    MAKE_exp_dummy ( s, NULL_exp, LINK_NONE, NULL_off, 0, c ) ;
681
	}
682
	MAKE_off_extra ( p, -1, off ) ;
683
	MAKE_exp_add_ptr ( t, a, off, 0, e ) ;
684
    }
685
 
686
    /* Create extra arguments */
687
    if ( IS_NULL_id ( pid ) ) {
688
	if ( npids >= 2 ) {
689
	    /* Pass size as extra argument */
690
	    EXP sz = sizeof_exp ( p ) ;
691
	    if ( !IS_NULL_exp ( c ) ) {
692
		EXP ex ;
693
		OFFSET off ;
694
		sz = make_dim_exp ( lex_star, sz, c ) ;
695
		MAKE_off_extra ( p, 1, off ) ;
696
		MAKE_exp_offset_size ( type_size_t, off, type_char, 1, ex ) ;
697
		sz = make_dim_exp ( lex_plus, sz, ex ) ;
698
	    }
699
	    CONS_exp ( sz, args, args ) ;
700
	}
701
    } else {
702
	/* Copy placement arguments */
703
	/* NOT YET IMPLEMENTED */
704
	args = copy_exp_list ( place, NULL_type, NULL_type ) ;
705
    }
706
 
707
    /* Construct function call */
708
    if ( !IS_NULL_id ( id ) ) {
709
	if ( need_cast ) {
710
	    MAKE_exp_cast ( type_void_star, CONV_PTR_VOID, e, e ) ;
711
	}
712
	CONS_exp ( e, args, args ) ;
713
	if ( IS_id_stat_mem_func ( id ) ) {
714
	    /* Allow for static member functions */
715
	    CONS_exp ( NULL_exp, args, args ) ;
716
	}
717
	use_func_id ( id, 0, suppress_usage ) ;
718
	e = apply_func_id ( id, qual_none, NULL_graph, args ) ;
719
	if ( v == ( EXTRA_DESTR | EXTRA_DELETE ) ) {
720
	    /* 'operator delete' called via destructor */
721
	    MAKE_exp_paren ( type_void, e, e ) ;
722
	}
723
    } else {
724
	e = NULL_exp ;
725
    }
726
 
727
    /* Construct result */
728
    MAKE_exp_dealloc ( type_void, d, e, a, c, e ) ;
729
    return ( e ) ;
730
}
731
 
732
 
733
/*
734
    CREATE A SIMPLE DELETE EXPRESSION
735
 
736
    This routine is a special case of placement_delete which handles the
737
    explicit delete expressions.
738
*/
739
 
740
EXP make_delete_exp
741
    PROTO_N ( ( op, b, a ) )
742
    PROTO_T ( int op X int b X EXP a )
743
{
744
    EXP e = placement_delete ( op, b, a, NULL_id, NULL_list ( EXP ) ) ;
745
    return ( e ) ;
746
}
747
 
748
 
749
/*
750
    DELETE ARRAY ANACHRONISM
751
 
752
    It used to be necessary to include the size of the array being deleted
753
    in 'delete []'.  This routine deals with this anachronism.
754
*/
755
 
756
void old_delete_array
757
    PROTO_N ( ( e ) )
758
    PROTO_T ( EXP e )
759
{
760
    /* Check that e is a suitable array bound */
761
    int op = lex_delete_Harray ;
762
    IGNORE make_new_array_dim ( e ) ;
763
 
764
    /* But complain just the same */
765
    report ( crt_loc, ERR_expr_delete_array ( op ) ) ;
766
    return ;
767
}
768
 
769
 
770
/*
771
    CONSTRUCT A NEW ARRAY BOUND
772
 
773
    In a new-declarator the first array bound can be a variable expression,
774
    whereas all subsequent array bounds must be constant expressions as
775
    normal.  This routine is a version of make_array_dim designed exclusively
776
    to deal with this first bound.  Note that the result is not strictly
777
    a legal NAT and is only used to pass the bound information to
778
    make_new_exp, where it is prompty destroyed.
779
*/
780
 
781
NAT make_new_array_dim
782
    PROTO_N ( ( e ) )
783
    PROTO_T ( EXP e )
784
{
785
    NAT n ;
786
    if ( IS_exp_int_lit ( e ) ) {
787
	/* Get the value if e is constant */
788
	n = DEREF_nat ( exp_int_lit_nat ( e ) ) ;
789
    } else {
790
	/* Make dummy literal */
791
	MAKE_nat_calc ( e, n ) ;
792
    }
793
    return ( n ) ;
794
}
795
 
796
 
797
/*
798
    CONSTRUCT A TEMPLATE DEPENDENT NEW EXPRESSION
799
 
800
    This routine constructs a new expression in the case where the object
801
    type is a template parameter.  t gives the given type with array
802
    dimension d, while p is the pointer type.
803
*/
804
 
805
static EXP make_templ_new
806
    PROTO_N ( ( t, d, p, b, place, init ) )
807
    PROTO_T ( TYPE t X EXP d X TYPE p X int b X LIST ( EXP ) place X EXP init )
808
{
809
    EXP e ;
810
    int op = ( b ? lex_new_Hfull : lex_new ) ;
811
    CONS_exp ( init, place, place ) ;
812
    CONS_exp ( d, place, place ) ;
813
    MAKE_exp_value ( t, e ) ;
814
    CONS_exp ( e, place, place ) ;
815
    MAKE_exp_opn ( p, op, place, e ) ;
816
    return ( e ) ;
817
}
818
 
819
 
820
/*
821
    CONSTRUCT A NEW EXPRESSION
822
 
823
    This routine constructs the expression 'new ( place ) ( t ) ( init )',
824
    where place is a possibly empty list of expressions and init is
825
    a new-initialiser expression.  n gives the number of types defined
826
    in t and b indicates whether the expression was actually '::new'.
827
*/
828
 
829
EXP make_new_exp
830
    PROTO_N ( ( t, n, b, place, init ) )
831
    PROTO_T ( TYPE t X int n X int b X LIST ( EXP ) place X EXP init )
832
{
833
    EXP e ;
834
    EXP sz ;
835
    TYPE ret ;
836
    TYPE u = t ;
837
    IDENTIFIER id ;
838
    EXP v = NULL_exp ;
839
    NAT d = NULL_nat ;
840
    EXP gc = NULL_exp ;
841
    EXP arr = NULL_exp ;
842
    int need_cast = 1 ;
843
    int op = lex_new ;
844
    int opd = lex_delete ;
845
    LIST ( EXP ) placement = NULL_list ( EXP ) ;
846
 
847
    /* Check for type definitions */
848
    if ( n ) report ( crt_loc, ERR_expr_new_typedef () ) ;
849
 
850
    /* Find result type (a pointer to t) and size of t */
851
    if ( IS_type_array ( t ) ) {
852
	/* Array form */
853
	EXP c1 ;
854
	TYPE tsz = type_size_t ;
855
	TYPE s = DEREF_type ( type_array_sub ( t ) ) ;
856
	MAKE_type_ptr ( cv_none, s, ret ) ;
857
 
858
	/* Check initial array bound */
859
	d = DEREF_nat ( type_array_size ( t ) ) ;
860
	if ( IS_nat_calc ( d ) ) {
861
	    /* Variable sized array */
862
	    TYPE tc ;
863
	    unsigned cc ;
864
	    c1 = DEREF_exp ( nat_calc_value ( d ) ) ;
865
	    tc = DEREF_type ( exp_type ( c1 ) ) ;
866
	    cc = type_category ( &tc ) ;
867
	    if ( !IS_TYPE_INT ( cc ) && !IS_TYPE_TEMPL ( cc ) ) {
868
		/* Should have integral type */
869
		if ( !IS_TYPE_ERROR ( cc ) ) {
870
		    report ( crt_loc, ERR_expr_new_dim ( tc ) ) ;
871
		}
872
	    }
873
	    if ( !in_template_decl ) {
874
		/* Convert dimension to type 'size_t' */
875
		c1 = cast_exp ( tsz, c1, KILL_err, CAST_STATIC ) ;
876
	    }
877
	    u = s ;
878
	    v = c1 ;
879
	} else {
880
	    c1 = calc_nat_value ( d, tsz ) ;
881
	}
882
 
883
	/* Find overall array size */
884
	if ( IS_type_array ( s ) ) {
885
	    EXP c2 = sizeof_array ( &s, tsz ) ;
886
	    c1 = make_dim_exp ( lex_star, c2, c1 ) ;
887
	}
888
	if ( IS_exp_int_lit ( c1 ) ) {
889
	    /* Constant sized array */
890
	    if ( IS_type_compound ( s ) ) {
891
		TYPE tc = DEREF_type ( exp_type ( c1 ) ) ;
892
		MAKE_exp_dummy ( tc, c1, LINK_NONE, NULL_off, 0, arr ) ;
893
	    }
894
	    sz = sizeof_exp ( t ) ;
895
	    d = DEREF_nat ( exp_int_lit_nat ( c1 ) ) ;
896
	} else {
897
	    /* Variable sized array */
898
	    TYPE tc = DEREF_type ( exp_type ( c1 ) ) ;
899
	    MAKE_exp_dummy ( tc, c1, LINK_NONE, NULL_off, 0, arr ) ;
900
	    sz = sizeof_exp ( s ) ;
901
	    sz = make_dim_exp ( lex_star, sz, arr ) ;
902
	    MAKE_nat_calc ( c1, d ) ;
903
	    if ( !IS_type_compound ( s ) ) arr = NULL_exp ;
904
	}
905
 
906
	/* Add extra array space */
907
	if ( IS_type_compound ( s ) ) {
908
	    OFFSET off ;
909
	    MAKE_off_extra ( s, 1, off ) ;
910
	    MAKE_exp_offset_size ( tsz, off, type_char, 1, c1 ) ;
911
	    sz = make_dim_exp ( lex_plus, sz, c1 ) ;
912
	}
913
	op = lex_new_Harray ;
914
	opd = lex_delete_Harray ;
915
	t = s ;
916
    } else {
917
	/* Normal form */
918
	if ( IS_type_top_etc ( t ) ) need_cast = 0 ;
919
	MAKE_type_ptr ( cv_none, t, ret ) ;
920
	sz = sizeof_exp ( t ) ;
921
    }
922
 
923
    /* Do reference conversions */
924
    if ( !IS_NULL_list ( place ) ) {
925
	place = convert_args ( place ) ;
926
	placement = place ;
927
    }
928
 
929
    /* Check for template parameters */
930
    if ( is_templ_type ( t ) ) {
931
	e = make_templ_new ( u, v, ret, b, place, init ) ;
932
	return ( e ) ;
933
    }
934
 
935
    /* Add 'sizeof ( t )' to the start of placement */
936
    CONS_exp ( sz, place, place ) ;
937
 
938
    /* Call allocator function */
939
    id = find_allocator ( t, op, b, NULL_id ) ;
940
    if ( IS_NULL_id ( id ) ) {
941
	e = make_error_exp ( 0 ) ;
942
	return ( e ) ;
943
    }
944
    if ( IS_id_stat_mem_func ( id ) ) {
945
	CONS_exp ( NULL_exp, place, place ) ;
946
    }
947
    id = resolve_call ( id, place, qual_none, 0 ) ;
948
    use_func_id ( id, 0, suppress_usage ) ;
949
    e = apply_func_id ( id, qual_none, NULL_graph, place ) ;
950
    if ( need_cast ) {
951
	MAKE_exp_cast ( ret, ( CONV_PTR_VOID | CONV_REVERSE ), e, e ) ;
952
    }
953
 
954
    /* Deal with array initialisers */
955
    if ( !IS_NULL_exp ( init ) ) {
956
	EXP a0 = new_try_body ( init ) ;
957
	if ( IS_NULL_exp ( a0 ) ) {
958
	    /* Can happen with templates */
959
	    init = NULL_exp ;
960
	} else {
961
	    if ( !IS_NULL_nat ( d ) ) {
962
		EXP a = DEREF_exp ( exp_assign_arg ( a0 ) ) ;
963
		MAKE_type_array ( cv_none, t, d, t ) ;
964
		MAKE_exp_nof ( t, NULL_exp, d, a, NULL_exp, a ) ;
965
		COPY_exp ( exp_assign_arg ( a0 ), a ) ;
966
		a = DEREF_exp ( exp_assign_ref ( a0 ) ) ;
967
		COPY_type ( exp_type ( a ), t ) ;
968
		COPY_type ( exp_type ( a0 ), t ) ;
969
		/* NOT YET IMPLEMENTED - destructors of temporaries */
970
	    }
971
	}
972
    }
973
 
974
    /* Deal with clean-up routine */
975
    if ( !IS_NULL_exp ( init ) ) {
976
	EXP a ;
977
	int du = do_dump ;
978
	int ac = do_access_checks ;
979
	do_dump = 0 ;
980
	do_access_checks = 0 ;
981
	MAKE_exp_value ( ret, a ) ;
982
	if ( IS_NULL_list ( placement ) ) id = NULL_id ;
983
	gc = placement_delete ( opd, b, a, id, placement ) ;
984
	do_access_checks = ac ;
985
	do_dump = du ;
986
    }
987
 
988
    /* Return the result */
989
    MAKE_exp_alloc ( ret, e, init, gc, arr, e ) ;
990
    return ( e ) ;
991
}
992
 
993
 
994
/*
995
    CREATE A NEW-INITIALISER
996
 
997
    This routine creates a new-initialiser expression of type t from the
998
    expression list p.
999
*/
1000
 
1001
EXP make_new_init
1002
    PROTO_N ( ( t, p, init ) )
1003
    PROTO_T ( TYPE t X LIST ( EXP ) p X int init )
1004
{
1005
    EXP e ;
1006
    int op = lex_new ;
1007
    ERROR err = check_complete ( t ) ;
1008
    if ( !IS_NULL_err ( err ) ) {
1009
	/* Type should be complete */
1010
	err = concat_error ( err, ERR_expr_new_incompl () ) ;
1011
	report ( crt_loc, err ) ;
1012
    }
1013
    err = check_abstract ( t ) ;
1014
    if ( !IS_NULL_err ( err ) ) {
1015
	/* Type can't be abstract */
1016
	err = concat_error ( err, ERR_expr_new_abstract () ) ;
1017
	report ( crt_loc, err ) ;
1018
	err = NULL_err ;
1019
    }
1020
    while ( IS_type_array ( t ) ) {
1021
	/* Step over array components */
1022
	op = lex_new_Harray ;
1023
	if ( init ) {
1024
	    report ( crt_loc, ERR_expr_new_array_init ( op ) ) ;
1025
	    init = 0 ;
1026
	}
1027
	t = DEREF_type ( type_array_sub ( t ) ) ;
1028
    }
1029
    p = convert_args ( p ) ;
1030
    if ( is_templ_type ( t ) ) {
1031
	if ( op == lex_new_Harray ) {
1032
	    /* Create dummy array type */
1033
	    NAT n = small_nat [1] ;
1034
	    MAKE_type_array ( cv_none, t, n, t ) ;
1035
	}
1036
	if ( init ) {
1037
	    MAKE_exp_opn ( t, lex_compute, p, e ) ;
1038
	} else {
1039
	    MAKE_exp_op ( t, lex_compute, NULL_exp, NULL_exp, e ) ;
1040
	}
1041
    } else {
1042
	if ( init ) {
1043
	    e = init_constr ( t, p, &err ) ;
1044
	} else {
1045
	    e = init_empty ( t, cv_none, 0, &err ) ;
1046
	}
1047
	if ( !IS_NULL_err ( err ) ) {
1048
	    /* Report conversion errors */
1049
	    err = concat_error ( ERR_expr_new_init ( op ), err ) ;
1050
	    report ( crt_loc, err ) ;
1051
	}
1052
	if ( !IS_NULL_exp ( e ) ) {
1053
	    /* Assign value to dummy expression */
1054
	    EXP a ;
1055
	    MAKE_exp_dummy ( t, NULL_exp, LINK_NONE, NULL_off, 1, a ) ;
1056
	    MAKE_exp_assign ( t, a, e, e ) ;
1057
	}
1058
    }
1059
    return ( e ) ;
1060
}
1061
 
1062
 
1063
/*
1064
    BEGIN A NEW-INITIALISER TRY BLOCK
1065
 
1066
    Each new-initialiser is enclosed in a dummy try block.  This is because
1067
    if the initialiser throws an exception it is necessary to catch it,
1068
    delete the memory just allocated, and then re-throw the exception to
1069
    the enclosing real handler.
1070
*/
1071
 
1072
EXP begin_new_try
1073
    PROTO_Z ()
1074
{
1075
    EXP a = begin_try_stmt ( 0 ) ;
1076
    EXP b = begin_compound_stmt ( 2 ) ;
1077
    COPY_exp ( exp_try_block_body ( a ), b ) ;
1078
    return ( a ) ;
1079
}
1080
 
1081
 
1082
/*
1083
    END A NEW-INITIALISER TRY BLOCK
1084
 
1085
    This routine adds the new-initialiser expression b to the try block a.
1086
*/
1087
 
1088
EXP end_new_try
1089
    PROTO_N ( ( a, b ) )
1090
    PROTO_T ( EXP a X EXP b )
1091
{
1092
    EXP c = DEREF_exp ( exp_try_block_body ( a ) ) ;
1093
    c = add_compound_stmt ( c, b ) ;
1094
    c = end_compound_stmt ( c ) ;
1095
    a = cont_try_stmt ( a, c ) ;
1096
    a = end_try_stmt ( a, 1 ) ;
1097
    if ( IS_NULL_exp ( b ) ) {
1098
	free_exp ( a, 1 ) ;
1099
	a = NULL_exp ;
1100
    }
1101
    return ( a ) ;
1102
}
1103
 
1104
 
1105
/*
1106
    FIND THE BODY OF A NEW-INITIALISER TRY BLOCK
1107
 
1108
    This routine returns the initialiser component of the new-initialiser
1109
    try block a.
1110
*/
1111
 
1112
EXP new_try_body
1113
    PROTO_N ( ( a ) )
1114
    PROTO_T ( EXP a )
1115
{
1116
    while ( !IS_NULL_exp ( a ) ) {
1117
	switch ( TAG_exp ( a ) ) {
1118
	    case exp_try_block_tag : {
1119
		a = DEREF_exp ( exp_try_block_body ( a ) ) ;
1120
		break ;
1121
	    }
1122
	    case exp_decl_stmt_tag : {
1123
		a = DEREF_exp ( exp_decl_stmt_body ( a ) ) ;
1124
		break ;
1125
	    }
1126
	    case exp_sequence_tag : {
1127
		LIST ( EXP ) p = DEREF_list ( exp_sequence_first ( a ) ) ;
1128
		p = TAIL_list ( p ) ;
1129
		if ( IS_NULL_list ( p ) ) {
1130
		    a = NULL_exp ;
1131
		} else {
1132
		    a = DEREF_exp ( HEAD_list ( p ) ) ;
1133
		}
1134
		break ;
1135
	    }
1136
	    case exp_location_tag : {
1137
		a = DEREF_exp ( exp_location_arg ( a ) ) ;
1138
		break ;
1139
	    }
1140
	    default : {
1141
		return ( a ) ;
1142
	    }
1143
	}
1144
    }
1145
    return ( NULL_exp ) ;
1146
}
1147
 
1148
 
1149
/*
1150
    END OF ALLOCATION ROUTINES
1151
 
1152
    The remaining routines are common to both producers.
1153
*/
1154
 
1155
#endif /* LANGUAGE_CPP */
1156
 
1157
 
1158
/*
1159
    MULTIPLY ARRAY DIMENSIONS
1160
 
1161
    This routine multiplies the dimensions of any array components in the
1162
    type pointed to by pt returning it as an expression of type s.  It
1163
    assigns the non-array components back to pt.
1164
*/
1165
 
1166
EXP sizeof_array
1167
    PROTO_N ( ( pt, s ) )
1168
    PROTO_T ( TYPE *pt X TYPE s )
1169
{
1170
    TYPE t = *pt ;
1171
    EXP a = NULL_exp ;
1172
    while ( IS_type_array ( t ) ) {
1173
	EXP b ;
1174
	NAT n = DEREF_nat ( type_array_size ( t ) ) ;
1175
	if ( IS_NULL_nat ( n ) ) n = small_nat [0] ;
1176
	b = calc_nat_value ( n, s ) ;
1177
	a = make_dim_exp ( lex_star, a, b ) ;
1178
	t = DEREF_type ( type_array_sub ( t ) ) ;
1179
    }
1180
    *pt = t ;
1181
    return ( a ) ;
1182
}
1183
 
1184
 
1185
/*
1186
    FIND THE SIZE OF A TYPE
1187
 
1188
    This routine calculates the size of the type t when this can be precisely
1189
    evaluated, returning the null literal if this is not possible.
1190
*/
1191
 
1192
static NAT sizeof_type
1193
    PROTO_N ( ( t ) )
1194
    PROTO_T ( TYPE t )
1195
{
1196
    switch ( TAG_type ( t ) ) {
1197
	case type_integer_tag : {
1198
	    /* Allow for integral types */
1199
	    INT_TYPE it = DEREF_itype ( type_integer_rep ( t ) ) ;
1200
	    if ( IS_itype_basic ( it ) ) {
1201
		BASE_TYPE bt = DEREF_btype ( itype_basic_rep ( it ) ) ;
1202
		if ( bt & btype_char ) {
1203
		    /* char has size one */
1204
		    NAT n = small_nat [1] ;
1205
		    return ( n ) ;
1206
		}
1207
	    }
1208
	    break ;
1209
	}
1210
	case type_top_tag :
1211
	case type_bottom_tag : {
1212
	    /* void has size one */
1213
	    NAT n = small_nat [1] ;
1214
	    return ( n ) ;
1215
	}
1216
	case type_array_tag : {
1217
	    /* Allow for array types */
1218
	    TYPE s = type_size_t ;
1219
	    EXP a = sizeof_array ( &t, s ) ;
1220
	    NAT n = sizeof_type ( t ) ;
1221
	    if ( !IS_NULL_nat ( n ) ) {
1222
		EXP b = calc_nat_value ( n, s ) ;
1223
		a = make_dim_exp ( lex_star, a, b ) ;
1224
		if ( IS_exp_int_lit ( a ) ) {
1225
		    n = DEREF_nat ( exp_int_lit_nat ( a ) ) ;
1226
		    return ( n ) ;
1227
		}
1228
	    }
1229
	    break ;
1230
	}
1231
	case type_enumerate_tag : {
1232
	    /* An enumeration maps to its underlying type */
1233
	    ENUM_TYPE et = DEREF_etype ( type_enumerate_defn ( t ) ) ;
1234
	    TYPE s = DEREF_type ( etype_rep ( et ) ) ;
1235
	    return ( sizeof_type ( s ) ) ;
1236
	}
1237
    }
1238
    return ( NULL_nat ) ;
1239
}
1240
 
1241
 
1242
/*
1243
    CREATE A SIZEOF EXPRESSION
1244
 
1245
    This routine constructs the expression 'sizeof ( t )' without applying
1246
    any checks to t.
1247
*/
1248
 
1249
EXP sizeof_exp
1250
    PROTO_N ( ( t ) )
1251
    PROTO_T ( TYPE t )
1252
{
1253
    EXP e ;
1254
    NAT sz = sizeof_type ( t ) ;
1255
    if ( IS_NULL_nat ( sz ) ) {
1256
	/* Calculate size if it is not obvious */
1257
	OFFSET off ;
1258
	MAKE_off_type ( t, off ) ;
1259
	MAKE_exp_offset_size ( type_size_t, off, type_char, 1, e ) ;
1260
	MAKE_nat_calc ( e, sz ) ;
1261
    }
1262
    MAKE_exp_int_lit ( type_size_t, sz, exp_offset_size_tag, e ) ;
1263
    return ( e ) ;
1264
}
1265
 
1266
 
1267
/*
1268
    CONSTRUCT A SIZEOF EXPRESSION
1269
 
1270
    This routine constructs the expression 'sizeof ( t )'.  Note that
1271
    'sizeof a' has already been reduced to 'sizeof ( typeof ( a ) )'
1272
    except in the case where the result depends on a template parameter.
1273
    The argument n gives the number of types defined in t.  Note that the
1274
    result is a constant integer expression.
1275
*/
1276
 
1277
EXP make_sizeof_exp
1278
    PROTO_N ( ( t, a, n, op ) )
1279
    PROTO_T ( TYPE t X EXP a X int n X int op )
1280
{
1281
    /* Deal with argument dependent case */
1282
#if LANGUAGE_CPP
1283
    if ( !IS_NULL_exp ( a ) ) {
1284
	EXP e ;
1285
	NAT sz ;
1286
	TYPE s = type_size_t ;
1287
	MAKE_exp_op ( s, op, a, NULL_exp, e ) ;
1288
	MAKE_nat_calc ( e, sz ) ;
1289
	MAKE_exp_int_lit ( s, sz, exp_op_tag, e ) ;
1290
	return ( e ) ;
1291
    }
1292
#else
1293
    UNUSED ( a ) ;
1294
#endif
1295
 
1296
    /* Check on type */
1297
    switch ( TAG_type ( t ) ) {
1298
	case type_func_tag : {
1299
	    /* Can't have sizeof ( function ) */
1300
	    report ( crt_loc, ERR_expr_sizeof_func ( op ) ) ;
1301
	    MAKE_type_ptr ( cv_none, t, t ) ;
1302
	    break ;
1303
	}
1304
	case type_bitfield_tag : {
1305
	    /* Can't have sizeof ( bitfield ) */
1306
	    report ( crt_loc, ERR_expr_sizeof_bitf ( op ) ) ;
1307
	    t = find_bitfield_type ( t ) ;
1308
	    break ;
1309
	}
1310
	case type_ref_tag : {
1311
	    /* sizeof ( T & ) equals sizeof ( T ) */
1312
	    t = DEREF_type ( type_ref_sub ( t ) ) ;
1313
	    break ;
1314
	}
1315
	default : {
1316
	    /* Can't have sizeof ( incomplete ) */
1317
	    ERROR err = check_incomplete ( t ) ;
1318
	    if ( !IS_NULL_err ( err ) ) {
1319
		err = concat_error ( err, ERR_expr_sizeof_incompl ( op ) ) ;
1320
		report ( crt_loc, err ) ;
1321
	    }
1322
	    break ;
1323
	}
1324
    }
1325
 
1326
    /* Report on type definitions */
1327
    if ( n ) report ( crt_loc, ERR_expr_sizeof_typedef ( op ) ) ;
1328
 
1329
    /* Calculate result */
1330
    return ( sizeof_exp ( t ) ) ;
1331
}
1332
 
1333
 
1334
/*
1335
    FIND THE TYPE OF AN EXPRESSION
1336
 
1337
    This routine returns the type of the expression pointed to by pa after
1338
    apply reference conversions to it.  It is used, for example, to
1339
    transform 'sizeof ( a )' into 'sizeof ( t )'.  n gives the number of
1340
    side effects in pa.
1341
*/
1342
 
1343
TYPE typeof_exp
1344
    PROTO_N ( ( pa, n, op ) )
1345
    PROTO_T ( EXP *pa X int n X int op )
1346
{
1347
    TYPE t ;
1348
    EXP a = *pa ;
1349
    if ( n ) report ( crt_loc, ERR_expr_sizeof_side ( op ) ) ;
1350
    a = convert_reference ( a, REF_NORMAL ) ;
1351
    a = convert_none ( a ) ;
1352
    t = DEREF_type ( exp_type ( a ) ) ;
1353
    if ( !is_templ_type ( t ) ) {
1354
	/* Free operand in simple case */
1355
	free_exp ( a, 2 ) ;
1356
	a = NULL_exp ;
1357
    }
1358
    *pa = a ;
1359
    return ( t ) ;
1360
}
1361
 
1362
 
1363
/*
1364
    FIND THE NUMBER OF ITEMS IN AN INITIALISER EXPRESSION
1365
 
1366
    This routine returns the number of initialisers in the expression e
1367
    counting each array element separately.
1368
*/
1369
 
1370
EXP sizeof_init
1371
    PROTO_N ( ( e, s ) )
1372
    PROTO_T ( EXP e X TYPE s )
1373
{
1374
    EXP a = NULL_exp ;
1375
    unsigned long v = 0 ;
1376
    if ( !IS_NULL_exp ( e ) ) {
1377
	LIST ( EXP ) p, q ;
1378
	if ( IS_exp_comma ( e ) ) {
1379
	    p = DEREF_list ( exp_comma_args ( e ) ) ;
1380
	    p = END_list ( p ) ;
1381
	    e = DEREF_exp ( HEAD_list ( p ) ) ;
1382
	}
1383
	if ( IS_exp_initialiser ( e ) ) {
1384
	    p = DEREF_list ( exp_initialiser_args ( e ) ) ;
1385
	    q = NULL_list ( EXP ) ;
1386
	} else {
1387
	    CONS_exp ( e, NULL_list ( EXP ), p ) ;
1388
	    q = p ;
1389
	}
1390
	while ( !IS_NULL_list ( p ) ) {
1391
	    EXP b = DEREF_exp ( HEAD_list ( p ) ) ;
1392
	    if ( !IS_NULL_exp ( b ) ) {
1393
		TYPE t = DEREF_type ( exp_type ( b ) ) ;
1394
		if ( IS_type_array ( t ) ) {
1395
		    /* Multiply up array bounds */
1396
		    EXP c = sizeof_array ( &t, s ) ;
1397
		    a = make_dim_exp ( lex_plus, a, c ) ;
1398
		} else {
1399
		    /* Other types count once */
1400
		    v++ ;
1401
		}
1402
	    }
1403
	    p = TAIL_list ( p ) ;
1404
	}
1405
	if ( !IS_NULL_list ( q ) ) DESTROY_list ( q, SIZE_exp ) ;
1406
    }
1407
    if ( IS_NULL_exp ( a ) ) {
1408
	NAT n = make_nat_value ( v ) ;
1409
	a = calc_nat_value ( n, s ) ;
1410
    } else {
1411
	if ( v ) {
1412
	    NAT n = make_nat_value ( v ) ;
1413
	    EXP c = calc_nat_value ( n, s ) ;
1414
	    a = make_dim_exp ( lex_plus, a, c ) ;
1415
	}
1416
    }
1417
    return ( a ) ;
1418
}