Subversion Repositories tendra.SVN

Rev

Rev 2 | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 7u83 1
/*
2
    		 Crown Copyright (c) 1997
3
 
4
    This TenDRA(r) Computer Program is subject to Copyright
5
    owned by the United Kingdom Secretary of State for Defence
6
    acting through the Defence Evaluation and Research Agency
7
    (DERA).  It is made available to Recipients with a
8
    royalty-free licence for its use, reproduction, transfer
9
    to other parties and amendment for any purpose not excluding
10
    product development provided that any such use et cetera
11
    shall be deemed to be acceptance of the following conditions:-
12
 
13
        (1) Its Recipients shall ensure that this Notice is
14
        reproduced upon any copies or amended versions of it;
15
 
16
        (2) Any amended version of it shall be clearly marked to
17
        show both the nature of and the organisation responsible
18
        for the relevant amendment or amendments;
19
 
20
        (3) Its onward transfer from a recipient to another
21
        party shall be deemed to be that party's acceptance of
22
        these conditions;
23
 
24
        (4) DERA gives no warranty or assurance as to its
25
        quality or suitability for any purpose and DERA accepts
26
        no liability whatsoever in relation to any use to which
27
        it may be put.
28
*/
29
 
30
 
31
#include "config.h"
32
#include "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 "loc_ext.h"
44
#include "nat_ops.h"
45
#include "nspace_ops.h"
46
#include "off_ops.h"
47
#include "tok_ops.h"
48
#include "type_ops.h"
49
#include "error.h"
50
#include "catalog.h"
51
#include "basetype.h"
52
#include "bits.h"
53
#include "char.h"
54
#include "chktype.h"
55
#include "dump.h"
56
#include "encode.h"
57
#include "exception.h"
58
#include "file.h"
59
#include "inttype.h"
60
#include "save.h"
61
#include "syntax.h"
62
#include "ustring.h"
63
 
64
 
65
/*
66
    FORWARD DECLARATIONS
67
 
68
    The following forward declarations are required in the spec output
69
    routines.
70
*/
71
 
72
static BITSTREAM *save_exp PROTO_S ( ( BITSTREAM *, EXP, TYPE ) ) ;
73
static BITSTREAM *save_type PROTO_S ( ( BITSTREAM *, TYPE, IDENTIFIER ) ) ;
74
static BITSTREAM *save_ctype PROTO_S ( ( BITSTREAM *, CLASS_TYPE, IDENTIFIER ) ) ;
75
static BITSTREAM *save_type_list PROTO_S ( ( BITSTREAM *, LIST ( TYPE ) ) ) ;
76
static BITSTREAM *save_tok PROTO_S ( ( BITSTREAM *, TOKEN, int ) ) ;
77
 
78
 
79
/*
80
    SIMPLE WRITING ROUTINES
81
 
82
    These macros give the simple writing routines for the enumeration
83
    types etc.  Note that ENC_BITS_2 is used when the values occupy more
84
    than 16 bits.
85
*/
86
 
87
#define save_btype( A, B )	ENC_BITS_2 ( ( A ), BITS_btype, ( B ) )
88
#define save_cinfo( A, B )	ENC_BITS_2 ( ( A ), BITS_cinfo, ( B ) )
89
#define save_cusage( A, B )	ENC_BITS ( ( A ), BITS_cusage, ( B ) )
90
#define save_cv( A, B )		ENC_BITS ( ( A ), BITS_cv_qual, ( B ) )
91
#define save_dspec( A, B )	ENC_BITS_2 ( ( A ), BITS_dspec, ( B ) )
92
#define save_lex( A, B )	ENC_BITS ( ( A ), BITS_lex, ( B ) )
93
#define save_mqual( A, B )	ENC_BITS ( ( A ), BITS_cv, ( B ) )
94
#define save_ntype( A, B )	ENC_BITS ( ( A ), BITS_ntype, ( B ) )
95
#define save_qual( A, B )	ENC_BITS ( ( A ), BITS_qual, ( B ) )
96
 
97
 
98
/*
99
    WRITE A LIST OF PREPROCESSING TOKENS
100
 
101
    This routine writes the list of preprocessing tokens p to the
102
    bitstream bs.
103
*/
104
 
105
static BITSTREAM *save_pptoks
106
    PROTO_N ( ( bs, p ) )
107
    PROTO_T ( BITSTREAM *bs X PPTOKEN *p )
108
{
109
    /* NOT YET IMPLEMENTED */
110
    UNUSED ( p ) ;
111
    return ( bs ) ;
112
}
113
 
114
 
115
/*
116
    WRITE A LOCATION
117
 
118
    This routine writes the location ploc to the bitstream bs.
119
*/
120
 
121
static BITSTREAM *save_loc
122
    PROTO_N ( ( bs, ploc ) )
123
    PROTO_T ( BITSTREAM *bs X PTR ( LOCATION ) ploc )
124
{
125
    static LOCATION last_loc = NULL_loc ;
126
    if ( !IS_NULL_ptr ( ploc ) ) {
127
	unsigned long ln = DEREF_ulong ( loc_line ( ploc ) ) ;
128
	PTR ( POSITION ) posn = DEREF_ptr ( loc_posn ( ploc ) ) ;
129
	if ( EQ_ptr ( posn, last_loc.posn ) || IS_NULL_ptr ( posn ) ) {
130
	    if ( ln == last_loc.line ) {
131
		/* Same position */
132
		ENC_OFF ( bs ) ;
133
	    } else {
134
		/* Different line */
135
		ENC_ON ( bs ) ;
136
		ENC_INT ( bs, ln ) ;
137
		ENC_OFF ( bs ) ;
138
		last_loc.line = ln ;
139
	    }
140
	} else {
141
	    int eq =0 ;
142
	    unsigned long off = DEREF_ulong ( posn_offset ( posn ) ) ;
143
	    string a1 = DEREF_string ( posn_file ( posn ) ) ;
144
	    string b1 = DEREF_string ( posn_input ( posn ) ) ;
145
	    if ( !IS_NULL_ptr ( last_loc.posn ) ) {
146
		string a2 = DEREF_string ( posn_file ( last_loc.posn ) ) ;
147
		string b2 = DEREF_string ( posn_input ( last_loc.posn ) ) ;
148
		if ( ustreq ( a1, a2 ) && ustreq ( b1, b2 ) ) {
149
		    eq = 1 ;
150
		}
151
	    }
152
	    ENC_ON ( bs ) ;
153
	    ENC_INT ( bs, ln ) ;
154
	    ENC_ON ( bs ) ;
155
	    ENC_INT ( bs, off ) ;
156
	    if ( eq ) {
157
		/* Same file */
158
		ENC_OFF ( bs ) ;
159
	    } else {
160
		ulong date ;
161
		ENC_ON ( bs ) ;
162
		bs = enc_ustring ( bs, a1 ) ;
163
		if ( ustreq ( a1, b1 ) ) {
164
		    /* Same file names */
165
		    ENC_OFF ( bs ) ;
166
		} else {
167
		    /* Different file names */
168
		    ENC_ON ( bs ) ;
169
		    bs = enc_ustring ( bs, b1 ) ;
170
		}
171
		date = DEREF_ulong ( posn_datestamp ( posn ) ) ;
172
		ENC_INT ( bs, date ) ;
173
	    }
174
	    last_loc.line = ln ;
175
	    last_loc.posn = posn ;
176
	}
177
    } else {
178
	ENC_OFF ( bs ) ;
179
    }
180
    return ( bs ) ;
181
}
182
 
