Warning: Attempt to read property "date" on null in /usr/local/www/websvn.planix.org/blame.php on line 247

Warning: Attempt to read property "msg" on null in /usr/local/www/websvn.planix.org/blame.php on line 247
WebSVN – tendra.SVN – Blame – /branches/tendra5/src/producers/common/construct/token.c – Rev 2

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 <limits.h>
33
#include "c_types.h"
34
#include "ctype_ops.h"
35
#include "etype_ops.h"
36
#include "exp_ops.h"
37
#include "ftype_ops.h"
38
#include "hashid_ops.h"
39
#include "id_ops.h"
40
#include "itype_ops.h"
41
#include "nat_ops.h"
42
#include "nspace_ops.h"
43
#include "member_ops.h"
44
#include "off_ops.h"
45
#include "tok_ops.h"
46
#include "type_ops.h"
47
#include "error.h"
48
#include "catalog.h"
49
#include "option.h"
50
#include "access.h"
51
#include "basetype.h"
52
#include "check.h"
53
#include "chktype.h"
54
#include "class.h"
55
#include "constant.h"
56
#include "convert.h"
57
#include "copy.h"
58
#include "declare.h"
59
#include "dump.h"
60
#include "exception.h"
61
#include "expression.h"
62
#include "function.h"
63
#include "hash.h"
64
#include "identifier.h"
65
#include "initialise.h"
66
#include "instance.h"
67
#include "inttype.h"
68
#include "lex.h"
69
#include "macro.h"
70
#include "namespace.h"
71
#include "parse.h"
72
#include "predict.h"
73
#include "preproc.h"
74
#include "redeclare.h"
75
#include "statement.h"
76
#include "syntax.h"
77
#include "template.h"
78
#include "tok.h"
79
#include "tokdef.h"
80
#include "token.h"
81
 
82
 
83
/*
84
    FIND A TYPE TOKEN KEY
85
 
86
    This routine returns the keyword associated with a type token of
87
    kind bt.
88
*/
89
 
90
int type_token_key
91
    PROTO_N ( ( bt ) )
92
    PROTO_T ( BASE_TYPE bt )
93
{
94
    int key = lex_type_Hcap ;
95
    if ( bt & btype_float ) {
96
	if ( bt & btype_star ) {
97
	    key = lex_scalar_Hcap ;
98
	} else if ( bt & btype_int ) {
99
	    key = lex_arith_Hcap ;
100
	} else {
101
	    key = lex_float_Hcap ;
102
	}
103
    } else if ( bt & btype_int ) {
104
	if ( bt & btype_signed ) {
105
	    key = lex_signed ;
106
	} else if ( bt & btype_unsigned ) {
107
	    key = lex_unsigned ;
108
	} else {
109
	    key = lex_variety_Hcap ;
110
	}
111
    } else if ( bt == btype_class ) {
112
	key = lex_class_Hcap ;
113
    } else if ( bt == btype_struct ) {
114
	key = lex_struct_Hcap ;
115
    } else if ( bt == btype_union ) {
116
	key = lex_union_Hcap ;
117
    }
118
    return ( key ) ;
119
}
120
 
121
 
122
/*
123
    CREATE A TYPE TOKEN
124
 
125
    This routine creates a type token of kind bt.
126
*/
127
 
128
TOKEN make_type_token
129
    PROTO_N ( ( bt ) )
130
    PROTO_T ( BASE_TYPE bt )
131
{
132
    TOKEN tok ;
133
    MAKE_tok_type ( bt, NULL_type, tok ) ;
134
    return ( tok ) ;
135
}
136
 
137
 
138
/*
139
    CREATE AN EXPRESSION TOKEN
140
 
141
    This routine creates an expression token of type t.
142
*/
143
 
144
TOKEN make_exp_token
145
    PROTO_N ( ( t, lv, c ) )
146
    PROTO_T ( TYPE t X int lv X int c )
147
{
148
    TOKEN tok ;
149
    if ( lv ) {
150
	t = lvalue_type ( t ) ;
151
    } else {
152
	t = rvalue_type ( t ) ;
153
    }
154
    object_type ( t, id_token_tag ) ;
155
    MAKE_tok_exp ( t, c, NULL_exp, tok ) ;
156
    return ( tok ) ;
157
}
158
 
159
 
160
/*
161
    CREATE A FUNCTION TOKEN
162
 
163
    This routine creates a function token of type t.
164
*/
165
 
166
TOKEN make_func_token
167
    PROTO_N ( ( t ) )
168
    PROTO_T ( TYPE t )
169
{
170
    int ell ;
171
    TOKEN tok ;
172
    if ( !IS_type_func ( t ) ) {
173
	report ( preproc_loc, ERR_token_func ( t ) ) ;
174
	tok = make_exp_token ( t, 0, 0 ) ;
175
	return ( tok ) ;
176
    }
177
    ell = DEREF_int ( type_func_ellipsis ( t ) ) ;
178
    if ( ell & FUNC_NO_PARAMS ) {
179
	/* Map 't ()' to 't ( void )' */
180
	COPY_int ( type_func_ellipsis ( t ), FUNC_NONE ) ;
181
    }
182
    MAKE_tok_func ( t, tok ) ;
183
    return ( tok ) ;
184
}
185
 
186
 
187
/*
188
    CREATE A MEMBER SELECTOR TOKEN
189
 
190
    This routine creates a member selector token for a member of s of
191
    type t.  acc gives the member access.
192
*/
193
 
194
TOKEN make_member_token
195
    PROTO_N ( ( t, s, acc ) )
196
    PROTO_T ( TYPE t X TYPE s X DECL_SPEC acc )
197
{
198
    TOKEN tok ;
199
    if ( !IS_type_compound ( s ) ) {
200
	report ( preproc_loc, ERR_token_mem ( s ) ) ;
201
	tok = make_exp_token ( t, 0, 0 ) ;
202
	return ( tok ) ;
203
    }
204
#if LANGUAGE_CPP
205
    crt_access = acc ;
206
#else
207
    UNUSED ( acc ) ;
208
#endif
209
    MAKE_tok_member ( s, t, NULL_off, tok ) ;
210
    return ( tok ) ;
211
}
212
 
213
 
214
/*
215
    CHECK A TOKEN PARAMETER OR RESULT SORT
216
 
217
    Procedure tokens which take or return other procedure tokens are not
218
    allowed.  This routine checks the parameter token sort tok.
219
*/
220
 
221
static TOKEN check_param_sort
222
    PROTO_N ( ( tok ) )
223
    PROTO_T ( TOKEN tok )
224
{
225
    if ( !IS_NULL_tok ( tok ) ) {
226
	if ( IS_tok_func ( tok ) ) {
227
	    tok = func_proc_token ( tok ) ;
228
	}
229
	if ( IS_tok_proc ( tok ) ) {
230
	    report ( preproc_loc, ERR_token_proc_high () ) ;
231
	    tok = DEREF_tok ( tok_proc_res ( tok ) ) ;
232
	}
233
    }
234
    return ( tok ) ;
235
}
236
 
237
 
238
/*
239
    BEGIN THE DEFINITION OF A PROCEDURE TOKEN
240
 
241
    This routine begins the construction of a procedure token.
242
*/
243
 
244
TOKEN begin_proc_token
245
    PROTO_Z ()
246
{
247
    TOKEN tok ;
248
    begin_param ( NULL_id ) ;
249
    MAKE_tok_proc ( NULL_tok, crt_namespace, lex_identifier, tok ) ;
250
    return ( tok ) ;
251
}
252
 
253
 
254
/*
255
    SET THE PARAMETER NUMBERS FOR A PROCEDURE TOKEN
256
 
257
    This routine sets the token numbers for the list of procedure token
258
    parameters p.
259
*/
260
 
261
void set_proc_token
262
    PROTO_N ( ( p ) )
263
    PROTO_T ( LIST ( IDENTIFIER ) p )
264
{
265
    ulong n = 0 ;
266
    while ( !IS_NULL_list ( p ) ) {
267
	IDENTIFIER pid = DEREF_id ( HEAD_list ( p ) ) ;
268
	if ( !IS_NULL_id ( pid ) ) {
269
	    COPY_ulong ( id_no ( pid ), n ) ;
270
	}
271
	n++ ;
272
	p = TAIL_list ( p ) ;
273
    }
274
    return ;
275
}
276
 
277
 
278
/*
279
    CONTINUE THE DEFINITION OF A PROCEDURE TOKEN
280
 
281
    This routine continues the definition of the procedure token prev
282
    by adding the lists of bound and program parameters, p and q.
283
*/
284
 
285
TOKEN cont_proc_token
286
    PROTO_N ( ( prev, p, q ) )
287
    PROTO_T ( TOKEN prev X LIST ( IDENTIFIER ) p X LIST ( IDENTIFIER ) q )
288
{
289
    if ( !IS_NULL_tok ( prev ) ) {
290
	unsigned n ;
291
	if ( !EQ_list ( p, q ) ) {
292
	    int eq = 1 ;
293
	    LIST ( IDENTIFIER ) ps = p ;
294
	    LIST ( IDENTIFIER ) qs = q ;
295
	    while ( !IS_NULL_list ( ps ) && !IS_NULL_list ( qs ) ) {
296
		IDENTIFIER ip = DEREF_id ( HEAD_list ( ps ) ) ;
297
		IDENTIFIER iq = DEREF_id ( HEAD_list ( qs ) ) ;
298
		if ( !EQ_id ( ip, iq ) ) {
299
		    eq = 0 ;
300
		    break ;
301
		}
302
		ps = TAIL_list ( ps ) ;
303
		qs = TAIL_list ( qs ) ;
304
	    }
305
	    if ( eq && EQ_list ( ps, qs ) ) {
306
		/* Parameter lists match */
307
		DESTROY_list ( q, SIZE_id ) ;
308
		q = p ;
309
	    } else {
310
		set_proc_token ( q ) ;
311
	    }
312
	}
313
	set_proc_token ( p ) ;
314
	COPY_list ( tok_proc_bids ( prev ), p ) ;
315
	COPY_list ( tok_proc_pids ( prev ), q ) ;
316
	n = LENGTH_list ( q ) ;
317
	IGNORE check_value ( OPT_VAL_macro_pars, ( ulong ) n ) ;
318
    }
319
    return ( prev ) ;
320
}
321
 
322
 
323
/*
324
    COMPLETE THE DEFINITION OF A PROCEDURE TOKEN
325
 
326
    This routine completes the definition of the procedure token prev by
327
    filling in the token result sort res.
328
*/
329
 
330
TOKEN end_proc_token
331
    PROTO_N ( ( prev, res ) )
332
    PROTO_T ( TOKEN prev X TOKEN res )
333
{
334
    res = check_param_sort ( res ) ;
335
    if ( !IS_NULL_tok ( prev ) ) {
336
	COPY_tok ( tok_proc_res ( prev ), res ) ;
337
    }
338
    end_param () ;
339
    return ( prev ) ;
340
}
341
 
342
 
343
/*
344
    CREATE A TOKEN PARAMETER
345
 
346
    This routine declares a token bound parameter of sort tok with name
347
    id, which belongs to the tag namespace if tag is true.
348
*/
349
 
350
IDENTIFIER make_tok_param
351
    PROTO_N ( ( tok, tag, id ) )
352
    PROTO_T ( TOKEN tok X int tag X IDENTIFIER id )
353
{
354
    if ( IS_NULL_id ( id ) ) {
355
	HASHID nm = lookup_anon () ;
356
	id = DEREF_id ( hashid_id ( nm ) ) ;
357
    }
358
    tok = check_param_sort ( tok ) ;
359
    id = make_token_decl ( tok, tag, id, NULL_id ) ;
360
    if ( do_dump ) dump_token_param ( id ) ;
361
    return ( id ) ;
362
}
363
 
364
 
365
/*
366
    FIND A TOKEN MEMBER
367
 
368
    This routine looks up a member id of the class type t.  If the member
369
    is not found or t is not a class type then an error message is printed
370
    and the null identifier is returned.
371
*/
372
 
373
IDENTIFIER tok_member
374
    PROTO_N ( ( id, t, force ) )
375
    PROTO_T ( IDENTIFIER id X TYPE t X int force )
376
{
377
    if ( IS_type_compound ( t ) ) {
378
	HASHID nm = DEREF_hashid ( id_name ( id ) ) ;
379
	CLASS_TYPE ct = DEREF_ctype ( type_compound_defn ( t ) ) ;
380
	NAMESPACE ns = DEREF_nspace ( ctype_member ( ct ) ) ;
381
	IDENTIFIER fid = search_id ( ns, nm, 0, 0 ) ;
382
	if ( IS_NULL_id ( fid ) ) {
383
	    /* Member not declared */
384
	    if ( force ) {
385
		/* Report error */
386
		report ( preproc_loc, ERR_lookup_qual_bad ( id, ns ) ) ;
387
	    } else {
388
		/* Create token member */
389
		TOKEN tok ;
390
		HASHID fnm = lookup_anon () ;
391
		fid = DEREF_id ( hashid_id ( fnm ) ) ;
392
		MAKE_tok_member ( t, type_error, NULL_off, tok ) ;
393
		fid = make_token_decl ( tok, 0, id, fid ) ;
394
		fid = DEREF_id ( id_token_alt ( fid ) ) ;
395
	    }
396
	}
397
	return ( fid ) ;
398
    }
399
    report ( preproc_loc, ERR_token_mem ( t ) ) ;
400
    return ( NULL_id ) ;
401
}
402
 
403
 
404
/*
405
    CREATE A TOKEN PROGRAM PARAMETER
406
 
407
    This routine declares a token program parameter named id.  tt gives
408
    the associated token sort, while t gives the structure type if this
409
    denotes a member token or the parameter type if this denotes a type
410
    token.
411
*/
412
 
413
IDENTIFIER prog_tok_param
414
    PROTO_N ( ( id, t, tt, p ) )
415
    PROTO_T ( IDENTIFIER id X TYPE t X unsigned tt X LIST ( IDENTIFIER ) p )
