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 "system.h"
34
#include "c_types.h"
35
#include "ctype_ops.h"
36
#include "etype_ops.h"
37
#include "exp_ops.h"
38
#include "ftype_ops.h"
39
#include "graph_ops.h"
40
#include "hashid_ops.h"
41
#include "id_ops.h"
42
#include "itype_ops.h"
43
#include "member_ops.h"
44
#include "nspace_ops.h"
45
#include "tok_ops.h"
46
#include "type_ops.h"
47
#include "virt_ops.h"
48
#include "error.h"
49
#include "tdf.h"
50
#include "access.h"
51
#include "basetype.h"
52
#include "buffer.h"
53
#include "capsule.h"
54
#include "check.h"
55
#include "class.h"
56
#include "compile.h"
57
#include "constant.h"
58
#include "convert.h"
59
#include "destroy.h"
60
#include "diag.h"
61
#include "diag2.h"
62
#include "encode.h"
63
#include "exception.h"
64
#include "exp.h"
65
#include "file.h"
66
#include "function.h"
67
#include "hash.h"
68
#include "mangle.h"
69
#include "namespace.h"
70
#include "print.h"
71
#include "shape.h"
72
#include "stmt.h"
73
#include "struct.h"
74
#include "syntax.h"
75
#include "throw.h"
76
#include "tok.h"
77
#include "typeid.h"
78
#include "ustring.h"
79
#include "virtual.h"
80
#if ( TDF_OUTPUT && TDF_NEW_DIAG )
81
 
82
 
83
/*
84
    DWARF TAG VALUES
85
 
86
    Certain values used within the diagnostic format are actually DWARF
87
    tag values.  These macros give the values used.
88
*/
89
 
90
#define DWARF_LANG_TRAD_C		1
91
#define DWARF_LANG_ANSI_C		2
92
#define DWARF_LANG_CPP			4
93
 
94
#if LANGUAGE_C
95
#define DWARF_LANG			DWARF_LANG_ANSI_C
96
#define DWARF_LANG_NOT			DWARF_LANG_CPP
97
#else
98
#define DWARF_LANG			DWARF_LANG_CPP
99
#define DWARF_LANG_NOT			DWARF_LANG_ANSI_C
100
#endif
101
 
102
#define DWARF_EXPLICIT			1
103
#define DWARF_IMPLICIT			2
104
#define DWARF_VIRT_EXPL			3
105
#define DWARF_VIRT_IMPL			4
106
#define DWARF_CONSTR			5
107
#define DWARF_VIRT_CONSTR		6
108
#define DWARF_DESTR			7
109
#define DWARF_VIRT_DESTR		8
110
 
111
#define DWARF_USING_DIR			3
112
#define DWARF_USING_DECL		5
113
 
114
#define DWARF_ORDINARY			1
115
#define DWARF_NO_CALL			2
116
#define DWARF_RUN_TIME			3
117
 
118
#define DWARF_CASE_SENSITIVE		0
119
 
120
 
121
/*
122
    ENCODE A DIAGNOSTIC FILE NAME
123
 
124
    This routine adds the diagnostic file name given by posn to the
125
    bitstream bs.
126
*/
127
 
128
static BITSTREAM *enc_dg_filename
129
    PROTO_N ( ( bs, posn ) )
130
    PROTO_T ( BITSTREAM *bs X PTR ( POSITION ) posn )
131
{
132
    ulong n = DEREF_ulong ( posn_tok ( posn ) ) ;
133
    if ( n == LINK_NONE ) {
134
	BITSTREAM *ts ;
135
	string bn = DEREF_string ( posn_base ( posn ) ) ;
136
	string mn = ustrlit ( find_machine () ) ;
137
	ulong date = DEREF_ulong ( posn_datestamp ( posn ) ) ;
138
	n = capsule_no ( NULL_string, VAR_token ) ;
139
	COPY_ulong ( posn_tok ( posn ), n ) ;
140
	if ( !output_date ) date = 0 ;
141
	ts = enc_tokdef_start ( n, "Q", NIL ( ulong ), 0 ) ;
142
	ENC_make_dg_filename ( ts ) ;
143
	ENC_make_nat ( ts ) ;
144
	ENC_INT ( ts, date ) ;
145
	ENC_make_string ( ts ) ;
146
	ts = enc_ustring ( ts, mn ) ;
147
	ENC_make_string ( ts ) ;
148
	if ( is_full_pathname ( bn ) ) {
149
	    ts = enc_ustring ( ts, ustrlit ( "" ) ) ;
150
	} else {
151
	    string dn = DEREF_string ( posn_dir ( posn ) ) ;
152
	    if ( dn == NULL ) {
153
		string en = ustrlit ( find_cwd () ) ;
154
		ts = enc_ustring ( ts, en ) ;
155
	    } else if ( is_full_pathname ( dn ) ) {
156
		ts = enc_ustring ( ts, dn ) ;
157
	    } else {
158
		string en = ustrlit ( find_cwd () ) ;
159
		BUFFER *bf = clear_buffer ( &incl_buff, NIL ( FILE ) ) ;
160
		bfprintf ( bf, "%s/%s", en, dn ) ;
161
		ts = enc_ustring ( ts, bf->start ) ;
162
	    }
163
	}
164
	ENC_make_string ( ts ) ;
165
	ts = enc_ustring ( ts, bn ) ;
166
	enc_tokdef_end ( n, ts ) ;
167
    }
168
 
169
    /* Encode token application */
170
    ENC_dg_filename_apply_token ( bs ) ;
171
    n = link_no ( bs, n, VAR_token ) ;
172
    ENC_make_tok ( bs, n ) ;
173
    ENC_LEN_SMALL ( bs, 0 ) ;
174
    return ( bs ) ;
175
}
176
 
177
 
178
/*
179
    ENCODE A DIAGNOSTIC SOURCE POSITION
180
 
181
    This routine adds the source position given by the span from p to q
182
    to the bitstream bs.
183
*/
184
 
185
static BITSTREAM *enc_dg_loc
186
    PROTO_N ( ( bs, p, q ) )
187
    PROTO_T ( BITSTREAM *bs X PTR ( LOCATION ) p X PTR ( LOCATION ) q )
188
{
189
    if ( IS_NULL_ptr ( p ) || IS_NULL_ptr ( q ) ) {
190
	ENC_dg_null_sourcepos ( bs ) ;
191
    } else {
192
	ulong lp = DEREF_ulong ( loc_line ( p ) ) ;
193
	ulong lq = DEREF_ulong ( loc_line ( q ) ) ;
194
	ulong cp = DEREF_ulong ( loc_column ( p ) ) ;
195
	ulong cq = DEREF_ulong ( loc_column ( q ) ) ;
196
	PTR ( POSITION ) fp = DEREF_ptr ( loc_posn ( p ) ) ;
197
	PTR ( POSITION ) fq = DEREF_ptr ( loc_posn ( q ) ) ;
198
	if ( EQ_ptr ( p, q ) ) {
199
	    ENC_dg_mark_sourcepos ( bs ) ;
200
	} else if ( lp == lq && cp == cq && EQ_ptr ( fp, fq ) ) {
201
	    ENC_dg_mark_sourcepos ( bs ) ;
202
	    q = p ;
203
	} else {
204
	    ENC_dg_span_sourcepos ( bs ) ;
205
	}
206
	bs = enc_dg_filename ( bs, fp ) ;
207
	ENC_make_nat ( bs ) ;
208
	ENC_INT ( bs, lp ) ;
209
	ENC_make_nat ( bs ) ;
210
	ENC_INT ( bs, cp ) ;
211
	if ( !EQ_ptr ( p, q ) ) {
212
	    if ( EQ_ptr ( fp, fq ) ) {
213
		ENC_OFF ( bs ) ;
214
	    } else {
215
		ENC_ON ( bs ) ;
216
		bs = enc_dg_filename ( bs, fq ) ;
217
	    }
218
	    ENC_make_nat ( bs ) ;
219
	    ENC_INT ( bs, lq ) ;
220
	    ENC_make_nat ( bs ) ;
221
	    ENC_INT ( bs, cq ) ;
222
	}
223
    }
224
    return ( bs ) ;
225
}
226
 
227
 
228
/*
229
    FIND THE START OR END OF A BLOCK
230
 
231
    This routine returns the location of the start or end of the block e.
232
*/
233
 
234
static PTR ( LOCATION ) block_loc
235
    PROTO_N ( ( e, end ) )
236
    PROTO_T ( EXP e X int end )
237
{
238
    PTR ( LOCATION ) loc = NULL_ptr ( LOCATION ) ;
239
    if ( !IS_NULL_exp ( e ) ) {
240
	if ( IS_exp_solve_stmt ( e ) ) {
241
	    e = DEREF_exp ( exp_solve_stmt_body ( e ) ) ;
242
	}
243
	if ( IS_exp_sequence ( e ) ) {
244
	    EXP a ;
245
	    LIST ( EXP ) p ;
246
	    if ( end ) {
247
		p = DEREF_list ( exp_sequence_last ( e ) ) ;
248
	    } else {
249
		p = DEREF_list ( exp_sequence_first ( e ) ) ;
250
	    }
251
	    a = DEREF_exp ( HEAD_list ( p ) ) ;
252
	    if ( !IS_NULL_exp ( a ) && IS_exp_location ( a ) ) {
253
		loc = exp_location_end ( a ) ;
254
	    }
255
	}
256
    }
257
    return ( loc ) ;
258
}
259
 
260
 
261
/*
262
    ENCODE THE START OF A NAMESPACE
263
 
264
    This routine adds the start of a list of names derived from the
265
    namespace ns to the bitstream bs.
266
*/
267
 
268
static BITSTREAM *enc_dg_namelist
269
    PROTO_N ( ( bs, ns ) )
270
    PROTO_T ( BITSTREAM *bs X NAMESPACE ns )
271
{
272
    ulong n = capsule_no ( NULL_string, VAR_dgtag ) ;
273
    IDENTIFIER id = DEREF_id ( nspace_name ( ns ) ) ;
274
    if ( !IS_NULL_id ( id ) ) COPY_ulong ( id_no ( id ), n ) ;
275
    record_usage ( n, VAR_dgtag, USAGE_DEFN ) ;
276
    ENC_dg_tag_namelist ( bs ) ;
277
    n = link_no ( bs, n, VAR_dgtag ) ;
278
    ENC_make_dg_tag ( bs, n ) ;
279
    ENC_make_dg_namelist ( bs ) ;
280
    ENC_LIST_SMALL ( bs, 0 ) ;
281
    return ( bs ) ;
282
}
283
 
284
 
285
/*
286
    ENCODE COMMAND-LINE OPTIONS
287
 
288
    This routine adds the revelant command-line options as a list of
289
    strings to the bitstream bs.
290
*/
291
 
292
static BITSTREAM *enc_dg_options
293
    PROTO_N ( ( bs ) )
294
    PROTO_T ( BITSTREAM *bs )
295
{
296
    unsigned n = 0 ;
297
    INCL_DIR *d = dir_path ;
298
    while ( d != NULL ) {
299
	n++ ;
300
	d = d->next ;
301
    }
302
    ENC_LIST ( bs, n ) ;
303
    d = dir_path ;
304
    while ( d != NULL ) {
305
	BUFFER *bf = clear_buffer ( &incl_buff, NIL ( FILE ) ) ;
306
	ENC_make_string ( bs ) ;
307
	bfprintf ( bf, "-I%s", d->path ) ;
308
	bs = enc_ustring ( bs, bf->start ) ;
309
	d = d->next ;
310
    }
311
    return ( bs ) ;
312
}
313
 
314
 
315
/*
316
    ENCODE A COMPILATION UNIT
317
 
318
    This routine adds the top-level compilation unit information to the
319
    bitstream bs.  The current location gives information about the
320
    primary source file.
321
*/
322
 
323
BITSTREAM *enc_dg_compilation
324
    PROTO_N ( ( bs ) )
