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, 1998
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 "version.h"
33
#include "c_types.h"
34
#include "ctype_ops.h"
35
#include "exp_ops.h"
36
#include "hashid_ops.h"
37
#include "id_ops.h"
38
#include "nspace_ops.h"
39
#include "tok_ops.h"
40
#include "type_ops.h"
41
#include "virt_ops.h"
42
#include "error.h"
43
#include "catalog.h"
44
#include "tdf.h"
45
#include "basetype.h"
46
#include "buffer.h"
47
#include "capsule.h"
48
#include "check.h"
49
#include "class.h"
50
#include "compile.h"
51
#include "constant.h"
52
#include "construct.h"
53
#include "convert.h"
54
#include "copy.h"
55
#include "destroy.h"
56
#include "diag.h"
57
#include "encode.h"
58
#include "exception.h"
59
#include "exp.h"
60
#include "file.h"
61
#include "function.h"
62
#include "identifier.h"
63
#include "init.h"
64
#include "initialise.h"
65
#include "mangle.h"
66
#include "namespace.h"
67
#include "redeclare.h"
68
#include "shape.h"
69
#include "statement.h"
70
#include "stmt.h"
71
#include "struct.h"
72
#include "tok.h"
73
#include "token.h"
74
#include "throw.h"
75
#include "ustring.h"
76
#include "variable.h"
77
#include "xalloc.h"
78
 
79
 
80
/*
81
    LIST OF ALL PENDING FUNCTIONS
82
 
83
    This list contains all the inline and implicit functions and
84
    literal constants defined in the program.
85
*/
86
 
87
LIST ( IDENTIFIER ) pending_funcs = NULL_list ( IDENTIFIER ) ;
88
 
89
 
90
/*
91
    CHECK A MANGLED IDENTIFIER NAME
92
 
93
    This routine checks whether the identifier id is used but not defined
94
    because, although it has external linkage, its mangled name is empty.
95
*/
96
 
97
static void check_mangled
98
    PROTO_N ( ( id ) )
99
    PROTO_T ( IDENTIFIER id )
100
{
101
    IDENTIFIER lid = DEREF_id ( id_alias ( id ) ) ;
102
    DECL_SPEC ds = DEREF_dspec ( id_storage ( lid ) ) ;
103
    if ( !( ds & dspec_done ) ) {
104
	if ( ( ds & dspec_extern ) && !( ds & dspec_defn ) ) {
105
	    if ( ds & ( dspec_used | dspec_called ) ) {
106
		/* Should have an external name */
107
		string s = mangle_name ( lid, VAR_tag, 0 ) ;
108
		if ( s == NULL && has_linkage ( lid ) ) {
109
		    LOCATION loc ;
110
		    DEREF_loc ( id_loc ( lid ), loc ) ;
111
		    report ( loc, ERR_basic_odr_undef ( lid ) ) ;
112
		}
113
	    }
114
	}
115
	ds |= dspec_done ;
116
	COPY_dspec ( id_storage ( lid ), ds ) ;
117
    }
118
    return ;
119
}
120
 
121
 
122
/*
123
    START OF TDF OUTPUT ROUTINES
124
 
125
    The compiler can optionally be compiled with the TDF output routines
126
    disabled by defining the TDF_OUTPUT macro to be zero on the
127
    command-line.  The following routines are concerned with TDF output.
128
*/
129
 
130
#if TDF_OUTPUT
131
 
132
 
133
/*
134
    CURRENT FUNCTION ACCESS
135
 
136
    This variable is used to hold the declaration specifiers for the
137
    current function.
138
*/
139
 
140
DECL_SPEC crt_func_access = dspec_none ;
141
 
142
 
143
/*
144
    ENCODE AN IDENTIFIER ACCESS
145
 
146
    This routine adds an optional TDF ACCESS corresponding to the
147
    declaration specifiers ds.
148
*/
149
 
150
BITSTREAM *enc_access
151
    PROTO_N ( ( bs, ds ) )
152
    PROTO_T ( BITSTREAM *bs X DECL_SPEC ds )
153
{
154
    if ( ds & dspec_mutable ) {
155
	ENC_ON ( bs ) ;
156
	if ( output_bugs ) {
157
	    /* Needed for old installer bug */
158
	    ENC_add_accesses ( bs ) ;
159
	    ENC_visible ( bs ) ;
160
	}
161
	ENC_long_jump_access ( bs ) ;
162
    } else {
163
	ENC_OFF ( bs ) ;
164
    }
165
    return ( bs ) ;
166
}
167
 
168
 
169
/*
170
    ENCODE AN IDENTIFIER SIGNATURE
171
 
172
    This routine adds an optional identifier signature corresponding to id
173
    to the bitstream bs.  Note that these signatures were only introduced
174
    in TDF version 4.0.
175
*/
176
 
177
static BITSTREAM *enc_signature
178
    PROTO_N ( ( bs, id ) )
179
    PROTO_T ( BITSTREAM *bs X IDENTIFIER id )
180
{
181
#if ( TDF_major >= 4 )
182
    ENC_OFF ( bs ) ;
183
#endif
184
    UNUSED ( id ) ;
185
    return ( bs ) ;
186
}
187
 
188
 
189
/*
190
    SHOULD A VARIABLE BE COMMON?
191
 
192
    This routine checks whether the local static variable id should be
193
    made a common tag.  It returns 2 if it should and 1 otherwise (see
194
    enc_tagdec).  The prefix to be used for mangling the name is returned
195
    via ps.
196
*/
197
 
198
static int is_common_tag
199
    PROTO_N ( ( id, ps ) )
200
    PROTO_T ( IDENTIFIER id X string *ps )
201
{
202
    NAMESPACE ns = DEREF_nspace ( id_parent ( id ) ) ;
203
    IDENTIFIER pid = DEREF_id ( nspace_name ( ns ) ) ;
204
    if ( !IS_NULL_id ( pid ) && IS_id_function_etc ( pid ) ) {
205
	DECL_SPEC ds = DEREF_dspec ( id_storage ( pid ) ) ;
206
	if ( ( ds & dspec_inline ) && ( ds & dspec_extern ) ) {
207
	    string s = mangle_name ( pid, VAR_tag, 1 ) ;
208
	    if ( s ) {
209
		*ps = s ;
210
		return ( 2 ) ;
211
	    }
212
	}
213
    }
214
    return ( 1 ) ;
215
}
216
 
217
 
218
/*
219
    CREATE A STATIC TAG DEFINITION
220
 
221
    This routine adds the tag declaration for the static variable id to
222
    the bitstream bs.  If id has a constant initialiser and no destructor
223
    then this is mapped to a simple tag definition, otherwise the
224
    initialisation and termination need to be done dynamically.
225
*/
226
 
227
static BITSTREAM *enc_static_var
228
    PROTO_N ( ( bs, id ) )
229
    PROTO_T ( BITSTREAM *bs X IDENTIFIER id )
230
{
231
    ulong n ;
232
    int ext = 0 ;
233
    BITSTREAM *ts ;
234
    string s = NULL ;
235
    int i = in_static_init ;
236
    int uc = unreached_code ;
237
    int var = is_common_tag ( id, &s ) ;
238
    TYPE t = DEREF_type ( id_variable_type ( id ) ) ;
239
    EXP a = DEREF_exp ( id_variable_init ( id ) ) ;
240
    EXP b = DEREF_exp ( id_variable_term ( id ) ) ;
241
 
242
    /* Encode the tag declaration */
243
    if ( var == 2 || output_all ) ext = 1 ;;
244
    IGNORE capsule_id ( id, VAR_tag ) ;
245
    n = DEREF_ulong ( id_no ( id ) ) ;
246
    if ( ext ) {
247
	/* Make up external name for variable */
248
	string sn = mangle_common ( s, id ) ;
249
	n = capsule_name ( n, &sn, VAR_tag ) ;
250
    }
251
    enc_tagdec ( id, n, t, var ) ;
252
 
253
    /* Encode the tag definition */
254
    ts = enc_tagdef_start ( id, n, t, var ) ;
255
    in_static_init = 1 ;
256
    unreached_code = 0 ;
257
    if ( !IS_NULL_exp ( a ) && IS_exp_dynamic ( a ) ) {
258
	/* Dynamic initialiser */
259
	ts = enc_null_exp ( ts, t ) ;
260
    } else {
261
	/* Static initialiser */
262
	if ( var == 2 ) {
263
	    ts = enc_null_exp ( ts, t ) ;
264
	    if ( is_null_exp ( a ) ) a = NULL_exp ;
265
	} else {
266
	    ts = enc_exp ( ts, a ) ;
267
	    a = NULL_exp ;
268
	}
269
    }
270
    unreached_code = uc ;
271
    in_static_init = i ;
272
    enc_tagdef_end ( ts ) ;
273
 
274
    /* Encode dynamic components */
275
    if ( !IS_NULL_exp ( a ) || !IS_NULL_exp ( b ) ) {
276
	/* Declare flag */
277
	ulong m1 ;
278
	int dummy = 0 ;
279
	EXP b1 = NULL_exp ;
280
	TYPE si = type_sint ;
281
	ulong m = capsule_no ( NULL_string, VAR_tag ) ;
282
	if ( ext ) {
283
	    /* Make up external name for flag */
284
	    string sm = mangle_common ( s, NULL_id ) ;
285
	    m = capsule_name ( m, &sm, VAR_tag ) ;
286
	}
287
	enc_tagdec ( NULL_id, m, si, var ) ;
288
	ts = enc_tagdef_start ( NULL_id, m, si, var ) ;
289
	in_static_init = 1 ;
290
	ts = enc_make_int ( ts, si, 0 ) ;
291
	in_static_init = i ;
292
	enc_tagdef_end ( ts ) ;
293
	if ( !IS_NULL_exp ( b ) ) {
294
	    if ( !output_term ) {
295
		/* Set up terminator if necessary */
296
		b1 = b ;
297
		b = NULL_exp ;
298
		make_term_global ( t, &b1 ) ;
299
		if ( IS_NULL_exp ( a ) ) {
300
		    a = make_dummy_init ( t ) ;
301
		    dummy = 1 ;
302
		}
303
	    }
304
	    term_no++ ;
305
	}
306
 
307
	/* Encode initialiser */
308
	ENC_SEQ_SMALL ( bs, 1 ) ;
309
	m1 = link_no ( bs, m, VAR_tag ) ;
310
	if ( !IS_NULL_exp ( a ) ) {
311
	    unsigned seq = 2 ;
312
	    ulong n1 = link_no ( bs, n, VAR_tag ) ;
313
	    if ( !IS_NULL_exp ( b1 ) ) seq = 3 ;
314
	    bs = enc_flag_test ( bs, m1, seq, 0, ntest_eq ) ;
315
	    bs = enc_init_tag ( bs, n1, NULL_off, 0, t, a, b1, 2 ) ;
316
	    if ( dummy ) free_exp ( a, 1 ) ;
317
	}
318
	ENC_assign ( bs ) ;
319
	ENC_obtain_tag ( bs ) ;
320
	ENC_make_tag ( bs, m1 ) ;
321
	bs = enc_make_int ( bs, si, 1 ) ;
322
	if ( !IS_NULL_exp ( a ) ) {
323
	    ENC_make_top ( bs ) ;
324
	}
325
 
326
	/* Encode destructor */
327
	if ( !IS_NULL_exp ( b ) ) {
328
	    ts = term_static_func ;
329
	    ts = enc_term_global ( ts, n, t, b, m ) ;
330
	    term_static_func = ts ;
331
	}
332
    }
333
    return ( bs ) ;
334
}
335
 