416
{
417
    /* Look up member identifier */
418
    IDENTIFIER tid = id ;
419
    if ( tt == tok_member_tag ) {
420
	tid = tok_member ( tid, t, 1 ) ;
421
	if ( IS_NULL_id ( tid ) ) return ( NULL_id ) ;
422
    }
423
 
424
    /* Check through tokens */
425
    while ( !IS_NULL_list ( p ) ) {
426
	IDENTIFIER pid = DEREF_id ( HEAD_list ( p ) ) ;
427
	if ( !IS_NULL_id ( pid ) && IS_id_token ( pid ) ) {
428
	    IDENTIFIER qid = DEREF_id ( id_token_alt ( pid ) ) ;
429
	    if ( EQ_id ( qid, tid ) ) {
430
		/* Matching token found */
431
		TOKEN tok = DEREF_tok ( id_token_sort ( pid ) ) ;
432
		unsigned pt = TAG_tok ( tok ) ;
433
		switch ( pt ) {
434
		    case tok_nat_tag :
435
		    case tok_snat_tag : {
436
			pt = tok_exp_tag ;
437
			break ;
438
		    }
439
		    case tok_templ_tag :
440
		    case tok_func_tag : {
441
			pt = tok_proc_tag ;
442
			break ;
443
		    }
444
		}
445
		if ( pt != tt ) {
446
		    /* Wrong sort given for token parameter */
447
		    report ( preproc_loc, ERR_token_arg_sort ( pid ) ) ;
448
		}
449
		return ( pid ) ;
450
	    }
451
	}
452
	p = TAIL_list ( p ) ;
453
    }
454
 
455
    /* Allow for complex type parameters */
456
    if ( tt == tok_type_tag ) {
457
	HASHID nm = lookup_anon () ;
458
	int tq = crt_templ_qualifier ;
459
	QUALIFIER cq = crt_id_qualifier ;
460
	crt_id_qualifier = qual_none ;
461
	crt_templ_qualifier = 0 ;
462
	tid = DEREF_id ( hashid_id ( nm ) ) ;
463
	tid = make_object_decl ( dspec_typedef, t, tid, 0 ) ;
464
	crt_templ_qualifier = tq ;
465
	crt_id_qualifier = cq ;
466
	return ( tid ) ;
467
    }
468
    report ( preproc_loc, ERR_token_arg_bad ( tid ) ) ;
469
    return ( NULL_id ) ;
470
}
471
 
472
 
473
/*
474
    FIND AN UNDERLYING PROCEDURE TOKEN
475
 
476
    This routine returns the procedure token underlying the function
477
    token tok, creating this if necessary.
478
*/
479
 
480
TOKEN func_proc_token
481
    PROTO_N ( ( tok ) )
482
    PROTO_T ( TOKEN tok )
483
{
484
    TOKEN res ;
485
    if ( !IS_tok_func ( tok ) ) return ( tok ) ;
486
    res = DEREF_tok ( tok_func_proc ( tok ) ) ;
487
    if ( IS_NULL_tok ( res ) ) {
488
	TYPE t = DEREF_type ( tok_func_type ( tok ) ) ;
489
	int ell = DEREF_int ( type_func_ellipsis ( t ) ) ;
490
	if ( ell & FUNC_ELLIPSIS ) {
491
	    res = tok ;
492
	} else {
493
	    TOKEN rtok ;
494
	    IDENTIFIER pid ;
495
	    EXP e = NULL_exp ;
496
	    LIST ( IDENTIFIER ) qids ;
497
	    IDENTIFIER fn = DEREF_id ( tok_func_defn ( tok ) ) ;
498
	    TYPE r = DEREF_type ( type_func_ret ( t ) ) ;
499
	    LIST ( TYPE ) p = DEREF_list ( type_func_mtypes ( t ) ) ;
500
	    LIST ( IDENTIFIER ) pids = NULL_list ( IDENTIFIER ) ;
501
	    res = begin_proc_token () ;
502
	    while ( !IS_NULL_list ( p ) ) {
503
		/* Normal function parameters */
504
		TYPE s = DEREF_type ( HEAD_list ( p ) ) ;
505
		if ( pass_complex_type ( s ) ) {
506
		    MAKE_type_ptr ( cv_none, s, s ) ;
507
		}
508
		MAKE_tok_exp ( s, 0, NULL_exp, rtok ) ;
509
		pid = make_tok_param ( rtok, 0, NULL_id ) ;
510
		CONS_id ( pid, pids, pids ) ;
511
		p = TAIL_list ( p ) ;
512
	    }
513
	    /* Extra constructor parameters ... */
514
	    pids = REVERSE_list ( pids ) ;
515
	    qids = pids ;
516
	    if ( pass_complex_type ( r ) ) {
517
		/* Complex function return */
518
		TYPE s ;
519
		MAKE_type_ptr ( cv_none, r, s ) ;
520
		MAKE_tok_exp ( s, 0, NULL_exp, rtok ) ;
521
		pid = make_tok_param ( rtok, 0, NULL_id ) ;
522
		CONS_id ( pid, pids, pids ) ;
523
		r = type_void ;
524
	    }
525
	    res = cont_proc_token ( res, pids, qids ) ;
526
	    if ( !IS_NULL_id ( fn ) ) {
527
		/* Token already defined */
528
		MAKE_exp_value ( t, e ) ;
529
	    }
530
	    MAKE_tok_exp ( r, 0, e, rtok ) ;
531
	    res = end_proc_token ( res, rtok ) ;
532
	}
533
	COPY_tok ( tok_func_proc ( tok ), res ) ;
534
    }
535
    return ( res ) ;
536
}
537
 
538
 
539
/*
540
    EXPAND A TOKEN VALUE
541
 
542
    This routine expands the token value tok. If force is true then a copy
543
    is always made.
544
*/
545
 
546
TOKEN expand_sort
547
    PROTO_N ( ( tok, rec, force ) )
548
    PROTO_T ( TOKEN tok X int rec X int force )
549
{
550
    if ( !IS_NULL_tok ( tok ) ) {
551
	unsigned tag = TAG_tok ( tok ) ;
552
	switch ( tag ) {
553
	    case tok_exp_tag : {
554
		/* Expression tokens */
555
		EXP a1 = DEREF_exp ( tok_exp_value ( tok ) ) ;
556
		EXP a2 = expand_exp ( a1, rec, 0 ) ;
557
		if ( force || !eq_exp_exact ( a1, a2 ) ) {
558
		    int c = DEREF_int ( tok_exp_constant ( tok ) ) ;
559
		    TYPE t = DEREF_type ( tok_exp_type ( tok ) ) ;
560
		    t = expand_type ( t, rec ) ;
561
		    MAKE_tok_exp ( t, c, a2, tok ) ;
562
		}
563
		break ;
564
	    }
565
	    case tok_nat_tag :
566
	    case tok_snat_tag : {
567
		/* Integral constant tokens */
568
		ERROR err = NULL_err ;
569
		NAT n1 = DEREF_nat ( tok_nat_etc_value ( tok ) ) ;
570
		NAT n2 = expand_nat ( n1, rec, 0, &err ) ;
571
		if ( !IS_NULL_err ( err ) ) report ( crt_loc, err ) ;
572
		if ( force || !EQ_nat ( n1, n2 ) ) {
573
		    MAKE_tok_nat_etc ( tag, n2, tok ) ;
574
		}
575
		break ;
576
	    }
577
	    case tok_stmt_tag : {
578
		/* Statement tokens */
579
		EXP a1 = DEREF_exp ( tok_stmt_value ( tok ) ) ;
580
		EXP a2 = expand_exp ( a1, rec, 1 ) ;
581
		if ( force || !eq_exp_exact ( a1, a2 ) ) {
582
		    EXP b = get_parent_stmt ( a1 ) ;
583
		    set_parent_stmt ( a2, b ) ;
584
		    MAKE_tok_stmt ( a2, tok ) ;
585
		}
586
		break ;
587
	    }
588
	    case tok_member_tag : {
589
		/* Member tokens */
590
		OFFSET a1 = DEREF_off ( tok_member_value ( tok ) ) ;
591
		OFFSET a2 = expand_offset ( a1, rec ) ;
592
		if ( force || !EQ_off ( a1, a2 ) ) {
593
		    TYPE s = DEREF_type ( tok_member_of ( tok ) ) ;
594
		    TYPE t = DEREF_type ( tok_member_type ( tok ) ) ;
595
		    s = expand_type ( s, rec ) ;
596
		    t = expand_type ( t, rec ) ;
597
		    MAKE_tok_member ( s, t, a2, tok ) ;
598
		}
599
		break ;
600
	    }
601
	    case tok_type_tag : {
602
		/* Type tokens */
603
		TYPE t1 = DEREF_type ( tok_type_value ( tok ) ) ;
604
		TYPE t2 = expand_type ( t1, rec ) ;
605
		if ( force || !EQ_type ( t1, t2 ) ) {
606
		    BASE_TYPE bs = DEREF_btype ( tok_type_kind ( tok ) ) ;
607
		    MAKE_tok_type ( bs, t2, tok ) ;
608
		}
609
		break ;
610
	    }
611
	    case tok_class_tag : {
612
		/* Template class tokens */
613
		IDENTIFIER cid = DEREF_id ( tok_class_value ( tok ) ) ;
614
		/* NOT YET IMPLEMENTED */
615
		if ( force ) {
616
		    TYPE s = DEREF_type ( tok_class_type ( tok ) ) ;
617
		    TYPE t = DEREF_type ( tok_class_alt ( tok ) ) ;
618
		    MAKE_tok_class ( s, cid, tok ) ;
619
		    COPY_type ( tok_class_alt ( tok ), t ) ;
620
		}
621
		break ;
622
	    }
623
	    case tok_templ_tag : {
624
		/* Template tokens */
625
		if ( force ) {
626
		    int d ;
627
		    LIST ( IDENTIFIER ) pids ;
628
		    LIST ( IDENTIFIER ) rids ;
629
		    LIST ( IDENTIFIER ) qids = NULL_list ( IDENTIFIER ) ;
630
		    DECL_SPEC ds = DEREF_dspec ( tok_templ_usage ( tok ) ) ;
631
		    NAMESPACE ns = DEREF_nspace ( tok_templ_pars ( tok ) ) ;
632
		    pids = DEREF_list ( tok_templ_pids ( tok ) ) ;
633
		    rids = pids ;
634
		    d = save_token_args ( rids, NULL_list ( TOKEN ) ) ;
635
		    while ( !IS_NULL_list ( pids ) ) {
636
			/* Copy template parameters */
637
			TOKEN arg ;
638
			IDENTIFIER qid2 ;
639
			IDENTIFIER pid = DEREF_id ( HEAD_list ( pids ) ) ;
640
			IDENTIFIER pid2 = DEREF_id ( id_token_alt ( pid ) ) ;
641
			IDENTIFIER qid = copy_id ( pid, 2 ) ;
642
			DECL_SPEC qds = DEREF_dspec ( id_storage ( qid ) ) ;
643
			qds |= dspec_pure ;
644
			COPY_dspec ( id_storage ( qid ), qds ) ;
645
			arg = apply_token ( qid, NULL_list ( TOKEN ) ) ;
646
			assign_token ( pid, arg ) ;
647
			qid2 = copy_id ( pid2, 2 ) ;
648
			COPY_id ( id_token_alt ( qid ), qid2 ) ;
649
			CONS_id ( qid, qids, qids ) ;
650
			pids = TAIL_list ( pids ) ;
651
		    }
652
		    restore_token_args ( rids, d ) ;
653
		    MAKE_tok_templ ( ds, ns, tok ) ;
654
		    qids = REVERSE_list ( qids ) ;
655
		    COPY_list ( tok_templ_pids ( tok ), qids ) ;
656
		    set_proc_token ( qids ) ;
657
		}
658
		break ;
659
	    }
660
	}
661
    }
662
    return ( tok ) ;
663
}
664
 
665
 
666
/*
667
    EXPAND A LIST OF TOKEN ARGUMENTS
668
 
669
    This routine expands the list of token arguments p passing the parameter
670
    rec to the individual expansion routines.  The null list is returned to
671
    indicate that the expansion has no effect.
672
*/
673
 
674
LIST ( TOKEN ) expand_args
675
    PROTO_N ( ( p, rec, force ) )
676
    PROTO_T ( LIST ( TOKEN ) p X int rec X int force )
677
{
678
    int changed = 0 ;
679
    LIST ( TOKEN ) q = NULL_list ( TOKEN ) ;
680
    while ( !IS_NULL_list ( p ) ) {
681
	TOKEN a = DEREF_tok ( HEAD_list ( p ) ) ;
682
	TOKEN b = expand_sort ( a, rec, force ) ;
683
	if ( !EQ_tok ( a, b ) ) changed = 1 ;
684
	CONS_tok ( b, q, q ) ;
685
	p = TAIL_list ( p ) ;
686
    }
687
    if ( !changed ) {
688
	/* No effect */
689
	DESTROY_list ( q, SIZE_tok ) ;
690
	return ( NULL_list ( TOKEN ) ) ;
691
    }
692
    q = REVERSE_list ( q ) ;
693
    return ( q ) ;
694
}
695
 
696
 
697
/*
698
    EXPAND A TEMPLATE SORT
699
 
700
    This routine copies the given template sort producing a new sort
701
    comprising only those parameters which are unbound.  If all the
702
    parameters are bound then the null sort is returned.
703
*/
704
 
705
TOKEN expand_templ_sort
706
    PROTO_N ( ( sort, rec ) )
707
    PROTO_T ( TOKEN sort X int rec )
708
{
709
    NAMESPACE ns ;
710
    int changed = 0 ;
711
    int all_unbound = 1 ;
712
    LIST ( TOKEN ) dargs = NULL_list ( TOKEN ) ;
713
    DECL_SPEC ex = DEREF_dspec ( tok_templ_usage ( sort ) ) ;
714
    LIST ( IDENTIFIER ) p = DEREF_list ( tok_templ_pids ( sort ) ) ;
715
    LIST ( IDENTIFIER ) q = NULL_list ( IDENTIFIER ) ;
716
    LIST ( IDENTIFIER ) p0 = p ;
717
    while ( !IS_NULL_list ( p ) ) {
718
	IDENTIFIER pid = DEREF_id ( HEAD_list ( p ) ) ;
719
	if ( !IS_NULL_id ( pid ) && IS_id_token ( pid ) ) {
720
	    TOKEN tok = DEREF_tok ( id_token_sort ( pid ) ) ;
721
	    if ( is_bound_tok ( tok, 0 ) ) {
722
		/* Have bound parameter */
723
		all_unbound = 0 ;
724
		changed = 1 ;
725
	    } else {
726
		/* Add unbound parameter to list */
727
		/* NOT YET IMPLEMENTED */
728
		CONS_id ( pid, q, q ) ;
729
	    }
730
	}
731
	p = TAIL_list ( p ) ;
732
    }
733
    if ( IS_NULL_list ( q ) ) {
734
	/* All parameters are bound */
735
	return ( NULL_tok ) ;
736
    }
737
    if ( changed ) {
738
	/* Get unbound parameters into order */
739
	q = REVERSE_list ( q ) ;
740
    } else {
741
	/* Use existing list */
742
	DESTROY_list ( q, SIZE_id ) ;
743
	q = p0 ;
744
    }
745
    if ( all_unbound ) {
746
	/* Preserve instances and default arguments */
747
	LIST ( TOKEN ) d ;
748
	dargs = DEREF_list ( tok_templ_dargs ( sort ) ) ;
749
	d = expand_args ( dargs, rec, 0 ) ;
750
	if ( !IS_NULL_list ( d ) ) dargs = d ;
751
    }
752
    ns = DEREF_nspace ( tok_templ_pars ( sort ) ) ;
753
    MAKE_tok_templ ( ex, ns, sort ) ;
754
    COPY_list ( tok_templ_pids ( sort ), q ) ;
755
    COPY_list ( tok_templ_dargs ( sort ), dargs ) ;
756
    return ( sort ) ;
757
}
758
 