325
    PROTO_T ( BITSTREAM *bs )
326
{
327
    LOCATION loc ;
328
    ulong date = crt_time ;
329
    string vers = report_version ( 0 ) ;
330
    ENC_make_dg_compilation ( bs ) ;
331
    bs = enc_dg_filename ( bs, crt_loc.posn ) ;
332
    ENC_LIST_SMALL ( bs, 0 ) ;
333
    ENC_LIST_SMALL ( bs, 0 ) ;
334
    loc = crt_loc ;
335
    IGNORE set_crt_loc ( ustrlit ( "" ), 0 ) ;
336
    bs = enc_dg_filename ( bs, crt_loc.posn ) ;
337
    crt_loc = loc ;
338
    if ( !output_date ) date = 0 ;
339
    ENC_make_nat ( bs ) ;
340
    ENC_INT ( bs, date ) ;
341
    ENC_make_nat ( bs ) ;
342
    ENC_INT ( bs, DWARF_LANG ) ;
343
    ENC_make_nat ( bs ) ;
344
    ENC_INT ( bs, DWARF_CASE_SENSITIVE ) ;
345
    ENC_make_string ( bs ) ;
346
    bs = enc_ustring ( bs, vers ) ;
347
    bs = enc_dg_options ( bs ) ;
348
    bs = enc_dg_namelist ( bs, global_namespace ) ;
349
 
350
    /* Output basic type definitions */
351
    if ( output_builtin ) {
352
	CV_SPEC cv ;
353
	BUILTIN_TYPE n ;
354
	for ( n = ntype_char ; n < ntype_ellipsis ; n++ ) {
355
	    TYPE t = type_builtin [n] ;
356
	    switch ( TAG_type ( t ) ) {
357
		case type_integer_tag :
358
		case type_floating_tag : {
359
		    IGNORE enc_dg_basetype ( t, 1 ) ;
360
		    break ;
361
		}
362
	    }
363
	}
364
	for ( cv = cv_none ; cv <= cv_qual ; cv++ ) {
365
	    TYPE t = qualify_type ( type_void, cv, 0 ) ;
366
	    MAKE_type_ptr ( cv_none, t, t ) ;
367
	    IGNORE enc_dg_basetype ( t, 1 ) ;
368
	}
369
    }
370
    return ( bs ) ;
371
}
372
 
373
 
374
/*
375
    ENCODE A DIAGNOSTIC ACCESS SPECIFIER
376
 
377
    This routine adds the access specifier component of ds to the bitstream
378
    bs.  All access specifiers are optional, the default being public.
379
*/
380
 
381
static BITSTREAM *enc_dg_access
382
    PROTO_N ( ( bs, ds ) )
383
    PROTO_T ( BITSTREAM *bs X DECL_SPEC ds )
384
{
385
    DECL_SPEC acc = ( ds & dspec_access ) ;
386
    if ( acc == dspec_private ) {
387
	ENC_ON ( bs ) ;
388
	ENC_dg_private_accessibility ( bs ) ;
389
    } else if ( acc == dspec_protected ) {
390
	ENC_ON ( bs ) ;
391
	ENC_dg_protected_accessibility ( bs ) ;
392
    } else {
393
	ENC_OFF ( bs ) ;
394
    }
395
    return ( bs ) ;
396
}
397
 
398
 
399
/*
400
    ENCODE A DIAGNOSTIC VIRTUAL SPECIFIER
401
 
402
    This routine adds the virtual specifier component of ds to the bitstream
403
    bs.  All virtual specifiers are optional, the default being non-virtual.
404
*/
405
 
406
static BITSTREAM *enc_dg_virtual
407
    PROTO_N ( ( bs, ds ) )
408
    PROTO_T ( BITSTREAM *bs X DECL_SPEC ds )
409
{
410
    if ( ds & dspec_virtual ) {
411
	ENC_ON ( bs ) ;
412
	if ( ds & dspec_pure ) {
413
	    ENC_dg_abstract_virtuality ( bs ) ;
414
	} else {
415
	    ENC_dg_virtual_virtuality ( bs ) ;
416
	}
417
    } else {
418
	ENC_OFF ( bs ) ;
419
    }
420
    return ( bs ) ;
421
}
422
 
423
 
424
/*
425
    ENCODE A TEMPLATE ARGUMENT
426
 
427
    Template arguments are encoded as dummy object or type names.
428
*/
429
 
430
static BITSTREAM *enc_dg_token_arg
431
    PROTO_N ( ( bs, tok ) )
432
    PROTO_T ( BITSTREAM *bs X TOKEN tok )
433
{
434
    int is_type = 0 ;
435
    EXP e = NULL_exp ;
436
    TYPE t = NULL_type ;
437
    if ( !IS_NULL_tok ( tok ) ) {
438
	switch ( TAG_tok ( tok ) ) {
439
	    case tok_exp_tag : {
440
		int c = DEREF_int ( tok_exp_constant ( tok ) ) ;
441
		if ( c ) e = DEREF_exp ( tok_exp_value ( tok ) ) ;
442
		break ;
443
	    }
444
	    case tok_nat_tag :
445
	    case tok_snat_tag : {
446
		NAT n = DEREF_nat ( tok_nat_etc_value ( tok ) ) ;
447
		e = calc_nat_value ( n, type_sint ) ;
448
		break ;
449
	    }
450
	    case tok_type_tag : {
451
		t = DEREF_type ( tok_type_value ( tok ) ) ;
452
		is_type = 1 ;
453
		break ;
454
	    }
455
	    case tok_class_tag : {
456
		is_type = 1 ;
457
		break ;
458
	    }
459
	}
460
    }
461
    if ( is_type ) {
462
	/* Type name */
463
	ENC_dg_type_name ( bs ) ;
464
	ENC_OFF ( bs ) ;
465
	ENC_dg_null_sourcepos ( bs ) ;
466
	ENC_OFF ( bs ) ;
467
	if ( !IS_NULL_type ( t ) ) {
468
	    ENC_ON ( bs ) ;
469
	    bs = enc_dg_type ( bs, t, 0 ) ;
470
	} else {
471
	    ENC_OFF ( bs ) ;
472
	}
473
	ENC_false ( bs ) ;
474
	ENC_OFFS ( bs, 2 ) ;
475
    } else {
476
	/* Object name */
477
	ENC_dg_object_name ( bs ) ;
478
	bs = enc_dg_name ( bs, NULL_id, NULL_type ) ;
479
	ENC_dg_null_sourcepos ( bs ) ;
480
	if ( !IS_NULL_exp ( e ) ) {
481
	    t = DEREF_type ( exp_type ( e ) ) ;
482
	    bs = enc_dg_type ( bs, t, 0 ) ;
483
	    ENC_ON ( bs ) ;
484
	    bs = enc_exp ( bs, e ) ;
485
	} else {
486
	    bs = enc_dg_type ( bs, t, 0 ) ;
487
	    ENC_OFF ( bs ) ;
488
	}
489
	ENC_OFF ( bs ) ;
490
    }
491
    return ( bs ) ;
492
}
493
 
494
 
495
/*
496
    ENCODE AN ARTIFICIAL IDENTIFIER NAME
497
 
498
    This routine adds the artificial identifier name s to the bitstream bs.
499
*/
500
 
501
static BITSTREAM *enc_dg_artificial
502
    PROTO_N ( ( bs, s ) )
503
    PROTO_T ( BITSTREAM *bs X CONST char *s )
504
{
505
    ENC_dg_artificial_idname ( bs ) ;
506
    ENC_ON ( bs ) ;
507
    ENC_make_string ( bs ) ;
508
    bs = enc_ustring ( bs, ustrlit ( s ) ) ;
509
    return ( bs ) ;
510
}
511
 
512
 
513
/*
514
    ENCODE A DIAGNOSTIC IDENTIFIER NAME
515
 
516
    This routine adds the name of the identifier id to the bitstream bs.
517
*/
518
 
519
BITSTREAM *enc_dg_name
520
    PROTO_N ( ( bs, id, form ) )
521
    PROTO_T ( BITSTREAM *bs X IDENTIFIER id X TYPE form )
522
{
523
    if ( !IS_NULL_type ( form ) && IS_type_token ( form ) ) {
524
	/* Template instance name */
525
	IDENTIFIER tid = DEREF_id ( type_token_tok ( form ) ) ;
526
	LIST ( TOKEN ) args = DEREF_list ( type_token_args ( form ) ) ;
527
	if ( !IS_id_token ( tid ) ) {
528
	    ENC_dg_instance_idname ( bs ) ;
529
	    ENC_OFF ( bs ) ;
530
	    bs = enc_dg_name ( bs, tid, NULL_type ) ;
531
	    bs = enc_dg_loc ( bs, id_loc ( tid ), id_loc ( tid ) ) ;
532
	    ENC_LIST ( bs, LENGTH_list ( args ) ) ;
533
	    while ( !IS_NULL_list ( args ) ) {
534
		TOKEN arg = DEREF_tok ( HEAD_list ( args ) ) ;
535
		bs = enc_dg_token_arg ( bs, arg ) ;
536
		args = TAIL_list ( args ) ;
537
	    }
538
	    return ( bs ) ;
539
	}
540
    }
541
    if ( !IS_NULL_id ( id ) ) {
542
	string s ;
543
	HASHID nm = DEREF_hashid ( id_name ( id ) ) ;
544
	switch ( TAG_hashid ( nm ) ) {
545
	    case hashid_name_tag : {
546
		/* Simple case */
547
		s = DEREF_string ( hashid_name_text ( nm ) ) ;
548
		break ;
549
	    }
550
	    case hashid_ename_tag : {
551
		/* Extended case */
552
		if ( EQ_KEYWORD ( nm, lex_this_Hname ) ) {
553
		    bs = enc_dg_artificial ( bs, "this" ) ;
554
		    return ( bs ) ;
555
		}
556
		s = DEREF_string ( hashid_ename_text ( nm ) ) ;
557
		break ;
558
	    }
559
	    case hashid_anon_tag : {
560
		/* Anonymous case */
561
		ENC_dg_anonymous_idname ( bs ) ;
562
		ENC_OFF ( bs ) ;
563
		return ( bs ) ;
564
	    }
565
	    default : {
566
		/* Other cases */
567
		BUFFER *bf ;
568
		bf = clear_buffer ( &mangle_buff, NIL ( FILE ) ) ;
569
		IGNORE print_hashid ( nm, 0, 0, bf, 0 ) ;
570
		s = bf->start ;
571
		break ;
572
	    }
573
	}
574
	if ( has_linkage ( id ) ) {
575
	    ENC_dg_external_idname ( bs ) ;
576
	} else {
577
	    ENC_dg_sourcestring_idname ( bs ) ;
578
	}
579
	ENC_make_string ( bs ) ;
580
	bs = enc_ustring ( bs, s ) ;
581
    } else {
582
	ENC_dg_anonymous_idname ( bs ) ;
583
	ENC_OFF ( bs ) ;
584
    }
585
    return ( bs ) ;
586
}
587
 
588
 
589
/*
590
    ENCODE A DIAGNOSTIC IDENTIFIER
591
 
592
    This routine adds the diagnostics for the identifier id to the
593
    bitstream bs.  use indicates whether a declaration or a definition
594
    should be output.
595
*/
596
 
597
static BITSTREAM *enc_dg_decl
598
    PROTO_N ( ( bs, id, n, use ) )
599
    PROTO_T ( BITSTREAM *bs X IDENTIFIER id X ulong n X unsigned use )