183
 
184
/*
185
    WRITE AN IDENTIFIER NAME
186
 
187
    This routine writes the identifier name nm to the bitstream bs.
188
    ns gives the current namespace.
189
*/
190
 
191
static BITSTREAM *save_hashid
192
    PROTO_N ( ( bs, nm, ns ) )
193
    PROTO_T ( BITSTREAM *bs X HASHID nm X NAMESPACE ns )
194
{
195
    if ( IS_NULL_hashid ( nm ) ) {
196
	ENC_BITS ( bs, BITS_hashid, 0 ) ;
197
    } else {
198
	unsigned tag = TAG_hashid ( nm ) ;
199
	ENC_BITS ( bs, BITS_hashid, tag + 1 ) ;
200
	ASSERT ( ORDER_hashid == 7 ) ;
201
	switch ( tag ) {
202
	    case hashid_name_tag :
203
	    case hashid_ename_tag : {
204
		string s = DEREF_string ( hashid_name_etc_text ( nm ) ) ;
205
		bs = enc_ustring ( bs, s ) ;
206
		break ;
207
	    }
208
	    case hashid_constr_tag : {
209
		UNUSED ( ns ) ;
210
		break ;
211
	    }
212
	    case hashid_destr_tag : {
213
		UNUSED ( ns ) ;
214
		break ;
215
	    }
216
	    case hashid_conv_tag : {
217
		TYPE t = DEREF_type ( hashid_conv_type ( nm ) ) ;
218
		bs = save_type ( bs, t, NULL_id ) ;
219
		break ;
220
	    }
221
	    case hashid_op_tag : {
222
		int op = DEREF_int ( hashid_op_lex ( nm ) ) ;
223
		save_lex ( bs, op ) ;
224
		break ;
225
	    }
226
	    case hashid_anon_tag : {
227
		break ;
228
	    }
229
	}
230
    }
231
    return ( bs ) ;
232
}
233
 
234
 
235
/*
236
    WRITE A LIST OF IDENTIFIER NAMES
237
 
238
    This routine saves a list of identifier names to the bitstream bs.
239
*/
240
 
241
static BITSTREAM *save_hashid_list
242
    PROTO_N ( ( bs, p, ns ) )
243
    PROTO_T ( BITSTREAM *bs X LIST ( HASHID ) p X NAMESPACE ns )
244
{
245
    while ( !IS_NULL_list ( p ) ) {
246
	HASHID nm = DEREF_hashid ( HEAD_list ( p ) ) ;
247
	ENC_ON ( bs ) ;
248
	bs = save_hashid ( bs, nm, ns ) ;
249
	p = TAIL_list ( p ) ;
250
    }
251
    ENC_OFF ( bs ) ;
252
    return ( bs ) ;
253
}
254
 
255
 
256
/*
257
    WRITE AN IDENTIFIER NUMBER
258
 
259
    This routine writes the identifier number for the identifier id to
260
    the bitstream bs.  The spec and dump output formats share the same
261
    identifier numbers, with zero representing the null identifier.
262
*/
263
 
264
static BITSTREAM *save_use
265
    PROTO_N ( ( bs, id ) )
266
    PROTO_T ( BITSTREAM *bs X IDENTIFIER id )
267
{
268
    ulong d = 0 ;
269
    if ( !IS_NULL_id ( id ) ) {
270
	d = DEREF_ulong ( id_dump ( id ) ) ;
271
	if ( d == LINK_NONE ) {
272
	    d = dump_id_next++ ;
273
	    d |= LINK_EXTERN ;
274
	    COPY_ulong ( id_dump ( id ), d ) ;
275
	}
276
	d &= ~LINK_EXTERN ;
277
    }
278
    ENC_INT ( bs, d ) ;
279
    return ( bs ) ;
280
}
281
 
282
 
283
/*
284
    WRITE A LIST OF IDENTIFIER NUMBERS
285
 
286
    This routine saves a list of identifier numbers to the bitstream bs.
287
*/
288
 
289
static BITSTREAM *save_use_list
290
    PROTO_N ( ( bs, p ) )
291
    PROTO_T ( BITSTREAM *bs X LIST ( IDENTIFIER ) p )
292
{
293
    while ( !IS_NULL_list ( p ) ) {
294
	IDENTIFIER id = DEREF_id ( HEAD_list ( p ) ) ;
295
	ENC_ON ( bs ) ;
296
	bs = save_use ( bs, id ) ;
297
	p = TAIL_list ( p ) ;
298
    }
299
    ENC_OFF ( bs ) ;
300
    return ( bs ) ;
301
}
302
 
303
 
304
/*
305
    WRITE A LIST OF IDENTIFIERS
306
 
307
    This routine saves a list of identifiers to the bitstream bs.
308
*/
309
 
310
static BITSTREAM *save_id_list
311
    PROTO_N ( ( bs, p, ns ) )
312
    PROTO_T ( BITSTREAM *bs X LIST ( IDENTIFIER ) p X NAMESPACE ns )
313
{
314
    while ( !IS_NULL_list ( p ) ) {
315
	IDENTIFIER id = DEREF_id ( HEAD_list ( p ) ) ;
316
	ENC_ON ( bs ) ;
317
	bs = save_id ( bs, id, ns ) ;
318
	p = TAIL_list ( p ) ;
319
    }
320
    ENC_OFF ( bs ) ;
321
    return ( bs ) ;
322
}
323
 
324
 
325
/*
326
    WRITE A LIST OF TOKENS
327
 
328
    This routine writes the list of tokens p to the bitstream bs.  def
329
    is as in save_tok.
330
*/
331
 
332
static BITSTREAM *save_tok_list
333
    PROTO_N ( ( bs, p, def ) )
334
    PROTO_T ( BITSTREAM *bs X LIST ( TOKEN ) p X int def )
335
{
336
    while ( !IS_NULL_list ( p ) ) {
337
	TOKEN tok = DEREF_tok ( HEAD_list ( p ) ) ;
338
	ENC_ON ( bs ) ;
339
	bs = save_tok ( bs, tok, def ) ;
340
	p = TAIL_list ( p ) ;
341
    }
342
    ENC_OFF ( bs ) ;
343
    return ( bs ) ;
344
}
345
 