759
 
760
/*
761
    RESTORE A TEMPLATE SORT
762
 
763
    This routine is called at the end of the expansion of a template
764
    type to restore the sort produced by expand_templ_sort.
765
*/
766
 
767
void reset_templ_sort
768
    PROTO_N ( ( sort ) )
769
    PROTO_T ( TOKEN sort )
770
{
771
    UNUSED ( sort ) ;
772
    return ;
773
}
774
 
775
 
776
/*
777
    EXPAND AN EXPRESSION TOKEN
778
 
779
    This routine expands any token definitions in the expression e.
780
    rec gives the level of expansion, 0 for just the top level, 1 for a
781
    complete recursive expansion, and 2 for a recursive expansion of
782
    token parameters only.  Negative values just return e.
783
*/
784
 
785
EXP expand_exp
786
    PROTO_N ( ( e, rec, stmt ) )
787
    PROTO_T ( EXP e X int rec X int stmt )
788
{
789
    unsigned etag ;
790
    if ( rec < 0 ) return ( e ) ;
791
    if ( IS_NULL_exp ( e ) ) return ( NULL_exp ) ;
792
    etag = TAG_exp ( e ) ;
793
    if ( etag == exp_token_tag ) {
794
	/* Tokenised values */
795
	TOKEN tok ;
796
	DECL_SPEC ds ;
797
	unsigned tag ;
798
	IDENTIFIER id = DEREF_id ( exp_token_tok ( e ) ) ;
799
	IDENTIFIER aid = DEREF_id ( id_alias ( id ) ) ;
800
	LIST ( TOKEN ) p = DEREF_list ( exp_token_args ( e ) ) ;
801
	if ( !EQ_id ( id, aid ) ) {
802
	    /* Replace token by its alias */
803
	    e = apply_exp_token ( aid, p, 1 ) ;
804
	    id = aid ;
805
	}
806
	ds = DEREF_dspec ( id_storage ( id ) ) ;
807
	tok = DEREF_tok ( id_token_sort ( id ) ) ;
808
	tag = TAG_tok ( tok ) ;
809
	if ( tag == tok_proc_tag ) {
810
	    tok = DEREF_tok ( tok_proc_res ( tok ) ) ;
811
	    tag = TAG_tok ( tok ) ;
812
	}
813
	if ( rec ) {
814
	    /* Expand token arguments */
815
	    p = expand_args ( p, rec, 1 ) ;
816
	    e = apply_exp_token ( id, p, rec ) ;
817
	}
818
	/* if ( rec == 2 && !( ds & dspec_auto ) ) break ; */
819
	if ( ds & dspec_temp ) {
820
	    /* Check for recursive token expansions */
821
	    report ( crt_loc, ERR_token_recursive ( id ) ) ;
822
	    return ( make_error_exp ( 0 ) ) ;
823
	}
824
	COPY_dspec ( id_storage ( id ), ( ds | dspec_temp ) ) ;
825
	if ( tag == tok_exp_tag ) {
826
	    EXP a = DEREF_exp ( tok_exp_value ( tok ) ) ;
827
	    if ( !IS_NULL_exp ( a ) ) {
828
		/* Expand token definition */
829
		e = expand_exp ( a, rec, 0 ) ;
830
		if ( ds & dspec_auto ) {
831
		    COPY_exp ( tok_exp_value ( tok ), e ) ;
832
		}
833
	    }
834
	} else if ( tag == tok_stmt_tag ) {
835
	    EXP a = DEREF_exp ( tok_stmt_value ( tok ) ) ;
836
	    if ( !IS_NULL_exp ( a ) ) {
837
		/* Expand token definition */
838
		EXP b = get_parent_stmt ( a ) ;
839
		e = expand_exp ( a, rec, 1 ) ;
840
		set_parent_stmt ( e, b ) ;
841
		if ( ds & dspec_auto ) {
842
		    COPY_exp ( tok_stmt_value ( tok ), e ) ;
843
		}
844
	    }
845
	}
846
	COPY_dspec ( id_storage ( id ), ds ) ;
847
 
848
    } else if ( etag == exp_int_lit_tag ) {
849
	/* Integer constants */
850
	ERROR err = NULL_err ;
851
	NAT n1 = DEREF_nat ( exp_int_lit_nat ( e ) ) ;
852
	NAT n2 = expand_nat ( n1, rec, 0, &err ) ;
853
	if ( rec || !EQ_nat ( n1, n2 ) ) {
854
	    TYPE t = DEREF_type ( exp_type ( e ) ) ;
855
	    unsigned tag = DEREF_unsigned ( exp_int_lit_etag ( e ) ) ;
856
	    MAKE_exp_int_lit ( t, n2, tag, e ) ;
857
	    if ( !IS_NULL_err ( err ) ) report ( crt_loc, err ) ;
858
	}
859
 
860
    } else {
861
	/* Other cases */
862
	if ( rec && !stmt ) e = copy_exp ( e, NULL_type, NULL_type ) ;
863
    }
864
    return ( e ) ;
865
}
866
 
867
 
868
/*
869
    EXPAND AN INTEGER CONSTANT TOKEN
870
 
871
    This routine expands any token definitions in the integer constant
872
    expression n.  rec is as above, ch is as in eval_exp.
873
*/
874
 
875
NAT expand_nat
876
    PROTO_N ( ( n, rec, ch, err ) )
877
    PROTO_T ( NAT n X int rec X int ch X ERROR *err )
878
{
879
    if ( rec < 0 ) return ( n ) ;
880
    if ( IS_NULL_nat ( n ) ) return ( NULL_nat ) ;
881
    switch ( TAG_nat ( n ) ) {
882
	case nat_calc_tag : {
883
	    /* Calculated values */
884
	    EXP e2 ;
885
	    EXP e1 = DEREF_exp ( nat_calc_value ( n ) ) ;
886
	    ulong tok = DEREF_ulong ( nat_calc_tok ( n ) ) ;
887
	    if ( rec ) {
888
		e2 = eval_exp ( e1, ch ) ;
889
	    } else {
890
		e2 = expand_exp ( e1, 0, 0 ) ;
891
	    }
892
	    e2 = convert_reference ( e2, REF_NORMAL ) ;
893
	    e2 = convert_lvalue ( e2 ) ;
894
	    if ( !EQ_exp ( e1, e2 ) && !eq_exp_exact ( e1, e2 ) ) {
895
		n = make_nat_exp ( e2, err ) ;
896
		if ( IS_nat_calc ( n ) ) {
897
		    COPY_ulong ( nat_calc_tok ( n ), tok ) ;
898
		}
899
	    }
900
	    break ;
901
	}
902
	case nat_token_tag : {
903
	    /* Tokenised values */
904
	    TOKEN tok ;
905
	    DECL_SPEC ds ;
906
	    unsigned tag ;
907
	    IDENTIFIER id = DEREF_id ( nat_token_tok ( n ) ) ;
908
	    IDENTIFIER aid = DEREF_id ( id_alias ( id ) ) ;
909
	    LIST ( TOKEN ) p = DEREF_list ( nat_token_args ( n ) ) ;
910
	    if ( !EQ_id ( id, aid ) ) {
911
		/* Replace token by its alias */
912
		n = apply_nat_token ( aid, p ) ;
913
		id = aid ;
914
	    }
915
	    ds = DEREF_dspec ( id_storage ( id ) ) ;
916
	    tok = DEREF_tok ( id_token_sort ( id ) ) ;
917
	    tag = TAG_tok ( tok ) ;
918
	    if ( tag == tok_proc_tag ) {
919
		if ( rec ) {
920
		    /* Expand token arguments */
921
		    p = expand_args ( p, rec, 0 ) ;
922
		    if ( !IS_NULL_list ( p ) ) {
923
			n = apply_nat_token ( id, p ) ;
924
		    }
925
		}
926
		tok = DEREF_tok ( tok_proc_res ( tok ) ) ;
927
		tag = TAG_tok ( tok ) ;
928
	    }
929
	    /* if ( rec == 2 && !( ds & dspec_auto ) ) break ; */
930
	    if ( ds & dspec_temp ) {
931
		/* Check for recursive token expansions */
932
		report ( crt_loc, ERR_token_recursive ( id ) ) ;
933
		return ( small_nat [1] ) ;
934
	    }
935
	    COPY_dspec ( id_storage ( id ), ( ds | dspec_temp ) ) ;
936
	    if ( tag == tok_nat_tag || tag == tok_snat_tag ) {
937
		NAT m = DEREF_nat ( tok_nat_etc_value ( tok ) ) ;
938
		if ( !IS_NULL_nat ( m ) ) {
939
		    /* Expand token definition */
940
		    n = expand_nat ( m, rec, ch, err ) ;
941
		    if ( ds & dspec_auto ) {
942
			COPY_nat ( tok_nat_etc_value ( tok ), n ) ;
943
		    }
944
		}
945
	    }
946
	    COPY_dspec ( id_storage ( id ), ds ) ;
947
	    break ;
948
	}
949
    }
950
    return ( n ) ;
951
}
952
 
953
 
954
/*
955
    EXPAND A MEMBER TOKEN
956
 
957
    This routine expands any token definitions in the offset off.  rec
958
    is as above.
959
*/
960
 
961
OFFSET expand_offset
962
    PROTO_N ( ( off, rec ) )
963
    PROTO_T ( OFFSET off X int rec )
964
{
965
    if ( rec > 0 ) off = copy_offset ( off, lex_plus ) ;
966
    return ( off ) ;
967
}
968
 
969
 
970
/*
971
    EXPAND A TEMPLATE TYPE
972
 
973
    This routine is a special case of expand_type which deals with
974
    template types.
975
*/
976
 
977
static TYPE expand_templ_type
978
    PROTO_N ( ( t, rec ) )
979
    PROTO_T ( TYPE t X int rec )
980
{
981
    CV_SPEC cv = DEREF_cv ( type_qual ( t ) ) ;
982
    TYPE s = DEREF_type ( type_templ_defn ( t ) ) ;
983
    TOKEN sort = DEREF_tok ( type_templ_sort ( t ) ) ;
984
    sort = expand_templ_sort ( sort, rec ) ;
985
    if ( IS_type_compound ( s ) ) {
986
	/* Template classes */
987
	s = copy_class ( s, dspec_instance ) ;
988
    } else {
989
	/* Other template types */
990
	s = expand_type ( s, rec ) ;
991
    }
992
    if ( IS_NULL_tok ( sort ) ) {
993
	/* No unbound parameters */
994
	t = qualify_type ( s, cv, 0 ) ;
995
    } else {
996
	/* Unbound parameters - result is a specialisation */
997
	MAKE_type_templ ( cv, sort, s, 1, t ) ;
998
    }
999
    reset_templ_sort ( sort ) ;
1000
    return ( t ) ;
1001
}
1002
 
1003
 
1004
/*
1005
    EXPAND A LIST OF EXCEPTION TYPES
1006
 
1007
    This routine expands the list of exception types p, setting changed to
1008
    true if any changes.
1009
*/
1010
 
1011
LIST ( TYPE ) expand_exceptions
1012
    PROTO_N ( ( p, rec, changed ) )
1013
    PROTO_T ( LIST ( TYPE ) p X int rec X int *changed )
1014
{
1015
    LIST ( TYPE ) q = NULL_list ( TYPE ) ;
1016
    if ( EQ_list ( p, univ_type_set ) ) {
1017
	q = p ;
1018
    } else if ( EQ_list ( p, empty_type_set ) ) {
1019
	q = p ;
1020
    } else {
1021
	while ( !IS_NULL_list ( p ) ) {
1022
	    TYPE s1 = DEREF_type ( HEAD_list ( p ) ) ;
1023
	    TYPE s2 = expand_type ( s1, rec ) ;
1024
	    if ( !EQ_type ( s1, s2 ) ) {
1025
		s2 = check_except_type ( s2, 0 ) ;
1026
		*changed = 1 ;
1027
	    }
1028
	    CONS_type ( s2, q, q ) ;
1029
	    p = TAIL_list ( p ) ;
1030
	}
1031
	q = REVERSE_list ( q ) ;
1032
    }
1033
    return ( q ) ;
1034
}
1035
 
1036
 
1037
/*
1038
    EXPAND A FUNCTION TYPE
1039
 
1040
    This routine is a special case of expand_type which deals with
1041
    function types.  rec will not be zero.
1042
*/
1043
 
1044
static TYPE expand_func_type
1045
    PROTO_N ( ( t, rec ) )
1046
    PROTO_T ( TYPE t X int rec )