600
{
601
    int spec = 0 ;
602
    int force = 1 ;
603
    int tagged = 0 ;
604
    unsigned tag = TAG_id ( id ) ;
605
    DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
606
    switch ( tag ) {
607
	case id_class_name_tag :
608
	case id_enum_name_tag : {
609
	    /* Class and enumeration names */
610
	    tagged = LANGUAGE_C ;
611
	    force = 2 ;
612
	    break ;
613
	}
614
    }
615
    if ( n != LINK_NONE && !tagged ) {
616
	/* Declare diagnostic tag if required */
617
	if ( use & USAGE_DECL ) {
618
	    ulong m = link_no ( bs, n, VAR_dgtag ) ;
619
	    if ( use & USAGE_USE ) {
620
		ENC_dg_spec_ref_name ( bs ) ;
621
	    } else {
622
		ENC_dg_tag_name ( bs ) ;
623
	    }
624
	    ENC_make_dg_tag ( bs, m ) ;
625
	    if ( use & USAGE_DEFN ) {
626
		record_usage ( n, VAR_dgtag, USAGE_DEFN ) ;
627
	    } else {
628
		record_usage ( n, VAR_dgtag, USAGE_DECL ) ;
629
		ENC_dg_is_spec_name ( bs ) ;
630
		spec = 1 ;
631
	    }
632
	}
633
    }
634
    switch ( tag ) {
635
 
636
	case id_variable_tag :
637
	case id_parameter_tag :
638
	case id_stat_member_tag : {
639
	    /* Object names */
640
	    TYPE t = DEREF_type ( id_variable_etc_type ( id ) ) ;
641
	    ENC_dg_object_name ( bs ) ;
642
	    bs = enc_dg_name ( bs, id, NULL_type ) ;
643
	    bs = enc_dg_loc ( bs, id_loc ( id ), id_loc ( id ) ) ;
644
	    bs = enc_dg_type ( bs, t, 0 ) ;
645
	    if ( use & USAGE_DEFN ) {
646
		EXP e ;
647
		int et = error_threshold ;
648
		error_threshold = ERROR_SERIOUS ;
649
		ENC_ON ( bs ) ;
650
		MAKE_exp_identifier ( t, id, qual_none, e ) ;
651
		e = convert_reference ( e, REF_NORMAL ) ;
652
		e = convert_lvalue ( e ) ;
653
		if ( IS_type_array ( t ) ) {
654
		    /* Do really want contents of array */
655
		    MAKE_exp_contents ( t, e, e ) ;
656
		}
657
		bs = enc_exp ( bs, e ) ;
658
		free_exp ( e, 1 ) ;
659
		error_threshold = et ;
660
	    } else {
661
		ENC_OFF ( bs ) ;
662
	    }
663
	    bs = enc_dg_access ( bs, ds ) ;
664
	    break ;
665
	}
666
 
667
	case id_function_tag :
668
	case id_mem_func_tag :
669
	case id_stat_mem_func_tag : {
670
	    /* Function names */
671
	    PTR ( LOCATION ) end_loc = id_loc ( id ) ;
672
	    TYPE t = DEREF_type ( id_function_etc_type ( id ) ) ;
673
	    TYPE form = DEREF_type ( id_function_etc_form ( id ) ) ;
674
	    if ( use & USAGE_DEFN ) {
675
		EXP e = DEREF_exp ( id_function_etc_defn ( id ) ) ;
676
		end_loc = block_loc ( e, 1 ) ;
677
		if ( IS_NULL_ptr ( end_loc ) ) end_loc = id_loc ( id ) ;
678
	    }
679
	    ENC_dg_proc_name ( bs ) ;
680
	    bs = enc_dg_name ( bs, id, form ) ;
681
	    if ( ds & dspec_implicit ) {
682
		/* Implicitly declared function */
683
		ENC_dg_null_sourcepos ( bs ) ;
684
	    } else {
685
		bs = enc_dg_loc ( bs, id_loc ( id ), end_loc ) ;
686
	    }
687
	    bs = enc_dg_type ( bs, t, 0 ) ;
688
	    if ( use & USAGE_DEFN ) {
689
		ulong m = DEREF_ulong ( id_no ( id ) ) ;
690
		ENC_ON ( bs ) ;
691
		if ( m == LINK_NONE ) {
692
		    ENC_make_top ( bs ) ;
693
		} else {
694
		    ENC_obtain_tag ( bs ) ;
695
		    m = unit_no ( bs, id, VAR_tag, 0 ) ;
696
		    ENC_make_tag ( bs, m ) ;
697
		}
698
	    } else {
699
		ENC_OFF ( bs ) ;
700
	    }
701
	    bs = enc_dg_access ( bs, ds ) ;
702
	    bs = enc_dg_virtual ( bs, ds ) ;
703
	    bs = enc_bool ( bs, ( ( ds & dspec_inline ) ? 1 : 0 ) ) ;
704
	    if ( IS_type_func ( t ) ) {
705
		LIST ( TYPE ) ex = DEREF_list ( type_func_except ( t ) ) ;
706
		if ( EQ_list ( ex, univ_type_set ) ) {
707
		    ENC_OFF ( bs ) ;
708
		} else {
709
		    ENC_ON ( bs ) ;
710
		    ENC_LIST ( bs, LENGTH_list ( ex ) ) ;
711
		    while ( !IS_NULL_list ( ex ) ) {
712
			TYPE s = DEREF_type ( HEAD_list ( ex ) ) ;
713
			bs = enc_dg_type ( bs, s, 0 ) ;
714
			ex = TAIL_list ( ex ) ;
715
		    }
716
		}
717
	    } else {
718
		ENC_OFF ( bs ) ;
719
	    }
720
	    ENC_OFF ( bs ) ;
721
	    break ;
722
	}
723
 
724
	case id_class_name_tag :
725
	case id_enum_name_tag :
726
	case id_class_alias_tag :
727
	case id_enum_alias_tag :
728
	case id_type_alias_tag : {
729
	    /* Type names */
730
	    TYPE t = DEREF_type ( id_class_name_etc_defn ( id ) ) ;
731
	    ENC_dg_type_name ( bs ) ;
732
	    if ( tagged ) {
733
		ENC_OFF ( bs ) ;
734
	    } else {
735
		TYPE form = NULL_type ;
736
		if ( IS_type_compound ( t ) ) {
737
		    CLASS_TYPE ct ;
738
		    ct = DEREF_ctype ( type_compound_defn ( t ) ) ;
739
		    form = DEREF_type ( ctype_form ( ct ) ) ;
740
		}
741
		ENC_ON ( bs ) ;
742
		bs = enc_dg_name ( bs, id, form ) ;
743
	    }
744
	    bs = enc_dg_loc ( bs, id_loc ( id ), id_loc ( id ) ) ;
745
	    bs = enc_dg_access ( bs, ds ) ;
746
	    ENC_ON ( bs ) ;
747
	    if ( tagged ) {
748
		ulong m = link_no ( bs, n, VAR_dgtag ) ;
749
		if ( use & USAGE_USE ) {
750
		    ENC_dg_spec_ref_type ( bs ) ;
751
		} else {
752
		    ENC_dg_tag_type ( bs ) ;
753
		}
754
		ENC_make_dg_tag ( bs, m ) ;
755
		if ( use & USAGE_DEFN ) {
756
		    record_usage ( n, VAR_dgtag, USAGE_DEFN ) ;
757
		} else {
758
		    record_usage ( n, VAR_dgtag, USAGE_DECL ) ;
759
		}
760
	    }
761
	    bs = enc_dg_type ( bs, t, force ) ;
762
	    ENC_false ( bs ) ;
763
	    ENC_OFFS ( bs, 2 ) ;
764
	    break ;
765
	}
766
 
767
	case id_nspace_name_tag : {
768
	    /* Namespace names */
769
	    IDENTIFIER nid = id ;
770
	    NAMESPACE ns = DEREF_nspace ( id_nspace_name_defn ( id ) ) ;
771
	    if ( IS_nspace_unnamed ( ns ) ) nid = NULL_id ;
772
	    ENC_dg_namespace_name ( bs ) ;
773
	    bs = enc_dg_name ( bs, nid, NULL_type ) ;
774
	    bs = enc_dg_loc ( bs, id_loc ( id ), id_loc ( id ) ) ;
775
	    bs = enc_dg_namelist ( bs, ns ) ;
776
	    break ;
777
	}
778
    }
779
    if ( spec ) ENC_OFF ( bs ) ;
780
    return ( bs ) ;
781
}
782
 
783
 
784
/*
785
    ENCODE DIAGNOSTICS FOR A TOKEN DEFINITION
786
 
787
    This routine outputs any diagnostic information for the token id
788
    to the appropriate diagnostic units.  It is only called if id is
789
    defined.  The type t may be used to override the type of id.
790
*/
791
 
792
void enc_dg_token
793
    PROTO_N ( ( id, t ) )
794
    PROTO_T ( IDENTIFIER id X TYPE t )
795
{
796
    UNUSED ( id ) ;
797
    UNUSED ( t ) ;
798
    return ;
799
}
800
 
801
 
802
/*
803
    LIST OF INCOMPLETE CLASSES
804
 
805
    This list is used to hold all the classes which are used while they
806
    are incomplete.  A diagnostic tag is introduced for each such class
807
    which may be defined later if the class is completed.
808
*/
809
 
810
static LIST ( IDENTIFIER ) dg_classes = NULL_list ( IDENTIFIER ) ;
811
 
812
 
813
/*
814
    DEFINE INCOMPLETE CLASSES
815
 
816
    This routine defines the diagnostic tags for the incomplete classes
817
    in the list above.
818
*/
819
 
820
int enc_dg_pending
821
    PROTO_Z ()
822
{
823
    int changed = 0 ;
824
    LIST ( IDENTIFIER ) p ;
825
    while ( p = dg_classes, !IS_NULL_list ( p ) ) {
826
	dg_classes = NULL_list ( IDENTIFIER ) ;
827
	while ( !IS_NULL_list ( p ) ) {
828
	    IDENTIFIER id ;
829
	    DESTROY_CONS_id ( destroy, id, p, p ) ;
830
	    enc_dg_id ( id, 2 ) ;
831
	    changed = 1 ;
832
	}
833
    }
834
    return ( changed ) ;
835
}
836
 
837
 
838
/*
839
    FIND A DIAGNOSTIC TAG USAGE
840
 
841
    This routine determines the usage for the diagnostic tag associated
842
    with the identifier id in the context given by def (true for
843
    definitions, false for declarations).  The value returned indicates
844
    whether the diagnostic tag should be declared or defined.
845
*/
846
 
847
static unsigned find_dg_usage
848
    PROTO_N ( ( id, pn, def ) )
849
    PROTO_T ( IDENTIFIER id X ulong *pn X int def )