336
 
337
/*
338
    CREATE A LOCAL TAG DEFINITION
339
 
340
    This routine adds the start of a local tag declaration for the variable
341
    id to the bitstream bs.  The definition body has to be added later.
342
    Any destructor for id is returned via d.  var is 1 to indicate that
343
    id is a variable as opposed to an identity.  A value of 2 or more for
344
    var indicates that the variable should be just declared rather than
345
    defined.  This is only used for automatic variables.  e gives the
346
    corresponding declaration statement for use with diagnostics.
347
*/
348
 
349
BITSTREAM *enc_variable
350
    PROTO_N ( ( bs, id, var, d, e ) )
351
    PROTO_T ( BITSTREAM *bs X IDENTIFIER id X int var X EXP *d X EXP e )
352
{
353
    /* Check for previous definition */
354
    IDENTIFIER lid = DEREF_id ( id_alias ( id ) ) ;
355
    DECL_SPEC ds = DEREF_dspec ( id_storage ( lid ) ) ;
356
    if ( ds & dspec_done ) return ( bs ) ;
357
    ds |= dspec_done ;
358
 
359
    if ( ds & dspec_auto ) {
360
	/* Local variable definition */
361
	int dummy = 0 ;
362
	ulong n = unit_no ( bs, id, VAR_tag, 1 ) ;
363
	EXP a = DEREF_exp ( id_variable_init ( id ) ) ;
364
	EXP b = DEREF_exp ( id_variable_term ( id ) ) ;
365
	EXP b1 = NULL_exp ;
366
	TYPE t = DEREF_type ( id_variable_type ( id ) ) ;
367
	COPY_dspec ( id_storage ( lid ), ds ) ;
368
	if ( var ) {
369
	    if ( !IS_NULL_exp ( b ) ) {
370
		if ( output_except || var == 4 ) {
371
		    /* Set up terminator variable */
372
		    bs = make_term_local ( bs, t, &b, var ) ;
373
		    b1 = b ;
374
		    if ( IS_NULL_exp ( a ) && var == 1 ) {
375
			a = make_dummy_init ( t ) ;
376
			dummy = 1 ;
377
		    }
378
		}
379
	    }
380
	    ENC_variable ( bs ) ;
381
	} else {
382
	    ENC_identify ( bs ) ;
383
	}
384
	bs = enc_access ( bs, ds ) ;
385
	ENC_make_tag ( bs, n ) ;
386
	if ( IS_NULL_exp ( a ) || var >= 2 ) {
387
	    ENC_make_value ( bs ) ;
388
	    bs = enc_shape ( bs, t ) ;
389
	} else if ( var ) {
390
	    bs = enc_init_local ( bs, a, b1, n, t, e ) ;
391
	} else {
392
	    if ( !IS_NULL_exp ( e ) ) {
393
		BITSTREAM *ts = enc_diag_begin ( &bs ) ;
394
		ts = enc_addr_exp ( ts, t, a ) ;
395
		bs = enc_diag_end ( bs, ts, e, 1 ) ;
396
	    } else {
397
		bs = enc_addr_exp ( bs, t, a ) ;
398
	    }
399
	}
400
	if ( dummy ) free_exp ( a, 1 ) ;
401
	if ( d ) *d = b ;
402
    } else if ( !( ds & dspec_linkage ) ) {
403
	/* Static variable definition */
404
	if ( IS_id_variable ( id ) ) {
405
	    COPY_dspec ( id_storage ( lid ), ds ) ;
406
	    bs = enc_static_var ( bs, id ) ;
407
	}
408
    }
409
    return ( bs ) ;
410
}
411
 
412
 
413
/*
414
    ENCODE A FUNCTION DEFINITION
415
 
416
    This routine encodes the definition of the function id with body e
417
    to the bitstream bs.
418
*/
419
 
420
static BITSTREAM *enc_func_defn
421
    PROTO_N ( ( bs, id, e ) )
422
    PROTO_T ( BITSTREAM *bs X IDENTIFIER id X EXP e )