1047
{
1048
    int mf = 0 ;
1049
    int expanded = 0 ;
1050
    TYPE r1 = DEREF_type ( type_func_ret ( t ) ) ;
1051
    TYPE r2 ;
1052
    LIST ( TYPE ) p1 = DEREF_list ( type_func_ptypes ( t ) ) ;
1053
    LIST ( TYPE ) p2 ;
1054
    LIST ( TYPE ) m1 = DEREF_list ( type_func_mtypes ( t ) ) ;
1055
    LIST ( TYPE ) m2 = NULL_list ( TYPE ) ;
1056
    LIST ( TYPE ) e1 = DEREF_list ( type_func_except ( t ) ) ;
1057
    LIST ( TYPE ) e2 ;
1058
    if ( !EQ_list ( p1, m1 ) ) {
1059
	if ( !IS_NULL_list ( m1 ) && EQ_list ( p1, TAIL_list ( m1 ) ) ) {
1060
	    /* Normal member function type */
1061
	    mf = 1 ;
1062
	} else {
1063
	    /* Swapped member function type */
1064
	    mf = -1 ;
1065
	    m1 = p1 ;
1066
	}
1067
    }
1068
 
1069
    /* Copy return type */
1070
    r2 = expand_type ( r1, rec ) ;
1071
    if ( !EQ_type ( r1, r2 ) ) expanded = 1 ;
1072
 
1073
    /* Copy parameter types */
1074
    while ( !IS_NULL_list ( m1 ) ) {
1075
	TYPE s1 = DEREF_type ( HEAD_list ( m1 ) ) ;
1076
	TYPE s2 = expand_type ( s1, rec ) ;
1077
	if ( !EQ_type ( s1, s2 ) ) expanded = 1 ;
1078
	CONS_type ( s2, m2, m2 ) ;
1079
	m1 = TAIL_list ( m1 ) ;
1080
    }
1081
    m2 = REVERSE_list ( m2 ) ;
1082
 
1083
    /* Copy exception types */
1084
    e2 = expand_exceptions ( e1, rec, &expanded ) ;
1085
 
1086
    /* Check for default arguments */
1087
    if ( !expanded ) {
1088
	LIST ( IDENTIFIER ) pids = DEREF_list ( type_func_pids ( t ) ) ;
1089
	while ( !IS_NULL_list ( pids ) ) {
1090
	    IDENTIFIER id = DEREF_id ( HEAD_list ( pids ) ) ;
1091
	    EXP e = DEREF_exp ( id_parameter_init ( id ) ) ;
1092
	    if ( !IS_NULL_exp ( e ) ) {
1093
		if ( depends_on_exp ( e, any_token_param, 0 ) ) {
1094
		    /* Needs expansion */
1095
		    expanded = 1 ;
1096
		    break ;
1097
		}
1098
	    }
1099
	    pids = TAIL_list ( pids ) ;
1100
	}
1101
    }
1102
 
1103
    /* Expand remaining items */
1104
    if ( expanded ) {
1105
	CV_SPEC cv = DEREF_cv ( type_qual ( t ) ) ;
1106
	CV_SPEC mq = DEREF_cv ( type_func_mqual ( t ) ) ;
1107
	int ell = DEREF_int ( type_func_ellipsis ( t ) ) ;
1108
	NAMESPACE pars = DEREF_nspace ( type_func_pars ( t ) ) ;
1109
	LIST ( IDENTIFIER ) pids = DEREF_list ( type_func_pids ( t ) ) ;
1110
	LIST ( IDENTIFIER ) qids = NULL_list ( IDENTIFIER ) ;
1111
 
1112
	/* Copy parameters */
1113
	while ( !IS_NULL_list ( pids ) ) {
1114
	    TYPE s ;
1115
	    IDENTIFIER id = DEREF_id ( HEAD_list ( pids ) ) ;
1116
	    IDENTIFIER lid = chase_alias ( id ) ;
1117
	    EXP e = DEREF_exp ( id_parameter_init ( id ) ) ;
1118
	    id = copy_id ( id, 2 ) ;
1119
	    COPY_id ( id_alias ( id ), lid ) ;
1120
	    s = DEREF_type ( id_parameter_type ( id ) ) ;
1121
	    check_par_decl ( s, id, CONTEXT_WEAK_PARAM ) ;
1122
	    if ( !IS_NULL_exp ( e ) ) {
1123
		/* Copy default argument */
1124
		EXP d ;
1125
		e = expand_exp ( e, rec, 0 ) ;
1126
		e = init_general ( s, e, id, 0 ) ;
1127
		d = destroy_general ( s, id ) ;
1128
		COPY_exp ( id_parameter_term ( id ), d ) ;
1129
		COPY_exp ( id_parameter_init ( id ), e ) ;
1130
	    }
1131
	    CONS_id ( id, qids, qids ) ;
1132
	    pids = TAIL_list ( pids ) ;
1133
	}
1134
	qids = REVERSE_list ( qids ) ;
1135
 
1136
	/* Form function type */
1137
	if ( mf == 0 ) {
1138
	    p2 = m2 ;
1139
	} else if ( mf == 1 ) {
1140
	    p2 = TAIL_list ( m2 ) ;
1141
	} else {
1142
	    p2 = m2 ;
1143
	    m2 = TAIL_list ( p2 ) ;
1144
	}
1145
	MAKE_type_func ( cv, NULL_type, p2, ell, mq, m2, pars, qids, e2, t ) ;
1146
	t = inject_pre_type ( t, r2, 0 ) ;
1147
    } else {
1148
	/* Free unused type lists */
1149
	if ( !EQ_list ( m2, m1 ) ) DESTROY_list ( m2, SIZE_type ) ;
1150
	if ( !EQ_list ( e2, e1 ) ) DESTROY_list ( e2, SIZE_type ) ;
1151
    }
1152
    return ( t ) ;
1153
}
1154
 
1155
 
1156
/*
1157
    RESCAN A CLASS NAME
1158
 
1159
    This routine expands the class type ct by rescanning its name in the
1160
    current context.  It returns the null type if the result is not a
1161
    type name.
1162
*/
1163
 
1164
static TYPE rescan_class
1165
    PROTO_N ( ( ct ) )
1166
    PROTO_T ( CLASS_TYPE ct )
1167
{
1168
    IDENTIFIER cid = DEREF_id ( ctype_name ( ct ) ) ;
1169
    TYPE t = find_typename ( cid, NULL_list ( TOKEN ), btype_none, 1 ) ;
1170
    return ( t ) ;
1171
}
1172
 
1173
 
1174
/*
1175
    RESCAN AN ENUMERATION NAME
1176
 
1177
    This routine expands the enumeration type et by rescanning its name
1178
    in the current context.  It returns the null type if the result is
1179
    not a type name.
1180
*/
1181
 
1182
static TYPE rescan_enum
1183
    PROTO_N ( ( et ) )
1184
    PROTO_T ( ENUM_TYPE et )
1185
{
1186
    IDENTIFIER eid = DEREF_id ( etype_name ( et ) ) ;
1187
    TYPE t = find_typename ( eid, NULL_list ( TOKEN ), btype_none, 1 ) ;
1188
    return ( t ) ;
1189
}
1190
 
1191
 
1192
/*
1193
    EXPAND A CLASS TYPE
1194
 
1195
    This routine expands any token definitions in the class type ct.
1196
    rec is as above.  The null class is returned if the result is not
1197
    a class type with the actual type being assigned to pt.
1198
*/
1199
 
1200
CLASS_TYPE expand_ctype
1201
    PROTO_N ( ( ct, rec, pt ) )
1202
    PROTO_T ( CLASS_TYPE ct X int rec X TYPE *pt )
1203
{
1204
    if ( rec >= 0 ) {
1205
	TYPE s = NULL_type ;
1206
	TYPE t = DEREF_type ( ctype_form ( ct ) ) ;
1207
	if ( !IS_NULL_type ( t ) ) {
1208
	    if ( IS_type_token ( t ) ) {
1209
		IDENTIFIER id = DEREF_id ( type_token_tok ( t ) ) ;
1210
		LIST ( TOKEN ) p = DEREF_list ( type_token_args ( t ) ) ;
1211
		if ( IS_id_token ( id ) ) {
1212
		    /* Tokenised classes */
1213
		    s = expand_type ( t, rec ) ;
1214
		} else if ( rec ) {
1215
		    /* Template classes */
1216
		    p = expand_args ( p, rec, 0 ) ;
1217
		    if ( !IS_NULL_list ( p ) ) {
1218
			/* Template class instance */
1219
			id = instance_type ( id, p, 0, 1 ) ;
1220
			s = DEREF_type ( id_class_name_defn ( id ) ) ;
1221
			while ( IS_type_templ ( s ) ) {
1222
			    s = DEREF_type ( type_templ_defn ( s ) ) ;
1223
			}
1224
		    }
1225
		}
1226
		if ( EQ_type ( s, t ) ) {
1227
		    /* No expansion possible */
1228
		    return ( ct ) ;
1229
		}
1230
	    } else if ( IS_type_instance ( t ) ) {
1231
		s = rescan_class ( ct ) ;
1232
		if ( EQ_type ( s, t ) ) {
1233
		    /* No expansion possible */
1234
		    return ( ct ) ;
1235
		}
1236
	    } else {
1237
		/* Recursive template classes */
1238
		s = expand_type ( t, rec ) ;
1239
	    }
1240
	} else {
1241
	    CLASS_INFO ci = DEREF_cinfo ( ctype_info ( ct ) ) ;
1242
	    if ( ci & cinfo_rescan ) s = rescan_class ( ct ) ;
1243
	}
1244
	if ( !IS_NULL_type ( s ) ) {
1245
	    if ( IS_type_compound ( s ) ) {
1246
		ct = DEREF_ctype ( type_compound_defn ( s ) ) ;
1247
	    } else {
1248
		*pt = s ;
1249
		if ( is_templ_type ( s ) ) {
1250
		    IDENTIFIER id = DEREF_id ( type_token_tok ( s ) ) ;
1251
		    ct = find_class ( id ) ;
1252
		} else {
1253
		    ct = NULL_ctype ;
1254
		}
1255
	    }
1256
	}
1257
    }
1258
    return ( ct ) ;
1259
}
1260
 
1261
 
1262
/*
1263
    BITFIELD EXPANSION FLAG
1264
 
1265
    This flag may be set to true to allow for zero sized bitfields in
1266
    expand_type.  The only way this can occur is in the expansion
1267
    of an anonymous member type.
1268
*/
1269
 
1270
int expand_anon_bitfield = 0 ;
1271
 
1272
 
1273
/*
1274
    EXPAND A TYPE TOKEN
1275
 
1276
    This routine expands any token definitions in the type t.  rec is
1277
    as above.
1278
*/
1279
 
1280
TYPE expand_type
1281
    PROTO_N ( ( t, rec ) )
1282
    PROTO_T ( TYPE t X int rec )