850
{
851
    unsigned use = USAGE_NONE ;
852
    switch ( TAG_id ( id ) ) {
853
	case id_class_name_tag :
854
	case id_enum_name_tag :
855
	case id_class_alias_tag :
856
	case id_enum_alias_tag :
857
	case id_type_alias_tag : {
858
	    /* Type names */
859
	    TYPE t ;
860
	    ulong n = DEREF_ulong ( id_no ( id ) ) ;
861
	    if ( n == LINK_NONE ) {
862
		/* Introduce diagnostic tag for type */
863
		NAMESPACE ns ;
864
		string s = NULL ;
865
		if ( def == 0 ) return ( USAGE_NONE ) ;
866
		t = DEREF_type ( id_class_name_etc_defn ( id ) ) ;
867
		if ( IS_type_top_etc ( t ) ) {
868
		    /* Ignore 'void' types */
869
		    return ( USAGE_NONE ) ;
870
		}
871
		ns = DEREF_nspace ( id_parent ( id ) ) ;
872
		if ( is_local_nspace ( ns ) == 2 ) return ( USAGE_NONE ) ;
873
		if ( output_all ) s = mangle_tname ( "__dg__", t ) ;
874
		n = capsule_no ( s, VAR_dgtag ) ;
875
		COPY_ulong ( id_no ( id ), n ) ;
876
	    } else {
877
		use = USAGE_USE ;
878
	    }
879
	    if ( is_defined ( id, &t, 0 ) ) {
880
		/* Only define each type once */
881
		unsigned prev = find_usage ( n, VAR_dgtag ) ;
882
		if ( prev & USAGE_DEFN ) {
883
		    use = USAGE_NONE ;
884
		} else {
885
		    use |= ( USAGE_DECL | USAGE_DEFN ) ;
886
		}
887
	    } else {
888
		/* Only declare each type once */
889
		if ( use == USAGE_USE ) {
890
		    use = USAGE_NONE ;
891
		} else {
892
		    CONS_id ( id, dg_classes, dg_classes ) ;
893
		    use = USAGE_DECL ;
894
		}
895
	    }
896
	    *pn = n ;
897
	    break ;
898
	}
899
	case id_variable_tag :
900
	case id_stat_member_tag :
901
	case id_function_tag :
902
	case id_mem_func_tag :
903
	case id_stat_mem_func_tag : {
904
	    /* Tag names */
905
	    ulong n = get_diag_tag ( id, VAR_tag ) ;
906
	    if ( n == LINK_NONE ) {
907
		/* Introduce diagnostic tag for tag */
908
		string s = NULL ;
909
		if ( output_all ) s = mangle_name ( id, VAR_dgtag, 0 ) ;
910
		n = capsule_no ( s, VAR_dgtag ) ;
911
		set_diag_tag ( id, VAR_tag, n ) ;
912
		use = USAGE_DECL ;
913
		if ( def ) use |= USAGE_DEFN ;
914
	    } else {
915
		/* Only declare each tag once */
916
		if ( def ) {
917
		    unsigned prev = find_usage ( n, VAR_dgtag ) ;
918
		    if ( prev & USAGE_DEFN ) {
919
			use = USAGE_NONE ;
920
		    } else {
921
			use = ( USAGE_USE | USAGE_DECL | USAGE_DEFN ) ;
922
		    }
923
		}
924
	    }
925
	    *pn = n ;
926
	    break ;
927
	}
928
	case id_nspace_name_tag : {
929
	    /* Namespace names */
930
	    use = USAGE_DEFN ;
931
	    break ;
932
	}
933
    }
934
    return ( use ) ;
935
}
936
 
937
 
938
/*
939
    ENCODE A GLOBAL DIAGNOSTIC IDENTIFIER
940
 
941
    This routine adds the diagnostic information for the global identifier
942
    id to the diagnostic definition unit.  def is true for a definition.
943
*/
944
 
945
void enc_dg_id
946
    PROTO_N ( ( id, def ) )
947
    PROTO_T ( IDENTIFIER id X int def )
948
{
949
    ulong n ;
950
    NAMESPACE ns ;
951
    BITSTREAM *bs ;
952
    IDENTIFIER pid ;
953
 
954
    /* Check the identifier */
955
    ulong m = LINK_NONE ;
956
    unsigned use = find_dg_usage ( id, &m, def ) ;
957
    if ( use == USAGE_NONE ) return ;
958
 
959
    /* Find the parent namespace */
960
    ns = DEREF_nspace ( id_parent ( id ) ) ;
961
    while ( !IS_NULL_nspace ( ns ) && IS_nspace_ctype ( ns ) ) {
962
	pid = DEREF_id ( nspace_name ( ns ) ) ;
963
	enc_dg_id ( pid, 1 ) ;
964
	if ( m != LINK_NONE ) {
965
	    /* Check for inline definitions */
966
	    unsigned prev = find_usage ( m, VAR_dgtag ) ;
967
	    if ( prev & USAGE_DEFN ) return ;
968
	}
969
	ns = DEREF_nspace ( id_parent ( pid ) ) ;
970
    }
971
    if ( IS_NULL_nspace ( ns ) || !IS_nspace_named_etc ( ns ) ) {
972
	/* Ignore local identifiers */
973
	return ;
974
    }
975
    pid = DEREF_id ( nspace_name ( ns ) ) ;
976
    if ( IS_NULL_id ( pid ) ) return ;
977
    n = DEREF_ulong ( id_no ( pid ) ) ;
978
    if ( n == LINK_NONE ) {
979
	/* Allocate namespace list number */
980
	enc_dg_id ( pid, 1 ) ;
981
	n = DEREF_ulong ( id_no ( pid ) ) ;
982
	if ( n == LINK_NONE ) return ;
983
    }
984
 
985
    /* Add the identifier to the namespace */
986
    bs = start_bitstream ( NIL ( FILE ), diagcomp_unit->link ) ;
987
    ENC_dg_name_append ( bs ) ;
988
    n = link_no ( bs, n, VAR_dgtag ) ;
989
    ENC_make_dg_tag ( bs, n ) ;
990
    bs = enc_dg_decl ( bs, id, m, use ) ;
991
    count_item ( bs ) ;
992
    diagcomp_unit = join_bitstreams ( diagcomp_unit, bs ) ;
993
    return ;
994
}
995
 
996
 
997
/*
998
    DIAGNOSTICS FOR POINTER TO VOID
999
 
1000
    This table gives the diagnostic tag numbers used to represent the types
1001
    'cv void *'  for the various cv-qualifiers, cv.
1002
*/
1003
 
1004
static ulong diag_ptr_void [4] = {
1005
    LINK_NONE, LINK_NONE, LINK_NONE, LINK_NONE
1006
} ;
1007
 
1008
 
1009
/*
1010
    ENCODE A BUILT-IN DIAGNOSTIC TYPE
1011
 
1012
    This routine adds the diagnostics for the definition of the built-in
1013
    type t to the diagnostic  bs.  This includes 'void *' as well as the
1014
    more obvious integer and floating point types.
1015
*/
1016
 
1017
ulong enc_dg_basetype
1018
    PROTO_N ( ( t, def ) )
1019
    PROTO_T ( TYPE t X int def )
1020
{
1021
    BITSTREAM *bs = NULL ;
1022
    CV_SPEC cv = cv_none ;
1023
    BASE_TYPE bt = btype_none ;
1024
    unsigned tag = TAG_type ( t ) ;
1025
    string nm = mangle_tname ( "__dg__", t ) ;
1026
    ulong n = capsule_no ( nm, VAR_dgtag ) ;
1027
 
1028
    /* Introduce dummy type name */
1029
    if ( def ) {
1030
	IDENTIFIER gid = DEREF_id ( nspace_name ( global_namespace ) ) ;
1031
	ulong m = DEREF_ulong ( id_no ( gid ) ) ;
1032
	record_usage ( n, VAR_dgtag, USAGE_DEFN ) ;
1033
	bs = start_bitstream ( NIL ( FILE ), diagcomp_unit->link ) ;
1034
	ENC_dg_name_append ( bs ) ;
1035
	m = link_no ( bs, m, VAR_dgtag ) ;
1036
	ENC_make_dg_tag ( bs, m ) ;
1037
	ENC_dg_type_name ( bs ) ;
1038
	ENC_OFF ( bs ) ;
1039
	ENC_dg_global_sourcepos ( bs ) ;
1040
	ENC_OFF ( bs ) ;
1041
	ENC_ON ( bs ) ;
1042
	ENC_dg_tag_type ( bs ) ;
1043
	m = link_no ( bs, n, VAR_dgtag ) ;
1044
	ENC_make_dg_tag ( bs, m ) ;
1045
    }
1046
 
1047
    /* Encode type definition */
1048
    switch ( tag ) {
1049
	case type_integer_tag : {
1050
	    INT_TYPE it = DEREF_itype ( type_integer_rep ( t ) ) ;
1051
	    COPY_ulong ( itype_diag ( it ), n ) ;
1052
	    if ( IS_itype_basic ( it ) ) {
1053
		bt = DEREF_btype ( itype_basic_rep ( it ) ) ;
1054
	    }
1055
	    if ( def ) {
1056
		if ( bt & ( btype_char | btype_wchar_t ) ) {
1057
		    ENC_dg_char_type ( bs ) ;
1058
		} else if ( bt & btype_bool ) {
1059
		    ENC_dg_boolean_type ( bs ) ;
1060
		} else {
1061
		    ENC_dg_integer_type ( bs ) ;
1062
		}
1063
	    }
1064
	    break ;
1065
	}
1066
	case type_floating_tag : {
1067
	    FLOAT_TYPE ft = DEREF_ftype ( type_floating_rep ( t ) ) ;
1068
	    COPY_ulong ( ftype_diag ( ft ), n ) ;
1069
	    if ( IS_ftype_basic ( ft ) ) {
1070
		bt = DEREF_btype ( ftype_basic_rep ( ft ) ) ;
1071
	    }
1072
	    if ( def ) ENC_dg_float_type ( bs ) ;
1073
	    break ;
1074
	}
1075
	case type_ptr_tag : {
1076
	    TYPE s = DEREF_type ( type_ptr_sub ( t ) ) ;
1077
	    cv = DEREF_cv ( type_qual ( s ) ) ;
1078
	    cv &= cv_qual ;
1079
	    diag_ptr_void [ cv ] = n ;
1080
	    bt = ( btype_void | btype_star ) ;
1081
	    if ( def ) ENC_dg_address_type ( bs ) ;
1082
	    break ;
1083
	}
1084
    }
1085
    if ( def ) {
1086
	if ( bt == btype_none ) {
1087
	    bs = enc_dg_name ( bs, NULL_id, NULL_type ) ;
1088
	} else {
1089
	    int sp = 0 ;
1090
	    BUFFER *bf = clear_buffer ( &mangle_buff, NIL ( FILE ) ) ;
1091
	    ENC_dg_external_idname ( bs ) ;
1092
	    ENC_make_string ( bs ) ;
1093
	    if ( cv ) sp = print_cv ( cv, bf, sp ) ;
1094
	    IGNORE print_btype ( bt, bf, sp ) ;
1095
	    bs = enc_ustring ( bs, bf->start ) ;
1096
	}
1097
	switch ( tag ) {
1098
	    case type_integer_tag : {
1099
		bs = enc_variety ( bs, t ) ;
1100
		break ;
1101
	    }
1102
	    case type_floating_tag : {
1103
		bs = enc_flvar ( bs, t ) ;
1104
		break ;
1105
	    }
1106
	    case type_ptr_tag : {
1107
		bs = enc_shape ( bs, t ) ;
1108
		break ;
1109
	    }
1110
	}
1111
	ENC_true ( bs ) ;
1112
	ENC_OFFS ( bs, 2 ) ;
1113
	count_item ( bs ) ;
1114
	diagcomp_unit = join_bitstreams ( diagcomp_unit, bs ) ;
1115
    }
1116
    return ( n ) ;
1117
}
1118
 
1119
 
1120
/*
1121
    ENCODE A DIAGNOSTIC CLASS TAG
1122
 
1123
    This routine adds the diagnostic tag corresponding to the class ct
1124
    to the bitstream bs.
1125
*/
1126
 
1127
static BITSTREAM *enc_dg_ctype
1128
    PROTO_N ( ( bs, ct ) )
1129
    PROTO_T ( BITSTREAM *bs X CLASS_TYPE ct )
1130
{
1131
    ulong n ;
1132
    IDENTIFIER cid = DEREF_id ( ctype_name ( ct ) ) ;
1133
    cid = DEREF_id ( id_alias ( cid ) ) ;
1134
    n = DEREF_ulong ( id_no ( cid ) ) ;
1135
    if ( n == LINK_NONE ) {
1136
	enc_dg_id ( cid, 1 ) ;
1137
	n = DEREF_ulong ( id_no ( cid ) ) ;
1138
    }
1139
    n = link_no ( bs, n, VAR_dgtag ) ;
1140
    ENC_make_dg_tag ( bs, n ) ;
1141
    return ( bs ) ;
1142
}
1143
 
1144
 
1145
/*
1146
    ENCODE A DIAGNOSTIC OFFSET TOKEN
1147
 
1148
    This routine adds the offset off plus the offset token tok to the
1149
    bitstream bs in the form of a token with one expression parameter
1150
    which returns the parameter plus the offset (allowing for virtual
1151
    indirections etc.).
1152
*/
1153
 