423
{
424
    unsigned n ;
425
    unsigned npids ;
426
    int is_main = 0 ;
427
    EXP r = NULL_exp ;
428
    unsigned seq = 0 ;
429
    unsigned rpids = 0 ;
430
    unsigned epids = 0 ;
431
    BITSTREAM *ts = NULL ;
432
    int diag = output_diag ;
433
    LIST ( IDENTIFIER ) qids ;
434
    IDENTIFIER eid = NULL_id ;
435
    DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
436
    TYPE fn = DEREF_type ( id_function_etc_type ( id ) ) ;
437
    TYPE ret = DEREF_type ( type_func_ret ( fn ) ) ;
438
    int ell = DEREF_int ( type_func_ellipsis ( fn ) ) ;
439
    LIST ( IDENTIFIER ) pids = DEREF_list ( type_func_pids ( fn ) ) ;
440
#if LANGUAGE_CPP
441
    EXP post = NULL_exp ;
442
    int throws = output_except ;
443
    LIST ( TYPE ) except = DEREF_list ( type_func_except ( fn ) ) ;
444
#endif
445
 
446
    /* Check for main routine */
447
    if ( ds & dspec_main ) {
448
	HASHID nm = DEREF_hashid ( id_name ( id ) ) ;
449
	if ( IS_hashid_name ( nm ) ) {
450
	    ds &= ~dspec_friend ;
451
	    is_main = 1 ;
452
	    seq++ ;
453
	}
454
    }
455
 
456
    /* Check exception specifier */
457
#if LANGUAGE_CPP
458
    if ( throws ) {
459
	if ( output_partial ) post = except_postlude ( id ) ;
460
	if ( IS_NULL_exp ( post ) ) {
461
	    if ( EQ_list ( except, univ_type_set ) ) {
462
		throws = 0 ;
463
	    } else if ( ds & ( dspec_friend | dspec_implicit ) ) {
464
		/* No exception specification required */
465
		throws = 0 ;
466
	    }
467
	} else {
468
	    ds |= dspec_mutable ;
469
	}
470
    }
471
#endif
472
 
473
    /* Encode start of function */
474
    common_no = 0 ;
475
    crt_func_access = ds ;
476
    clear_params () ;
477
    ENC_make_proc ( bs ) ;
478
    if ( pass_complex_type ( ret ) ) {
479
	ENC_top ( bs ) ;
480
	rpids = 1 ;
481
    } else {
482
	if ( IS_type_top_etc ( ret ) ) {
483
	    last_params [ DUMMY_return ] = LINK_ZERO ;
484
	} else if ( is_main ) {
485
	    MAKE_exp_null ( ret, r ) ;
486
	} else {
487
	    MAKE_exp_value ( ret, r ) ;
488
	}
489
	bs = enc_shape ( bs, ret ) ;
490
    }
491
    MAKE_exp_return_stmt ( type_bottom, r, r ) ;
492
 
493
    /* Encode 'this' parameter */
494
    if ( IS_id_mem_func ( id ) ) {
495
	CLASS_TYPE ct = parent_class ( id ) ;
496
	IDENTIFIER pid = this_param ( id, 0 ) ;
497
	ASSERT ( !IS_NULL_id ( pid ) ) ;
498
	CONS_id ( pid, pids, pids ) ;
499
	epids = extra_constr_args ( id, ct ) ;
500
	last_class = ct ;
501
    }
502
 
503
    /* Encode number of parameters */
504
    npids = LENGTH_list ( pids ) ;
505
    ENC_LIST ( bs, rpids + npids + epids ) ;
506
    qids = pids ;
507
 
508
    /* Encode function return parameter */
509
    if ( rpids ) {
510
	ulong pn = unit_no ( bs, NULL_id, VAR_tag, 1 ) ;
511
	ENC_pointer ( bs ) ;
512
	bs = enc_alignment ( bs, ret ) ;
513
	bs = enc_access ( bs, ds ) ;
514
	ENC_make_tag ( bs, pn ) ;
515
	last_params [ DUMMY_return ] = pn ;
516
    }
517
 
518
    /* Encode normal function parameters */
519
    n = 0 ;
520
    while ( !IS_NULL_list ( pids ) ) {
521
	IDENTIFIER pid = DEREF_id ( HEAD_list ( pids ) ) ;
522
	DECL_SPEC pds = DEREF_dspec ( id_storage ( pid ) ) ;
523
	TYPE pt = DEREF_type ( id_parameter_type ( pid ) ) ;
524
	ulong pn = unit_no ( bs, pid, VAR_tag, 1 ) ;
525
	if ( n < DUMMY_params ) {
526
	    last_params [n] = pn ;
527
	    n++ ;
528
	}
529
	if ( pass_complex_type ( pt ) ) {
530
	    /* Introduce identity for complex parameters */
531
	    ulong pm = unit_no ( bs, NULL_id, VAR_tag, 1 ) ;
532
	    ENC_pointer ( bs ) ;
533
	    bs = enc_alignment ( bs, pt ) ;
534
	    if ( ts == NULL ) {
535
		ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
536
	    }
537
	    ENC_identify ( ts ) ;
538
	    ts = enc_access ( ts, ds ) ;
539
	    ENC_make_tag ( ts, pn ) ;
540
	    ENC_contents ( ts ) ;
541
	    ENC_pointer ( ts ) ;
542
	    ts = enc_alignment ( ts, pt ) ;
543
	    ENC_obtain_tag ( ts ) ;
544
	    ENC_make_tag ( ts, pm ) ;
545
	    pn = pm ;
546
	} else if ( pds & dspec_virtual ) {
547
	    /* Introduce variable for weak parameter types */
548
	    ulong pm = unit_no ( bs, NULL_id, VAR_tag, 1 ) ;
549
	    TYPE pu = arg_promote_type ( pt, KILL_err ) ;
550
	    bs = enc_shape ( bs, pu ) ;
551
	    if ( ts == NULL ) {
552
		ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
553
	    }
554
	    ENC_variable ( ts ) ;
555
	    ts = enc_access ( ts, ds ) ;
556
	    ENC_make_tag ( ts, pn ) ;
557
	    if ( IS_type_integer ( pt ) ) {
558
		ENC_change_variety ( ts ) ;
559
		ts = enc_error_treatment ( ts, pt ) ;
560
		ts = enc_variety ( ts, pt ) ;
561
	    } else {
562
		ENC_change_floating_variety ( ts ) ;
563
		ENC_impossible ( ts ) ;
564
		ts = enc_flvar ( ts, pt ) ;
565
	    }
566
	    ENC_contents ( ts ) ;
567
	    ts = enc_shape ( ts, pu ) ;
568
	    ENC_obtain_tag ( ts ) ;
569
	    ENC_make_tag ( ts, pm ) ;
570
	    pn = pm ;
571
	} else {
572
	    /* Simple parameter */
573
	    bs = enc_shape ( bs, pt ) ;
574
	}
575
	bs = enc_access ( bs, ds ) ;
576
	ENC_make_tag ( bs, pn ) ;
577
	pids = TAIL_list ( pids ) ;
578
    }
579
 
580
    /* Encode extra function parameters */
581
    while ( epids ) {
582
	ulong pn = unit_no ( bs, NULL_id, VAR_tag, 1 ) ;
583
	bs = enc_shape ( bs, type_sint ) ;
584
	bs = enc_access ( bs, ds ) ;
585
	ENC_make_tag ( bs, pn ) ;
586
	last_params [ DUMMY_extra ] = pn ;
587
	epids-- ;
588
    }
589
 
590
    /* Encode ellipsis parameter */
591
    if ( ell & FUNC_ELLIPSIS ) {
592
	ulong pn ;
593
	eid = ellipsis_param ( id ) ;
594
	ASSERT ( !IS_NULL_id ( eid ) ) ;
595
	pn = unit_no ( bs, eid, VAR_tag, 1 ) ;
596
	ENC_ON ( bs ) ;
597
	ENC_make_tag ( bs, pn ) ;
598
	bs = enc_access ( bs, ds ) ;
599
	last_params [ DUMMY_ellipsis ] = pn ;
600
    } else {
601
	ENC_OFF ( bs ) ;
602
    }
603
 
604
    /* Allow for reference parameters */
605
    if ( ts ) bs = join_bitstreams ( bs, ts ) ;
606
    ts = bs ;
607
 
608
    /* Encode function body */
609
    seq += stmt_length ( e ) ;
610
    if ( diag ) bs = start_bitstream ( NIL ( FILE ), bs->link ) ;
611
#if LANGUAGE_CPP
612
    if ( throws ) bs = enc_try_func ( bs, post ) ;
613
#endif
614
    ENC_SEQUENCE ( bs, seq ) ;
615
    if ( is_main ) bs = enc_special ( bs, TOK_start ) ;
616
    bs = enc_compound_stmt ( bs, e ) ;
617
#if LANGUAGE_CPP
618
    if ( throws ) bs = enc_catch_func ( bs, except, post ) ;
619
#endif
620
    if ( diag ) {
621
	BITSTREAM *us = enc_diag_begin ( &bs ) ;
622
	us = enc_stmt ( us, r ) ;
623
	bs = enc_diag_end ( bs, us, r, 1 ) ;
624
	bs = enc_diag_params ( ts, qids, bs, e ) ;
625
    } else {
626
	bs = enc_stmt ( bs, r ) ;
627
    }
628
    free_exp ( r, 1 ) ;
629
 
630
    /* Clear parameter tag numbers */
631
    pids = qids ;
632
    while ( !IS_NULL_list ( pids ) ) {
633
	IDENTIFIER pid = DEREF_id ( HEAD_list ( pids ) ) ;
634
	clear_no ( pid ) ;
635
	pids = TAIL_list ( pids ) ;
636
    }
637
    if ( !IS_NULL_id ( eid ) ) clear_no ( eid ) ;
638
    crt_func_access = dspec_none ;
639
    clear_params () ;
640
    return ( bs ) ;
641
}
642
 
643
 
644
/*
645
    ENCODE THE START OF A TAG DECLARATION
646
 
647
    This routine adds the start of a declaration of the tag with identifier
648
    id, capsule number n and type t in the tag declaration unit.  var
649
    is 0 if the tag is an identity, 1 for a variable and 2 for a common tag.
650
    The actual tag type has to be added (t is only used for access checks).
651
*/
652
 
653
BITSTREAM *enc_tagdec_start
654
    PROTO_N ( ( id, n, t, var ) )
655
    PROTO_T ( IDENTIFIER id X ulong n X TYPE t X int var )
656
{
657
    unsigned use = USAGE_DECL ;
658
    BITSTREAM *bs = start_bitstream ( NIL ( FILE ), tagdec_unit->link ) ;
659
    ulong m = link_no ( bs, n, VAR_tag ) ;
660
    if ( var == 0 ) {
661
	ENC_make_id_tagdec ( bs ) ;
662
    } else if ( var == 1 ) {
663
	ENC_make_var_tagdec ( bs ) ;
664
    } else {
665
	ENC_common_tagdec ( bs ) ;
666
	use |= USAGE_COMMON ;
667
    }
668
    ENC_INT ( bs, m ) ;
669
    bs = enc_access ( bs, dspec_none ) ;
670
    bs = enc_signature ( bs, id ) ;
671
    record_usage ( n, VAR_tag, use ) ;
672
    UNUSED ( t ) ;
673
    return ( bs ) ;
674
}
675
 
676
 
677
/*
678
    ENCODE THE END OF A TAG DECLARATION
679
 
680
    This routine ends the tag declaration started by enc_tagdec_start.
681
*/
682
 
683
void enc_tagdec_end
684
    PROTO_N ( ( bs ) )
685
    PROTO_T ( BITSTREAM *bs )
686
{
687
    count_item ( bs ) ;
688
    tagdec_unit = join_bitstreams ( tagdec_unit, bs ) ;
689
    return ;
690
}
691
 
692
 
693
/*
694
    ENCODE A TAG DECLARATION
695
 
696
    This routine adds a complete tag declaration to the tag declaration
697
    unit if it has not already been declared.
698
*/
699
 
700
void enc_tagdec
701
    PROTO_N ( ( id, n, t, var ) )
702
    PROTO_T ( IDENTIFIER id X ulong n X TYPE t X int var )
703
{
704
    unsigned u = find_usage ( n, VAR_tag ) ;
705
    if ( !( u & USAGE_DECL ) ) {
706
	BITSTREAM *bs = enc_tagdec_start ( id, n, t, var ) ;
707
	bs = enc_shape ( bs, t ) ;
708
	enc_tagdec_end ( bs ) ;
709
    }
710
    return ;
711
}
712
 
713
 
714
/*
715
    ENCODE THE START OF A TAG DEFINITION
716
 
717
    This routine adds a definition of the tag with identifier id, capsule
718
    number n and type t to the tag definition unit.  var is as in
719
    enc_tagdec_start.  The routine returns a bitstream to allow the actual
720
    definition to be added.
721
*/
722
 
723
BITSTREAM *enc_tagdef_start
724
    PROTO_N ( ( id, n, t, var ) )
725
    PROTO_T ( IDENTIFIER id X ulong n X TYPE t X int var )
726
{
727
    unsigned use = USAGE_DEFN ;
728
    BITSTREAM *bs = start_bitstream ( NIL ( FILE ), tagdef_unit->link ) ;
729
    ulong m = link_no ( bs, n, VAR_tag ) ;
730
    if ( var == 0 ) {
731
	ENC_make_id_tagdef ( bs ) ;
732
    } else if ( var == 1 ) {
733
	ENC_make_var_tagdef ( bs ) ;
734
    } else {
735
	ENC_common_tagdef ( bs ) ;
736
	use |= USAGE_COMMON ;
737
    }
738
    ENC_INT ( bs, m ) ;
739
    if ( var ) bs = enc_access ( bs, dspec_none ) ;
740
    bs = enc_signature ( bs, id ) ;
741
    record_usage ( n, VAR_tag, use ) ;
742
    UNUSED ( t ) ;
743
    return ( bs ) ;
744
}
745
 
746
 
747
/*
748
    ENCODE THE END OF A TAG DEFINITION
749
 
750
    This routine ends the tag definition started by enc_tagdef_start.
751
*/
752
 
753
void enc_tagdef_end
754
    PROTO_N ( ( bs ) )
755
    PROTO_T ( BITSTREAM *bs )
756
{
757
    count_item ( bs ) ;
758
    tagdef_unit = join_bitstreams ( tagdef_unit, bs ) ;
759
    return ;
760
}
761
 
762
 