346
 
347
/*
348
    WRITE AN INTEGER CONSTANT
349
 
350
    This routine writes the integer constant n to the bitstream bs.
351
*/
352
 
353
static BITSTREAM *save_nat
354
    PROTO_N ( ( bs, n ) )
355
    PROTO_T ( BITSTREAM *bs X NAT n )
356
{
357
    unsigned tag ;
358
    if ( IS_NULL_nat ( n ) ) {
359
	ENC_BITS ( bs, BITS_nat, 0 ) ;
360
	return ( bs ) ;
361
    }
362
    tag = TAG_nat ( n ) ;
363
    ENC_BITS ( bs, BITS_nat, tag + 1 ) ;
364
    ASSERT ( ORDER_nat == 5 ) ;
365
    switch ( tag ) {
366
	case nat_small_tag : {
367
	    unsigned v = DEREF_unsigned ( nat_small_value ( n ) ) ;
368
	    ENC_INT ( bs, v ) ;
369
	    break ;
370
	}
371
	case nat_large_tag : {
372
	    LIST ( unsigned ) p = DEREF_list ( nat_large_values ( n ) ) ;
373
	    while ( !IS_NULL_list ( p ) ) {
374
		unsigned v = DEREF_unsigned ( HEAD_list ( p ) ) ;
375
		ENC_ON ( bs ) ;
376
		ENC_INT ( bs, v ) ;
377
		p = TAIL_list ( p ) ;
378
	    }
379
	    ENC_OFF ( bs ) ;
380
	    break ;
381
	}
382
	case nat_calc_tag : {
383
	    EXP e = DEREF_exp ( nat_calc_value ( n ) ) ;
384
	    bs = save_exp ( bs, e, type_sint ) ;
385
	    break ;
386
	}
387
	case nat_neg_tag : {
388
	    NAT m = DEREF_nat ( nat_neg_arg ( n ) ) ;
389
	    bs = save_nat ( bs, m ) ;
390
	    break ;
391
	}
392
	case nat_token_tag : {
393
	    IDENTIFIER tok = DEREF_id ( nat_token_tok ( n ) ) ;
394
	    LIST ( TOKEN ) args = DEREF_list ( nat_token_args ( n ) ) ;
395
	    bs = save_use ( bs, tok ) ;
396
	    bs = save_tok_list ( bs, args, 1 ) ;
397
	    break ;
398
	}
399
    }
400
    return ( bs ) ;
401
}
402
 
403
 
404
/*
405
    WRITE AN OFFSET
406
 
407
    This routine writes the offset off to the bitstream bs.
408
*/
409
 
410
static BITSTREAM *save_off
411
    PROTO_N ( ( bs, off ) )
412
    PROTO_T ( BITSTREAM *bs X OFFSET off )
413
{
414
    /* NOT YET IMPLEMENTED */
415
    UNUSED ( off ) ;
416
    return ( bs ) ;
417
}
418
 
419
 
420
/*
421
    WRITE AN EXPRESSION
422
 
423
    This routine writes the expression e to the bitstream bs.
424
*/
425
 
426
static BITSTREAM *save_exp
427
    PROTO_N ( ( bs, e, t ) )
428
    PROTO_T ( BITSTREAM *bs X EXP e X TYPE t )
429
{
430
    unsigned tag ;
431
    if ( IS_NULL_exp ( e ) ) {
432
	ENC_BITS ( bs, BITS_exp, 0 ) ;
433
	return ( bs ) ;
434
    }
435
    tag = TAG_exp ( e ) ;
436
    ENC_BITS ( bs, BITS_exp, tag + 1 ) ;
437
    switch ( tag ) {
438
	case exp_int_lit_tag : {
439
	    NAT m = DEREF_nat ( exp_int_lit_nat ( e ) ) ;
440
	    unsigned etag = DEREF_unsigned ( exp_int_lit_etag ( e ) ) ;
441
	    bs = save_nat ( bs, m ) ;
442
	    ENC_BITS ( bs, BITS_exp, etag ) ;
443
	    break ;
444
	}
445
	case exp_token_tag : {
446
	    IDENTIFIER tok = DEREF_id ( exp_token_tok ( e ) ) ;
447
	    LIST ( TOKEN ) args = DEREF_list ( exp_token_args ( e ) ) ;
448
	    bs = save_use ( bs, tok ) ;
449
	    bs = save_tok_list ( bs, args, 1 ) ;
450
	    break ;
451
	}
452
	default : {
453
	    /* NOT YET IMPLEMENTED */
454
	    break ;
455
	}
456
    }
457
    UNUSED ( t ) ;
458
    return ( bs ) ;
459
}
460
 
461
 
462
/*
463
    WRITE AN INTEGRAL TYPE
464
 
465
    This routine writes the integral type it to the bitstream bs.
466
*/
467
 
468
static BITSTREAM *save_itype
469
    PROTO_N ( ( bs, it ) )
470
    PROTO_T ( BITSTREAM *bs X INT_TYPE it )
471
{
472
    unsigned tag ;
473
    if ( IS_NULL_itype ( it ) ) {
474
	ENC_BITS ( bs, BITS_itype, 0 ) ;
475
	return ( bs ) ;
476
    }
477
    tag = TAG_itype ( it ) ;
478
    ENC_BITS ( bs, BITS_itype, tag + 1 ) ;
479
    ASSERT ( ORDER_itype == 6 ) ;
480
    switch ( tag ) {
481
	case itype_basic_tag : {
482
	    BUILTIN_TYPE nt = DEREF_ntype ( itype_basic_no ( it ) ) ;
483
	    save_ntype ( bs, nt ) ;
484
	    break ;
485
	}
486
	case itype_bitfield_tag : {
487
	    NAT m = DEREF_nat ( itype_bitfield_size ( it ) ) ;
488
	    TYPE s = DEREF_type ( itype_bitfield_sub ( it ) ) ;
489
	    BASE_TYPE bt = DEREF_btype ( itype_bitfield_rep ( it ) ) ;
490
	    bs = save_type ( bs, s, NULL_id ) ;
491
	    save_btype ( bs, bt ) ;
492
	    bs = save_nat ( bs, m ) ;
493
	    break ;
494
	}
495
	case itype_promote_tag : {
496
	    INT_TYPE is = DEREF_itype ( itype_promote_arg ( it ) ) ;
497
	    bs = save_itype ( bs, is ) ;
498
	    break ;
499
	}
500
	case itype_arith_tag : {
501
	    INT_TYPE is = DEREF_itype ( itype_arith_arg1 ( it ) ) ;
502
	    INT_TYPE ir = DEREF_itype ( itype_arith_arg2 ( it ) ) ;
503
	    bs = save_itype ( bs, is ) ;
504
	    bs = save_itype ( bs, ir ) ;
505
	    break ;
506
	}
507
	case itype_literal_tag : {
508
	    NAT m = DEREF_nat ( itype_literal_nat ( it ) ) ;
509
	    int form = DEREF_int ( itype_literal_form ( it ) ) ;
510
	    int suff = DEREF_int ( itype_literal_suff ( it ) ) ;
511
	    bs = save_nat ( bs, m ) ;
512
	    ENC_BITS ( bs, 2, form ) ;
513
	    ENC_BITS ( bs, 3, suff ) ;
514
	    break ;
515
	}
516
	case itype_token_tag : {
517
	    IDENTIFIER tok = DEREF_id ( itype_token_tok ( it ) ) ;
518
	    LIST ( TOKEN ) args = DEREF_list ( itype_token_args ( it ) ) ;
519
	    bs = save_use ( bs, tok ) ;
520
	    bs = save_tok_list ( bs, args, 1 ) ;
521
	    break ;
522
	}
523
    }
524
    return ( bs ) ;
525
}
526
 