1154
static BITSTREAM *enc_dg_offset
1155
    PROTO_N ( ( bs, off, tok, spec ) )
1156
    PROTO_T ( BITSTREAM *bs X OFFSET off X ulong tok X int spec )
1157
{
1158
    BITSTREAM *ts, *us ;
1159
    ulong m = LINK_NONE ;
1160
    ulong n = capsule_no ( NULL_string, VAR_token ) ;
1161
    ts = enc_tokdef_start ( n, "EE", &m, 1 ) ;
1162
    if ( spec == -1 ) {
1163
	us = ts ;
1164
    } else {
1165
	ts = enc_special ( ts, spec ) ;
1166
	us = start_bitstream ( NIL ( FILE ), ts->link ) ;
1167
    }
1168
    if ( tok == LINK_NONE ) {
1169
	us = enc_add_ptr ( us, NULL_exp, m, off, 1 ) ;
1170
    } else {
1171
	ENC_add_to_ptr ( us ) ;
1172
	us = enc_add_ptr ( us, NULL_exp, m, off, 1 ) ;
1173
	tok = link_no ( us, tok, VAR_token ) ;
1174
	ENC_exp_apply_token ( us ) ;
1175
	ENC_make_tok ( us, tok ) ;
1176
	ENC_LEN_SMALL ( us, 0 ) ;
1177
    }
1178
    if ( spec == -1 ) {
1179
	ts = us ;
1180
    } else {
1181
	ts = enc_bitstream ( ts, us ) ;
1182
    }
1183
    enc_tokdef_end ( n, ts ) ;
1184
    n = link_no ( bs, n, VAR_token ) ;
1185
    ENC_make_tok ( bs, n ) ;
1186
    return ( bs ) ;
1187
}
1188
 
1189
 
1190
/*
1191
    ENCODE A LIST OF DIAGNOSTIC BASE CLASSES
1192
 
1193
    This routine adds the list of diagnostic base classes given by br
1194
    to the bitstream bs.
1195
*/
1196
 
1197
static BITSTREAM *enc_dg_bases
1198
    PROTO_N ( ( bs, br ) )
1199
    PROTO_T ( BITSTREAM *bs X LIST ( GRAPH ) br )
1200
{
1201
    ENC_LIST ( bs, LENGTH_list ( br ) ) ;
1202
    while ( !IS_NULL_list ( br ) ) {
1203
	GRAPH gs = DEREF_graph ( HEAD_list ( br ) ) ;
1204
	OFFSET off = DEREF_off ( graph_off ( gs ) ) ;
1205
	CLASS_TYPE cs = DEREF_ctype ( graph_head ( gs ) ) ;
1206
	DECL_SPEC acc = DEREF_dspec ( graph_access ( gs ) ) ;
1207
	ENC_make_dg_class_base ( bs ) ;
1208
	bs = enc_dg_ctype ( bs, cs ) ;
1209
	ENC_OFF ( bs ) ;
1210
	if ( is_zero_offset ( off ) ) {
1211
	    ENC_OFF ( bs ) ;
1212
	} else {
1213
	    /* Base class offset */
1214
	    ENC_ON ( bs ) ;
1215
	    bs = enc_dg_offset ( bs, off, LINK_NONE, -1 ) ;
1216
	}
1217
	bs = enc_dg_access ( bs, acc ) ;
1218
	bs = enc_dg_virtual ( bs, acc ) ;
1219
	br = TAIL_list ( br ) ;
1220
    }
1221
    return ( bs ) ;
1222
}
1223
 
1224
 
1225
/*
1226
    ENCODE A DIAGNOSTIC CLASS MEMBER
1227
 
1228
    This routine adds the class member id to the bitstream bs as a
1229
    DG_CLASSMEM if ct is not null, or as a DG_FIELD otherwise.  The
1230
    number of members is recorded in pm.  The routine is also used to
1231
    handle type members of blocks when blk is true.
1232
*/
1233
 
1234
static BITSTREAM *enc_dg_member
1235
    PROTO_N ( ( bs, id, pm, ct, blk ) )
1236
    PROTO_T ( BITSTREAM *bs X IDENTIFIER id X unsigned *pm X
1237
	      CLASS_TYPE ct X int blk )
1238
{
1239
    int def = 0 ;
1240
    unsigned done = 0 ;
1241
    DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
1242
    if ( IS_id_function_etc ( id ) ) {
1243
	/* Allow for overloaded functions */
1244
	IDENTIFIER fid = DEREF_id ( id_function_etc_over ( id ) ) ;
1245
	if ( !IS_NULL_id ( fid ) ) {
1246
	    bs = enc_dg_member ( bs, fid, pm, ct, blk ) ;
1247
	}
1248
    }
1249
    if ( ds & ( dspec_alias | dspec_inherit | dspec_token ) ) {
1250
	/* Ignore inherited members */
1251
	return ( bs ) ;
1252
    }
1253
    if ( ds & dspec_defn ) def = 1 ;
1254
    switch ( TAG_id ( id ) ) {
1255
	case id_member_tag : {
1256
	    /* Data members */
1257
	    HASHID nm = DEREF_hashid ( id_name ( id ) ) ;
1258
	    if ( !IS_hashid_anon ( nm ) ) {
1259
		TYPE t = DEREF_type ( id_member_type ( id ) ) ;
1260
		OFFSET off = DEREF_off ( id_member_off ( id ) ) ;
1261
		ENC_dg_field_classmem ( bs ) ;
1262
		bs = enc_dg_name ( bs, id, NULL_type ) ;
1263
		bs = enc_dg_loc ( bs, id_loc ( id ), id_loc ( id ) ) ;
1264
		bs = enc_offset ( bs, off ) ;
1265
		bs = enc_dg_type ( bs, t, 0 ) ;
1266
		bs = enc_dg_access ( bs, ds ) ;
1267
		ENC_OFFS ( bs, 2 ) ;
1268
		done = 1 ;
1269
	    }
1270
	    break ;
1271
	}
1272
	case id_stat_member_tag : {
1273
	    /* Static data members */
1274
	    if ( !IS_NULL_ctype ( ct ) ) {
1275
		ulong m = LINK_NONE ;
1276
		unsigned use = find_dg_usage ( id, &m, def ) ;
1277
		ENC_dg_name_classmem ( bs ) ;
1278
		bs = enc_dg_decl ( bs, id, m, ( use | USAGE_DECL ) ) ;
1279
		done = 1 ;
1280
	    }
1281
	    break ;
1282
	}
1283
	case id_mem_func_tag : {
1284
	    /* Member functions */
1285
	    if ( !IS_NULL_ctype ( ct ) && !( ds & dspec_trivial ) ) {
1286
		ulong m = LINK_NONE ;
1287
		unsigned use = find_dg_usage ( id, &m, def ) ;
1288
		ENC_dg_function_classmem ( bs ) ;
1289
		bs = enc_dg_decl ( bs, id, m, ( use | USAGE_DECL ) ) ;
1290
		if ( ds & dspec_virtual ) {
1291
		    /* Offset from start of virtual function table */
1292
		    BITSTREAM *ts ;
1293
		    VIRTUAL vt = DEREF_virt ( ctype_virt ( ct ) ) ;
1294
		    ulong n = virtual_no ( id, vt ) ;
1295
		    ENC_ON ( bs ) ;
1296
		    ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
1297
		    bs = enc_special ( bs, TOK_vtab_off ) ;
1298
		    ts = enc_make_snat ( ts, ( int ) n ) ;
1299
		    bs = enc_bitstream ( bs, ts ) ;
1300
		} else {
1301
		    ENC_OFF ( bs ) ;
1302
		}
1303
		done = 1 ;
1304
	    }
1305
	    break ;
1306
	}
1307
	case id_stat_mem_func_tag : {
1308
	    /* Static member functions */
1309
	    if ( !IS_NULL_ctype ( ct ) ) {
1310
		ulong m = LINK_NONE ;
1311
		unsigned use = find_dg_usage ( id, &m, def ) ;
1312
		ENC_dg_name_classmem ( bs ) ;
1313
		bs = enc_dg_decl ( bs, id, m, ( use | USAGE_DECL ) ) ;
1314
		done = 1 ;
1315
	    }
1316
	    break ;
1317
	}
1318
	case id_class_name_tag :
1319
	case id_enum_name_tag :
1320
	case id_class_alias_tag :
1321
	case id_enum_alias_tag :
1322
	case id_type_alias_tag : {
1323
	    /* Nested types */
1324
	    if ( !IS_NULL_ctype ( ct ) || blk ) {
1325
		ulong m = LINK_NONE ;
1326
		unsigned use = find_dg_usage ( id, &m, 1 ) ;
1327
		if ( blk ) {
1328
		    use = ( ( use & USAGE_DEFN ) | USAGE_DECL ) ;
1329
		    ENC_name_decl_dg ( bs ) ;
1330
		} else {
1331
		    ENC_dg_name_classmem ( bs ) ;
1332
		}
1333
		bs = enc_dg_decl ( bs, id, m, use ) ;
1334
		done = 1 ;
1335
	    }
1336
	    break ;
1337
	}
1338
    }
1339
    *pm += done ;
1340
    return ( bs ) ;
1341
}
1342
 
1343
 
1344
/*
1345
    ENCODE A LIST OF DIAGNOSTIC MEMBERS
1346
 
1347
    This routine calls enc_dg_member for all the members of the
1348
    namespace ns.
1349
*/
1350
 
1351
static BITSTREAM *enc_dg_namespace
1352
    PROTO_N ( ( bs, ns, pm, ct ) )
1353
    PROTO_T ( BITSTREAM *bs X NAMESPACE ns X unsigned *pm X CLASS_TYPE ct )
1354
{
1355
    MEMBER mem ;
1356
    int blk = 0 ;
1357
    if ( IS_nspace_ctype ( ns ) ) {
1358
	mem = DEREF_member ( nspace_ctype_first ( ns ) ) ;
1359
    } else {
1360
	mem = DEREF_member ( nspace_last ( ns ) ) ;
1361
	blk = 1 ;
1362
    }
1363
    while ( !IS_NULL_member ( mem ) ) {
1364
	/* Class members */
1365
	IDENTIFIER mid = DEREF_id ( member_id ( mem ) ) ;
1366
	IDENTIFIER nid = DEREF_id ( member_alt ( mem ) ) ;
1367
	if ( !IS_NULL_id ( mid ) ) {
1368
	    bs = enc_dg_member ( bs, mid, pm, ct, blk ) ;
1369
	}
1370
	if ( !IS_NULL_id ( nid ) && !EQ_id ( nid, mid ) ) {
1371
	    bs = enc_dg_member ( bs, nid, pm, ct, blk ) ;
1372
	}
1373
	mem = DEREF_member ( member_next ( mem ) ) ;
1374
    }
1375
    return ( bs ) ;
1376
}
1377
 
1378
 
1379
/*
1380
    ENCODE VIRTUAL FUNCTION TABLE INFORMATION
1381
 
1382
    This routine adds the information for the virtual function table
1383
    and run-time type information associated with the polymorphic class
1384
    t to the bitstream bs in the form of a number of dummy class members.
1385
    Information on these members is returned via vtags.
1386
*/
1387
 
1388
#if LANGUAGE_CPP
1389
 
1390
static BITSTREAM *enc_dg_vtable
1391
    PROTO_N ( ( bs, t, vtags ) )
1392
    PROTO_T ( BITSTREAM *bs X TYPE t X ulong *vtags )