763
/*
764
    CREATE A TAG DEFINITION
765
 
766
    This routine creates a tag declaration and definition for the tag
767
    id of type t and definition e.  var is true for a variable tag.
768
    The expression d gives any associated destructor.  id can be the
769
    null identifier, indicating a local tag, and e can be the null
770
    expression, indicating that the tag is only declared.  The routine
771
    returns the external (capsule) tag number.
772
*/
773
 
774
ulong make_tagdef
775
    PROTO_N ( ( id, t, e, d, var ) )
776
    PROTO_T ( IDENTIFIER id X TYPE t X EXP e X EXP d X int var )
777
{
778
    ulong n ;
779
    int fn = 0 ;
780
    int def = 1 ;
781
    LOCATION loc ;
782
 
783
    /* Find the tag number */
784
    bad_crt_loc++ ;
785
    loc = crt_loc ;
786
    if ( IS_NULL_id ( id ) ) {
787
	n = capsule_no ( NULL_string, VAR_tag ) ;
788
    } else {
789
	PTR ( LOCATION ) ploc = id_loc ( id ) ;
790
	DEREF_loc ( ploc, crt_loc ) ;
791
	crt_enc_loc = ploc ;
792
	IGNORE capsule_id ( id, VAR_tag ) ;
793
	n = DEREF_ulong ( id_no ( id ) ) ;
794
	if ( IS_id_function_etc ( id ) ) {
795
	    var = 0 ;
796
	    fn = 1 ;
797
	}
798
    }
799
 
800
    /* Encode the declaration */
801
    enc_tagdec ( id, n, t, var ) ;
802
 
803
    /* Check for definition */
804
    if ( !IS_NULL_exp ( e ) ) {
805
	BITSTREAM *bs ;
806
	EXP d1 = NULL_exp ;
807
	int uc = unreached_code ;
808
	if ( !IS_NULL_exp ( d ) ) {
809
	    if ( !output_term ) {
810
		/* Set up terminator if necessary */
811
		d1 = d ;
812
		d = NULL_exp ;
813
		make_term_global ( t, &d1 ) ;
814
	    }
815
	    term_no++ ;
816
	}
817
	bs = enc_tagdef_start ( id, n, t, var ) ;
818
	unreached_code = 0 ;
819
	if ( fn ) {
820
	    /* Function definition */
821
	    bs = enc_func_defn ( bs, id, e ) ;
822
	} else if ( var ) {
823
	    /* Variable definition */
824
	    bs = enc_init_global ( bs, e, d1, n, t ) ;
825
	} else {
826
	    /* Identity definition */
827
	    int i = in_static_init ;
828
	    in_static_init = 1 ;
829
	    bs = enc_addr_exp ( bs, t, e ) ;
830
	    in_static_init = i ;
831
	}
832
	unreached_code = uc ;
833
	enc_tagdef_end ( bs ) ;
834
 
835
	/* Check for destructor */
836
	if ( !IS_NULL_exp ( d ) ) {
837
	    BITSTREAM *ts = term_func ;
838
	    ts = enc_term_global ( ts, n, t, d, LINK_NONE ) ;
839
	    term_func = ts ;
840
	}
841
    } else {
842
	/* Only declared */
843
	if ( !IS_NULL_id ( id ) ) {
844
	    string s = NULL ;
845
	    IGNORE capsule_name ( n, &s, VAR_tag ) ;
846
	    if ( s == NULL ) {
847
		if ( has_linkage ( id ) ) {
848
		    /* Doesn't have external name */
849
		    report ( crt_loc, ERR_basic_odr_undef ( id ) ) ;
850
		}
851
		s = mangle_anon () ;
852
	    }
853
	    IGNORE capsule_name ( n, &s, VAR_tag ) ;
854
	    def = 0 ;
855
	}
856
    }
857
    if ( !IS_NULL_id ( id ) && output_diag ) {
858
	HASHID nm = DEREF_hashid ( id_name ( id ) ) ;
859
	if ( !IS_hashid_anon ( nm ) ) enc_diag_id ( id, def ) ;
860
    }
861
    crt_loc = loc ;
862
    bad_crt_loc-- ;
863
    return ( n ) ;
864
}
865
 
866
 
867
/*
868
    CREATE THE DYNAMIC INITIALISATION FUNCTIONS
869
 
870
    This routine creates the dynamic initialisation and termination
871
    functions.
872
*/
873
 
874
void enc_dynamic_init
875
    PROTO_Z ()
876
{
877
    BITSTREAM *bs ;
878
    ulong m1 = LINK_NONE ;
879
    ulong m2 = LINK_NONE ;
880
    ulong init = init_no ;
881
    ulong term = term_no ;
882
    int diag = output_diag ;
883
    if ( output_all ) diag = 1 ;
884
 
885
    /* Create the termination function */
886
    if ( term ) {
887
	if ( output_term ) {
888
	    /* Define the termination function */
889
	    TYPE t = dummy_func ;
890
	    m1 = capsule_no ( NULL_string, VAR_tag ) ;
891
	    if ( diag ) enc_diag_init ( "__term", m1, t ) ;
892
	    enc_tagdec ( NULL_id, m1, t, 0 ) ;
893
	    bs = enc_tagdef_start ( NULL_id, m1, t, 0 ) ;
894
	    ENC_make_proc ( bs ) ;
895
	    ENC_top ( bs ) ;
896
	    ENC_LIST_SMALL ( bs, 0 ) ;
897
	    ENC_OFF ( bs ) ;
898
	    ENC_SEQUENCE ( bs, term ) ;
899
	    bs = join_bitstreams ( bs, term_static_func ) ;
900
	    bs = join_bitstreams ( bs, term_func ) ;
901
	    ENC_return ( bs ) ;
902
	    ENC_make_top ( bs ) ;
903
	    enc_tagdef_end ( bs ) ;
904
 
905
	    /* Define the termination link */
906
	    m2 = capsule_no ( NULL_string, VAR_tag ) ;
907
	    bs = enc_tagdec_start ( NULL_id, m2, NULL_type, 1 ) ;
908
	    bs = enc_special ( bs, TOK_destr_type ) ;
909
	    enc_tagdec_end ( bs ) ;
910
	    bs = enc_tagdef_start ( NULL_id, m2, NULL_type, 1 ) ;
911
	    bs = enc_special ( bs, TOK_destr_null ) ;
912
	    enc_tagdef_end ( bs ) ;
913
	    init++ ;
914
	}
915
	init++ ;
916
    }
917
 
918
    /* Create the initialisation function */
919
    if ( init ) {
920
	int var = 1 ;
921
	TYPE t = type_sint ;
922
	TYPE s = t ;
923
	string nm = mangle_init () ;
924
	ulong n1 = capsule_no ( nm, VAR_tag ) ;
925
	if ( output_init ) {
926
	    /* Initialisation function required */
927
	    t = dummy_func ;
928
	    var = 0 ;
929
	}
930
	if ( diag ) enc_diag_init ( "__init", n1, t ) ;
931
	enc_tagdec ( NULL_id, n1, t, var ) ;
932
	bs = enc_tagdef_start ( NULL_id, n1, t, var ) ;
933
	if ( var == 0 ) {
934
	    ENC_make_proc ( bs ) ;
935
	    bs = enc_shape ( bs, s ) ;
936
	    ENC_LIST_SMALL ( bs, 0 ) ;
937
	    ENC_OFF ( bs ) ;
938
	} else {
939
	    ENC_initial_value ( bs ) ;
940
	}
941
	ENC_SEQUENCE ( bs, init ) ;
942
	if ( term ) {
943
	    /* Initialise termination function */
944
	    bs = enc_special ( bs, TOK_destr_init ) ;
945
	}
946
	bs = join_bitstreams ( bs, init_func ) ;
947
	if ( m1 != LINK_NONE ) {
948
	    /* Set up termination function */
949
	    ulong n ;
950
	    BITSTREAM *ts ;
951
	    bs = enc_special ( bs, TOK_destr_global ) ;
952
	    ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
953
	    n = link_no ( ts, m2, VAR_tag ) ;
954
	    ENC_obtain_tag ( ts ) ;
955
	    ENC_make_tag ( ts, n ) ;
956
	    ENC_make_null_ptr ( ts ) ;
957
	    ts = enc_special ( ts, TOK_empty_align ) ;
958
	    n = link_no ( ts, m1, VAR_tag ) ;
959
	    ENC_obtain_tag ( ts ) ;
960
	    ENC_make_tag ( ts, n ) ;
961
	    bs = enc_bitstream ( bs, ts ) ;
962
	}
963
	if ( var == 0 ) ENC_return ( bs ) ;
964
	bs = enc_make_int ( bs, s, 1 ) ;
965
	enc_tagdef_end ( bs ) ;
966
 
967
	/* Set up initialisation variable */
968
	if ( var == 0 && nm == NULL ) {
969
	    ulong n2 = capsule_no ( NULL_string, VAR_tag ) ;
970
	    if ( diag ) enc_diag_init ( "__init2", n2, s ) ;
971
	    enc_tagdec ( NULL_id, n2, s, 1 ) ;
972
	    bs = enc_tagdef_start ( NULL_id, n2, s, 1 ) ;
973
	    ENC_initial_value ( bs ) ;
974
	    ENC_apply_proc ( bs ) ;
975
	    bs = enc_shape ( bs, s ) ;
976
	    n1 = link_no ( bs, n1, VAR_tag ) ;
977
	    ENC_obtain_tag ( bs ) ;
978
	    ENC_make_tag ( bs, n1 ) ;
979
	    ENC_LIST_SMALL ( bs, 0 ) ;
980
	    ENC_OFF ( bs ) ;
981
	    enc_tagdef_end ( bs ) ;
982
	}
983
    }
984
    return ;
985
}
986
 
987
 
988
/*
989
    CREATE A TOKEN DECLARATION
990
 
991
    This routine creates a token declaration body bitstream for a token
992
    with external (capsule) number n and sort sorts.  This is only output
993
    for tokens with at least one parameter to aid in pretty-printing.
994
*/
995
 
996
void enc_tokdec
997
    PROTO_N ( ( n, sorts ) )