1283
{
1284
    CV_SPEC cv ;
1285
    int prom = 0 ;
1286
    IDENTIFIER id ;
1287
    LIST ( TOKEN ) p ;
1288
    if ( rec < 0 ) return ( t ) ;
1289
    if ( IS_NULL_type ( t ) ) return ( NULL_type ) ;
1290
    cv = DEREF_cv ( type_qual ( t ) ) ;
1291
    ASSERT ( ORDER_type == 18 ) ;
1292
    switch ( TAG_type ( t ) ) {
1293
 
1294
	case type_integer_tag : {
1295
	    /* Integral types */
1296
	    INT_TYPE it = DEREF_itype ( type_integer_rep ( t ) ) ;
1297
	    unsigned tag = TAG_itype ( it ) ;
1298
	    if ( tag == itype_arith_tag ) {
1299
		/* Expand arithmetic types */
1300
		INT_TYPE ir = DEREF_itype ( itype_arith_arg1 ( it ) ) ;
1301
		INT_TYPE is = DEREF_itype ( itype_arith_arg2 ( it ) ) ;
1302
		TYPE r1 = DEREF_type ( itype_prom ( ir ) ) ;
1303
		TYPE r2 = expand_type ( r1, rec ) ;
1304
		TYPE s1 = DEREF_type ( itype_prom ( is ) ) ;
1305
		TYPE s2 = expand_type ( s1, rec ) ;
1306
		if ( !EQ_type ( r1, r2 ) || !EQ_type ( s1, s2 ) ) {
1307
		    t = arith_type ( r2, s2, NULL_exp, NULL_exp ) ;
1308
		    if ( cv ) t = qualify_type ( t, cv, 0 ) ;
1309
		}
1310
	    } else {
1311
		/* Expand other integral types */
1312
		if ( tag == itype_promote_tag ) {
1313
		    it = DEREF_itype ( itype_promote_arg ( it ) ) ;
1314
		    tag = TAG_itype ( it ) ;
1315
		    prom = 1 ;
1316
		}
1317
		if ( tag == itype_token_tag ) {
1318
		    id = DEREF_id ( itype_token_tok ( it ) ) ;
1319
		    p = DEREF_list ( itype_token_args ( it ) ) ;
1320
		    goto expand_label ;
1321
		}
1322
		if ( tag == itype_basic_tag ) {
1323
		    /* Allow for special tokens */
1324
		    BUILTIN_TYPE n = DEREF_ntype ( itype_basic_no ( it ) ) ;
1325
		    id = get_special ( base_token [n].tok, 0 ) ;
1326
		    if ( !IS_NULL_id ( id ) ) {
1327
			p = NULL_list ( TOKEN ) ;
1328
			goto expand_label ;
1329
		    }
1330
		}
1331
	    }
1332
	    break ;
1333
	}
1334
 
1335
	case type_floating_tag : {
1336
	    /* Floating point types */
1337
	    FLOAT_TYPE ft = DEREF_ftype ( type_floating_rep ( t ) ) ;
1338
	    unsigned tag = TAG_ftype ( ft ) ;
1339
	    if ( tag == ftype_arith_tag ) {
1340
		/* Expand arithmetic types */
1341
		FLOAT_TYPE fr = DEREF_ftype ( ftype_arith_arg1 ( ft ) ) ;
1342
		FLOAT_TYPE fs = DEREF_ftype ( ftype_arith_arg2 ( ft ) ) ;
1343
		TYPE r1 = make_ftype ( fr, NULL_ftype ) ;
1344
		TYPE r2 = expand_type ( r1, rec ) ;
1345
		TYPE s1 = make_ftype ( fs, NULL_ftype ) ;
1346
		TYPE s2 = expand_type ( s1, rec ) ;
1347
		if ( !EQ_type ( r1, r2 ) || !EQ_type ( s1, s2 ) ) {
1348
		    t = arith_type ( r2, s2, NULL_exp, NULL_exp ) ;
1349
		    if ( cv ) t = qualify_type ( t, cv, 0 ) ;
1350
		}
1351
	    } else {
1352
		/* Expand other floating point types */
1353
		if ( tag == ftype_arg_promote_tag ) {
1354
		    ft = DEREF_ftype ( ftype_arg_promote_arg ( ft ) ) ;
1355
		    tag = TAG_ftype ( ft ) ;
1356
		    prom = 2 ;
1357
		}
1358
		if ( tag == ftype_token_tag ) {
1359
		    id = DEREF_id ( ftype_token_tok ( ft ) ) ;
1360
		    p = DEREF_list ( ftype_token_args ( ft ) ) ;
1361
		    goto expand_label ;
1362
		}
1363
	    }
1364
	    break ;
1365
	}
1366
 
1367
	case type_ptr_tag : {
1368
	    /* Pointer types */
1369
	    if ( rec ) {
1370
		TYPE s1 = DEREF_type ( type_ptr_sub ( t ) ) ;
1371
		TYPE s2 = expand_type ( s1, rec ) ;
1372
		if ( !EQ_type ( s1, s2 ) ) {
1373
		    if ( TAG_type ( s1 ) == TAG_type ( s2 ) ) {
1374
			/* Don't check in this case */
1375
			MAKE_type_ptr ( cv, s2, t ) ;
1376
		    } else {
1377
			MAKE_type_ptr ( cv, NULL_type, t ) ;
1378
			t = inject_pre_type ( t, s2, 0 ) ;
1379
		    }
1380
		}
1381
	    }
1382
	    break ;
1383
	}
1384
 
1385
	case type_ref_tag : {
1386
	    /* Reference types */
1387
	    if ( rec ) {
1388
		TYPE s1 = DEREF_type ( type_ref_sub ( t ) ) ;
1389
		TYPE s2 = expand_type ( s1, rec ) ;
1390
		if ( !EQ_type ( s1, s2 ) ) {
1391
		    MAKE_type_ref ( cv, NULL_type, t ) ;
1392
		    t = inject_pre_type ( t, s2, 0 ) ;
1393
		}
1394
	    }
1395
	    break ;
1396
	}
1397
 
1398
	case type_ptr_mem_tag : {
1399
	    /* Pointer to member types */
1400
	    if ( rec ) {
1401
		TYPE r2 = NULL_type ;
1402
		CLASS_TYPE c1 = DEREF_ctype ( type_ptr_mem_of ( t ) ) ;
1403
		CLASS_TYPE c2 = expand_ctype ( c1, rec, &r2 ) ;
1404
		TYPE s1 = DEREF_type ( type_ptr_mem_sub ( t ) ) ;
1405
		TYPE s2 = expand_type ( s1, rec ) ;
1406
		if ( !EQ_ctype ( c1, c2 ) ) {
1407
		    if ( IS_NULL_ctype ( c2 ) ) {
1408
			/* Illegal class type expansion */
1409
			report ( crt_loc, ERR_dcl_mptr_class ( r2 ) ) ;
1410
			MAKE_type_ptr ( cv, NULL_type, t ) ;
1411
		    } else {
1412
			MAKE_type_ptr_mem ( cv, c2, NULL_type, t ) ;
1413
		    }
1414
		    t = inject_pre_type ( t, s2, 0 ) ;
1415
		} else if ( !EQ_type ( s1, s2 ) ) {
1416
		    MAKE_type_ptr_mem ( cv, c1, NULL_type, t ) ;
1417
		    t = inject_pre_type ( t, s2, 0 ) ;
1418
		}
1419
	    }
1420
	    break ;
1421
	}
1422
 
1423
	case type_func_tag : {
1424
	    /* Function types */
1425
	    if ( rec ) t = expand_func_type ( t, rec ) ;
1426
	    break ;
1427
	}
1428
 
1429
	case type_array_tag : {
1430
	    /* Array types */
1431
	    if ( rec ) {
1432
		ERROR err = NULL_err ;
1433
		TYPE s1 = DEREF_type ( type_array_sub ( t ) ) ;
1434
		TYPE s2 = expand_type ( s1, rec ) ;
1435
		NAT n1 = DEREF_nat ( type_array_size ( t ) ) ;
1436
		NAT n2 = expand_nat ( n1, rec, 0, &err ) ;
1437
		if ( !EQ_nat ( n1, n2 ) ) {
1438
		    if ( !IS_NULL_err ( err ) ) {
1439
			ERROR err2 = ERR_dcl_array_dim_const () ;
1440
			err = concat_error ( err, err2 ) ;
1441
			report ( crt_loc, err ) ;
1442
		    }
1443
		    n2 = check_array_dim ( n2 ) ;
1444
		    MAKE_type_array ( cv, NULL_type, n2, t ) ;
1445
		    t = inject_pre_type ( t, s2, 0 ) ;
1446
		} else if ( !EQ_type ( s1, s2 ) ) {
1447
		    MAKE_type_array ( cv, NULL_type, n2, t ) ;
1448
		    t = inject_pre_type ( t, s2, 0 ) ;
1449
		}
1450
	    }
1451
	    break ;
1452
	}
1453
 
1454
	case type_bitfield_tag : {
1455
	    /* Bitfield types */
1456
	    if ( rec ) {
1457
		ERROR err = NULL_err ;
1458
		INT_TYPE it = DEREF_itype ( type_bitfield_defn ( t ) ) ;
1459
		TYPE s1 = DEREF_type ( itype_bitfield_sub ( it ) ) ;
1460
		NAT n1 = DEREF_nat ( itype_bitfield_size ( it ) ) ;
1461
		TYPE s2 = expand_type ( s1, rec ) ;
1462
		NAT n2 = expand_nat ( n1, rec, 0, &err ) ;
1463
		if ( !EQ_type ( s1, s2 ) || !EQ_nat ( n1, n2 ) ) {
1464
		    BASE_TYPE rep ;
1465
		    int anon = expand_anon_bitfield ;
1466
		    rep = DEREF_btype ( itype_bitfield_rep ( it ) ) ;
1467
		    if ( !IS_NULL_err ( err ) ) {
1468
			ERROR err2 = ERR_class_bit_dim_const () ;
1469
			err = concat_error ( err, err2 ) ;
1470
			report ( crt_loc, err ) ;
1471
		    }
1472
		    rep = get_bitfield_rep ( s2, rep ) ;
1473
		    t = check_bitfield_type ( cv, s2, rep, n2, anon ) ;
1474
		}
1475
	    }
1476
	    break ;
1477
	}
1478
 
1479
	case type_compound_tag : {
1480
	    /* Class types */
1481
	    CLASS_TYPE ct = DEREF_ctype ( type_compound_defn ( t ) ) ;
1482
	    TYPE s = DEREF_type ( ctype_form ( ct ) ) ;
1483
	    if ( !IS_NULL_type ( s ) ) {
1484
		if ( IS_type_token ( s ) ) {
1485
		    /* Tokenised and template classes */
1486
		    id = DEREF_id ( type_token_tok ( s ) ) ;
1487
		    p = DEREF_list ( type_token_args ( s ) ) ;
1488
		    if ( IS_id_token ( id ) ) goto expand_label ;
1489
		    if ( rec ) {
1490
			p = expand_args ( p, rec, 0 ) ;
1491
			if ( !IS_NULL_list ( p ) ) {
1492
			    /* Template class instance */
1493
			    id = instance_type ( id, p, 0, 1 ) ;
1494
			    t = DEREF_type ( id_class_name_defn ( id ) ) ;
1495
			    while ( IS_type_templ ( t ) ) {
1496
				t = DEREF_type ( type_templ_defn ( t ) ) ;
1497
			    }
1498
			    if ( cv ) t = qualify_type ( t, cv, 0 ) ;
1499
			}
1500
		    }
1501
		} else if ( IS_type_instance ( s ) ) {
1502
		    s = rescan_class ( ct ) ;
1503
		    if ( !IS_NULL_type ( s ) ) {
1504
			t = s ;
1505
			if ( cv ) t = qualify_type ( t, cv, 0 ) ;
1506
		    }
1507
		} else {
1508
		    /* Recursive template classes */
1509
		    t = expand_type ( s, rec ) ;
1510
		    if ( cv ) t = qualify_type ( t, cv, 0 ) ;
1511
		}
1512
	    } else {
1513
		CLASS_INFO ci = DEREF_cinfo ( ctype_info ( ct ) ) ;
1514
		if ( ci & cinfo_rescan ) {
1515
		    /* Force rescan */
1516
		    s = rescan_class ( ct ) ;
1517
		    if ( !IS_NULL_type ( s ) ) {
1518
			t = s ;
1519
			if ( cv ) t = qualify_type ( t, cv, 0 ) ;
1520
		    }
1521
		}
1522
	    }
1523
	    break ;
1524
	}
1525
 
1526
	case type_enumerate_tag : {
1527
	    /* Enumeration types */
1528
	    ENUM_TYPE et = DEREF_etype ( type_enumerate_defn ( t ) ) ;
1529
	    CLASS_INFO ei = DEREF_cinfo ( etype_info ( et ) ) ;
1530
	    if ( ei & cinfo_rescan ) {
1531
		/* Force rescan */
1532
		TYPE s = rescan_enum ( et ) ;
1533
		if ( !IS_NULL_type ( s ) ) {
1534
		    t = s ;
1535
		    if ( cv ) t = qualify_type ( t, cv, 0 ) ;
1536
		}
1537
	    }
1538
	    break ;
1539
	}
1540
 
1541
	case type_token_tag : {
1542
	    /* Tokenised types */
1543
	    id = DEREF_id ( type_token_tok ( t ) ) ;
1544
	    p = DEREF_list ( type_token_args ( t ) ) ;
1545
	    expand_label : {
1546
		TOKEN tok ;
1547
		unsigned tag ;
1548
		DECL_SPEC ds ;
1549
		IDENTIFIER aid ;
1550
		int changed = 0 ;
1551
		if ( !IS_id_token ( id ) ) break ;
1552
		aid = DEREF_id ( id_alias ( id ) ) ;
1553
		if ( !EQ_id ( id, aid ) ) {
1554
		    /* Replace token by its alias */
1555
		    t = apply_type_token ( aid, p, NULL_id ) ;
1556
		    changed = 1 ;
1557
		    id = aid ;
1558
		}
1559
		ds = DEREF_dspec ( id_storage ( id ) ) ;
1560
		tok = DEREF_tok ( id_token_sort ( id ) ) ;
1561
		tag = TAG_tok ( tok ) ;
1562
		if ( tag == tok_proc_tag ) {
1563
		    if ( rec ) {
1564
			/* Expand token arguments */
1565
			p = expand_args ( p, rec, 0 ) ;
1566
			if ( !IS_NULL_list ( p ) ) {
1567
			    t = apply_type_token ( id, p, NULL_id ) ;
1568
			    changed = 1 ;
1569
			}
1570
		    }
1571
		    tok = DEREF_tok ( tok_proc_res ( tok ) ) ;
1572
		    tag = TAG_tok ( tok ) ;
1573
		}
1574
		/* if ( rec == 2 && !( ds & dspec_auto ) ) break ; */
1575
		if ( ds & dspec_temp ) {
1576
		    /* Check for recursive token expansions */
1577
		    report ( crt_loc, ERR_token_recursive ( id ) ) ;
1578
		    return ( type_error ) ;
1579
		}
1580
		COPY_dspec ( id_storage ( id ), ( ds | dspec_temp ) ) ;
1581
		if ( tag == tok_type_tag ) {
1582
		    /* Tokenised type */
1583
		    TYPE s = DEREF_type ( tok_type_value ( tok ) ) ;
1584
		    if ( !IS_NULL_type ( s ) ) {
1585
			/* Expand token definition */
1586
			t = expand_type ( s, rec ) ;
1587
			if ( ds & dspec_auto ) {
1588
			    COPY_type ( tok_type_value ( tok ), t ) ;
1589
			}
1590
			changed = 1 ;
1591
		    } else {
1592
			BASE_TYPE bt ;
1593
			bt = DEREF_btype ( tok_type_kind ( tok ) ) ;
1594
			if ( bt & btype_typename ) {
1595
			    /* Allow for typename */
1596
			    s = find_typename ( id, p, bt, 0 ) ;
1597
			    if ( !IS_NULL_type ( s ) ) {
1598
				t = expand_type ( s, rec ) ;
1599
				changed = 1 ;
1600
			    }
1601
			}
1602
		    }
1603
		} else if ( tag == tok_class_tag ) {
1604
		    /* Template template parameter */
1605
		    aid = DEREF_id ( tok_class_value ( tok ) ) ;
1606
		    if ( !IS_NULL_id ( aid ) && rec ) {
1607
			p = expand_args ( p, rec, 1 ) ;
1608
			aid = apply_template ( aid, p, 0, 0 ) ;
1609
			if ( IS_id_class_name_etc ( aid ) ) {
1610
			    t = DEREF_type ( id_class_name_etc_defn ( aid ) ) ;
1611
			    changed = 1 ;
1612
			}
1613
		    }
1614
		}
1615
		if ( changed ) {
1616
		    /* Qualify modified type */
1617
		    if ( prom == 1 ) {
1618
			t = promote_type ( t ) ;
1619
		    } else if ( prom == 2 ) {
1620
			t = arg_promote_type ( t, KILL_err ) ;
1621
		    }
1622
		    if ( cv ) {
1623
			CV_SPEC qual = DEREF_cv ( type_qual ( t ) ) ;
1624
			t = qualify_type ( t, ( qual | cv ), 0 ) ;
1625
		    }
1626
		}
1627
		COPY_dspec ( id_storage ( id ), ds ) ;
1628
	    }
1629
	    break ;
1630
	}
1631
 
1632
	case type_templ_tag : {
1633
	    /* Template types */
1634
	    t = expand_templ_type ( t, rec ) ;
1635
	    break ;
1636
	}
1637
    }
1638
    return ( t ) ;
1639
}
1640
 
1641
 
1642
/*
1643
    APPLY AN EXPRESSION TOKEN
1644
 
1645
    This routine applies the expression, statement or integer constant
1646
    token id to the arguments args.  If rec is true then the result
1647
    type is expanded.
1648
*/
1649
 
1650
EXP apply_exp_token
1651
    PROTO_N ( ( id, args, rec ) )
1652
    PROTO_T ( IDENTIFIER id X LIST ( TOKEN ) args X int rec )
1653
{
1654
    EXP e ;
1655
    int is_proc = 0 ;
1656
    TOKEN tok = DEREF_tok ( id_token_sort ( id ) ) ;
1657
    unsigned tag = TAG_tok ( tok ) ;
1658
    if ( tag == tok_func_tag ) {
1659
	tok = func_proc_token ( tok ) ;
1660
	tag = TAG_tok ( tok ) ;
1661
    }
1662
    if ( tag == tok_proc_tag ) {
1663
	is_proc = 1 ;
1664
	tok = DEREF_tok ( tok_proc_res ( tok ) ) ;
1665
	tag = TAG_tok ( tok ) ;
1666
    }
1667
    switch ( tag ) {
1668
	case tok_exp_tag : {
1669
	    /* Expression tokens */
1670
	    int pt = in_proc_token ;
1671
	    TYPE t = DEREF_type ( tok_exp_type ( tok ) ) ;
1672
	    int c = DEREF_int ( tok_exp_constant ( tok ) ) ;
1673
	    if ( rec > 0 ) {
1674
		t = expand_type ( t, rec ) ;
1675
	    } else if ( pt ) {
1676
		in_proc_token = 0 ;
1677
		t = expand_type ( t, 2 ) ;
1678
		in_proc_token = pt ;
1679
	    }
1680
	    t = convert_qual_type ( t ) ;
1681
	    MAKE_exp_token ( t, id, args, e ) ;
1682
	    if ( c ) {
1683
		/* Check for integer constant tokens */
1684
		unsigned tt = TAG_type ( t ) ;
1685
		if ( tt == type_integer_tag || tt == type_enumerate_tag ) {
1686
		    NAT n ;
1687
		    MAKE_nat_calc ( e, n ) ;
1688
		    MAKE_exp_int_lit ( t, n, exp_token_tag, e ) ;
1689
		}
1690
	    } else {
1691
		/* Allow for exceptions */
1692
		if ( is_proc ) {
1693
		    IGNORE check_throw ( NULL_type, 0 ) ;
1694
		}
1695
	    }
1696
	    break ;
1697
	}
1698
	case tok_stmt_tag : {
1699
	    /* Statement tokens */
1700
	    MAKE_exp_token ( type_void, id, args, e ) ;
1701
	    while ( !IS_NULL_list ( args ) ) {
1702
		TOKEN arg = DEREF_tok ( HEAD_list ( args ) ) ;
1703
		if ( IS_tok_stmt ( arg ) ) {
1704
		    /* Set parent statement for arguments */
1705
		    EXP a = DEREF_exp ( tok_stmt_value ( arg ) ) ;
1706
		    set_parent_stmt ( a, e ) ;
1707
		}
1708
		args = TAIL_list ( args ) ;
1709
	    }
1710
	    IGNORE check_throw ( NULL_type, 0 ) ;
1711
	    break ;
1712
	}
1713
	case tok_nat_tag :
1714
	case tok_snat_tag : {
1715
	    /* Integer constant tokens */
1716
	    NAT n ;
1717
	    MAKE_nat_token ( id, args, n ) ;
1718
	    MAKE_exp_int_lit ( type_sint, n, exp_token_tag, e ) ;
1719
	    break ;
1720
	}
1721
	default : {
1722
	    /* Other tokens */
1723
	    e = NULL_exp ;
1724
	    break ;
1725
	}
1726
    }
1727
    return ( e ) ;
1728
}
1729
 