1393
{
1394
    ulong n, m ;
1395
    IDENTIFIER tid = dummy_type_name ;
1396
    TYPE ti = get_type_info ( lex_typeid, t, 0 ) ;
1397
    TYPE tv  = get_type_info ( lex_vtable, t, 0 ) ;
1398
    TYPE pv = DEREF_type ( type_array_sub ( tv ) ) ;
1399
    CLASS_TYPE ct = DEREF_ctype ( type_compound_defn ( t ) ) ;
1400
    VIRTUAL vt = DEREF_virt ( ctype_virt ( ct ) ) ;
1401
    ulong tok = DEREF_ulong ( virt_table_tok ( vt ) ) ;
1402
    OFFSET off = DEREF_off ( virt_table_off ( vt ) ) ;
1403
    ulong tbl = DEREF_ulong ( virt_table_tbl ( vt ) ) ;
1404
 
1405
    /* Make tag for slot type */
1406
    m = capsule_no ( NULL_string, VAR_dgtag ) ;
1407
    COPY_ulong ( id_no ( tid ), m ) ;
1408
    COPY_id ( type_name ( pv ), tid ) ;
1409
    record_usage ( m, VAR_dgtag, USAGE_DEFN ) ;
1410
 
1411
    /* Virtual function table pointer */
1412
    n = capsule_no ( NULL_string, VAR_dgtag ) ;
1413
    record_usage ( n, VAR_dgtag, USAGE_DEFN ) ;
1414
    vtags [0] = n ;
1415
    ENC_dg_tag_classmem ( bs ) ;
1416
    n = link_no ( bs, n, VAR_dgtag ) ;
1417
    ENC_make_dg_tag ( bs, n ) ;
1418
    ENC_dg_indirect_classmem ( bs ) ;
1419
    bs = enc_dg_artificial ( bs, "__vptr" ) ;
1420
    ENC_dg_null_sourcepos ( bs ) ;
1421
    bs = enc_dg_offset ( bs, off, tok, -1 ) ;
1422
    ENC_dg_pointer_type ( bs ) ;
1423
    ENC_dg_tag_type ( bs ) ;
1424
    m = link_no ( bs, m, VAR_dgtag ) ;
1425
    ENC_make_dg_tag ( bs, m ) ;
1426
    bs = enc_dg_type ( bs, pv, 1 ) ;
1427
    ENC_OFF ( bs ) ;
1428
 
1429
    /* Run-time type information pointer */
1430
    if ( output_rtti ) {
1431
	n = capsule_no ( NULL_string, VAR_dgtag ) ;
1432
	record_usage ( n, VAR_dgtag, USAGE_DEFN ) ;
1433
	vtags [1] = n ;
1434
	ENC_dg_tag_classmem ( bs ) ;
1435
	n = link_no ( bs, n, VAR_dgtag ) ;
1436
	ENC_make_dg_tag ( bs, n ) ;
1437
	ENC_dg_indirect_classmem ( bs ) ;
1438
	bs = enc_dg_artificial ( bs, "__tptr" ) ;
1439
	ENC_dg_null_sourcepos ( bs ) ;
1440
	bs = enc_dg_offset ( bs, off, tok, TOK_typeid_ref ) ;
1441
	ENC_dg_pointer_type ( bs ) ;
1442
	bs = enc_dg_type ( bs, ti, 0 ) ;
1443
	ENC_OFF ( bs ) ;
1444
    }
1445
 
1446
    /* Virtual function table */
1447
    n = capsule_no ( NULL_string, VAR_dgtag ) ;
1448
    record_usage ( n, VAR_dgtag, USAGE_DEFN ) ;
1449
    vtags [2] = n ;
1450
    record_usage ( tbl, VAR_tag, USAGE_USE ) ;
1451
    ENC_dg_name_classmem ( bs ) ;
1452
    ENC_dg_tag_name ( bs ) ;
1453
    n = link_no ( bs, n, VAR_dgtag ) ;
1454
    ENC_make_dg_tag ( bs, n ) ;
1455
    ENC_dg_object_name ( bs ) ;
1456
    bs = enc_dg_artificial ( bs, "__vtbl" ) ;
1457
    ENC_dg_null_sourcepos ( bs ) ;
1458
    bs = enc_dg_type ( bs, tv, 0 ) ;
1459
    ENC_ON ( bs ) ;
1460
    ENC_contents ( bs ) ;
1461
    bs = enc_shape ( bs, tv ) ;
1462
    ENC_obtain_tag ( bs ) ;
1463
    tbl = link_no ( bs, tbl, VAR_tag ) ;
1464
    ENC_make_tag ( bs, tbl ) ;
1465
    ENC_OFF ( bs ) ;
1466
 
1467
    /* Run-time type information structure */
1468
    if ( output_rtti ) {
1469
	n = capsule_no ( NULL_string, VAR_dgtag ) ;
1470
	record_usage ( n, VAR_dgtag, USAGE_DEFN ) ;
1471
	vtags [3] = n ;
1472
	ENC_dg_name_classmem ( bs ) ;
1473
	ENC_dg_tag_name ( bs ) ;
1474
	n = link_no ( bs, n, VAR_dgtag ) ;
1475
	ENC_make_dg_tag ( bs, n ) ;
1476
	ENC_dg_object_name ( bs ) ;
1477
	bs = enc_dg_artificial ( bs, "__typeid" ) ;
1478
	ENC_dg_null_sourcepos ( bs ) ;
1479
	bs = enc_dg_type ( bs, ti, 0 ) ;
1480
	ENC_ON ( bs ) ;
1481
	ENC_contents ( bs ) ;
1482
	bs = enc_shape ( bs, ti ) ;
1483
	bs = enc_rtti_type ( bs, t, lex_typeid ) ;
1484
	ENC_OFF ( bs ) ;
1485
    }
1486
 
1487
    /* Clear slot type */
1488
    COPY_ulong ( id_no ( tid ), LINK_NONE ) ;
1489
    COPY_id ( type_name ( pv ), NULL_id ) ;
1490
    return ( bs ) ;
1491
}
1492
 
1493
#endif
1494
 
1495
 
1496
/*
1497
    ENCODE A DIAGNOSTIC CLASS
1498
 
1499
    This routine adds the definition of the class type t to the bitstream
1500
    bs.  force is 2 to indicate that a tag name should be output for this
1501
    class.
1502
*/
1503
 
1504
static BITSTREAM *enc_dg_class
1505
    PROTO_N ( ( bs, t, force ) )
1506
    PROTO_T ( BITSTREAM *bs X TYPE t X int force )
1507
{
1508
    BITSTREAM *ts ;
1509
    unsigned m = 0 ;
1510
    ulong vtags [4] ;
1511
    CLASS_TYPE cs = NULL_ctype ;
1512
    CLASS_TYPE ct = DEREF_ctype ( type_compound_defn ( t ) ) ;
1513
    CLASS_INFO ci = DEREF_cinfo ( ctype_info ( ct ) ) ;
1514
    NAMESPACE ns = DEREF_nspace ( ctype_member ( ct ) ) ;
1515
    if ( force == 0 ) {
1516
	ENC_dg_unknown_type ( bs ) ;
1517
	bs = enc_shape ( bs, t ) ;
1518
	return ( bs ) ;
1519
    }
1520
    if ( ( ci & cinfo_complete ) && ( ci & cinfo_defined ) ) {
1521
	/* Complete class */
1522
	IGNORE compile_class ( ct ) ;
1523
	if ( ci & ( cinfo_static | cinfo_function | cinfo_base ) ) {
1524
	    cs = ct ;
1525
	} else if ( ( ci & cinfo_trivial ) != cinfo_trivial ) {
1526
	    cs = ct ;
1527
	} else {
1528
	    LIST ( IDENTIFIER ) ft ;
1529
	    ft = DEREF_list ( ctype_nest ( ct ) ) ;
1530
	    if ( !IS_NULL_list ( ft ) ) cs = ct ;
1531
	    ft = DEREF_list ( ctype_pals ( ct ) ) ;
1532
	    if ( !IS_NULL_list ( ft ) ) cs = ct ;
1533
	}
1534
    } else {
1535
	/* Incomplete class */
1536
	ENC_dg_is_spec_type ( bs ) ;
1537
	t = NULL_type ;
1538
    }
1539
    if ( !IS_NULL_ctype ( cs ) ) {
1540
	/* Class type */
1541
	GRAPH gr = DEREF_graph ( ctype_base ( ct ) ) ;
1542
	LIST ( GRAPH ) br = DEREF_list ( graph_tails ( gr ) ) ;
1543
	ENC_dg_class_type ( bs ) ;
1544
	bs = enc_dg_bases ( bs, br ) ;
1545
    } else {
1546
	/* Structure type */
1547
	ENC_dg_struct_type ( bs ) ;
1548
    }
1549
    vtags [0] = LINK_NONE ;
1550
    vtags [1] = LINK_NONE ;
1551
    vtags [2] = LINK_NONE ;
1552
    vtags [3] = LINK_NONE ;
1553
    ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
1554
    ts = enc_dg_namespace ( ts, ns, &m, cs ) ;
1555
#if LANGUAGE_CPP
1556
    if ( !IS_NULL_ctype ( cs ) ) {
1557
	if ( ci & cinfo_polymorphic ) {
1558
	    ts = enc_dg_vtable ( ts, t, vtags ) ;
1559
	    if ( output_rtti ) m += 2 ;
1560
	    m += 2 ;
1561
	}
1562
    }
1563
#endif
1564
    ENC_LIST ( bs, m ) ;
1565
    bs = join_bitstreams ( bs, ts ) ;
1566
    if ( !IS_NULL_ctype ( cs ) ) {
1567
	/* Friends */
1568
	ENC_OFF ( bs ) ;
1569
	ENC_LIST_SMALL ( bs, 0 ) ;
1570
    }
1571
    if ( !IS_NULL_type ( t ) ) {
1572
	/* Class shape */
1573
	ENC_ON ( bs ) ;
1574
	bs = enc_shape ( bs, t ) ;
1575
    } else {
1576
	ENC_OFF ( bs ) ;
1577
    }
1578
    if ( !IS_NULL_ctype ( cs ) ) {
1579
	/* Virtual function table information */
1580
	if ( vtags [0] == LINK_NONE ) {
1581
	    ENC_OFFS ( bs, 2 ) ;
1582
	} else {
1583
	    ENC_ON ( bs ) ;
1584
	    vtags [2] = link_no ( bs, vtags [2], VAR_dgtag ) ;
1585
	    ENC_make_dg_tag ( bs, vtags [2] ) ;
1586
	    ENC_ON ( bs ) ;
1587
	    vtags [0] = link_no ( bs, vtags [0], VAR_dgtag ) ;
1588
	    ENC_make_dg_tag ( bs, vtags [0] ) ;
1589
	}
1590
    }
1591
    if ( force == 2 ) {
1592
	/* Output tag name */
1593
	IDENTIFIER cid = DEREF_id ( ctype_name ( ct ) ) ;
1594
	TYPE form = DEREF_type ( ctype_form ( ct ) ) ;
1595
	ENC_ON ( bs ) ;
1596
	bs = enc_dg_name ( bs, cid, form ) ;
1597
	ENC_ON ( bs ) ;
1598
	bs = enc_dg_loc ( bs, id_loc ( cid ), id_loc ( cid ) ) ;
1599
    } else {
1600
	ENC_OFFS ( bs, 2 ) ;
1601
    }
1602
    if ( IS_NULL_ctype ( cs ) ) ENC_OFF ( bs ) ;
1603
    bs = enc_bool ( bs, ( ( ci & cinfo_union ) ? 1 : 0 ) ) ;
1604
    if ( !IS_NULL_ctype ( cs ) ) {
1605
	/* Run-time type information */
1606
	if ( vtags [1] == LINK_NONE ) {
1607
	    ENC_OFFS ( bs, 2 ) ;
1608
	} else {
1609
	    ENC_ON ( bs ) ;
1610
	    vtags [3] = link_no ( bs, vtags [3], VAR_dgtag ) ;
1611
	    ENC_make_dg_tag ( bs, vtags [3] ) ;
1612
	    ENC_ON ( bs ) ;
1613
	    vtags [1] = link_no ( bs, vtags [1], VAR_dgtag ) ;
1614
	    ENC_make_dg_tag ( bs, vtags [1] ) ;
1615
	}
1616
    }
1617
    bs = enc_bool ( bs, LANGUAGE_CPP ) ;
1618
    if ( !IS_NULL_ctype ( cs ) ) ENC_OFF ( bs ) ;
1619
    return ( bs ) ;
1620
}
1621
 