527
 
528
/*
529
    WRITE A FLOATING POINT TYPE
530
 
531
    This routine writes the floating point type ft to the bitstream bs.
532
*/
533
 
534
static BITSTREAM *save_ftype
535
    PROTO_N ( ( bs, ft ) )
536
    PROTO_T ( BITSTREAM *bs X FLOAT_TYPE ft )
537
{
538
    unsigned tag ;
539
    if ( IS_NULL_ftype ( ft ) ) {
540
	ENC_BITS ( bs, BITS_ftype, 0 ) ;
541
	return ( bs ) ;
542
    }
543
    tag = TAG_ftype ( ft ) ;
544
    ENC_BITS ( bs, BITS_ftype, tag + 1 ) ;
545
    switch ( tag ) {
546
	case ftype_basic_tag : {
547
	    BUILTIN_TYPE no = DEREF_ntype ( ftype_basic_no ( ft ) ) ;
548
	    save_ntype ( bs, no ) ;
549
	    break ;
550
	}
551
	case ftype_arg_promote_tag : {
552
	    FLOAT_TYPE fs = DEREF_ftype ( ftype_arg_promote_arg ( ft ) ) ;
553
	    bs = save_ftype ( bs, fs ) ;
554
	    break ;
555
	}
556
	case ftype_arith_tag : {
557
	    FLOAT_TYPE fs = DEREF_ftype ( ftype_arith_arg1 ( ft ) ) ;
558
	    FLOAT_TYPE fr = DEREF_ftype ( ftype_arith_arg2 ( ft ) ) ;
559
	    bs = save_ftype ( bs, fs ) ;
560
	    bs = save_ftype ( bs, fr ) ;
561
	    break ;
562
	}
563
	case ftype_token_tag : {
564
	    IDENTIFIER tok = DEREF_id ( ftype_token_tok ( ft ) ) ;
565
	    LIST ( TOKEN ) args = DEREF_list ( ftype_token_args ( ft ) ) ;
566
	    bs = save_use ( bs, tok ) ;
567
	    bs = save_tok_list ( bs, args, 1 ) ;
568
	    break ;
569
	}
570
    }
571
    return ( bs ) ;
572
}
573
 
574
 
575
/*
576
    WRITE A BASE CLASS GRAPH
577
 
578
    This routine writes the base class graph gr to the bitstream bs.
579
    The graph gt gives the top of the graph which is not output.
580
*/
581
 
582
static BITSTREAM *save_graph
583
    PROTO_N ( ( bs, gr, gt ) )
584
    PROTO_T ( BITSTREAM *bs X GRAPH gr X GRAPH gt )
585
{
586
    LIST ( GRAPH ) br = DEREF_list ( graph_tails ( gr ) ) ;
587
    if ( !EQ_graph ( gr, gt ) ) {
588
	CLASS_TYPE ct = DEREF_ctype ( graph_head ( gr ) ) ;
589
	DECL_SPEC acc = DEREF_dspec ( graph_access ( gr ) ) ;
590
	bs = save_ctype ( bs, ct, NULL_id ) ;
591
	save_dspec ( bs, acc ) ;
592
    }
593
    while ( !IS_NULL_list ( br ) ) {
594
	GRAPH gs = DEREF_graph ( HEAD_list ( br ) ) ;
595
	ENC_ON ( bs ) ;
596
	bs = save_graph ( bs, gs, gt ) ;
597
	br = TAIL_list ( br ) ;
598
    }
599
    ENC_OFF ( bs ) ;
600
    return ( bs ) ;
601
}
602
 
603
 
604
/*
605
    WRITE A CLASS TYPE
606
 
607
    This routine writes the class type ct to the bitstream bs.  If def
608
    is not null then the full definition is written, otherwise just a use
609
    is written.
610
*/
611
 
612
static BITSTREAM *save_ctype
613
    PROTO_N ( ( bs, ct, def ) )
614
    PROTO_T ( BITSTREAM *bs X CLASS_TYPE ct X IDENTIFIER def )
615
{
616
    if ( !IS_NULL_id ( def ) ) {
617
	CLASS_INFO ci = DEREF_cinfo ( ctype_info ( ct ) ) ;
618
	CLASS_USAGE cu = DEREF_cusage ( ctype_usage ( ct ) ) ;
619
	GRAPH gr = DEREF_graph ( ctype_base ( ct ) ) ;
620
	TYPE form = DEREF_type ( ctype_form ( ct ) ) ;
621
	save_cinfo ( bs, ci ) ;
622
	save_cusage ( bs, cu ) ;
623
	bs = save_graph ( bs, gr, gr ) ;
624
	if ( !IS_NULL_type ( form ) ) {
625
	    ENC_ON ( bs ) ;
626
	    bs = save_type ( bs, form, NULL_id ) ;
627
	} else {
628
	    ENC_OFF ( bs ) ;
629
	}
630
    } else {
631
	IDENTIFIER cid = DEREF_id ( ctype_name ( ct ) ) ;
632
	bs = save_use ( bs, cid ) ;
633
    }
634
    return ( bs ) ;
635
}
636
 
637
 
638
/*
639
    WRITE AN ENUMERATION TYPE
640
 
641
    This routine writes the enumeration type et to the bitstream bs.  If
642
    def is not null then the full definition is written, otherwise just a
643
    use is written.
644
*/
645
 
646
static BITSTREAM *save_etype
647
    PROTO_N ( ( bs, et, def ) )
648
    PROTO_T ( BITSTREAM *bs X ENUM_TYPE et X IDENTIFIER def )