998
    PROTO_T ( ulong n X CONST char *sorts )
999
{
1000
    BITSTREAM *bs = tokdec_unit ;
1001
    if ( bs ) {
1002
	char res = *( sorts++ ) ;
1003
	char arg = *sorts ;
1004
	if ( arg ) {
1005
	    ulong m = link_no ( bs, n, VAR_token ) ;
1006
	    record_usage ( n, VAR_token, USAGE_DECL ) ;
1007
	    ENC_make_tokdec ( bs ) ;
1008
	    ENC_INT ( bs, m ) ;
1009
	    bs = enc_signature ( bs, NULL_id ) ;
1010
	    ENC_token ( bs ) ;
1011
#if ( TDF_major >= 4 )
1012
	    /* Result sort first after TDF 4.0 */
1013
	    bs = enc_sort ( bs, ( int ) res ) ;
1014
#endif
1015
	    ENC_LIST ( bs, strlen ( sorts ) ) ;
1016
	    while ( arg = *( sorts++ ), arg != 0 ) {
1017
		bs = enc_sort ( bs, ( int ) arg ) ;
1018
	    }
1019
#if ( TDF_major < 4 )
1020
	    /* Result sort last before TDF 4.0 */
1021
	    bs = enc_sort ( bs, ( int ) res ) ;
1022
#endif
1023
	    count_item ( bs ) ;
1024
	    tokdec_unit = bs ;
1025
	}
1026
    }
1027
    return ;
1028
}
1029
 
1030
 
1031
/*
1032
    START A TOKEN DEFINITION
1033
 
1034
    This routine creates a token definition body bitstream for a token
1035
    with external (capsule) number n and sort given by sorts.  This
1036
    includes the allocation of any parameter token numbers, which are
1037
    returned via pars.
1038
*/
1039
 
1040
BITSTREAM *enc_tokdef_start
1041
    PROTO_N ( ( n, sorts, pars, d ) )
1042
    PROTO_T ( ulong n X CONST char *sorts X ulong *pars X int d )
1043
{
1044
    char res ;
1045
    unsigned i, m ;
1046
    BITSTREAM *bs ;
1047
    if ( d ) enc_tokdec ( n, sorts ) ;
1048
    record_usage ( n, VAR_token, USAGE_DEFN ) ;
1049
    bs = start_bitstream ( NIL ( FILE ), tokdef_unit->link ) ;
1050
    ENC_token_definition ( bs ) ;
1051
    res = *( sorts++ ) ;
1052
    bs = enc_sort ( bs, ( int ) res ) ;
1053
    m = ( unsigned ) strlen ( sorts ) ;
1054
    ENC_LIST ( bs, m ) ;
1055
    for ( i = 0 ; i < m ; i++ ) {
1056
	/* Encode token parameters */
1057
	char arg = sorts [i] ;
1058
	ulong r = unit_no ( bs, NULL_id, VAR_token, 1 ) ;
1059
	bs = enc_sort ( bs, ( int ) arg ) ;
1060
	ENC_INT ( bs, r ) ;
1061
	pars [i] = r ;
1062
    }
1063
    return ( bs ) ;
1064
}
1065
 
1066
 
1067
/*
1068
    COMPLETE A TOKEN DEFINITION
1069
 
1070
    This routine adds the definition of the token with external (capsule)
1071
    number n and token definition body ps to the main token definition unit.
1072
*/
1073
 
1074
void enc_tokdef_end
1075
    PROTO_N ( ( n, ps ) )
1076
    PROTO_T ( ulong n X BITSTREAM *ps )
1077
{
1078
    BITSTREAM *bs = tokdef_unit ;
1079
    ulong m = link_no ( bs, n, VAR_token ) ;
1080
    ENC_make_tokdef ( bs ) ;
1081
    ENC_INT ( bs, m ) ;
1082
    bs = enc_signature ( bs, NULL_id ) ;
1083
    bs = enc_bitstream ( bs, ps ) ;
1084
    count_item ( bs ) ;
1085
    tokdef_unit = bs ;
1086
    return ;
1087
}
1088
 
1089
 
1090
/*
1091
    ENCODE A TOKEN DEFINITION
1092
 
1093
    This routine encodes the declaration and, if necessary, the definition
1094
    of the token id.  If def is true then a dummy definition is output even
1095
    if id is not defined. It returns the code letter of the return sort.
1096
*/
1097
 
1098
int enc_tokdef
1099
    PROTO_N ( ( id, def ) )
1100
    PROTO_T ( IDENTIFIER id X int def )
1101
{
1102
    int dec ;
1103
    ulong n ;
1104
    BUFFER *bf ;
1105
    unsigned npars = 0 ;
1106
    IDENTIFIER fid = NULL_id ;
1107
    TOKEN tok = DEREF_tok ( id_token_sort ( id ) ) ;
1108
    unsigned tag = TAG_tok ( tok ) ;
1109
    int r = token_code ( tok ) ;
1110
 
1111
    /* Check for declaration and definition */
1112
    DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
1113
    if ( ds & dspec_auto ) {
1114
	/* Token parameter */
1115
	LOCATION loc ;
1116
	if ( ds & dspec_register ) return ( r ) ;
1117
	DEREF_loc ( id_loc ( id ), loc ) ;
1118
	report ( loc, ERR_token_scope ( id ) ) ;
1119
	ds |= dspec_register ;
1120
	COPY_dspec ( id_storage ( id ), ds ) ;
1121
	clear_no ( id ) ;
1122
    }
1123
    if ( ds & dspec_defn ) def = 1 ;
1124
    dec = capsule_id ( id, VAR_token ) ;
1125
    if ( def ) {
1126
	if ( ds & dspec_done ) return ( r ) ;
1127
    } else if ( dec ) {
1128
	if ( tokdec_unit == NULL ) return ( r ) ;
1129
    } else {
1130
	return ( r ) ;
1131
    }
1132
 
1133
    /* Construct token sort */
1134
    bf = clear_buffer ( &mangle_buff, NIL ( FILE ) ) ;
1135
    bfputc ( bf, r ) ;
1136
    if ( tag == tok_func_tag ) {
1137
	/* Function token */
1138
	fid = DEREF_id ( tok_func_defn ( tok ) ) ;
1139
	tok = func_proc_token ( tok ) ;
1140
	tag = TAG_tok ( tok ) ;
1141
	if ( tag != tok_proc_tag ) {
1142
	    /* Ellipsis function */
1143
	    return ( r ) ;
1144
	}
1145
    }
1146
    if ( tag == tok_proc_tag ) {
1147
	/*  Parameters for procedure tokens */
1148
	LIST ( IDENTIFIER ) p = DEREF_list ( tok_proc_bids ( tok ) ) ;
1149
	while ( !IS_NULL_list ( p ) ) {
1150
	    IDENTIFIER pid = DEREF_id ( HEAD_list ( p ) ) ;
1151
	    if ( !IS_NULL_id ( pid ) && IS_id_token ( pid ) ) {
1152
		TOKEN ptok = DEREF_tok ( id_token_sort ( pid ) ) ;
1153
		int s = token_code ( ptok ) ;
1154
		npars++ ;
1155
		bfputc ( bf, s ) ;
1156
	    }
1157
	    p = TAIL_list ( p ) ;
1158
	}
1159
    }
1160
    bfputc ( bf, 0 ) ;
1161
 
1162
    /* Output declaration and definition */
1163
    n = DEREF_ulong ( id_no ( id ) ) ;
1164
    if ( dec ) {
1165
	enc_tokdec ( n, strlit ( bf->start ) ) ;
1166
    }
1167
    if ( def ) {
1168
	BITSTREAM *bs ;
1169
	ulong std_pars [20] ;
1170
	ulong *pars = std_pars ;
1171
	if ( npars >= 20 ) pars = xmalloc_nof ( ulong, npars ) ;
1172
	bs = enc_tokdef_start ( n, strlit ( bf->start ), pars, 0 ) ;
1173
	COPY_dspec ( id_storage ( id ), ( ds | dspec_done ) ) ;
1174
	COPY_ulong ( id_no ( id ), LINK_TOKDEF ) ;
1175
	last_params [ DUMMY_token ] = n ;
1176
	if ( tag == tok_proc_tag ) {
1177
	    unsigned i = 0 ;
1178
	    if ( IS_NULL_id ( fid ) ) {
1179
		/* Procedure tokens */
1180
		LIST ( IDENTIFIER ) p, q ;
1181
		p = DEREF_list ( tok_proc_bids ( tok ) ) ;
1182
		q = p ;
1183
		while ( !IS_NULL_list ( q ) ) {
1184
		    IDENTIFIER pid = DEREF_id ( HEAD_list ( q ) ) ;
1185
		    if ( !IS_NULL_id ( pid ) && IS_id_token ( pid ) ) {
1186
			DECL_SPEC pds = DEREF_dspec ( id_storage ( pid ) ) ;
1187
			pds |= dspec_register ;
1188
			COPY_dspec ( id_storage ( pid ), pds ) ;
1189
			COPY_ulong ( id_no ( pid ), pars [i] ) ;
1190
			i++ ;
1191
		    }
1192
		    q = TAIL_list ( q ) ;
1193
		}
1194
		bs = enc_tokdef_body ( bs, id, tok ) ;
1195
		set_proc_token ( p ) ;
1196
	    } else {
1197
		/* Function tokens */
1198
		ulong m ;
1199
		TOKEN res = DEREF_tok ( tok_proc_res ( tok ) ) ;
1200
		TYPE ret = DEREF_type ( tok_exp_type ( res ) ) ;
1201
		ENC_apply_proc ( bs ) ;
1202
		bs = enc_shape ( bs, ret ) ;
1203
		IGNORE capsule_id ( fid, VAR_tag ) ;
1204
		m = unit_no ( bs, fid, VAR_tag, 1 ) ;
1205
		ENC_obtain_tag ( bs ) ;
1206
		ENC_make_tag ( bs, m ) ;
1207
		ENC_LIST ( bs, npars ) ;
1208
		while ( i < npars ) {
1209
		    ENC_exp_apply_token ( bs ) ;
1210
		    ENC_make_tok ( bs, pars [i] ) ;
1211
		    ENC_LEN_SMALL ( bs, 0 ) ;
1212
		    i++ ;
1213
		}
1214
		ENC_OFF ( bs ) ;
1215
	    }
1216
	} else {
1217
	    /* Other tokens */
1218
	    bs = enc_tokdef_body ( bs, id, tok ) ;
1219
	}
1220
	COPY_ulong ( id_no ( id ), n ) ;
1221
	enc_tokdef_end ( n, bs ) ;
1222
	if ( pars != std_pars ) xfree_nof ( pars ) ;
1223
    }
1224
    return ( r ) ;
1225
}
1226
 