1622
 
1623
/*
1624
    ENCODE A DIAGNOSTIC ENUMERATION TYPE
1625
 
1626
    This routine adds the definition of the enumeration type t to the
1627
    bitstream bs.  force is 2 to indicate that a tag name should be
1628
    output for this enumeration type.
1629
*/
1630
 
1631
static BITSTREAM *enc_dg_etype
1632
    PROTO_N ( ( bs, t, force ) )
1633
    PROTO_T ( BITSTREAM *bs X TYPE t X int force )
1634
{
1635
    ENUM_TYPE et = DEREF_etype ( type_enumerate_defn ( t ) ) ;
1636
    LIST ( IDENTIFIER ) p = DEREF_list ( etype_values ( et ) ) ;
1637
    CLASS_INFO ei = DEREF_cinfo ( etype_info ( et ) ) ;
1638
    if ( !( ei & cinfo_complete ) || force == 0 ) {
1639
	t = DEREF_type ( etype_rep ( et ) ) ;
1640
	bs = enc_dg_type ( bs, t, 0 ) ;
1641
	return ( bs ) ;
1642
    }
1643
    ENC_dg_enum_type ( bs ) ;
1644
    ENC_LIST ( bs, LENGTH_list ( p ) ) ;
1645
    while ( !IS_NULL_list ( p ) ) {
1646
	IDENTIFIER pid = DEREF_id ( HEAD_list ( p ) ) ;
1647
	EXP e = DEREF_exp ( id_enumerator_value ( pid ) ) ;
1648
	ENC_make_dg_enum ( bs ) ;
1649
	bs = enc_exp ( bs, e ) ;
1650
	bs = enc_dg_name ( bs, pid, NULL_type ) ;
1651
	bs = enc_dg_loc ( bs, id_loc ( pid ), id_loc ( pid ) ) ;
1652
	p = TAIL_list ( p ) ;
1653
    }
1654
    if ( force == 2 ) {
1655
	/* Output tag name */
1656
	IDENTIFIER eid = DEREF_id ( etype_name ( et ) ) ;
1657
	ENC_ON ( bs ) ;
1658
	bs = enc_dg_name ( bs, eid, NULL_type ) ;
1659
	ENC_ON ( bs ) ;
1660
	bs = enc_dg_loc ( bs, id_loc ( eid ), id_loc ( eid ) ) ;
1661
    } else {
1662
	ENC_OFFS ( bs, 2 ) ;
1663
    }
1664
    bs = enc_shape ( bs, t ) ;
1665
    bs = enc_bool ( bs, LANGUAGE_CPP ) ;
1666
    return ( bs ) ;
1667
}
1668
 
1669
 
1670
/*
1671
    ENCODE A DIAGNOSTIC TYPE
1672
 
1673
    This routine adds the diagnostic information for the type t to the
1674
    bitstream bs.
1675
*/
1676
 
1677
BITSTREAM *enc_dg_type
1678
    PROTO_N ( ( bs, t, force ) )
1679
    PROTO_T ( BITSTREAM *bs X TYPE t X int force )
1680
{
1681
    ulong n ;
1682
    CV_SPEC cv ;
1683
    if ( IS_NULL_type ( t ) ) {
1684
	ENC_dg_void_type ( bs ) ;
1685
	return ( bs ) ;
1686
    }
1687
    cv = DEREF_cv ( type_qual ( t ) ) ;
1688
    if ( cv & cv_const ) {
1689
	/* Allow for const qualifier */
1690
	ENC_dg_qualified_type ( bs ) ;
1691
	ENC_dg_const_qualifier ( bs ) ;
1692
    }
1693
    if ( cv & cv_volatile ) {
1694
	/* Allow for volatile qualifier */
1695
	ENC_dg_qualified_type ( bs ) ;
1696
	ENC_dg_volatile_qualifier ( bs ) ;
1697
    }
1698
 
1699
    /* Check type name */
1700
    if ( !force ) {
1701
	IDENTIFIER tid = DEREF_id ( type_name ( t ) ) ;
1702
	if ( !IS_NULL_id ( tid ) ) {
1703
	    tid = DEREF_id ( id_alias ( tid ) ) ;
1704
	    n = DEREF_ulong ( id_no ( tid ) ) ;
1705
	    if ( n == LINK_NONE ) {
1706
		enc_dg_id ( tid, 1 ) ;
1707
		n = DEREF_ulong ( id_no ( tid ) ) ;
1708
		if ( n == LINK_NONE ) goto type_label ;
1709
	    }
1710
	    ENC_dg_named_type ( bs ) ;
1711
	    n = link_no ( bs, n, VAR_dgtag ) ;
1712
	    ENC_make_dg_tag ( bs, n ) ;
1713
	    return ( bs ) ;
1714
	}
1715
    }
1716
 
1717
    /* Encode type definition */
1718
    type_label : {
1719
	ASSERT ( ORDER_type == 18 ) ;
1720
	switch ( TAG_type ( t ) ) {
1721
	    case type_integer_tag : {
1722
		/* Integral types */
1723
		INT_TYPE it = DEREF_itype ( type_integer_rep ( t ) ) ;
1724
		n = DEREF_ulong ( itype_diag ( it ) ) ;
1725
		goto basetype_lab ;
1726
	    }
1727
	    basetype_lab : {
1728
		if ( n == LINK_NONE ) {
1729
		    if ( cv & cv_qual ) t = qualify_type ( t, cv_none, 0 ) ;
1730
		    n = enc_dg_basetype ( t, 1 ) ;
1731
		}
1732
		ENC_dg_named_type ( bs ) ;
1733
		n = link_no ( bs, n, VAR_dgtag ) ;
1734
		ENC_make_dg_tag ( bs, n ) ;
1735
		break ;
1736
	    }
1737
	    case type_floating_tag : {
1738
		/* Floating point types */
1739
		FLOAT_TYPE ft = DEREF_ftype ( type_floating_rep ( t ) ) ;
1740
		n = DEREF_ulong ( ftype_diag ( ft ) ) ;
1741
		goto basetype_lab ;
1742
	    }
1743
	    case type_top_tag :
1744
	    case type_bottom_tag : {
1745
		/* Void types */
1746
		ENC_dg_void_type ( bs ) ;
1747
		break ;
1748
	    }
1749
	    case type_ptr_tag : {
1750
		/* Pointer types */
1751
		TYPE s = DEREF_type ( type_ptr_sub ( t ) ) ;
1752
		if ( IS_type_top_etc ( s ) ) {
1753
		    /* Pointer void types */
1754
		    cv = DEREF_cv ( type_qual ( s ) ) ;
1755
		    cv &= cv_qual ;
1756
		    n = diag_ptr_void [ cv ] ;
1757
		    goto basetype_lab ;
1758
		}
1759
		ENC_dg_pointer_type ( bs ) ;
1760
		bs = enc_dg_type ( bs, s, 0 ) ;
1761
		ENC_OFF ( bs ) ;
1762
		break ;
1763
	    }
1764
	    case type_ref_tag : {
1765
		/* Reference types */
1766
		TYPE s = DEREF_type ( type_ref_sub ( t ) ) ;
1767
		ENC_dg_reference_type ( bs ) ;
1768
		bs = enc_dg_type ( bs, s, 0 ) ;
1769
		break ;
1770
	    }
1771
	    case type_ptr_mem_tag : {
1772
		/* Pointer to member types */
1773
		CLASS_TYPE cs = DEREF_ctype ( type_ptr_mem_of ( t ) ) ;
1774
		TYPE s = DEREF_type ( type_ptr_mem_sub ( t ) ) ;
1775
		if ( IS_type_func ( s ) ) {
1776
		    ENC_dg_ptr_memfn_type ( bs ) ;
1777
		} else {
1778
		    ENC_dg_ptr_memdata_type ( bs ) ;
1779
		}
1780
		bs = enc_dg_ctype ( bs, cs ) ;
1781
		bs = enc_dg_type ( bs, s, 0 ) ;
1782
		bs = enc_shape ( bs, t ) ;
1783
		ENC_OFF ( bs ) ;
1784
		break ;
1785
	    }
1786
	    case type_func_tag : {
1787
		/* Function types */
1788
		TYPE r = DEREF_type ( type_func_ret ( t ) ) ;
1789
		int ell = DEREF_int ( type_func_ellipsis ( t ) ) ;
1790
		CV_SPEC mqual = DEREF_cv ( type_func_mqual ( t ) ) ;
1791
		LIST ( TYPE ) p = DEREF_list ( type_func_ptypes ( t ) ) ;
1792
		LIST ( TYPE ) q = DEREF_list ( type_func_mtypes ( t ) ) ;
1793
		unsigned nq = LENGTH_list ( q ) ;
1794
		ENC_dg_proc_type ( bs ) ;
1795
		ENC_LIST ( bs, nq ) ;
1796
		if ( !EQ_list ( p, q ) && !IS_NULL_list ( q ) ) {
1797
		    /* Allow for 'this' parameter */
1798
		    TYPE s = DEREF_type ( HEAD_list ( q ) ) ;
1799
		    ENC_dg_object_param ( bs ) ;
1800
		    ENC_ON ( bs ) ;
1801
		    bs = enc_dg_artificial ( bs, "this" ) ;
1802
		    ENC_OFFS ( bs, 2 ) ;
1803
		    bs = enc_dg_type ( bs, s, 0 ) ;
1804
		    ENC_OFF ( bs ) ;
1805
		    q = TAIL_list ( q ) ;
1806
		}
1807
		while ( !IS_NULL_list ( q ) ) {
1808
		    /* Real function parameters */
1809
		    TYPE s = DEREF_type ( HEAD_list ( q ) ) ;
1810
		    if ( ell & FUNC_PARAMS ) s = unpromote_type ( s ) ;
1811
		    ENC_dg_object_param ( bs ) ;
1812
		    ENC_OFFS ( bs, 3 ) ;
1813
		    bs = enc_dg_type ( bs, s, 0 ) ;
1814
		    ENC_OFF ( bs ) ;
1815
		    q = TAIL_list ( q ) ;
1816
		}
1817
		bs = enc_dg_type ( bs, r, 0 ) ;
1818
		if ( ell & FUNC_NON_PROTO ) {
1819
		    /* Non-prototype function */
1820
		    ENC_ON ( bs ) ;
1821
		    ENC_false ( bs ) ;
1822
		} else {
1823
		    /* Prototype function */
1824
		    ENC_OFF ( bs ) ;
1825
		}
1826
		ENC_OFF ( bs ) ;
1827
		if ( mqual & cv_lang ) {
1828
		    /* Default language linkage */
1829
		    ENC_OFF ( bs ) ;
1830
		} else {
1831
		    /* Non-default language linkage */
1832
		    ENC_ON ( bs ) ;
1833
		    ENC_make_nat ( bs ) ;
1834
		    ENC_INT ( bs, DWARF_LANG_NOT ) ;
1835
		}
1836
		if ( ell & FUNC_ELLIPSIS ) {
1837
		    /* Ellipsis function */
1838
		    ENC_ON ( bs ) ;
1839
		    ENC_var_callers ( bs ) ;
1840
		} else {
1841
		    /* Non-ellipsis function */
1842
		    ENC_OFF ( bs ) ;
1843
		}
1844
		break ;
1845
	    }
1846
	    case type_array_tag : {
1847
		/* Array types */
1848
		TYPE s = DEREF_type ( type_array_sub ( t ) ) ;
1849
		NAT m = DEREF_nat ( type_array_size ( t ) ) ;
1850
		ENC_dg_array_type ( bs ) ;
1851
		bs = enc_dg_type ( bs, s, 0 ) ;
1852
		bs = enc_shape_offset ( bs, s ) ;
1853
		ENC_OFF ( bs ) ;
1854
		ENC_LIST_SMALL ( bs, 1 ) ;
1855
		if ( IS_NULL_nat ( m ) ) {
1856
		    ENC_dg_unspecified_dim ( bs ) ;
1857
		} else {
1858
		    TYPE i = type_sint ;
1859
		    unsigned long v = get_nat_value ( m ) ;
1860
		    ENC_dg_bounds_dim ( bs ) ;
1861
		    ENC_dg_static_bound ( bs ) ;
1862
		    bs = enc_make_int ( bs, i, 0 ) ;
1863
		    ENC_dg_static_bound ( bs ) ;
1864
		    if ( v < SMALL_ARRAY_BOUND ) {
1865
			/* Small value */
1866
			if ( v ) v-- ;
1867
			bs = enc_make_int ( bs, i, ( int ) v ) ;
1868
		    } else {
1869
			ENC_minus ( bs ) ;
1870
			bs = enc_error_treatment ( bs, i ) ;
1871
			ENC_make_int ( bs ) ;
1872
			bs = enc_variety ( bs, i ) ;
1873
			bs = enc_snat ( bs, m, 0, 1 ) ;
1874
			bs = enc_make_int ( bs, i, 1 ) ;
1875
		    }
1876
		    bs = enc_dg_type ( bs, i, 0 ) ;
1877
		}
1878
		break ;
1879
	    }
1880
	    case type_bitfield_tag : {
1881
		/* Bitfield types */
1882
		INT_TYPE bf = DEREF_itype ( type_bitfield_defn ( t ) ) ;
1883
		TYPE s = DEREF_type ( itype_bitfield_sub ( bf ) ) ;
1884
		ENC_dg_bitfield_type ( bs ) ;
1885
		bs = enc_dg_type ( bs, s, 0 ) ;
1886
		bs = enc_bfvar ( bs, t ) ;
1887
		bs = enc_shape ( bs, s ) ;
1888
		break ;
1889
	    }
1890
	    case type_compound_tag : {
1891
		/* Class types */
1892
		bs = enc_dg_class ( bs, t, force ) ;
1893
		break ;
1894
	    }
1895
	    case type_enumerate_tag : {
1896
		/* Enumeration types */
1897
		bs = enc_dg_etype ( bs, t, force ) ;
1898
		break ;
1899
	    }
1900
	    default : {
1901
		/* Other types */
1902
		ENC_dg_unknown_type ( bs ) ;
1903
		bs = enc_shape ( bs, t ) ;
1904
		break ;
1905
	    }
1906
	}
1907
    }
1908
    return ( bs ) ;
1909
}
1910
 