649
{
650
    if ( !IS_NULL_id ( def ) ) {
651
	CLASS_INFO ei = DEREF_cinfo ( etype_info ( et ) ) ;
652
	TYPE t = DEREF_type ( etype_rep ( et ) ) ;
653
	TYPE form = DEREF_type ( etype_form ( et ) ) ;
654
	save_cinfo ( bs, ei ) ;
655
	bs = save_type ( bs, t, NULL_id ) ;
656
	if ( !IS_NULL_type ( form ) ) {
657
	    ENC_ON ( bs ) ;
658
	    bs = save_type ( bs, form, NULL_id ) ;
659
	} else {
660
	    ENC_OFF ( bs ) ;
661
	}
662
    } else {
663
	IDENTIFIER eid = DEREF_id ( etype_name ( et ) ) ;
664
	bs = save_use ( bs, eid ) ;
665
    }
666
    return ( bs ) ;
667
}
668
 
669
 
670
/*
671
    WRITE A TYPE
672
 
673
    This routine writes the type t to the bitstream bs.  def is passed to
674
    save_ctype and save_etype.
675
*/
676
 
677
static BITSTREAM *save_type
678
    PROTO_N ( ( bs, t, def ) )
679
    PROTO_T ( BITSTREAM *bs X TYPE t X IDENTIFIER def )
680
{
681
    CV_SPEC cv ;
682
    unsigned tag ;
683
    BUILTIN_TYPE nt = is_builtin_type ( t, 1 ) ;
684
    if ( nt != ntype_none ) {
685
	/* Built-in types */
686
	ENC_ON ( bs ) ;
687
	cv = DEREF_cv ( type_qual ( t ) ) ;
688
	save_cv ( bs, cv ) ;
689
	save_ntype ( bs, nt ) ;
690
	return ( bs ) ;
691
    }
692
    ENC_OFF ( bs ) ;
693
    if ( IS_NULL_type ( t ) ) {
694
	/* Null types */
695
	ENC_BITS ( bs, BITS_type, 0 ) ;
696
	return ( bs ) ;
697
    }
698
 
699
    /* Save type independent fields */
700
    tag = TAG_type ( t ) ;
701
    ENC_BITS ( bs, BITS_type, tag + 1 ) ;
702
    cv = DEREF_cv ( type_qual ( t ) ) ;
703
    save_cv ( bs, cv ) ;
704
 
705
    /* Save type dependent fields */
706
    ASSERT ( ORDER_type == 18 ) ;
707
    switch ( TAG_type ( t ) ) {
708
	case type_pre_tag : {
709
	    IDENTIFIER tid = DEREF_id ( type_name ( t ) ) ;
710
	    QUALIFIER qual = DEREF_qual ( type_pre_nqual ( t ) ) ;
711
	    BASE_TYPE bt = DEREF_btype ( type_pre_rep ( t ) ) ;
712
	    bs = save_use ( bs, tid ) ;
713
	    save_qual ( bs, qual ) ;
714
	    save_btype ( bs, bt ) ;
715
	    break ;
716
	}
717
	case type_integer_tag : {
718
	    INT_TYPE it = DEREF_itype ( type_integer_rep ( t ) ) ;
719
	    INT_TYPE is = DEREF_itype ( type_integer_sem ( t ) ) ;
720
	    INT_TYPE ir = it ;
721
	    bs = save_itype ( bs, it ) ;
722
	    if ( IS_itype_promote ( ir ) ) {
723
		/* Find default semantic type for it */
724
		ir = DEREF_itype ( itype_promote_arg ( ir ) ) ;
725
	    }
726
	    if ( EQ_itype ( ir, is ) || eq_itype ( ir, is ) ) {
727
		/* Default semantics */
728
		ENC_OFF ( bs ) ;
729
	    } else {
730
		/* Non-standard semantic type */
731
		ENC_ON ( bs ) ;
732
		bs = save_itype ( bs, is ) ;
733
	    }
734
	    break ;
735
	}
736
	case type_floating_tag : {
737
	    FLOAT_TYPE ft = DEREF_ftype ( type_floating_rep ( t ) ) ;
738
	    bs = save_ftype ( bs, ft ) ;
739
	    break ;
740
	}
741
	case type_top_tag :
742
	case type_bottom_tag : {
743
	    /* Already handled */
744
	    break ;
745
	}
746
	case type_ptr_tag :
747
	case type_ref_tag : {
748
	    TYPE s = DEREF_type ( type_ptr_etc_sub ( t ) ) ;
749
	    bs = save_type ( bs, s, NULL_id ) ;
750
	    break ;
751
	}
752
	case type_ptr_mem_tag : {
753
	    CLASS_TYPE cs = DEREF_ctype ( type_ptr_mem_of ( t ) ) ;
754
	    TYPE s = DEREF_type ( type_ptr_mem_sub ( t ) ) ;
755
	    bs = save_ctype ( bs, cs, NULL_id ) ;
756
	    bs = save_type ( bs, s, NULL_id ) ;
757
	    break ;
758
	}
759
	case type_func_tag : {
760
	    TYPE r = DEREF_type ( type_func_ret ( t ) ) ;
761
	    LIST ( IDENTIFIER ) pids = DEREF_list ( type_func_pids ( t ) ) ;
762
	    int ell = DEREF_int ( type_func_ellipsis ( t ) ) ;
763
	    LIST ( TYPE ) p = DEREF_list ( type_func_ptypes ( t ) ) ;
764
	    LIST ( TYPE ) m = DEREF_list ( type_func_mtypes ( t ) ) ;
765
	    LIST ( TYPE ) ex = DEREF_list ( type_func_except ( t ) ) ;
766
	    CV_SPEC mqual = DEREF_cv ( type_func_mqual ( t ) ) ;
767
	    bs = save_type ( bs, r, NULL_id ) ;
768
	    bs = save_id_list ( bs, pids, NULL_nspace ) ;
769
	    ENC_BITS ( bs, BITS_ellipsis, ell ) ;
770
	    save_mqual ( bs, mqual ) ;
771
	    if ( EQ_list ( p, m ) ) {
772
		ENC_OFF ( bs ) ;
773
	    } else {
774
		CLASS_TYPE cs ;
775
		TYPE s = DEREF_type ( HEAD_list ( m ) ) ;
776
		s = DEREF_type ( type_ref_sub ( s ) ) ;
777
		cs = DEREF_ctype ( type_compound_defn ( s ) ) ;
778
		ENC_ON ( bs ) ;
779
		bs = save_ctype ( bs, cs, NULL_id ) ;
780
	    }
781
	    if ( EQ_list ( ex, univ_type_set ) ) {
782
		ENC_OFF ( bs ) ;
783
	    } else {
784
		ENC_ON ( bs ) ;
785
		bs = save_type_list ( bs, ex ) ;
786
	    }
787
	    break ;
788
	}
789
	case type_array_tag : {
790
	    TYPE s = DEREF_type ( type_array_sub ( t ) ) ;
791
	    NAT m = DEREF_nat ( type_array_size ( t ) ) ;
792
	    bs = save_type ( bs, s, NULL_id ) ;
793
	    bs = save_nat ( bs, m ) ;
794
	    break ;
795
	}
796
	case type_bitfield_tag : {
797
	    INT_TYPE it = DEREF_itype ( type_bitfield_defn ( t ) ) ;
798
	    bs = save_itype ( bs, it ) ;
799
	    break ;
800
	}
801
	case type_compound_tag : {
802
	    CLASS_TYPE ct = DEREF_ctype ( type_compound_defn ( t ) ) ;
803
	    bs = save_ctype ( bs, ct, def ) ;
804
	    break ;
805
	}
806
	case type_enumerate_tag : {
807
	    ENUM_TYPE et = DEREF_etype ( type_enumerate_defn ( t ) ) ;
808
	    bs = save_etype ( bs, et, def ) ;
809
	    break ;
810
	}
811
	case type_token_tag : {
812
	    IDENTIFIER tok = DEREF_id ( type_token_tok ( t ) ) ;
813
	    LIST ( TOKEN ) args = DEREF_list ( type_token_args ( t ) ) ;
814
	    bs = save_use ( bs, tok ) ;
815
	    bs = save_tok_list ( bs, args, 1 ) ;
816
	    break ;
817
	}
818
	case type_templ_tag : {
819
	    TOKEN tok = DEREF_tok ( type_templ_sort ( t ) ) ;
820
	    TYPE s = DEREF_type ( type_templ_defn ( t ) ) ;
821
	    int fix = DEREF_int ( type_templ_fix ( t ) ) ;
822
	    bs = save_tok ( bs, tok, 0 ) ;
823
	    bs = save_type ( bs, s, def ) ;
824
	    ENC_BOOL ( bs, fix ) ;
825
	    break ;
826
	}
827
	case type_instance_tag : {
828
	    IDENTIFIER tid = DEREF_id ( type_name ( t ) ) ;
829
	    IDENTIFIER id = DEREF_id ( type_instance_id ( t ) ) ;
830
	    DECL_SPEC acc = DEREF_dspec ( type_instance_access ( t ) ) ;
831
	    bs = save_use ( bs, tid ) ;
832
	    bs = save_use ( bs, id ) ;
833
	    save_dspec ( bs, acc ) ;
834
	    break ;
835
	}
836
	case type_dummy_tag : {
837
	    int tok = DEREF_int ( type_dummy_tok ( t ) ) ;
838
	    ENC_INT ( bs, tok ) ;
839
	    break ;
840
	}
841
	case type_error_tag : {
842
	    break ;
843
	}
844
    }
845
    return ( bs ) ;
846
}
847
 