1227
 
1228
/*
1229
    SHOULD A VARIABLE BE COMPILED?
1230
 
1231
    This routine determines whether a variable declared with specifiers
1232
    ds and type t should be output.  It returns 1 if it should be output
1233
    immediately, 2 if the decision on whether to output should be deferred
1234
    until later, and 0 otherwise.
1235
*/
1236
 
1237
static int need_variable
1238
    PROTO_N ( ( ds, t, e, n ) )
1239
    PROTO_T ( DECL_SPEC ds X TYPE t X EXP e X ulong n )
1240
{
1241
    if ( ds & dspec_temp ) {
1242
	/* Temporary variables */
1243
	if ( ds & dspec_ignore ) return ( 0 ) ;
1244
	if ( ds & dspec_explicit ) return ( 2 ) ;
1245
    }
1246
    if ( ds & dspec_defn ) {
1247
	/* Output defined variables */
1248
	if ( ds & dspec_extern ) return ( 1 ) ;
1249
	if ( n == LINK_NONE ) {
1250
#if LANGUAGE_CPP
1251
	    CV_SPEC qual = DEREF_cv ( type_qual ( t ) ) ;
1252
	    if ( qual == ( cv_lvalue | cv_const ) ) {
1253
		/* Defer literal constants */
1254
		return ( 2 ) ;
1255
	    }
1256
#else
1257
	    UNUSED ( t ) ;
1258
#endif
1259
	    if ( !output_unused ) return ( 2 ) ;
1260
	    if ( !overflow_exp ( e ) ) return ( 2 ) ;
1261
	}
1262
	return ( 1 ) ;
1263
    }
1264
    if ( ds & dspec_used ) {
1265
	/* Defer used variables */
1266
	return ( 2 ) ;
1267
    }
1268
    return ( 0 ) ;
1269
}
1270
 
1271
 
1272
/*
1273
    COMPILE A VARIABLE
1274
 
1275
    This routine compiles the global variable or static data member id.
1276
*/
1277
 
1278
void compile_variable
1279
    PROTO_N ( ( id, force ) )
1280
    PROTO_T ( IDENTIFIER id X int force )
1281
{
1282
    if ( output_capsule ) {
1283
	IDENTIFIER lid = DEREF_id ( id_alias ( id ) ) ;
1284
	DECL_SPEC ds = DEREF_dspec ( id_storage ( lid ) ) ;
1285
	if ( !( ds & dspec_done ) ) {
1286
	    TYPE t ;
1287
	    EXP e, d ;
1288
	    int output ;
1289
	    switch ( TAG_id ( id ) ) {
1290
		case id_variable_tag :
1291
		case id_stat_member_tag : {
1292
		    /* Variables and static data members */
1293
		    t = DEREF_type ( id_variable_etc_type ( lid ) ) ;
1294
		    e = DEREF_exp ( id_variable_etc_init ( lid ) ) ;
1295
		    d = DEREF_exp ( id_variable_etc_term ( lid ) ) ;
1296
		    if ( !IS_NULL_exp ( e ) && IS_exp_zero ( e ) ) {
1297
			/* Ignore tentative definitions */
1298
			ds &= ~dspec_defn ;
1299
		    }
1300
		    break ;
1301
		}
1302
		case id_enumerator_tag : {
1303
		    /* Dummy enumerator values */
1304
		    if ( !output_unused ) return ;
1305
		    e = DEREF_exp ( id_enumerator_value ( lid ) ) ;
1306
		    e = eval_exp ( e, 1 ) ;
1307
		    if ( !overflow_exp ( e ) ) return ;
1308
		    t = DEREF_type ( exp_type ( e ) ) ;
1309
		    d = NULL_exp ;
1310
		    force = 1 ;
1311
		    break ;
1312
		}
1313
		default : {
1314
		    /* Shouldn't happen */
1315
		    return ;
1316
		}
1317
	    }
1318
	    if ( !IS_NULL_exp ( d ) && IS_exp_paren ( d ) ) {
1319
		/* Ignore parenthesised type information */
1320
		d = DEREF_exp ( exp_paren_arg ( d ) ) ;
1321
	    }
1322
	    if ( !( ds & dspec_defn ) ) {
1323
		/* Object not defined */
1324
		e = NULL_exp ;
1325
		d = NULL_exp ;
1326
	    }
1327
	    if ( ds & dspec_explicit ) {
1328
		/* Explicitly initialised object */
1329
		d = NULL_exp ;
1330
	    }
1331
	    if ( force ) {
1332
		/* Force output */
1333
		output = 1 ;
1334
	    } else if ( !IS_NULL_exp ( e ) && IS_exp_dynamic ( e ) ) {
1335
		/* Dynamic initialiser */
1336
		output = 1 ;
1337
	    } else if ( !IS_NULL_exp ( d ) ) {
1338
		/* Dynamic destructor */
1339
		output = 1 ;
1340
	    } else {
1341
		/* Determine whether to output */
1342
		ulong n = DEREF_ulong ( id_no ( lid ) ) ;
1343
		output = need_variable ( ds, t, e, n ) ;
1344
		if ( output == 2 ) {
1345
		    /* Defer variable until later */
1346
		    CONS_id ( lid, pending_funcs, pending_funcs ) ;
1347
		    output = 0 ;
1348
		}
1349
	    }
1350
	    if ( output ) {
1351
		/* Output variable definition */
1352
		ds |= dspec_done ;
1353
		COPY_dspec ( id_storage ( lid ), ds ) ;
1354
		crt_enc_loc = id_loc ( lid ) ;
1355
		IGNORE make_tagdef ( lid, t, e, d, 1 ) ;
1356
		crt_enc_loc = NULL_ptr ( LOCATION ) ;
1357
	    }
1358
	} else {
1359
	    /* Check for anonymous unions */
1360
	    if ( !EQ_id ( id, lid ) ) {
1361
		if ( output_diag && is_anon_member ( id ) ) {
1362
		    enc_diag_id ( id, 1 ) ;
1363
		}
1364
	    }
1365
	}
1366
    } else {
1367
	check_mangled ( id ) ;
1368
    }
1369
    return ;
1370
}
1371
 
1372
 
1373
/*
1374
    COMPILE ALL PENDING FUNCTIONS
1375
 
1376
    This routine compiles all the inline and implicit functions which
1377
    have been used in the program.  The usage information comes from
1378
    the fact that the function tag has actually been output rather than
1379
    the function has been used (possibly in a function which is not
1380
    itself used).
1381
*/
1382
 
1383
void compile_pending
1384
    PROTO_Z ()
1385
{
1386
    int changed ;
1387
    do {
1388
	LIST ( IDENTIFIER ) p = pending_funcs ;
1389
	if ( !output_capsule ) break ;
1390
	changed = 0 ;
1391
	while ( !IS_NULL_list ( p ) ) {
1392
	    IDENTIFIER id = DEREF_id ( HEAD_list ( p ) ) ;
1393
	    if ( !IS_NULL_id ( id ) ) {
1394
		ulong n = DEREF_ulong ( id_no ( id ) ) ;
1395
		if ( n != LINK_NONE ) {
1396
		    DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
1397
		    if ( !( ds & dspec_done ) ) {
1398
			if ( IS_id_function_etc ( id ) ) {
1399
			    if ( ds & dspec_trivial ) {
1400
				/* It can happen ... */
1401
				ds &= ~( dspec_defn | dspec_trivial ) ;
1402
				COPY_dspec ( id_storage ( id ), ds ) ;
1403
			    }
1404
			    if ( !( ds & dspec_defn ) ) {
1405
				/* Function not defined */
1406
				if ( ds & dspec_implicit ) {
1407
				    /* Compile implicit functions */
1408
				    LOCATION loc ;
1409
				    bad_crt_loc++ ;
1410
				    loc = crt_loc ;
1411
				    DEREF_loc ( id_loc ( id ), crt_loc ) ;
1412
				    implicit_defn ( id, DEFAULT_USR ) ;
1413
				    crt_loc = loc ;
1414
				    bad_crt_loc-- ;
1415
				} else if ( ds & dspec_extern ) {
1416
				    /* External linkage */
1417
				    update_tag ( id, 1 ) ;
1418
				}
1419
			    }
1420
			    compile_function ( id, 1 ) ;
1421
			} else {
1422
			    compile_variable ( id, 1 ) ;
1423
			}
1424
			changed = 1 ;
1425
		    }
1426
		    COPY_id ( HEAD_list ( p ), NULL_id ) ;
1427
		}
1428
	    }
1429
	    p = TAIL_list ( p ) ;
1430
	}
1431
	if ( !changed ) changed = enc_diag_pending () ;
1432
    } while ( changed ) ;
1433
    compile_incompl () ;
1434
    return ;
1435
}
1436
 
1437
 
1438
/*
1439
    SHOULD A FUNCTION BE COMPILED?
1440
 
1441
    This routine determines whether a function declared with specifiers
1442
    ds should be output.  It returns 1 if it should be output immediately,
1443
    2 if the decision on whether to output should be deferred until later,
1444
    and 0 otherwise.  The algorithm is somewhat complex to avoid outputting
1445
    inline and implicit function definitions unless absolutely necessary
1446
    and to only declare virtual functions when explicitly called or when
1447
    defining a virtual function table.
1448
*/
1449
 
1450
static int need_function
1451
    PROTO_N ( ( ds, n ) )
1452
    PROTO_T ( DECL_SPEC ds X ulong n )