1911
 
1912
/*
1913
    ENCODE A LOCAL DIAGNOSTIC IDENTIFIER
1914
 
1915
    This routine adds the diagnostic information for the local identifier
1916
    id to the bitstream bs.  ts gives the encoding of the scope of id.
1917
*/
1918
 
1919
BITSTREAM *enc_dg_local
1920
    PROTO_N ( ( bs, id, ts ) )
1921
    PROTO_T ( BITSTREAM *bs X IDENTIFIER id X BITSTREAM *ts )
1922
{
1923
    bs = enc_diag_start ( bs ) ;
1924
    ENC_name_decl_dg ( ts ) ;
1925
    ts = enc_dg_decl ( ts, id, LINK_NONE, USAGE_DEFN ) ;
1926
    bs = enc_bitstream ( bs, ts ) ;
1927
    return ( bs ) ;
1928
}
1929
 
1930
 
1931
/*
1932
    ENCODE A LIST OF DIAGNOSTIC PARAMETERS
1933
 
1934
    This routine adds the diagnostic information for the list of function
1935
    parameters p to the bitstream bs.  ts and e give the function body.
1936
*/
1937
 
1938
BITSTREAM *enc_dg_params
1939
    PROTO_N ( ( bs, p, ts, e ) )
1940
    PROTO_T ( BITSTREAM *bs X LIST ( IDENTIFIER ) p X BITSTREAM *ts X EXP e )
1941
{
1942
    bs = enc_diag_start ( bs ) ;
1943
    ENC_list_dg ( ts ) ;
1944
    ENC_LIST_SMALL ( ts, 2 ) ;
1945
    ENC_params_dg ( ts ) ;
1946
    ENC_LIST ( ts, LENGTH_list ( p ) ) ;
1947
    while ( !IS_NULL_list ( p ) ) {
1948
	IDENTIFIER pid = DEREF_id ( HEAD_list ( p ) ) ;
1949
	ts = enc_dg_decl ( ts, pid, LINK_NONE, USAGE_DEFN ) ;
1950
	p = TAIL_list ( p ) ;
1951
    }
1952
    ENC_OFF ( ts ) ;
1953
    ts = enc_dg_stmt ( ts, e, 1 ) ;
1954
    bs = enc_bitstream ( bs, ts ) ;
1955
    return ( bs ) ;
1956
}
1957
 
1958
 
1959
/*
1960
    ENCODE A DIAGNOSTIC STATEMENT
1961
 
1962
    This routine adds the diagnostic information associated with the
1963
    statement e to the bitstream bs.
1964
*/
1965
 
1966
BITSTREAM *enc_dg_stmt
1967
    PROTO_N ( ( bs, e, stmt ) )
1968
    PROTO_T ( BITSTREAM *bs X EXP e X int stmt )
1969
{
1970
    PTR ( LOCATION ) loc = crt_enc_loc ;
1971
    if ( !IS_NULL_exp ( e ) ) {
1972
	switch ( TAG_exp ( e ) ) {
1973
	    case exp_sequence_tag : {
1974
		/* Lexical block */
1975
		int blk = DEREF_int ( exp_sequence_block ( e ) ) ;
1976
		NAMESPACE ns = DEREF_nspace ( exp_sequence_decl ( e ) ) ;
1977
		if ( blk ) {
1978
		    BITSTREAM *ts ;
1979
		    unsigned m = 0 ;
1980
		    PTR ( LOCATION ) start_loc = block_loc ( e, 0 ) ;
1981
		    ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
1982
		    ts = enc_dg_namespace ( ts, ns, &m, NULL_ctype ) ;
1983
		    if ( blk > 1 ) m++ ;
1984
		    if ( m != 1 ) {
1985
			ENC_list_dg ( bs ) ;
1986
			ENC_LIST ( bs, m ) ;
1987
		    }
1988
		    if ( blk > 1 ) {
1989
			ENC_lexical_block_dg ( bs ) ;
1990
			ENC_OFF ( bs ) ;
1991
			bs = enc_dg_loc ( bs, start_loc, loc ) ;
1992
		    }
1993
		    bs = join_bitstreams ( bs, ts ) ;
1994
		    return ( bs ) ;
1995
		}
1996
		break ;
1997
	    }
1998
	    case exp_solve_stmt_tag : {
1999
		EXP a = DEREF_exp ( exp_solve_stmt_body ( e ) ) ;
2000
		bs = enc_dg_stmt ( bs, a, stmt ) ;
2001
		return ( bs ) ;
2002
	    }
2003
	    case exp_decl_stmt_tag : {
2004
		IDENTIFIER id = DEREF_id ( exp_decl_stmt_id ( e ) ) ;
2005
		loc = id_loc ( id ) ;
2006
		break ;
2007
	    }
2008
	    case exp_label_stmt_tag : {
2009
		IDENTIFIER id = DEREF_id ( exp_label_stmt_label ( e ) ) ;
2010
		HASHID nm = DEREF_hashid ( id_name ( id ) ) ;
2011
		loc = id_loc ( id ) ;
2012
		if ( !IS_hashid_anon ( nm ) ) {
2013
		    /* Named label */
2014
		    ENC_label_dg ( bs ) ;
2015
		    bs = enc_dg_name ( bs, id, NULL_type ) ;
2016
		    bs = enc_dg_loc ( bs, loc, loc ) ;
2017
		    return ( bs ) ;
2018
		}
2019
		break ;
2020
	    }
2021
#if LANGUAGE_CPP
2022
	    case exp_try_block_tag : {
2023
		/* Try block */
2024
		EXP a ;
2025
		unsigned np ;
2026
		LIST ( EXP ) p ;
2027
		a = DEREF_exp ( exp_try_block_ellipsis ( e ) ) ;
2028
		p = DEREF_list ( exp_try_block_handlers ( e ) ) ;
2029
		np = LENGTH_list ( p ) ;
2030
		if ( IS_exp_handler ( a ) ) np++ ;
2031
		ENC_list_dg ( bs ) ;
2032
		ENC_LIST_SMALL ( bs, 2 ) ;
2033
		ENC_exception_scope_dg ( bs ) ;
2034
		ENC_LIST ( bs, np ) ;
2035
		while ( !IS_NULL_list ( p ) ) {
2036
		    EXP b = DEREF_exp ( HEAD_list ( p ) ) ;
2037
		    ulong m = capsule_no ( NULL_string, VAR_dgtag ) ;
2038
		    COPY_ulong ( exp_handler_diag ( b ), m ) ;
2039
		    m = link_no ( bs, m, VAR_dgtag ) ;
2040
		    ENC_make_dg_tag ( bs, m ) ;
2041
		    p = TAIL_list ( p ) ;
2042
		}
2043
		if ( IS_exp_handler ( a ) ) {
2044
		    ulong m = capsule_no ( NULL_string, VAR_dgtag ) ;
2045
		    COPY_ulong ( exp_handler_diag ( a ), m ) ;
2046
		    m = link_no ( bs, m, VAR_dgtag ) ;
2047
		    ENC_make_dg_tag ( bs, m ) ;
2048
		}
2049
		e = DEREF_exp ( exp_try_block_body ( e ) ) ;
2050
		bs = enc_dg_stmt ( bs, e, stmt ) ;
2051
		return ( bs ) ;
2052
	    }
2053
	    case exp_handler_tag : {
2054
		/* Exception handler */
2055
		ulong m = DEREF_ulong ( exp_handler_diag ( e ) ) ;
2056
		IDENTIFIER id = DEREF_id ( exp_handler_except ( e ) ) ;
2057
		record_usage ( m, VAR_dgtag, USAGE_DEFN ) ;
2058
		ENC_list_dg ( bs ) ;
2059
		ENC_LIST_SMALL ( bs, 2 ) ;
2060
		ENC_make_tag_dg ( bs ) ;
2061
		m = link_no ( bs, m, VAR_dgtag ) ;
2062
		ENC_make_dg_tag ( bs, m ) ;
2063
		ENC_exception_handler_dg ( bs ) ;
2064
		if ( !IS_NULL_id ( id ) ) {
2065
		    ENC_ON ( bs ) ;
2066
		    bs = enc_dg_decl ( bs, id, LINK_NONE, USAGE_DEFN ) ;
2067
		} else {
2068
		    ENC_OFF ( bs ) ;
2069
		}
2070
		e = DEREF_exp ( exp_handler_body ( e ) ) ;
2071
		bs = enc_dg_stmt ( bs, e, stmt ) ;
2072
		return ( bs ) ;
2073
	    }
2074
#endif
2075
	}
2076
    }
2077
    if ( stmt == 2 ) {
2078
	/* Used to mark conditionals */
2079
	ENC_list_dg ( bs ) ;
2080
	ENC_LIST_SMALL ( bs, 2 ) ;
2081
	ENC_branch_dg ( bs ) ;
2082
	bs = enc_dg_loc ( bs, loc, loc ) ;
2083
    }
2084
    ENC_singlestep_dg ( bs ) ;
2085
    bs = enc_dg_loc ( bs, loc, loc ) ;
2086
    return ( bs ) ;
2087
}
2088
 
2089
 
2090
#endif /* TDF_OUTPUT && TDF_NEW_DIAG */