848
 
849
/*
850
    WRITE A LIST OF TYPES
851
 
852
    This routine saves a list of types to the bitstream bs.
853
*/
854
 
855
static BITSTREAM *save_type_list
856
    PROTO_N ( ( bs, p ) )
857
    PROTO_T ( BITSTREAM *bs X LIST ( TYPE ) p )
858
{
859
    while ( !IS_NULL_list ( p ) ) {
860
	TYPE t = DEREF_type ( HEAD_list ( p ) ) ;
861
	ENC_ON ( bs ) ;
862
	bs = save_type ( bs, t, NULL_id ) ;
863
	p = TAIL_list ( p ) ;
864
    }
865
    ENC_OFF ( bs ) ;
866
    return ( bs ) ;
867
}
868
 
869
 
870
/*
871
    WRITE A TOKEN
872
 
873
    This routine writes the token tok to the bitstream bs.  If def is
874
    true then the token value is included.
875
*/
876
 
877
static BITSTREAM *save_tok
878
    PROTO_N ( ( bs, tok, def ) )
879
    PROTO_T ( BITSTREAM *bs X TOKEN tok X int def )
880
{
881
    unsigned tag ;
882
    if ( IS_NULL_tok ( tok ) ) {
883
	ENC_BITS ( bs, BITS_tok, 0 ) ;
884
	return ( bs ) ;
885
    }
886
    tag = TAG_tok ( tok ) ;
887
    ENC_BITS ( bs, BITS_tok, tag + 1 ) ;
888
    ASSERT ( ORDER_tok == 10 ) ;
889
    switch ( tag ) {
890
	case tok_exp_tag : {
891
	    TYPE t = DEREF_type ( tok_exp_type ( tok ) ) ;
892
	    int c = DEREF_int ( tok_exp_constant ( tok ) ) ;
893
	    bs = save_type ( bs, t, NULL_id ) ;
894
	    ENC_BOOL ( bs, c ) ;
895
	    if ( def ) {
896
		EXP e = DEREF_exp ( tok_exp_value ( tok ) ) ;
897
		bs = save_exp ( bs, e, t ) ;
898
	    }
899
	    break ;
900
	}
901
	case tok_stmt_tag : {
902
	    if ( def ) {
903
		EXP e = DEREF_exp ( tok_stmt_value ( tok ) ) ;
904
		bs = save_exp ( bs, e, type_void ) ;
905
	    }
906
	    break ;
907
	}
908
	case tok_nat_tag :
909
	case tok_snat_tag : {
910
	    if ( def ) {
911
		NAT m = DEREF_nat ( tok_nat_etc_value ( tok ) ) ;
912
		bs = save_nat ( bs, m ) ;
913
	    }
914
	    break ;
915
	}
916
	case tok_type_tag : {
917
	    BASE_TYPE kind = DEREF_btype ( tok_type_kind ( tok ) ) ;
918
	    TYPE s = DEREF_type ( tok_type_alt ( tok ) ) ;
919
	    save_btype ( bs, kind ) ;
920
	    bs = save_type ( bs, s, NULL_id ) ;
921
	    if ( def ) {
922
		TYPE t = DEREF_type ( tok_type_value ( tok ) ) ;
923
		bs = save_type ( bs, t, NULL_id ) ;
924
	    }
925
	    break ;
926
	}
927
	case tok_func_tag : {
928
	    TYPE t = DEREF_type ( tok_func_type ( tok ) ) ;
929
	    TOKEN proc = DEREF_tok ( tok_func_proc ( tok ) ) ;
930
	    bs = save_type ( bs, t, NULL_id ) ;
931
	    bs = save_tok ( bs, proc, 0 ) ;
932
	    if ( def ) {
933
		IDENTIFIER id = DEREF_id ( tok_func_defn ( tok ) ) ;
934
		bs = save_use ( bs, id ) ;
935
	    }
936
	    break ;
937
	}
938
	case tok_member_tag : {
939
	    TYPE s = DEREF_type ( tok_member_of ( tok ) ) ;
940
	    TYPE t = DEREF_type ( tok_member_type ( tok ) ) ;
941
	    bs = save_type ( bs, s, NULL_id ) ;
942
	    bs = save_type ( bs, t, NULL_id ) ;
943
	    if ( def ) {
944
		OFFSET off = DEREF_off ( tok_member_value ( tok ) ) ;
945
		bs = save_off ( bs, off ) ;
946
	    }
947
	    break ;
948
	}
949
	case tok_class_tag : {
950
	    TYPE t = DEREF_type ( tok_class_type ( tok ) ) ;
951
	    TYPE s = DEREF_type ( tok_class_alt ( tok ) ) ;
952
	    bs = save_type ( bs, t, NULL_id ) ;
953
	    bs = save_type ( bs, s, NULL_id ) ;
954
	    if ( def ) {
955
		IDENTIFIER id = DEREF_id ( tok_class_value ( tok ) ) ;
956
		bs = save_use ( bs, id ) ;
957
	    }
958
	    break ;
959
	}
960
	case tok_proc_tag : {
961
	    LIST ( IDENTIFIER ) bids ;
962
	    LIST ( IDENTIFIER ) pids ;
963
	    int key = DEREF_int ( tok_proc_key ( tok ) ) ;
964
	    TOKEN res = DEREF_tok ( tok_proc_res ( tok ) ) ;
965
	    bids = DEREF_list ( tok_proc_bids ( tok ) ) ;
966
	    pids = DEREF_list ( tok_proc_pids ( tok ) ) ;
967
	    bs = save_id_list ( bs, bids, NULL_nspace ) ;
968
	    if ( EQ_list ( pids, bids ) ) {
969
		ENC_ON ( bs ) ;
970
	    } else {
971
		ENC_OFF ( bs ) ;
972
		bs = save_use_list ( bs, pids ) ;
973
	    }
974
	    bs = save_tok ( bs, res, def ) ;
975
	    if ( key == lex_identifier ) {
976
		ENC_OFF ( bs ) ;
977
	    } else {
978
		ENC_ON ( bs ) ;
979
		save_lex ( bs, key ) ;
980
	    }
981
	    break ;
982
	}
983
	case tok_templ_tag : {
984
	    DECL_SPEC ex = DEREF_dspec ( tok_templ_usage ( tok ) ) ;
985
	    NAMESPACE pns = DEREF_nspace ( tok_templ_pars ( tok ) ) ;
986
	    save_dspec ( bs, ex ) ;
987
	    if ( !IS_NULL_nspace ( pns ) ) {
988
		LIST ( TOKEN ) dargs ;
989
		LIST ( IDENTIFIER ) pids ;
990
		pids = DEREF_list ( tok_templ_pids ( tok ) ) ;
991
		dargs = DEREF_list ( tok_templ_dargs ( tok ) ) ;
992
		ENC_ON ( bs ) ;
993
		bs = save_id_list ( bs, pids, NULL_nspace ) ;
994
		bs = save_tok_list ( bs, dargs, 1 ) ;
995
	    } else {
996
		ENC_OFF ( bs ) ;
997
	    }
998
	    break ;
999
	}
1000
    }
1001
    return ( bs ) ;
1002
}
1003
 