1730
 
1731
/*
1732
    APPLY AN INTEGER CONSTANT TOKEN
1733
 
1734
    This routine applies the integer constant token id to the arguments args.
1735
*/
1736
 
1737
NAT apply_nat_token
1738
    PROTO_N ( ( id, args ) )
1739
    PROTO_T ( IDENTIFIER id X LIST ( TOKEN ) args )
1740
{
1741
    NAT n ;
1742
    TOKEN tok = DEREF_tok ( id_token_sort ( id ) ) ;
1743
    unsigned tag = TAG_tok ( tok ) ;
1744
    if ( tag == tok_proc_tag ) {
1745
	tok = DEREF_tok ( tok_proc_res ( tok ) ) ;
1746
	tag = TAG_tok ( tok ) ;
1747
    }
1748
    if ( tag == tok_nat_tag || tag == tok_snat_tag ) {
1749
	MAKE_nat_token ( id, args, n ) ;
1750
    } else {
1751
	n = NULL_nat ;
1752
    }
1753
    return ( n ) ;
1754
}
1755
 
1756
 
1757
/*
1758
    APPLY A BUILT-IN TYPE TOKEN
1759
 
1760
    Certain language extensions are implemented as built-in tokens (see
1761
    define_keyword).  This routine applies such a token, given by the
1762
    keyword lex, to the arguments args.
1763
*/
1764
 
1765
static TYPE key_type_token
1766
    PROTO_N ( ( lex, args ) )
1767
    PROTO_T ( int lex X LIST ( TOKEN ) args )
1768
{
1769
    TYPE t = NULL_type ;
1770
    switch ( lex ) {
1771
	case lex_representation : {
1772
	    TOKEN arg = DEREF_tok ( HEAD_list ( args ) ) ;
1773
	    t = DEREF_type ( tok_type_value ( arg ) ) ;
1774
	    if ( !IS_NULL_type ( t ) && IS_type_integer ( t ) ) {
1775
		TYPE s ;
1776
		args = TAIL_list ( args ) ;
1777
		arg = DEREF_tok ( HEAD_list ( args ) ) ;
1778
		s = DEREF_type ( tok_type_value ( arg ) ) ;
1779
		if ( !IS_NULL_type ( s ) && IS_type_integer ( s ) ) {
1780
		    INT_TYPE it = DEREF_itype ( type_integer_rep ( t ) ) ;
1781
		    INT_TYPE is = DEREF_itype ( type_integer_rep ( s ) ) ;
1782
		    t = make_itype ( it, is ) ;
1783
		}
1784
	    }
1785
	    break ;
1786
	}
1787
	case lex_typeof : {
1788
	    TOKEN arg = DEREF_tok ( HEAD_list ( args ) ) ;
1789
	    EXP e = DEREF_exp ( tok_exp_value ( arg ) ) ;
1790
	    if ( !IS_NULL_exp ( e ) ) {
1791
		t = DEREF_type ( exp_type ( e ) ) ;
1792
		if ( IS_type_bitfield ( t ) ) {
1793
		    t = promote_type ( t ) ;
1794
		}
1795
	    }
1796
	    break ;
1797
	}
1798
    }
1799
    return ( t ) ;
1800
}
1801
 
1802
 
1803
/*
1804
    APPLY A TYPE TOKEN
1805
 
1806
    This routine applies the type token id to the arguments args.  tid
1807
    gives the name, if any, to be given to any class created.
1808
*/
1809
 
1810
TYPE apply_type_token
1811
    PROTO_N ( ( id, args, tid ) )
1812
    PROTO_T ( IDENTIFIER id X LIST ( TOKEN ) args X IDENTIFIER tid )
1813
{
1814
    TYPE t ;
1815
    int pt = in_proc_token ;
1816
    TOKEN tok = DEREF_tok ( id_token_sort ( id ) ) ;
1817
    unsigned tag = TAG_tok ( tok ) ;
1818
    if ( tag == tok_proc_tag ) {
1819
	int lex = DEREF_int ( tok_proc_key ( tok ) ) ;
1820
	if ( lex != lex_identifier ) {
1821
	    t = key_type_token ( lex, args ) ;
1822
	    if ( !IS_NULL_type ( t ) ) return ( t ) ;
1823
	}
1824
	tok = DEREF_tok ( tok_proc_res ( tok ) ) ;
1825
	tag = TAG_tok ( tok ) ;
1826
    }
1827
    if ( tag == tok_type_tag ) {
1828
	BASE_TYPE bt = DEREF_btype ( tok_type_kind ( tok ) ) ;
1829
	if ( bt & btype_scalar ) {
1830
	    /* Scalar types */
1831
	    t = apply_itype_token ( id, args ) ;
1832
 
1833
	} else if ( bt & btype_named ) {
1834
	    /* Structure and union types */
1835
	    TYPE s ;
1836
	    CLASS_TYPE ct ;
1837
	    CLASS_INFO ci ;
1838
	    int tq = crt_templ_qualifier ;
1839
	    QUALIFIER cq = crt_id_qualifier ;
1840
	    int td = have_type_declaration ;
1841
	    if ( IS_NULL_id ( tid ) ) {
1842
		/* Make up class name if necessary */
1843
		HASHID tnm = lookup_anon () ;
1844
		tid = DEREF_id ( hashid_id ( tnm ) ) ;
1845
	    }
1846
 
1847
	    /* Define the class */
1848
	    crt_id_qualifier = qual_none ;
1849
	    crt_templ_qualifier = 0 ;
1850
	    tid = begin_class_defn ( tid, bt, cinfo_token, NULL_type ) ;
1851
	    if ( IS_NULL_list ( args ) ) {
1852
		COPY_id ( id_token_alt ( id ), tid ) ;
1853
	    }
1854
	    t = DEREF_type ( id_class_name_etc_defn ( tid ) ) ;
1855
	    while ( IS_type_templ ( t ) ) {
1856
		t = DEREF_type ( type_templ_defn ( t ) ) ;
1857
	    }
1858
	    ct = DEREF_ctype ( type_compound_defn ( t ) ) ;
1859
	    ci = DEREF_cinfo ( ctype_info ( ct ) ) ;
1860
	    ci &= ~cinfo_empty ;
1861
	    COPY_cinfo ( ctype_info ( ct ), ci ) ;
1862
	    MAKE_type_token ( cv_none, id, args, s ) ;
1863
	    COPY_type ( ctype_form ( ct ), s ) ;
1864
	    in_class_defn++ ;
1865
	    really_in_class_defn++ ;
1866
	    IGNORE end_class_defn ( tid ) ;
1867
	    really_in_class_defn-- ;
1868
	    in_class_defn-- ;
1869
	    have_type_declaration = td ;
1870
	    crt_templ_qualifier = tq ;
1871
	    crt_id_qualifier = cq ;
1872
 
1873
	} else {
1874
	    /* Generic types */
1875
	    MAKE_type_token ( cv_none, id, args, t ) ;
1876
	}
1877
    } else {
1878
	/* Shouldn't occur */
1879
	t = type_error ;
1880
    }
1881
    if ( pt ) {
1882
	/* Expand token arguments */
1883
	in_proc_token = 0 ;
1884
	t = expand_type ( t, 2 ) ;
1885
	in_proc_token = pt ;
1886
    }
1887
    return ( t ) ;
1888
}
1889
 
1890
 
1891
/*
1892
    APPLY A MEMBER TOKEN
1893
 
1894
    This routine applies the member token id to the arguments args.
1895
*/
1896
 
1897
OFFSET apply_mem_token
1898
    PROTO_N ( ( id, args ) )
1899
    PROTO_T ( IDENTIFIER id X LIST ( TOKEN ) args )
1900
{
1901
    OFFSET off ;
1902
    MAKE_off_token ( id, args, off ) ;
1903
    return ( off ) ;
1904
}
1905
 
1906
 
1907
/*
1908
    APPLY A TOKEN
1909
 
1910
    This routine applies the token id to the arguments args.
1911
*/
1912
 
1913
TOKEN apply_token
1914
    PROTO_N ( ( id, args ) )
1915
    PROTO_T ( IDENTIFIER id X LIST ( TOKEN ) args )
1916
{
1917
    TOKEN tok = NULL_tok ;
1918
    TOKEN sort = DEREF_tok ( id_token_sort ( id ) ) ;
1919
    unsigned tag = TAG_tok ( sort ) ;
1920
    if ( tag == tok_proc_tag ) {
1921
	sort = DEREF_tok ( tok_proc_res ( sort ) ) ;
1922
	tag = TAG_tok ( sort ) ;
1923
    }
1924
    switch ( tag ) {
1925
	case tok_exp_tag : {
1926
	    EXP e = apply_exp_token ( id, args, 0 ) ;
1927
	    TYPE t = DEREF_type ( exp_type ( e ) ) ;
1928
	    int c = DEREF_int ( tok_exp_constant ( sort ) ) ;
1929
	    MAKE_tok_exp ( t, c, e, tok ) ;
1930
	    break ;
1931
	}
1932
	case tok_nat_tag :
1933
	case tok_snat_tag : {
1934
	    NAT n = apply_nat_token ( id, args ) ;
1935
	    MAKE_tok_nat_etc ( tag, n, tok ) ;
1936
	    break ;
1937
	}
1938
	case tok_stmt_tag : {
1939
	    EXP e = apply_exp_token ( id, args, 0 ) ;
1940
	    MAKE_tok_stmt ( e, tok ) ;
1941
	    break ;
1942
	}
1943
	case tok_type_tag : {
1944
	    TYPE t ;
1945
	    BASE_TYPE bt = DEREF_btype ( tok_type_kind ( sort ) ) ;
1946
	    t = apply_type_token ( id, args, NULL_id ) ;
1947
	    MAKE_tok_type ( bt, t, tok ) ;
1948
	    break ;
1949
	}
1950
	case tok_member_tag : {
1951
	    TYPE s = DEREF_type ( tok_member_of ( sort ) ) ;
1952
	    TYPE t = DEREF_type ( tok_member_type ( sort ) ) ;
1953
	    OFFSET off = apply_mem_token ( id, args ) ;
1954
	    MAKE_tok_member ( s, t, off, tok ) ;
1955
	    break ;
1956
	}
1957
	case tok_class_tag : {
1958
	    TYPE t = DEREF_type ( tok_class_type ( sort ) ) ;
1959
	    MAKE_tok_class ( t, id, tok ) ;
1960
	    break ;
1961
	}
1962
    }
1963
    return ( tok ) ;
1964
}
1965
 
1966
 
1967
/*
1968
    COMPARE TWO TOKENS
1969
 
1970
    This routine compares the token sorts a and b.
1971
*/
1972
 
1973
static int eq_tok
1974
    PROTO_N ( ( a, b ) )
1975
    PROTO_T ( TOKEN a X TOKEN b )
1976
{
1977
    /* Check for obvious equality */
1978
    unsigned na, nb ;
1979
    if ( EQ_tok ( a, b ) ) return ( 1 ) ;
1980
    if ( IS_NULL_tok ( a ) ) return ( 0 ) ;
1981
    if ( IS_NULL_tok ( b ) ) return ( 0 ) ;
1982
 
1983
    /* Compare tags */
1984
    na = TAG_tok ( a ) ;
1985
    nb = TAG_tok ( b ) ;
1986
    if ( na != nb ) return ( 0 ) ;
1987
 
1988
    /* Compare token components */
1989
    ASSERT ( ORDER_tok == 10 ) ;
1990
    switch ( na ) {
1991
 
1992
	case tok_exp_tag : {
1993
	    /* Expression tokens */
1994
	    TYPE ta = DEREF_type ( tok_exp_type ( a ) ) ;
1995
	    TYPE tb = DEREF_type ( tok_exp_type ( b ) ) ;
1996
	    CV_SPEC qa = DEREF_cv ( type_qual ( ta ) ) ;
1997
	    CV_SPEC qb = DEREF_cv ( type_qual ( tb ) ) ;
1998
	    int ca = DEREF_int ( tok_exp_constant ( a ) ) ;
1999
	    int cb = DEREF_int ( tok_exp_constant ( b ) ) ;
2000
	    return ( ca == cb && qa == qb && eq_type ( ta, tb ) ) ;
2001
	}
2002
 
2003
	case tok_nat_tag :
2004
	case tok_snat_tag :
2005
	case tok_stmt_tag : {
2006
	    /* Trivial cases */
2007
	    break ;
2008
	}
2009
 
2010
	case tok_func_tag : {
2011
	    /* Function tokens */
2012
	    TYPE ta = DEREF_type ( tok_func_type ( a ) ) ;
2013
	    TYPE tb = DEREF_type ( tok_func_type ( b ) ) ;
2014
	    return ( eq_type ( ta, tb ) ) ;
2015
	}
2016
 
2017
	case tok_member_tag : {
2018
	    /* Member tokens */
2019
	    TYPE sa = DEREF_type ( tok_member_of ( a ) ) ;
2020
	    TYPE sb = DEREF_type ( tok_member_of ( b ) ) ;
2021
	    TYPE ta = DEREF_type ( tok_member_type ( a ) ) ;
2022
	    TYPE tb = DEREF_type ( tok_member_type ( b ) ) ;
2023
	    return ( eq_type ( sa, sb ) && eq_type ( ta, tb ) ) ;
2024
	}
2025
 
2026
	case tok_proc_tag : {
2027
	    /* Procedure tokens */
2028
	    LIST ( IDENTIFIER ) pa, pb ;
2029
	    TOKEN ra = DEREF_tok ( tok_proc_res ( a ) ) ;
2030
	    TOKEN rb = DEREF_tok ( tok_proc_res ( b ) ) ;
2031
	    if ( !eq_tok ( ra, rb ) ) return ( 0 ) ;
2032
 
2033
	    /* Compare program parameters */
2034
	    pa = DEREF_list ( tok_proc_pids ( a ) ) ;
2035
	    pb = DEREF_list ( tok_proc_pids ( b ) ) ;
2036
	    if ( LENGTH_list ( pa ) != LENGTH_list ( pb ) ) return ( 0 ) ;
2037
	    while ( !IS_NULL_list ( pa ) && !IS_NULL_list ( pb ) ) {
2038
		IDENTIFIER u = DEREF_id ( HEAD_list ( pa ) ) ;
2039
		IDENTIFIER v = DEREF_id ( HEAD_list ( pb ) ) ;
2040
		if ( IS_NULL_id ( u ) || !IS_id_token ( u ) ) return ( 0 ) ;
2041
		if ( IS_NULL_id ( v ) || !IS_id_token ( v ) ) return ( 0 ) ;
2042
		ra = DEREF_tok ( id_token_sort ( u ) ) ;
2043
		rb = DEREF_tok ( id_token_sort ( v ) ) ;
2044
		if ( !eq_tok ( ra, rb ) ) return ( 0 ) ;
2045
		pa = TAIL_list ( pa ) ;
2046
		pb = TAIL_list ( pb ) ;
2047
	    }
2048
 
2049
	    /* Compare bound parameters */
2050
	    pa = DEREF_list ( tok_proc_bids ( a ) ) ;
2051
	    pb = DEREF_list ( tok_proc_bids ( b ) ) ;
2052
	    if ( LENGTH_list ( pa ) != LENGTH_list ( pb ) ) return ( 0 ) ;
2053
	    while ( !IS_NULL_list ( pa ) && !IS_NULL_list ( pb ) ) {
2054
		IDENTIFIER u = DEREF_id ( HEAD_list ( pa ) ) ;
2055
		IDENTIFIER v = DEREF_id ( HEAD_list ( pb ) ) ;
2056
		if ( IS_NULL_id ( u ) || !IS_id_token ( u ) ) return ( 0 ) ;
2057
		if ( IS_NULL_id ( v ) || !IS_id_token ( v ) ) return ( 0 ) ;
2058
		ra = DEREF_tok ( id_token_sort ( u ) ) ;
2059
		rb = DEREF_tok ( id_token_sort ( v ) ) ;
2060
		if ( !eq_tok ( ra, rb ) ) return ( 0 ) ;
2061
		pa = TAIL_list ( pa ) ;
2062
		pb = TAIL_list ( pb ) ;
2063
	    }
2064
	    break ;
2065
	}
2066
 
2067
	case tok_type_tag : {
2068
	    /* Type tokens */
2069
	    BASE_TYPE ta = DEREF_btype ( tok_type_kind ( a ) ) ;
2070
	    BASE_TYPE tb = DEREF_btype ( tok_type_kind ( b ) ) ;
2071
	    if ( ta != tb ) return ( 0 ) ;
2072
	    break ;
2073
	}
2074
 
2075
	case tok_class_tag : {
2076
	    /* Template class tokens */
2077
	    TYPE ta = DEREF_type ( tok_class_type ( a ) ) ;
2078
	    TYPE tb = DEREF_type ( tok_class_type ( b ) ) ;
2079
	    if ( eq_type ( ta, tb ) == 1 ) return ( 1 ) ;
2080
	    return ( 0 ) ;
2081
	}
2082
 
2083
	case tok_templ_tag : {
2084
	    /* Templates */
2085
	    /* NOT YET IMPLEMENTED */
2086
	    return ( 0 ) ;
2087
	}
2088
    }
2089
    return ( 1 ) ;
2090
}
2091
 