1453
{
1454
    if ( ds & ( dspec_inline | dspec_implicit | dspec_token ) ) {
1455
	/* Defer inline functions */
1456
	if ( ( ds & dspec_defn ) && n != LINK_NONE ) return ( 1 ) ;
1457
	return ( 2 ) ;
1458
    }
1459
    if ( ds & dspec_defn ) {
1460
	/* Output defined functions */
1461
	if ( ( ds & dspec_extern ) || output_unused ) return ( 1 ) ;
1462
	if ( n != LINK_NONE ) return ( 1 ) ;
1463
	return ( 2 ) ;
1464
    }
1465
    if ( ds & ( dspec_used | dspec_called | dspec_virtual ) ) {
1466
	/* Defer called functions */
1467
	return ( 2 ) ;
1468
    }
1469
    return ( 0 ) ;
1470
}
1471
 
1472
 
1473
/*
1474
    COMPILE A FUNCTION
1475
 
1476
    This routine compiles the function or member function id.  If force
1477
    is true then the definition of id is always output.
1478
*/
1479
 
1480
void compile_function
1481
    PROTO_N ( ( id, force ) )
1482
    PROTO_T ( IDENTIFIER id X int force )
1483
{
1484
    /* Check for template functions */
1485
    TYPE t ;
1486
    IDENTIFIER lid = DEREF_id ( id_alias ( id ) ) ;
1487
    if ( IS_id_ambig ( lid ) ) return ;
1488
    t = DEREF_type ( id_function_etc_type ( lid ) ) ;
1489
    if ( IS_type_templ ( t ) ) return ;
1490
 
1491
    /* Simple functions */
1492
    if ( output_capsule ) {
1493
	DECL_SPEC ds = DEREF_dspec ( id_storage ( lid ) ) ;
1494
	if ( !( ds & ( dspec_done | dspec_trivial ) ) ) {
1495
	    int output ;
1496
	    if ( force ) {
1497
		/* Force output */
1498
		output = 1 ;
1499
	    } else {
1500
		/* Determine whether to output */
1501
		ulong n = DEREF_ulong ( id_no ( lid ) ) ;
1502
		output = need_function ( ds, n ) ;
1503
		if ( output == 2 ) {
1504
		    /* Defer function until later */
1505
		    CONS_id ( lid, pending_funcs, pending_funcs ) ;
1506
		    output = 0 ;
1507
		}
1508
	    }
1509
	    if ( output == 1 ) {
1510
		/* Output function definition */
1511
		EXP e = DEREF_exp ( id_function_etc_defn ( lid ) ) ;
1512
		if ( !( ds & dspec_defn ) ) e = NULL_exp ;
1513
		ds |= dspec_done ;
1514
		COPY_dspec ( id_storage ( lid ), ds ) ;
1515
		crt_enc_loc = id_loc ( lid ) ;
1516
		IGNORE make_tagdef ( lid, t, e, NULL_exp, 0 ) ;
1517
		crt_enc_loc = NULL_ptr ( LOCATION ) ;
1518
		free_function ( lid ) ;
1519
	    }
1520
	}
1521
    } else {
1522
	free_function ( lid ) ;
1523
	check_mangled ( lid ) ;
1524
    }
1525
    return ;
1526
}
1527
 
1528
 
1529
/*
1530
    VIRTUAL FUNCTION DECLARATION CHECK
1531
 
1532
    This value gives those virtual functions which are ignored when
1533
    deciding whether to output a virtual function table.
1534
*/
1535
 
1536
#define dspec_ignore_virtual\
1537
    ( dspec_inherit | dspec_implicit | dspec_inline | dspec_pure )
1538
 
1539
 
1540
/*
1541
    COMPILE A VIRTUAL FUNCTION TABLE
1542
 
1543
    This routine compiles the virtual function table associated with
1544
    the polymorphic class type ct.  anon is as in check_identifier.
1545
    The criterion used to limit duplicate copies is putting the virtual
1546
    function table definition in the same file as the definition of the
1547
    first (in the sense of first in the virtual function table, rather
1548
    than in the class definition) non-inline virtual function declared
1549
    in the class.
1550
*/
1551
 
1552
#if LANGUAGE_CPP
1553
 
1554
void compile_virtual
1555
    PROTO_N ( ( ct, anon ) )
1556
    PROTO_T ( CLASS_TYPE ct X int anon )
1557
{
1558
    if ( output_capsule ) {
1559
	IDENTIFIER cid = DEREF_id ( ctype_name ( ct ) ) ;
1560
	crt_enc_loc = id_loc ( cid ) ;
1561
	if ( anon == ANON_NONE && !output_virtual ) {
1562
	    LIST ( VIRTUAL ) pt ;
1563
	    VIRTUAL vt = DEREF_virt ( ctype_virt ( ct ) ) ;
1564
	    if ( IS_NULL_virt ( vt ) ) return ;
1565
	    pt = DEREF_list ( virt_table_entries ( vt ) ) ;
1566
	    while ( !IS_NULL_list ( pt ) ) {
1567
		VIRTUAL at = DEREF_virt ( HEAD_list ( pt ) ) ;
1568
		unsigned tag = TAG_virt ( at ) ;
1569
		while ( tag == virt_link_tag ) {
1570
		    /* Allow for symbolic links */
1571
		    at = DEREF_virt ( DEREF_ptr ( virt_link_to ( at ) ) ) ;
1572
		    tag = TAG_virt ( at ) ;
1573
		}
1574
		if ( tag == virt_simple_tag || tag == virt_override_tag ) {
1575
		    /* Examine virtual functions */
1576
		    IDENTIFIER fn = DEREF_id ( virt_func ( at ) ) ;
1577
		    DECL_SPEC ds = DEREF_dspec ( id_storage ( fn ) ) ;
1578
		    if ( !( ds & dspec_ignore_virtual ) ) {
1579
			if ( ds & dspec_defn ) {
1580
			    /* Define the table externally */
1581
			    define_vtable ( ct, 2, 1 ) ;
1582
			} else {
1583
			    /* Declare the table externally */
1584
			    define_vtable ( ct, 0, 1 ) ;
1585
			}
1586
			return ;
1587
		    }
1588
		}
1589
		pt = TAIL_list ( pt ) ;
1590
	    }
1591
	}
1592
	/* Define the table internally */
1593
	define_vtable ( ct, 1, 0 ) ;
1594
    }
1595
    return ;
1596
}
1597
 
1598
#endif
1599
 
1600
 
1601
/*
1602
    COMPILE A TOKEN
1603
 
1604
    This routine compiles the token id.  It is only called if id is defined
1605
    (in which case def is true) or should be defined.
1606
*/
1607
 
1608
void compile_token
1609
    PROTO_N ( ( id, def ) )
1610
    PROTO_T ( IDENTIFIER id X int def )
1611
{
1612
    if ( !def ) report ( crt_loc, ERR_token_undef ( id ) ) ;
1613
    if ( output_capsule ) {
1614
	crt_enc_loc = id_loc ( id ) ;
1615
	IGNORE enc_tokdef ( id, 1 ) ;
1616
	if ( output_diag ) enc_diag_token ( id, NULL_type ) ;
1617
	crt_enc_loc = NULL_ptr ( LOCATION ) ;
1618
    }
1619
    return ;
1620
}
1621
 
1622
 
1623
/*
1624
    COMPILE A TYPE
1625
 
1626
    This routine compiles the type named id.  This only has an effect in
1627
    diagnostics mode.
1628
*/
1629
 
1630
void compile_type
1631
    PROTO_N ( ( id ) )
1632
    PROTO_T ( IDENTIFIER id )
1633
{
1634
    if ( output_capsule && output_diag ) {
1635
	DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
1636
	if ( ( ds & dspec_used ) && !( ds & dspec_done ) ) {
1637
	    ds |= dspec_done ;
1638
	    COPY_dspec ( id_storage ( id ), ds ) ;
1639
	    if ( ds & dspec_token ) {
1640
		/* Tokenised type */
1641
		/* EMPTY */
1642
	    } else {
1643
		crt_enc_loc = id_loc ( id ) ;
1644
		enc_diag_id ( id, 0 ) ;
1645
		crt_enc_loc = NULL_ptr ( LOCATION ) ;
1646
	    }
1647
	}
1648
    }
1649
    return ;
1650
}
1651
 
1652
 
1653
/*
1654
    COMPILE AN EXTERNAL ASSEMBLER DIRECTIVE
1655
 
1656
    This routine compiles the asm definition e which is declared outside
1657
    any function definition.
1658
*/
1659
 
1660
void compile_asm
1661
    PROTO_N ( ( e ) )
1662
    PROTO_T ( EXP e )
1663
{
1664
    TYPE t = DEREF_type ( exp_type ( e ) ) ;
1665
    IGNORE make_tagdef ( NULL_id, t, e, NULL_exp, 1 ) ;
1666
    return ;
1667
}
1668
 
1669
 
1670
/*
1671
    COMPILE A COMMENT
1672
 
1673
    This routine adds the comment string s of length n to the output
1674
    capsule.  This is used in the implementation of the '#ident' directive.
1675
*/
1676
 
1677
void compile_comment
1678
    PROTO_N ( ( s, n ) )
1679
    PROTO_T ( string s X unsigned long n )
1680
{
1681
    if ( output_capsule ) {
1682
	BITSTREAM *bs = linkinfo_unit ;
1683
	ENC_make_comment ( bs ) ;
1684
	bs = enc_tdfstring ( bs, n, s ) ;
1685
	count_item ( bs ) ;
1686
	linkinfo_unit = bs ;
1687
    }
1688
    return ;
1689
}
1690
 
1691
 
1692
/*
1693
    COMPILE A PRESERVED STATIC IDENTIFIER
1694
 
1695
    This routine adds the preserved static identifier id to the output
1696
    capsule.
1697
*/
1698
 
1699
void compile_preserve
1700
    PROTO_N ( ( id ) )
1701
    PROTO_T ( IDENTIFIER id )