1004
 
1005
/*
1006
    STANDARD BITSTREAM
1007
 
1008
    This bitstream is used to write the spec output file.
1009
*/
1010
 
1011
BITSTREAM *spec_unit = NULL ;
1012
static int written_spec = 0 ;
1013
int output_spec = 0 ;
1014
 
1015
 
1016
/*
1017
    WRITE AN IDENTIFIER SPEC
1018
 
1019
    This routine writes the spec of the identifier id from the namespace ns
1020
    to the bitstream bs.
1021
*/
1022
 
1023
BITSTREAM *save_id
1024
    PROTO_N ( ( bs, id, ns ) )
1025
    PROTO_T ( BITSTREAM *bs X IDENTIFIER id X NAMESPACE ns )
1026
{
1027
    if ( bs && output_spec ) {
1028
	bs = save_use ( bs, id ) ;
1029
	if ( !IS_NULL_id ( id ) ) {
1030
	    /* Save identifier independent fields */
1031
	    unsigned tag = TAG_id ( id ) ;
1032
	    HASHID nm = DEREF_hashid ( id_name ( id ) ) ;
1033
	    DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
1034
	    IDENTIFIER lid = DEREF_id ( id_alias ( id ) ) ;
1035
	    ENC_BITS ( bs, BITS_id, tag + 1 ) ;
1036
	    bs = save_hashid ( bs, nm, ns ) ;
1037
	    save_dspec ( bs, ds ) ;
1038
	    bs = save_loc ( bs, id_loc ( id ) ) ;
1039
	    if ( EQ_id ( id, lid ) ) {
1040
		ENC_OFF ( bs ) ;
1041
	    } else {
1042
		ENC_ON ( bs ) ;
1043
		bs = save_use ( bs, lid ) ;
1044
	    }
1045
 
1046
	    /* Save identifier dependent fields */
1047
	    ASSERT ( ORDER_id == 29 ) ;
1048
	    switch ( tag ) {
1049
		case id_dummy_tag : {
1050
		    break ;
1051
		}
1052
		case id_keyword_tag :
1053
		case id_iso_keyword_tag :
1054
		case id_reserved_tag : {
1055
		    int key = ( int ) DEREF_ulong ( id_no ( id ) ) ;
1056
		    save_lex ( bs, key ) ;
1057
		    break ;
1058
		}
1059
		case id_builtin_tag : {
1060
		    LIST ( TYPE ) p ;
1061
		    TYPE r = DEREF_type ( id_builtin_ret ( id ) ) ;
1062
		    p = DEREF_list ( id_builtin_ptypes ( id ) ) ;
1063
		    bs = save_type ( bs, r, NULL_id ) ;
1064
		    bs = save_type_list ( bs, p ) ;
1065
		    break ;
1066
		}
1067
		case id_obj_macro_tag : {
1068
		    PPTOKEN *def ;
1069
		    def = DEREF_pptok ( id_obj_macro_defn ( id ) ) ;
1070
		    bs = save_pptoks ( bs, def ) ;
1071
		    break ;
1072
		}
1073
		case id_func_macro_tag : {
1074
		    PPTOKEN *def ;
1075
		    LIST ( HASHID ) pars ;
1076
		    def = DEREF_pptok ( id_func_macro_defn ( id ) ) ;
1077
		    pars = DEREF_list ( id_func_macro_params ( id ) ) ;
1078
		    bs = save_hashid_list ( bs, pars, NULL_nspace ) ;
1079
		    bs = save_pptoks ( bs, def ) ;
1080
		    break ;
1081
		}
1082
		case id_predicate_tag : {
1083
		    /* NOT YET IMPLEMENTED */
1084
		    break ;
1085
		}
1086
		case id_class_name_tag :
1087
		case id_enum_name_tag : {
1088
		    TYPE t = DEREF_type ( id_class_name_etc_defn ( id ) ) ;
1089
		    if ( !( ds & dspec_implicit ) ) {
1090
			bs = save_type ( bs, t, id ) ;
1091
		    }
1092
		    break ;
1093
		}
1094
		case id_class_alias_tag :
1095
		case id_enum_alias_tag :
1096
		case id_type_alias_tag : {
1097
		    TYPE t = DEREF_type ( id_class_name_etc_defn ( id ) ) ;
1098
		    bs = save_type ( bs, t, NULL_id ) ;
1099
		    break ;
1100
		}
1101
		case id_nspace_name_tag : {
1102
		    break ;
1103
		}
1104
		case id_nspace_alias_tag : {
1105
		    NAMESPACE pns ;
1106
		    IDENTIFIER pid ;
1107
		    pns = DEREF_nspace ( id_nspace_alias_defn ( id ) ) ;
1108
		    pid = DEREF_id ( nspace_name ( pns ) ) ;
1109
		    bs = save_use ( bs, pid ) ;
1110
		    break ;
1111
		}
1112
		case id_variable_tag :
1113
		case id_parameter_tag :
1114
		case id_stat_member_tag : {
1115
		    TYPE t = DEREF_type ( id_variable_etc_type ( id ) ) ;
1116
		    bs = save_type ( bs, t, NULL_id ) ;
1117
		    /* NOT YET IMPLEMENTED */
1118
		    break ;
1119
		}
1120
		case id_function_tag :
1121
		case id_mem_func_tag :
1122
		case id_stat_mem_func_tag : {
1123
		    TYPE t = DEREF_type ( id_function_etc_type ( id ) ) ;
1124
		    TYPE form = DEREF_type ( id_function_etc_form ( id ) ) ;
1125
		    bs = save_type ( bs, t, NULL_id ) ;
1126
		    if ( !IS_NULL_type ( form ) ) {
1127
			ENC_ON ( bs ) ;
1128
			bs = save_type ( bs, form, NULL_id ) ;
1129
		    } else {
1130
			ENC_OFF ( bs ) ;
1131
		    }
1132
		    /* NOT YET IMPLEMENTED */
1133
		    break ;
1134
		}
1135
		case id_member_tag : {
1136
		    TYPE t = DEREF_type ( id_member_type ( id ) ) ;
1137
		    bs = save_type ( bs, t, NULL_id ) ;
1138
		    /* NOT YET IMPLEMENTED */
1139
		    break ;
1140
		}
1141
		case id_enumerator_tag : {
1142
		    EXP e ;
1143
		    TYPE t ;
1144
		    t = DEREF_type ( id_enumerator_etype ( id ) ) ;
1145
		    e = DEREF_exp ( id_enumerator_value ( id ) ) ;
1146
		    bs = save_type ( bs, t, NULL_id ) ;
1147
		    bs = save_exp ( bs, e, t ) ;
1148
		    break ;
1149
		}
1150
		case id_label_tag :
1151
		case id_weak_param_tag : {
1152
		    /* NOT YET IMPLEMENTED */
1153
		    break ;
1154
		}
1155
		case id_token_tag : {
1156
		    TOKEN tok = DEREF_tok ( id_token_sort ( id ) ) ;
1157
		    bs = save_tok ( bs, tok, 0 ) ;
1158
		    break ;
1159
		}
1160
		case id_ambig_tag : {
1161
		    LIST ( IDENTIFIER ) ids ;
1162
		    int over = DEREF_int ( id_ambig_over ( id ) ) ;
1163
		    ids = DEREF_list ( id_ambig_ids ( id ) ) ;
1164
		    bs = save_use_list ( bs, ids ) ;
1165
		    ENC_BOOL ( bs, over ) ;
1166
		    break ;
1167
		}
1168
		case id_undef_tag : {
1169
		    TYPE form = DEREF_type ( id_undef_form ( id ) ) ;
1170
		    if ( !IS_NULL_type ( form ) ) {
1171
			ENC_ON ( bs ) ;
1172
			bs = save_type ( bs, form, NULL_id ) ;
1173
		    } else {
1174
			ENC_OFF ( bs ) ;
1175
		    }
1176
		    break ;
1177
		}
1178
		case id_pending_tag : {
1179
		    /* This shouldn't happen */
1180
		    break ;
1181
		}
1182
	    }
1183
	}
1184
    }
1185
    return ( bs ) ;
1186
}
1187
 