2092
 
2093
/*
2094
    DECLARE A TOKEN IDENTIFIER
2095
 
2096
    This routine declares a token identifier id with sort tok and external
2097
    name ext in the namespace ns.
2098
*/
2099
 
2100
static IDENTIFIER declare_token
2101
    PROTO_N ( ( id, tok, ns, ext ) )
2102
    PROTO_T ( IDENTIFIER id X TOKEN tok X NAMESPACE ns X IDENTIFIER ext )
2103
{
2104
    HASHID nm = DEREF_hashid ( id_name ( id ) ) ;
2105
    MEMBER mem = search_member ( ns, nm, 1 ) ;
2106
 
2107
    /* Check identifier name */
2108
    ERROR err = check_id_name ( id, CONTEXT_OBJECT ) ;
2109
    if ( !IS_NULL_err ( err ) ) report ( crt_loc, err ) ;
2110
 
2111
    /* Check for previous definition */
2112
    id = DEREF_id ( member_id ( mem ) ) ;
2113
    if ( !IS_NULL_id ( id ) ) {
2114
	id = redecl_inherit ( id, qual_none, 0, 0 ) ;
2115
	if ( !IS_NULL_id ( id ) ) {
2116
	    if ( IS_id_token ( id ) ) {
2117
		/* Allow for redeclarations */
2118
		IDENTIFIER tid = DEREF_id ( id_token_alt ( id ) ) ;
2119
		if ( EQ_id ( tid, ext ) ) return ( id ) ;
2120
	    }
2121
	    if ( IS_id_function ( id ) && IS_tok_proc ( tok ) ) {
2122
		IDENTIFIER pid = id ;
2123
		while ( !IS_NULL_id ( pid ) ) {
2124
		    TYPE t = DEREF_type ( id_function_type ( pid ) ) ;
2125
		    if ( IS_type_func ( t ) ) {
2126
			TOKEN ptok ;
2127
			MAKE_tok_func ( t, ptok ) ;
2128
			ptok = func_proc_token ( ptok ) ;
2129
			if ( eq_tok ( ptok, tok ) ) {
2130
			    /* Procedure token matches function */
2131
			    return ( pid ) ;
2132
			}
2133
		    }
2134
		    pid = DEREF_id ( id_function_over ( pid ) ) ;
2135
		}
2136
	    }
2137
	}
2138
    }
2139
 
2140
    /* Declare the token */
2141
    MAKE_id_token ( nm, dspec_token, ns, preproc_loc, tok, ext, id ) ;
2142
    set_member ( mem, id ) ;
2143
    return ( id ) ;
2144
}
2145
 
2146
 
2147
/*
2148
    DECLARE AN EXTERNAL TOKEN
2149
 
2150
    This routine declares a token of sort tok with internal name id,
2151
    which belongs to the tag namespace if tag is true, and external name
2152
    ext.  It returns the external token identifier.
2153
*/
2154
 
2155
IDENTIFIER make_token_decl
2156
    PROTO_N ( ( tok, tag, id, ext ) )
2157
    PROTO_T ( TOKEN tok X int tag X IDENTIFIER id X IDENTIFIER ext )
2158
{
2159
    int tq ;
2160
    HASHID nm ;
2161
    MEMBER mem ;
2162
    unsigned tt ;
2163
    QUALIFIER cq ;
2164
    NAMESPACE ns ;
2165
    NAMESPACE gns ;
2166
    int macro = 0 ;
2167
    int pushed = 0 ;
2168
    int done_dump = 0 ;
2169
    IDENTIFIER tid = NULL_id ;
2170
    DECL_SPEC ds = dspec_token ;
2171
    DECL_SPEC mark = dspec_token ;
2172
 
2173
    /* Ignore illegal tokens */
2174
    if ( IS_NULL_tok ( tok ) ) return ( NULL_id ) ;
2175
 
2176
    /* Find token name */
2177
    if ( !IS_NULL_id ( ext ) ) {
2178
	/* Externally named token */
2179
	ns = token_namespace ;
2180
	/* gns = global_namespace ; */
2181
	gns = nonblock_namespace ;
2182
	nm = DEREF_hashid ( id_name ( ext ) ) ;
2183
	mem = search_member ( ns, nm, 1 ) ;
2184
	ext = DEREF_id ( member_id ( mem ) ) ;
2185
	if ( !IS_NULL_id ( ext ) ) {
2186
	    TOKEN tok2 = DEREF_tok ( id_token_sort ( ext ) ) ;
2187
	    force_tokdef++ ;
2188
	    if ( !eq_tok ( tok, tok2 ) ) {
2189
		ERROR err = ERR_token_redecl ( ext, id_loc ( ext ) ) ;
2190
		report ( preproc_loc, err ) ;
2191
		ext = NULL_id ;
2192
	    }
2193
	    force_tokdef-- ;
2194
	}
2195
	if ( IS_hashid_anon ( nm ) ) {
2196
	    ds |= dspec_static ;
2197
	} else {
2198
	    ds |= dspec_extern ;
2199
	}
2200
    } else {
2201
	/* Token parameter */
2202
	ns = crt_namespace ;
2203
	gns = ns ;
2204
	nm = DEREF_hashid ( id_name ( id ) ) ;
2205
	mem = NULL_member ;
2206
	ds |= ( dspec_auto | dspec_pure ) ;
2207
    }
2208
 
2209
    /* Create the token */
2210
    if ( IS_NULL_id ( ext ) ) {
2211
	IDENTIFIER uid = underlying_id ( id ) ;
2212
	MAKE_id_token ( nm, ds, ns, preproc_loc, tok, uid, ext ) ;
2213
	if ( !IS_NULL_member ( mem ) ) {
2214
	    COPY_id ( member_id ( mem ), ext ) ;
2215
	}
2216
    }
2217
 
2218
    /* Declare the corresponding identifier */
2219
    cq = crt_id_qualifier ;
2220
    tq = crt_templ_qualifier ;
2221
    crt_id_qualifier = qual_none ;
2222
    crt_templ_qualifier = 0 ;
2223
    if ( !EQ_nspace ( gns, crt_namespace ) ) {
2224
	push_namespace ( gns ) ;
2225
	pushed = 1 ;
2226
    }
2227
    tt = TAG_tok ( tok ) ;
2228
    if ( tt == tok_type_tag ) {
2229
	BASE_TYPE bt = DEREF_btype ( tok_type_kind ( tok ) ) ;
2230
	if ( bt & btype_named ) {
2231
	    /* Allow structure and union tags */
2232
	    if ( tag ) tid = id ;
2233
	} else {
2234
	    tag = 0 ;
2235
	}
2236
    } else {
2237
	/* Other tags are not allowed */
2238
	tag = 0 ;
2239
    }
2240
    switch ( tt ) {
2241
 
2242
	case tok_type_tag : {
2243
	    /* Simple type tokens */
2244
	    TYPE t = apply_type_token ( ext, NULL_list ( TOKEN ), tid ) ;
2245
	    if ( tag ) {
2246
		CLASS_TYPE ct = DEREF_ctype ( type_compound_defn ( t ) ) ;
2247
		id = DEREF_id ( ctype_name ( ct ) ) ;
2248
		done_dump = 1 ;
2249
	    } else {
2250
		id = make_object_decl ( dspec_typedef, t, id, 0 ) ;
2251
		if ( !( ds & dspec_auto ) ) macro = 2 ;
2252
	    }
2253
	    break ;
2254
	}
2255
 
2256
	case tok_func_tag : {
2257
	    /* Function tokens (C linkage by default) */
2258
	    TYPE t = DEREF_type ( tok_func_type ( tok ) ) ;
2259
	    int ell = DEREF_int ( type_func_ellipsis ( t ) ) ;
2260
	    DECL_SPEC ln = crt_linkage ;
2261
	    if ( ln == dspec_none ) crt_linkage = dspec_c ;
2262
	    id = make_func_decl ( dspec_extern, t, id, 0 ) ;
2263
	    IGNORE init_object ( id, NULL_exp ) ;
2264
	    if ( IS_id_function_etc ( id ) && ell == FUNC_NONE ) {
2265
		TYPE form ;
2266
		MAKE_type_token ( cv_none, ext, NULL_list ( TOKEN ), form ) ;
2267
		COPY_type ( id_function_etc_form ( id ), form ) ;
2268
		if ( !( ds & dspec_auto ) ) macro = 1 ;
2269
		if ( is_redeclared ) {
2270
		    /* Mark functions which have already been declared */
2271
		    ds |= dspec_explicit ;
2272
		    COPY_dspec ( id_storage ( ext ), ds ) ;
2273
		}
2274
	    } else {
2275
		/* Ellipsis functions are not really tokenised */
2276
		mark = dspec_none ;
2277
	    }
2278
	    crt_linkage = ln ;
2279
	    break ;
2280
	}
2281
 
2282
	case tok_member_tag : {
2283
	    /* Member tokens */
2284
	    int pt = in_proc_token ;
2285
	    CLASS_TYPE cs = crt_class ;
2286
	    TYPE t = DEREF_type ( tok_member_of ( tok ) ) ;
2287
	    CLASS_TYPE ct = DEREF_ctype ( type_compound_defn ( t ) ) ;
2288
	    NAMESPACE cns = DEREF_nspace ( ctype_member ( ct ) ) ;
2289
	    crt_class = ct ;
2290
	    in_class_defn++ ;
2291
	    really_in_class_defn++ ;
2292
	    push_namespace ( cns ) ;
2293
	    t = DEREF_type ( tok_member_type ( tok ) ) ;
2294
	    if ( pt ) {
2295
		in_proc_token = 0 ;
2296
		t = expand_type ( t, 2 ) ;
2297
		in_proc_token = pt ;
2298
	    }
2299
	    id = make_member_decl ( dspec_token, t, id, 0 ) ;
2300
	    if ( IS_id_member ( id ) ) {
2301
		OFFSET off = DEREF_off ( id_member_off ( id ) ) ;
2302
		if ( !IS_NULL_off ( off ) ) {
2303
		    t = DEREF_type ( id_member_type ( id ) ) ;
2304
		    IGNORE define_mem_token ( ext, off, t, 1 ) ;
2305
		    if ( !IS_NULL_member ( mem ) ) {
2306
			if ( IS_off_member ( off ) ) {
2307
			    /* Record old member name */
2308
			    IDENTIFIER pid ;
2309
			    pid = DEREF_id ( off_member_id ( off ) ) ;
2310
			    COPY_id ( member_alt ( mem ), pid ) ;
2311
			}
2312
		    }
2313
		}
2314
		off = apply_mem_token ( ext, NULL_list ( TOKEN ) ) ;
2315
		COPY_off ( id_member_off ( id ), off ) ;
2316
		if ( !( ds & dspec_auto ) ) macro = 2 ;
2317
	    }
2318
	    IGNORE pop_namespace () ;
2319
	    really_in_class_defn-- ;
2320
	    in_class_defn-- ;
2321
	    crt_class = cs ;
2322
	    break ;
2323
	}
2324
 
2325
	case tok_class_tag : {
2326
	    /* Template template parameters */
2327
	    TYPE t ;
2328
	    TYPE q = DEREF_type ( tok_class_type ( tok ) ) ;
2329
	    MAKE_type_token ( cv_none, ext, NULL_list ( TOKEN ), t ) ;
2330
	    id = make_object_decl ( dspec_typedef, t, id, 0 ) ;
2331
	    t = inject_pre_type ( q, t, 0 ) ;
2332
	    COPY_type ( id_class_name_etc_defn ( id ), t ) ;
2333
	    COPY_type ( tok_class_type ( tok ), t ) ;
2334
	    mark |= dspec_template ;
2335
	    break ;
2336
	}
2337
 
2338
	default : {
2339
	    /* Other tokens */
2340
	    decl_loc = preproc_loc ;
2341
	    id = declare_token ( id, tok, gns, ext ) ;
2342
	    if ( IS_id_function ( id ) ) {
2343
		TYPE form ;
2344
		MAKE_type_token ( cv_none, ext, NULL_list ( TOKEN ), form ) ;
2345
		COPY_type ( id_function_form ( id ), form ) ;
2346
	    }
2347
	    if ( !( ds & dspec_auto ) ) macro = 1 ;
2348
	    break ;
2349
	}
2350
    }
2351
    if ( mark ) {
2352
	/* Mark object as a token */
2353
	ds = DEREF_dspec ( id_storage ( id ) ) ;
2354
	ds |= mark ;
2355
	COPY_dspec ( id_storage ( id ), ds ) ;
2356
    }
2357
    COPY_id ( id_token_alt ( ext ), id ) ;
2358
    if ( !IS_NULL_member ( mem ) ) {
2359
	IDENTIFIER pid = DEREF_id ( member_alt ( mem ) ) ;
2360
	if ( IS_NULL_id ( pid ) ) COPY_id ( member_alt ( mem ), id ) ;
2361
	if ( do_dump ) {
2362
	    if ( !done_dump ) dump_declare ( id, &preproc_loc, 0 ) ;
2363
	    dump_token ( id, ext ) ;
2364
	}
2365
    }
2366
    if ( pushed ) {
2367
	IGNORE pop_namespace () ;
2368
    }
2369
    crt_templ_qualifier = tq ;
2370
    crt_id_qualifier = cq ;
2371
 
2372
    /* Check for previous macro definition */
2373
    if ( macro ) {
2374
	IDENTIFIER mid ;
2375
	nm = DEREF_hashid ( id_name ( id ) ) ;
2376
	mid = DEREF_id ( hashid_id ( nm ) ) ;
2377
	switch ( TAG_id ( mid ) ) {
2378
	    case id_obj_macro_tag :
2379
	    case id_func_macro_tag : {
2380
		LOCATION loc ;
2381
		loc = preproc_loc ;
2382
		DEREF_loc ( id_loc ( mid ), preproc_loc ) ;
2383
		ds = DEREF_dspec ( id_storage ( mid ) ) ;
2384
		COPY_dspec ( id_storage ( mid ), ( ds | dspec_temp ) ) ;
2385
		if ( define_token_macro ( id, mid ) ) {
2386
		    ds |= dspec_used ;
2387
		    if ( do_macro && do_usage ) {
2388
			dump_use ( mid, &loc, 1 ) ;
2389
		    }
2390
		    COPY_loc ( id_loc ( ext ), preproc_loc ) ;
2391
		    no_declarations++ ;
2392
		}
2393
		COPY_dspec ( id_storage ( mid ), ds ) ;
2394
		preproc_loc = loc ;
2395
		break ;
2396
	    }
2397
	}
2398
    }
2399
    return ( ext ) ;
2400
}
2401
 