1702
{
1703
    if ( output_capsule ) {
1704
	ulong n ;
1705
	BITSTREAM *bs = linkinfo_unit ;
1706
	ENC_static_name_def ( bs ) ;
1707
	ENC_obtain_tag ( bs ) ;
1708
	IGNORE capsule_id ( id, VAR_tag ) ;
1709
	n = unit_no ( bs, id, VAR_tag, 1 ) ;
1710
	ENC_make_tag ( bs, n ) ;
1711
	bs = enc_diag_name ( bs, id, 1 ) ;
1712
	count_item ( bs ) ;
1713
	linkinfo_unit = bs ;
1714
    }
1715
    return ;
1716
}
1717
 
1718
 
1719
/*
1720
    COMPILE A WEAK LINKAGE DIRECTIVE
1721
 
1722
    This routine adds a weak linkage directive '#pragma weak id = aid'
1723
    to the output capsule.
1724
*/
1725
 
1726
void compile_weak
1727
    PROTO_N ( ( id, aid ) )
1728
    PROTO_T ( IDENTIFIER id X IDENTIFIER aid )
1729
{
1730
    if ( output_capsule && !IS_NULL_id ( id ) ) {
1731
	ulong n ;
1732
	string s = NULL ;
1733
	BITSTREAM *bs = linkinfo_unit ;
1734
 
1735
	/* Set up weak symbol name */
1736
	id = DEREF_id ( id_alias ( id ) ) ;
1737
	IGNORE capsule_id ( id, VAR_tag ) ;
1738
	n = DEREF_ulong ( id_no ( id ) ) ;
1739
	IGNORE capsule_name ( n, &s, VAR_tag ) ;
1740
	if ( s ) {
1741
	    ENC_make_weak_symbol ( bs ) ;
1742
	    bs = enc_ustring ( bs, s ) ;
1743
	    ENC_obtain_tag ( bs ) ;
1744
	    n = unit_no ( bs, id, VAR_tag, 1 ) ;
1745
	    ENC_make_tag ( bs, n ) ;
1746
	    count_item ( bs ) ;
1747
	}
1748
 
1749
	/* Set up weak symbol definition */
1750
	if ( !IS_NULL_id ( aid ) ) {
1751
	    aid = DEREF_id ( id_alias ( aid ) ) ;
1752
	    ENC_make_weak_defn ( bs ) ;
1753
	    ENC_obtain_tag ( bs ) ;
1754
	    n = unit_no ( bs, id, VAR_tag, 1 ) ;
1755
	    ENC_make_tag ( bs, n ) ;
1756
	    ENC_obtain_tag ( bs ) ;
1757
	    IGNORE capsule_id ( aid, VAR_tag ) ;
1758
	    n = unit_no ( bs, aid, VAR_tag, 1 ) ;
1759
	    ENC_make_tag ( bs, n ) ;
1760
	    count_item ( bs ) ;
1761
	}
1762
	linkinfo_unit = bs ;
1763
    }
1764
    return ;
1765
}
1766
 
1767
 
1768
/*
1769
    UPDATE A TAG NAME
1770
 
1771
    This routine updates the external name of the identifier id forcing
1772
    it to become internal or external, depending on the value of ext.  It
1773
    is used to handle inline functions with external linkage.
1774
*/
1775
 
1776
void update_tag
1777
    PROTO_N ( ( id, ext ) )
1778
    PROTO_T ( IDENTIFIER id X int ext )
1779
{
1780
    IDENTIFIER lid = DEREF_id ( id_alias ( id ) ) ;
1781
    ulong n = DEREF_ulong ( id_no ( lid ) ) ;
1782
    if ( n != LINK_NONE && ( n & LINK_EXTERN ) ) {
1783
	string s = mangle_name ( lid, VAR_tag, ext ) ;
1784
	n = capsule_name ( n, &s, VAR_tag ) ;
1785
	COPY_ulong ( id_no ( lid ), n ) ;
1786
	COPY_ulong ( id_no ( id ), n ) ;
1787
    }
1788
    return ;
1789
}
1790
 
1791
 
1792
/*
1793
    START OF DUMMY TDF OUTPUT ROUTINES
1794
 
1795
    The following routines are dummies which are used if TDF output is
1796
    disabled.  The output is still a valid TDF capsule, it just contains
1797
    no information.
1798
*/
1799
 
1800
#else /* TDF_OUTPUT */
1801
 
1802
 
1803
/*
1804
    COMPILE A VARIABLE (DUMMY VERSION)
1805
 
1806
    This routine is a dummy for compiling the variable id when TDF
1807
    output is disabled.
1808
*/
1809
 
1810
void compile_variable
1811
    PROTO_N ( ( id, force ) )
1812
    PROTO_T ( IDENTIFIER id X int force )
1813
{
1814
    check_mangled ( id ) ;
1815
    UNUSED ( force ) ;
1816
    return ;
1817
}
1818
 
1819
 
1820
/*
1821
    COMPILE ALL PENDING FUNCTIONS (DUMMY VERSION)
1822
 
1823
    This routine is a dummy for compiling all pending functions when
1824
    TDF output is disabled.
1825
*/
1826
 
1827
void compile_pending
1828
    PROTO_Z ()
1829
{
1830
    return ;
1831
}
1832
 
1833
 
1834
/*
1835
    COMPILE A FUNCTION (DUMMY VERSION)
1836
 
1837
    This routine is a dummy for compiling the function id when TDF
1838
    output is disabled.
1839
*/
1840
 
1841
void compile_function
1842
    PROTO_N ( ( id, force ) )
1843
    PROTO_T ( IDENTIFIER id X int force )
1844
{
1845
    TYPE t = DEREF_type ( id_function_etc_type ( t ) ) ;
1846
    if ( IS_type_func ( t ) ) free_function ( id ) ;
1847
    check_mangled ( id ) ;
1848
    UNUSED ( force ) ;
1849
    return ;
1850
}
1851
 
1852
 
1853
/*
1854
    COMPILE A VIRTUAL FUNCTION TABLE (DUMMY VERSION)
1855
 
1856
    This routine is a dummy for compiling the virtual function table
1857
    associated with the polymorphic class type ct when TDF output is
1858
    disabled.
1859
*/
1860
 
1861
#if LANGUAGE_CPP
1862
 
1863
void compile_virtual
1864
    PROTO_N ( ( ct, anon ) )
1865
    PROTO_T ( CLASS_TYPE ct X int anon )
1866
{
1867
    UNUSED ( ct ) ;
1868
    UNUSED ( anon ) ;
1869
    return ;
1870
}
1871
 
1872
#endif
1873
 
1874
 
1875
/*
1876
    COMPILE A TOKEN (DUMMY VERSION)
1877
 
1878
    This routine is a dummy for compiling the token id when TDF output
1879
    is disabled.
1880
*/
1881
 
1882
void compile_token
1883
    PROTO_N ( ( id, def ) )
1884
    PROTO_T ( IDENTIFIER id X int def )
1885
{
1886
    if ( !def ) report ( crt_loc, ERR_token_undef ( id ) ) ;
1887
    return ;
1888
}
1889
 
1890
 
1891
/*
1892
    COMPILE A TYPE (DUMMY VERSION)
1893
 
1894
    This routine is a dummy for compiling the type named id when TDF
1895
    output is disabled.
1896
*/
1897
 
1898
void compile_type
1899
    PROTO_N ( ( id ) )
1900
    PROTO_T ( IDENTIFIER id )
1901
{
1902
    UNUSED ( id ) ;
1903
    return ;
1904
}
1905
 
1906
 
1907
/*
1908
    COMPILE AN EXTERNAL ASSEMBLER DIRECTIVE (DUMMY VERSION)
1909
 
1910
    This routine is a dummy for compiling the asm definition e which is
1911
    declared outside any function definition.
1912
*/
1913
 
1914
void compile_asm
1915
    PROTO_N ( ( e ) )
1916
    PROTO_T ( EXP e )
1917
{
1918
    UNUSED ( e ) ;
1919
    return ;
1920
}
1921
 
1922
 
1923
/*
1924
    COMPILE A COMMENT (DUMMY VERSION)
1925
 
1926
    This routine is a dummy for compiling the comment given by s and n
1927
    when TDF output is disabled.
1928
*/
1929
 
1930
void compile_comment
1931
    PROTO_N ( ( s, n ) )
1932
    PROTO_T ( string s X unsigned long n )
1933
{
1934
    UNUSED ( s ) ;
1935
    UNUSED ( n ) ;
1936
    return ;
1937
}
1938
 
1939
 
1940
/*
1941
    COMPILE A PRESERVED STATIC IDENTIFIER (DUMMY VERSION)
1942
 
1943
    This routine is a dummy for compiling the preserved static identifier
1944
    id when TDF output is disabled.
1945
*/
1946
 
1947
void compile_preserve
1948
    PROTO_N ( ( id ) )
1949
    PROTO_T ( IDENTIFIER id )
1950
{
1951
    UNUSED ( id ) ;
1952
    return ;
1953
}
1954
 
1955
 
1956
/*
1957
    COMPILE A WEAK LINKAGE DIRECTIVE (DUMMY VERSION)
1958
 
1959
    This routine is a dummy for compiling the weak linkage directive
1960
    '#pragma weak id = aid' when TDF output is disabled.
1961
*/
1962
 
1963
void compile_weak
1964
    PROTO_N ( ( id, aid ) )
1965
    PROTO_T ( IDENTIFIER id X IDENTIFIER aid )
1966
{
1967
    UNUSED ( id ) ;
1968
    UNUSED ( aid ) ;
1969
    return ;
1970
}
1971
 
1972
 
1973
/*
1974
    UPDATE A TAG NAME (DUMMY VERSION)
1975
 
1976
    This routine is a dummy for updating the external name of the
1977
    identifier id when TDF output is disabled.
1978
*/
1979
 
1980
void update_tag
1981
    PROTO_N ( ( id, ext ) )
1982
    PROTO_T ( IDENTIFIER id X int ext )
1983
{
1984
    UNUSED ( id ) ;
1985
    UNUSED ( ext ) ;
1986
    return ;
1987
}
1988
 
1989
 
1990
#endif /* TDF_OUTPUT */