1188
 
1189
/*
1190
    WRITE THE END OF A NAMESPACE
1191
 
1192
    This routine marks the end of the namespace ns by writing the null
1193
    identifier to the bitstream bs.
1194
*/
1195
 
1196
BITSTREAM *save_end
1197
    PROTO_N ( ( bs, ns ) )
1198
    PROTO_T ( BITSTREAM *bs X NAMESPACE ns )
1199
{
1200
    bs = save_id ( bs, NULL_id, ns ) ;
1201
    return ( bs ) ;
1202
}
1203
 
1204
 
1205
/*
1206
    WRITE A SPEC FILE
1207
 
1208
    This routine begins the writing of a spec file to the second output
1209
    file.
1210
*/
1211
 
1212
void begin_spec
1213
    PROTO_Z ()
1214
{
1215
    string nm = output_name [ OUTPUT_SPEC ] ;
1216
    if ( nm && !written_spec ) {
1217
	/* Open output file */
1218
	FILE *f ;
1219
	BITSTREAM *bs ;
1220
	written_spec = 1 ;
1221
	if ( !open_output ( OUTPUT_SPEC, binary_mode ) ) {
1222
	    fail ( ERR_fail_spec ( nm ) ) ;
1223
	    spec_unit = NULL ;
1224
	    term_error ( 0 ) ;
1225
	    return ;
1226
	}
1227
	f = output_file [ OUTPUT_SPEC ] ;
1228
	bs = start_bitstream ( f, NULL_gen_ptr ) ;
1229
 
1230
	/* Write file identifier */
1231
	ENC_BITS ( bs, BYTE_SIZE, ascii_T ) ;
1232
	ENC_BITS ( bs, BYTE_SIZE, ascii_D ) ;
1233
	ENC_BITS ( bs, BYTE_SIZE, ascii_F ) ;
1234
	ENC_BITS ( bs, BYTE_SIZE, ascii_K ) ;
1235
	ENC_INT ( bs, SPEC_major ) ;
1236
	ENC_INT ( bs, SPEC_minor ) ;
1237
	ENC_INT ( bs, LANGUAGE_CPP ) ;
1238
	ENC_ALIGN ( bs ) ;
1239
	spec_unit = bs ;
1240
    }
1241
    return ;
1242
}
1243
 
1244
 
1245
/*
1246
    END A SPEC FILE
1247
 
1248
    This routine completes the output of a spec file.
1249
*/
1250
 
1251
void end_spec
1252
    PROTO_Z ()
1253
{
1254
    BITSTREAM *bs = spec_unit ;
1255
    if ( bs ) {
1256
	if ( !output_spec ) ENC_INT ( bs, 0 ) ;
1257
	end_bitstream ( bs, 1 ) ;
1258
	close_output ( OUTPUT_SPEC ) ;
1259
	spec_unit = NULL ;
1260
    }
1261
    return ;
1262
}