2402
 
2403
/*
2404
    FIND A TOKEN IDENTIFIER
2405
 
2406
    This routine finds the token identifier associated with the identifier
2407
    id.
2408
*/
2409
 
2410
static IDENTIFIER find_token_aux
2411
    PROTO_N ( ( id ) )
2412
    PROTO_T ( IDENTIFIER id )
2413
{
2414
    switch ( TAG_id ( id ) ) {
2415
	case id_class_name_tag :
2416
	case id_class_alias_tag : {
2417
	    /* Classes */
2418
	    TYPE t = DEREF_type ( id_class_name_etc_defn ( id ) ) ;
2419
	    if ( IS_type_compound ( t ) ) {
2420
		CLASS_TYPE ct = DEREF_ctype ( type_compound_defn ( t ) ) ;
2421
		t = DEREF_type ( ctype_form ( ct ) ) ;
2422
		if ( !IS_NULL_type ( t ) && IS_type_token ( t ) ) {
2423
		    id = DEREF_id ( type_token_tok ( t ) ) ;
2424
		    return ( id ) ;
2425
		}
2426
	    }
2427
	    break ;
2428
	}
2429
	case id_type_alias_tag : {
2430
	    /* Types */
2431
	    TYPE t = DEREF_type ( id_type_alias_defn ( id ) ) ;
2432
	    if ( IS_type_token ( t ) ) {
2433
		id = DEREF_id ( type_token_tok ( t ) ) ;
2434
		return ( id ) ;
2435
	    }
2436
	    break ;
2437
	}
2438
	case id_function_tag :
2439
	case id_mem_func_tag :
2440
	case id_stat_mem_func_tag : {
2441
	    /* Functions */
2442
	    TYPE form = DEREF_type ( id_function_etc_form ( id ) ) ;
2443
	    if ( !IS_NULL_type ( form ) && IS_type_token ( form ) ) {
2444
		IDENTIFIER ext = DEREF_id ( type_token_tok ( form ) ) ;
2445
		if ( !IS_NULL_id ( ext ) ) return ( ext ) ;
2446
	    }
2447
	    return ( id ) ;
2448
	}
2449
	case id_member_tag : {
2450
	    /* Members */
2451
	    OFFSET off = DEREF_off ( id_member_off ( id ) ) ;
2452
	    if ( IS_off_token ( off ) ) {
2453
		id = DEREF_id ( off_token_tok ( off ) ) ;
2454
		return ( id ) ;
2455
	    }
2456
	    break ;
2457
	}
2458
	case id_token_tag : {
2459
	    /* Tokens */
2460
	    IDENTIFIER alt = DEREF_id ( id_token_alt ( id ) ) ;
2461
	    if ( IS_id_token ( alt ) ) return ( alt ) ;
2462
	    return ( id ) ;
2463
	}
2464
    }
2465
    return ( id ) ;
2466
}
2467
 
2468
 
2469
/*
2470
    FIND AN EXTERNAL TOKEN IDENTIFIER
2471
 
2472
    This routine finds the external token corresponding to the identifier id.
2473
    For functions this refers only to the function id itself and not to
2474
    any overloading functions.
2475
*/
2476
 
2477
IDENTIFIER find_token
2478
    PROTO_N ( ( id ) )
2479
    PROTO_T ( IDENTIFIER id )
2480
{
2481
    MEMBER mem ;
2482
    DECL_SPEC ds ;
2483
    IDENTIFIER tid ;
2484
    HASHID nm = DEREF_hashid ( id_name ( id ) ) ;
2485
    if ( IS_id_keyword_etc ( id ) ) {
2486
	/* Rescan keywords */
2487
	id = find_id ( nm ) ;
2488
    }
2489
    ds = DEREF_dspec ( id_storage ( id ) ) ;
2490
    if ( ds & dspec_token ) {
2491
	/* Deal with simple tokens */
2492
	tid = find_token_aux ( id ) ;
2493
	if ( IS_id_token ( tid ) ) {
2494
	    ds = DEREF_dspec ( id_storage ( tid ) ) ;
2495
	    if ( !( ds & dspec_auto ) ) return ( tid ) ;
2496
	}
2497
    }
2498
 
2499
    /* Complex cases - check through token namespace */
2500
    id = DEREF_id ( id_alias ( id ) ) ;
2501
    mem = DEREF_member ( nspace_global_first ( token_namespace ) ) ;
2502
    while ( !IS_NULL_member ( mem ) ) {
2503
	tid = DEREF_id ( member_alt ( mem ) ) ;
2504
	if ( EQ_id ( tid, id ) ) {
2505
	    tid = DEREF_id ( member_id ( mem ) ) ;
2506
	    return ( tid ) ;
2507
	}
2508
	mem = DEREF_member ( member_next ( mem ) ) ;
2509
    }
2510
    return ( id ) ;
2511
}
2512
 
2513
 
2514
/*
2515
    FIND A TAG TOKEN IDENTIFIER
2516
 
2517
    This routine finds the token corresponding to the tag identifier id.
2518
*/
2519
 
2520
IDENTIFIER find_tag_token
2521
    PROTO_N ( ( id ) )
2522
    PROTO_T ( IDENTIFIER id )
2523
{
2524
    id = find_elaborate_type ( id, btype_any, NULL_type, dspec_used ) ;
2525
    return ( id ) ;
2526
}
2527
 
2528
 
2529
/*
2530
    FIND A MEMBER TOKEN IDENTIFIER
2531
 
2532
    This routine finds the token corresponding to the member mid of cid.
2533
*/
2534
 
2535
IDENTIFIER find_mem_token
2536
    PROTO_N ( ( cid, mid ) )
2537
    PROTO_T ( IDENTIFIER cid X IDENTIFIER mid )
2538
{
2539
    if ( IS_id_class_name_etc ( cid ) ) {
2540
	TYPE t = DEREF_type ( id_class_name_etc_defn ( cid ) ) ;
2541
	IDENTIFIER fid = tok_member ( mid, t, 1 ) ;
2542
	if ( !IS_NULL_id ( fid ) ) return ( fid ) ;
2543
	return ( mid ) ;
2544
    }
2545
    report ( preproc_loc, ERR_dcl_type_simple_undef ( cid ) ) ;
2546
    return ( mid ) ;
2547
}
2548
 
2549
 
2550
/*
2551
    FIND AN EXTERNAL TOKEN IDENTIFIER
2552
 
2553
    This routine finds the token with external name given by id.
2554
*/
2555
 
2556
IDENTIFIER find_ext_token
2557
    PROTO_N ( ( id ) )
2558
    PROTO_T ( IDENTIFIER id )
2559
{
2560
    HASHID nm = DEREF_hashid ( id_name ( id ) ) ;
2561
    id = search_id ( token_namespace, nm, 0, 0 ) ;
2562
    if ( IS_NULL_id ( id ) ) id = DEREF_id ( hashid_id ( nm ) ) ;
2563
    return ( id ) ;
2564
}
2565
 
2566
 
2567
/*
2568
    FIND A FUNCTION TOKEN IDENTIFIER
2569
 
2570
    This routine is identical to find_token except that it does a primitive
2571
    form of overload resolution on function tokens based on the number of
2572
    arguments n.  A value of UINT_MAX indicates that any number of
2573
    parameters is allowed.
2574
*/
2575
 
2576
IDENTIFIER find_func_token
2577
    PROTO_N ( ( id, n ) )
2578
    PROTO_T ( IDENTIFIER id X unsigned n )
2579
{
2580
    if ( IS_id_function_etc ( id ) ) {
2581
	int no = 0 ;
2582
	IDENTIFIER tid = NULL_id ;
2583
	IDENTIFIER fid = id ;
2584
	while ( !IS_NULL_id ( fid ) ) {
2585
	    TYPE form = DEREF_type ( id_function_etc_form ( fid ) ) ;
2586
	    if ( !IS_NULL_type ( form ) && IS_type_token ( form ) ) {
2587
		IDENTIFIER ext = DEREF_id ( type_token_tok ( form ) ) ;
2588
		if ( !IS_NULL_id ( ext ) && IS_id_token ( ext ) ) {
2589
		    if ( n == ( unsigned ) UINT_MAX ) {
2590
			tid = ext ;
2591
			no++ ;
2592
		    } else {
2593
			TYPE t ;
2594
			int ell ;
2595
			LIST ( TYPE ) p ;
2596
			t = DEREF_type ( id_function_etc_type ( fid ) ) ;
2597
			while ( IS_type_templ ( t ) ) {
2598
			    t = DEREF_type ( type_templ_defn ( t ) ) ;
2599
			}
2600
			p = DEREF_list ( type_func_ptypes ( t ) ) ;
2601
			ell = DEREF_int ( type_func_ellipsis ( t ) ) ;
2602
			if ( LENGTH_list ( p ) == n ) {
2603
			    if ( !( ell & FUNC_ELLIPSIS ) ) {
2604
				tid = ext ;
2605
				no++ ;
2606
			    }
2607
			}
2608
		    }
2609
		}
2610
	    }
2611
	    fid = DEREF_id ( id_function_etc_over ( fid ) ) ;
2612
	}
2613
	if ( no > 1 ) report ( preproc_loc, ERR_token_def_ambig ( id ) ) ;
2614
	return ( tid ) ;
2615
    }
2616
    return ( find_token ( id ) ) ;
2617
}
2618
 
2619
 
2620
/*
2621
    CURRENT INTERFACE METHOD
2622
 
2623
    This flag is used to record the current interface method.  It gives the
2624
    mapping of any '#pragma interface' to one of '#pragma define', '#pragma
2625
    no_def' or '#pragma ignore'.
2626
*/
2627
 
2628
int crt_interface = lex_no_Hdef ;
2629
 
2630
 
2631
/*
2632
    PERFORM A TOKEN INTERFACE OPERATION
2633
 
2634
    This routine performs the token interface operation indicated by i
2635
    (which will be lex_define, lex_no_Hdef, lex_ignore) on the token tid.
2636
*/
2637
 
2638
static void mark_interface
2639
    PROTO_N ( ( tid, i ) )
2640
    PROTO_T ( IDENTIFIER tid X int i )
2641
{
2642
    DECL_SPEC ds = DEREF_dspec ( id_storage ( tid ) ) ;
2643
    if ( i == lex_define ) {
2644
	/* Token must be defined */
2645
	ds |= dspec_static ;
2646
	ds &= ~dspec_pure ;
2647
    } else if ( i == lex_no_Hdef ) {
2648
	/* Token must not be defined */
2649
	ds |= dspec_pure ;
2650
	if ( ds & dspec_defn ) {
2651
	    /* Token already defined */
2652
	    PTR ( LOCATION ) loc = id_loc ( tid ) ;
2653
	    report ( preproc_loc, ERR_token_no_def ( tid, loc ) ) ;
2654
	}
2655
    } else {
2656
	/* Ignore token definitions */
2657
	ds |= dspec_done ;
2658
	ds &= ~dspec_pure ;
2659
    }
2660
    COPY_dspec ( id_storage ( tid ), ds ) ;
2661
    return ;
2662
}
2663
 
2664
 
2665
/*
2666
    PERFORM A TOKEN INTERFACE OPERATION
2667
 
2668
    This routine looks up the token id and performs the token operation
2669
    i on it.  In addition to the values above i can be lex_undef indicating
2670
    that the token should be undefined.
2671
*/
2672
 
2673
void token_interface
2674
    PROTO_N ( ( id, i ) )
2675
    PROTO_T ( IDENTIFIER id X int i )
2676
{
2677
    int ok = 0 ;
2678
    IDENTIFIER pid = id ;
2679
    while ( !IS_NULL_id ( pid ) ) {
2680
	IDENTIFIER tid = find_token ( pid ) ;
2681
	if ( IS_id_token ( tid ) ) {
2682
	    /* Token found */
2683
	    if ( i == lex_undef ) {
2684
		if ( do_dump ) dump_undefine ( pid, &preproc_loc, 1 ) ;
2685
		remove_id ( pid ) ;
2686
	    } else {
2687
		mark_interface ( tid, i ) ;
2688
	    }
2689
	    ok = 1 ;
2690
	}
2691
	if ( !IS_id_function_etc ( pid ) ) break ;
2692
	pid = DEREF_id ( id_function_etc_over ( pid ) ) ;
2693
    }
2694
    if ( !ok ) {
2695
	/* Token not found */
2696
	report ( preproc_loc, ERR_token_undecl ( id ) ) ;
2697
    }
2698
    return ;
2699
}