WebSVN – tendra.SVN – Blame – /branches/tendra5/src/producers/common/output/dump.c

Rev	Author	Line No.	Line
2	7u83	1	`/*`
		2	`Crown Copyright (c) 1997`
		3
		4	`This TenDRA(r) Computer Program is subject to Copyright`
		5	`owned by the United Kingdom Secretary of State for Defence`
		6	`acting through the Defence Evaluation and Research Agency`
		7	`(DERA). It is made available to Recipients with a`
		8	`royalty-free licence for its use, reproduction, transfer`
		9	`to other parties and amendment for any purpose not excluding`
		10	`product development provided that any such use et cetera`
		11	`shall be deemed to be acceptance of the following conditions:-`
		12
		13	`(1) Its Recipients shall ensure that this Notice is`
		14	`reproduced upon any copies or amended versions of it;`
		15
		16	`(2) Any amended version of it shall be clearly marked to`
		17	`show both the nature of and the organisation responsible`
		18	`for the relevant amendment or amendments;`
		19
		20	`(3) Its onward transfer from a recipient to another`
		21	`party shall be deemed to be that party's acceptance of`
		22	`these conditions;`
		23
		24	`(4) DERA gives no warranty or assurance as to its`
		25	`quality or suitability for any purpose and DERA accepts`
		26	`no liability whatsoever in relation to any use to which`
		27	`it may be put.`
		28	`*/`
		29
		30
		31	`#include "config.h"`
		32	`#include <limits.h>`
		33	`#include "system.h"`
		34	`#include "version.h"`
		35	`#include "c_types.h"`
		36	`#include "err_ext.h"`
		37	`#include "ctype_ops.h"`
		38	`#include "etype_ops.h"`
		39	`#include "exp_ops.h"`
		40	`#include "ftype_ops.h"`
		41	`#include "graph_ops.h"`
		42	`#include "hashid_ops.h"`
		43	`#include "id_ops.h"`
		44	`#include "itype_ops.h"`
		45	`#include "nat_ops.h"`
		46	`#include "nspace_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 "buffer.h"`
		53	`#include "char.h"`
		54	`#include "constant.h"`
		55	`#include "convert.h"`
		56	`#include "dump.h"`
		57	`#include "exception.h"`
		58	`#include "file.h"`
		59	`#include "function.h"`
		60	`#include "lex.h"`
		61	`#include "literal.h"`
		62	`#include "macro.h"`
		63	`#include "mangle.h"`
		64	`#include "print.h"`
		65	`#include "statement.h"`
		66	`#include "token.h"`
		67	`#include "ustring.h"`
		68	`#include "xalloc.h"`
		69
		70
		71	`/*`
		72	`DUMP FILE OPTIONS`
		73
		74	`These variables give the various dump file options.`
		75	`*/`
		76
		77	`int do_dump = 0 ;`
		78	`int do_error = 0 ;`
		79	`int do_header = 0 ;`
		80	`int do_keyword = 0 ;`
		81	`int do_local = 0 ;`
		82	`int do_macro = 0 ;`
		83	`int do_scope = 0 ;`
		84	`int do_string = 0 ;`
		85	`int do_usage = 0 ;`
		86
		87
		88	`/*`
		89	`DUMP FILE VARIABLES`
		90
		91	`These variables give the dump file and the associated dump buffer.`
		92	`*/`
		93
		94	`static FILE *dump_file = NULL ;`
		95	`static BUFFER dump_buff_rep = NULL_buff ;`
		96	`static BUFFER *dump_buff = &dump_buff_rep ;`
		97
		98
		99	`/*`
		100	`DUMP BUFFER TO FILE`
		101
		102	`This routine adds the contents of the dump buffer to the dump file.`
		103	`*/`
		104
		105	`static void dump_string`
		106	`PROTO_Z ()`
		107	`{`
		108	`FILE *f = dump_file ;`
		109	`BUFFER *bf = dump_buff ;`
		110	`string s = bf->start ;`
		111	`size_t n = ( size_t ) ( bf->posn - s ) ;`
		112	`fprintf_v ( f, "&%lu<", ( unsigned long ) n ) ;`
		113	`if ( n ) {`
		114	`IGNORE fwrite ( ( gen_ptr ) s, sizeof ( character ), n, f ) ;`
		115	`bf->posn = s ;`
		116	`}`
		117	`fputc_v ( '>', f ) ;`
		118	`return ;`
		119	`}`
		120
		121
		122	`/*`
		123	`FORWARD DECLARATIONS`
		124
		125	`The dump routines defined in this module are defined recursively`
		126	`so a couple of forward declarations are required.`
		127	`*/`
		128
		129	`static void dump_id PROTO_S ( ( IDENTIFIER ) ) ;`
		130	`static void dump_type PROTO_S ( ( TYPE ) ) ;`
		131	`static void dump_tok_appl PROTO_S ( ( IDENTIFIER, LIST ( TOKEN ) ) ) ;`
		132	`static void dump_nat PROTO_S ( ( NAT, int ) ) ;`
		133
		134
		135	`/*`
		136	`DUMP FLAGS`
		137
		138	`The flag dump_implicit can be set to true to indicate that the`
		139	`following declaration or definition is actually implicit. The flag`
		140	`dump_anon_class can be set to inhibit type definitions which name`
		141	`anonymous classes being output twice.`
		142	`*/`
		143
		144	`int dump_implicit = 0 ;`
		145	`int dump_template = 0 ;`
		146	`int dump_anon_class = 0 ;`
		147
		148
		149	`/*`
		150	`FIND AN IDENTIFIER KEY`
		151
		152	`This routine finds the key corresponding to the identifier id.`
		153	`This is a sequence of characters giving the type of identifier.`
		154	`*/`
		155
		156	`static CONST char *dump_key`
		157	`PROTO_N ( ( id, def ) )`
		158	`PROTO_T ( IDENTIFIER id X int def )`
		159	`{`
		160	`CONST char *key = NULL ;`
		161	`if ( do_dump && !IS_NULL_id ( id ) ) {`
		162	`switch ( TAG_id ( id ) ) {`
		163	`case id_keyword_tag :`
		164	`case id_iso_keyword_tag : {`
		165	`/* Keywords */`
		166	`key = "K" ;`
		167	`break ;`
		168	`}`
		169	`case id_obj_macro_tag : {`
		170	`/* Object-like macros */`
		171	`DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;`
		172	`if ( ds & dspec_builtin ) {`
		173	`key = "MB" ;`
		174	`} else {`
		175	`key = "MO" ;`
		176	`}`
		177	`break ;`
		178	`}`
		179	`case id_func_macro_tag : {`
		180	`/* Function-like macros */`
		181	`key = "MF" ;`
		182	`break ;`
		183	`}`
		184	`case id_builtin_tag : {`
		185	`/* Built-in functions */`
		186	`key = "FB" ;`
		187	`break ;`
		188	`}`
		189	`case id_class_name_tag : {`
		190	`/* Classes, structures and unions */`
		191	`CLASS_TYPE ct ;`
		192	`CLASS_INFO ci ;`
		193	`TYPE t = DEREF_type ( id_class_name_defn ( id ) ) ;`
		194	`while ( IS_type_templ ( t ) ) {`
		195	`t = DEREF_type ( type_templ_defn ( t ) ) ;`
		196	`}`
		197	`ct = DEREF_ctype ( type_compound_defn ( t ) ) ;`
		198	`ci = DEREF_cinfo ( ctype_info ( ct ) ) ;`
		199	`if ( ci & cinfo_union ) {`
		200	`key = "TU" ;`
		201	`} else if ( ci & cinfo_struct ) {`
		202	`key = "TS" ;`
		203	`} else {`
		204	`key = "TC" ;`
		205	`}`
		206	`break ;`
		207	`}`
		208	`case id_enum_name_tag : {`
		209	`/* Enumerations */`
		210	`key = "TE" ;`
		211	`break ;`
		212	`}`
		213	`case id_class_alias_tag :`
		214	`case id_enum_alias_tag :`
		215	`case id_type_alias_tag : {`
		216	`/* Type aliases */`
		217	`if ( dump_anon_class ) {`
		218	`dump_anon_class = 0 ;`
		219	`} else {`
		220	`key = "TA" ;`
		221	`}`
		222	`break ;`
		223	`}`
		224	`case id_nspace_name_tag : {`
		225	`/* Namespaces */`
		226	`key = "NN" ;`
		227	`break ;`
		228	`}`
		229	`case id_nspace_alias_tag : {`
		230	`/* Namespace aliases */`
		231	`key = "NA" ;`
		232	`break ;`
		233	`}`
		234	`case id_variable_tag : {`
		235	`/* Variables */`
		236	`DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;`
		237	`if ( ds & dspec_auto ) {`
		238	`if ( do_local ) key = "VA" ;`
		239	`} else if ( ds & dspec_static ) {`
		240	`key = "VS" ;`
		241	`} else {`
		242	`key = "VE" ;`
		243	`}`
		244	`break ;`
		245	`}`
		246	`case id_parameter_tag :`
		247	`case id_weak_param_tag : {`
		248	`/* Function parameters */`
		249	`if ( def && do_local ) key = "VP" ;`
		250	`break ;`
		251	`}`
		252	`case id_function_tag : {`
		253	`/* Functions */`
		254	`static char f [10] ;`
		255	`char *fp = f ;`
		256	`DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;`
		257	`*( fp++ ) = 'F' ;`
		258	`if ( ds & dspec_static ) {`
		259	`*( fp++ ) = 'S' ;`
		260	`} else {`
		261	`*( fp++ ) = 'E' ;`
		262	`}`
		263	`if ( ds & dspec_c ) *( fp++ ) = 'C' ;`
		264	`if ( ds & dspec_inline ) *( fp++ ) = 'I' ;`
		265	`*fp = 0 ;`
		266	`key = f ;`
		267	`break ;`
		268	`}`
		269	`case id_mem_func_tag : {`
		270	`/* Member functions */`
		271	`DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;`
		272	`if ( !( ds & dspec_trivial ) ) {`
		273	`if ( ds & dspec_virtual ) {`
		274	`key = "CV" ;`
		275	`} else {`
		276	`key = "CF" ;`
		277	`}`
		278	`}`
		279	`break ;`
		280	`}`
		281	`case id_stat_mem_func_tag : {`
		282	`/* Static member functions */`
		283	`key = "CS" ;`
		284	`break ;`
		285	`}`
		286	`case id_stat_member_tag : {`
		287	`/* Static data members */`
		288	`key = "CD" ;`
		289	`break ;`
		290	`}`
		291	`case id_member_tag : {`
		292	`/* Data members */`
		293	`key = "CM" ;`
		294	`break ;`
		295	`}`
		296	`case id_enumerator_tag : {`
		297	`/* Enumerators */`
		298	`key = "E" ;`
		299	`break ;`
		300	`}`
		301	`case id_label_tag : {`
		302	`/* Labels */`
		303	`key = "L" ;`
		304	`break ;`
		305	`}`
		306	`case id_token_tag : {`
		307	`/* Tokens */`
		308	`DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;`
		309	`if ( ds & dspec_auto ) {`
		310	`if ( ds & dspec_template ) {`
		311	`key = "XT" ;`
		312	`} else {`
		313	`key = "XP" ;`
		314	`}`
		315	`} else {`
		316	`TOKEN tok = DEREF_tok ( id_token_sort ( id ) ) ;`
		317	`if ( !IS_NULL_tok ( tok ) && IS_tok_proc ( tok ) ) {`
		318	`key = "XF" ;`
		319	`} else {`
		320	`key = "XO" ;`
		321	`}`
		322	`}`
		323	`break ;`
		324	`}`
		325	`}`
		326	`}`
		327	`return ( key ) ;`
		328	`}`
		329
		330
		331	`/*`
		332	`DUMP A LEXICAL TOKEN`
		333
		334	`This routine adds the lexical token t to the dump file.`
		335	`*/`
		336
		337	`static void dump_lex`
		338	`PROTO_N ( ( t ) )`
		339	`PROTO_T ( int t )`
		340	`{`
		341	`FILE *f = dump_file ;`
		342	`string s = token_name ( t ) ;`
		343	`if ( s ) {`
		344	`unsigned n = ( unsigned ) ustrlen ( s ) ;`
		345	`if ( n > 100 \|\| ustrchr ( s, '>' ) ) fprintf_v ( f, "&%u", n ) ;`
		346	`fprintf_v ( f, "<%s>", strlit ( s ) ) ;`
		347	`} else {`
		348	`fputs_v ( "<>", f ) ;`
		349	`}`
		350	`return ;`
		351	`}`
		352
		353
		354	`/*`
		355	`DUMP A HASH TABLE ENTRY`
		356
		357	`This routine adds the hash table entry nm to the dump file.`
		358	`*/`
		359
		360	`static void dump_hashid`
		361	`PROTO_N ( ( nm ) )`
		362	`PROTO_T ( HASHID nm )`
		363	`{`
		364	`FILE *f = dump_file ;`
		365	`if ( IS_NULL_hashid ( nm ) ) {`
		366	`fputs_v ( "<>", f ) ;`
		367	`return ;`
		368	`}`
		369	`switch ( TAG_hashid ( nm ) ) {`
		370	`case hashid_name_tag :`
		371	`case hashid_ename_tag : {`
		372	`/* Simple identifiers */`
		373	`string s = DEREF_string ( hashid_name_etc_text ( nm ) ) ;`
		374	`unsigned n = ( unsigned ) ustrlen ( s ) ;`
		375	`if ( n > 100 \|\| ustrchr ( s, '>' ) ) fprintf_v ( f, "&%u", n ) ;`
		376	`fprintf_v ( f, "<%s>", strlit ( s ) ) ;`
		377	`break ;`
		378	`}`
		379	`case hashid_constr_tag : {`
		380	`/* Constructor names */`
		381	`TYPE t = DEREF_type ( hashid_constr_type ( nm ) ) ;`
		382	`fputc_v ( 'C', f ) ;`
		383	`dump_type ( t ) ;`
		384	`break ;`
		385	`}`
		386	`case hashid_destr_tag : {`
		387	`/* Destructor names */`
		388	`TYPE t = DEREF_type ( hashid_destr_type ( nm ) ) ;`
		389	`fputc_v ( 'D', f ) ;`
		390	`dump_type ( t ) ;`
		391	`break ;`
		392	`}`
		393	`case hashid_conv_tag : {`
		394	`/* Conversion function names */`
		395	`TYPE t = DEREF_type ( hashid_conv_type ( nm ) ) ;`
		396	`fputc_v ( 'T', f ) ;`
		397	`dump_type ( t ) ;`
		398	`break ;`
		399	`}`
		400	`case hashid_op_tag : {`
		401	`/* Overloaded operator names */`
		402	`int t = DEREF_int ( hashid_op_lex ( nm ) ) ;`
		403	`fputc_v ( 'O', f ) ;`
		404	`dump_lex ( t ) ;`
		405	`break ;`
		406	`}`
		407	`default : {`
		408	`/* Other names */`
		409	`fputs_v ( "<>", f ) ;`
		410	`break ;`
		411	`}`
		412	`}`
		413	`return ;`
		414	`}`
		415
		416
		417	`/*`
		418	`DUMP A NAMESPACE`
		419
		420	`This routine adds the namespace ns to the dump file. The current`
		421	`declaration block is taken into account in blk is true.`
		422	`*/`
		423
		424	`static void dump_nspace`
		425	`PROTO_N ( ( ns, blk ) )`
		426	`PROTO_T ( NAMESPACE ns X int blk )`
		427	`{`
		428	`if ( !IS_NULL_nspace ( ns ) ) {`
		429	`if ( blk ) {`
		430	`LIST ( IDENTIFIER ) s ;`
		431	`s = LIST_stack ( DEREF_stack ( nspace_set ( ns ) ) ) ;`
		432	`if ( !IS_NULL_list ( s ) ) {`
		433	`/* Allow for declaration blocks */`
		434	`IDENTIFIER id = DEREF_id ( HEAD_list ( s ) ) ;`
		435	`dump_id ( id ) ;`
		436	`return ;`
		437	`}`
		438	`}`
		439	`if ( !IS_nspace_global ( ns ) ) {`
		440	`ulong n = DEREF_ulong ( nspace_dump ( ns ) ) ;`
		441	`if ( n == LINK_NONE ) {`
		442	`IDENTIFIER id = DEREF_id ( nspace_name ( ns ) ) ;`
		443	`if ( !IS_NULL_id ( id ) ) {`
		444	`/* Use namespace name */`
		445	`dump_id ( id ) ;`
		446	`n = DEREF_ulong ( id_dump ( id ) ) ;`
		447	`COPY_ulong ( nspace_dump ( ns ), n ) ;`
		448	`return ;`
		449	`}`
		450	`} else {`
		451	`/* Already assigned value */`
		452	`fprintf_v ( dump_file, "%lu", n ) ;`
		453	`return ;`
		454	`}`
		455	`}`
		456	`}`
		457	`fputs_v ( "*", dump_file ) ;`
		458	`return ;`
		459	`}`
		460
		461
		462	`/*`
		463	`DUMP AN ACCESS SPECIFIER`
		464
		465	`This routine adds the access specifier acc to the dump file.`
		466	`*/`
		467
		468	`static void dump_access`
		469	`PROTO_N ( ( acc ) )`
		470	`PROTO_T ( DECL_SPEC acc )`
		471	`{`
		472	`DECL_SPEC ds = ( acc & dspec_access ) ;`
		473	`if ( ds == dspec_private ) {`
		474	`fputc_v ( 'P', dump_file ) ;`
		475	`} else if ( ds == dspec_protected ) {`
		476	`fputc_v ( 'B', dump_file ) ;`
		477	`}`
		478	`return ;`
		479	`}`
		480
		481
		482	`/*`
		483	`IDENTIFIER DUMP NUMBER`
		484
		485	`Each identifier dumped is assigned a number in a sequence given`
		486	`by this variable. The zero value stands for the null identifier.`
		487	`*/`
		488
		489	`ulong dump_id_next = 1 ;`
		490
		491
		492	`/*`
		493	`DUMP AN IDENTIFIER`
		494
		495	`This routine adds the identifier id to the dump file.`
		496	`*/`
		497
		498	`static void dump_id`
		499	`PROTO_N ( ( id ) )`
		500	`PROTO_T ( IDENTIFIER id )`
		501	`{`
		502	`if ( IS_NULL_id ( id ) ) {`
		503	`fputs_v ( "0", dump_file ) ;`
		504	`} else {`
		505	`ulong n = DEREF_ulong ( id_dump ( id ) ) ;`
		506	`if ( n == LINK_NONE \|\| ( n & LINK_EXTERN ) ) {`
		507	`FILE *f = dump_file ;`
		508	`HASHID nm = DEREF_hashid ( id_name ( id ) ) ;`
		509	`NAMESPACE ns = DEREF_nspace ( id_parent ( id ) ) ;`
		510	`DECL_SPEC acc = DEREF_dspec ( id_storage ( id ) ) ;`
		511	`if ( n == LINK_NONE ) {`
		512	`/* Allocate new number */`
		513	`n = dump_id_next++ ;`
		514	`} else {`
		515	`/* Use number from spec file */`
		516	`n &= ~LINK_EXTERN ;`
		517	`}`
		518	`COPY_ulong ( id_dump ( id ), n ) ;`
		519	`fprintf_v ( f, "%lu = ", n ) ;`
		520	`dump_hashid ( nm ) ;`
		521	`fputc_v ( '\t', f ) ;`
		522	`dump_access ( acc ) ;`
		523	`dump_nspace ( ns, 1 ) ;`
		524	`} else {`
		525	`fprintf_v ( dump_file, "%lu", n ) ;`
		526	`}`
		527	`}`
		528	`return ;`
		529	`}`
		530
		531
		532	`/*`
		533	`LAST DUMP LOCATION`
		534
		535	`When dumping locations the previous location is stored in these`
		536	`variables and only items which have changed are output.`
		537	`*/`
		538
		539	`static unsigned long last_ln = 0 ;`
		540	`static unsigned long last_cn = 0 ;`
		541	`static string last_file = NULL ;`
		542	`static string last_input = NULL ;`
		543	`static PTR ( POSITION ) last_posn = NULL_ptr ( POSITION ) ;`
		544
		545
		546	`/*`
		547	`DUMP A LOCATION`
		548
		549	`This routine adds the location loc to the dump file.`
		550	`*/`
		551
		552	`static void dump_loc`
		553	`PROTO_N ( ( loc ) )`
		554	`PROTO_T ( LOCATION *loc )`
		555	`{`
		556	`FILE *f = dump_file ;`
		557	`unsigned long ln = loc->line ;`
		558	`unsigned long cn = loc->column ;`
		559	`PTR ( POSITION ) posn = loc->posn ;`
		560	`if ( EQ_ptr ( posn, last_posn ) ) {`
		561	`/* Same file information as previously */`
		562	`if ( ln == last_ln ) {`
		563	`if ( cn == last_cn ) {`
		564	`fputs_v ( "*", f ) ;`
		565	`} else {`
		566	`fprintf_v ( f, "%lu\t*", cn ) ;`
		567	`last_cn = cn ;`
		568	`}`
		569	`} else {`
		570	`fprintf_v ( f, "%lu\t%lu\t*", cn, ln ) ;`
		571	`last_cn = cn ;`
		572	`last_ln = ln ;`
		573	`}`
		574	`} else {`
		575	`/* Different file information */`
		576	`string file = DEREF_string ( posn_file ( posn ) ) ;`
		577	`string input = DEREF_string ( posn_input ( posn ) ) ;`
		578	`unsigned long off = DEREF_ulong ( posn_offset ( posn ) ) ;`
		579	`fprintf_v ( f, "%lu\t%lu\t%lu\t", cn, ln, ln - off ) ;`
		580	`if ( ustreq ( file, last_file ) && ustreq ( input, last_input ) ) {`
		581	`/* File names unchanged */`
		582	`fputc_v ( '*', f ) ;`
		583	`} else {`
		584	`unsigned n = ( unsigned ) ustrlen ( file ) ;`
		585	`fprintf_v ( f, "&%u<%s>\t", n, strlit ( file ) ) ;`
		586	`if ( ustreq ( file, input ) ) {`
		587	`/* Current and actual files match */`
		588	`fputc_v ( '*', f ) ;`
		589	`} else {`
		590	`/* Different current and actual files */`
		591	`n = ( unsigned ) ustrlen ( input ) ;`
		592	`fprintf_v ( f, "&%u<%s>", n, strlit ( input ) ) ;`
		593	`}`
		594	`last_input = input ;`
		595	`last_file = file ;`
		596	`}`
		597	`last_posn = posn ;`
		598	`last_cn = cn ;`
		599	`last_ln = ln ;`
		600	`}`
		601	`return ;`
		602	`}`
		603
		604
		605	`/*`
		606	`DUMP AN EXPRESSION`
		607
		608	`This routine adds the expression e to the dump file.`
		609	`*/`
		610
		611	`static void dump_exp`
		612	`PROTO_N ( ( e ) )`
		613	`PROTO_T ( EXP e )`
		614	`{`
		615	`if ( !IS_NULL_exp ( e ) ) {`
		616	`switch ( TAG_exp ( e ) ) {`
		617	`case exp_int_lit_tag : {`
		618	`/* Integer literals */`
		619	`NAT n = DEREF_nat ( exp_int_lit_nat ( e ) ) ;`
		620	`dump_nat ( n, 0 ) ;`
		621	`return ;`
		622	`}`
		623	`case exp_token_tag : {`
		624	`/* Tokenised expressions */`
		625	`IDENTIFIER id = DEREF_id ( exp_token_tok ( e ) ) ;`
		626	`LIST ( TOKEN ) args = DEREF_list ( exp_token_args ( e ) ) ;`
		627	`dump_tok_appl ( id, args ) ;`
		628	`return ;`
		629	`}`
		630	`}`
		631	`}`
		632	`IGNORE print_exp ( e, 0, dump_buff, 0 ) ;`
		633	`dump_string () ;`
		634	`return ;`
		635	`}`
		636
		637
		638	`/*`
		639	`DUMP AN OFFSET`
		640
		641	`This routine adds the offset off to the dump file.`
		642	`*/`
		643
		644	`static void dump_off`
		645	`PROTO_N ( ( off ) )`
		646	`PROTO_T ( OFFSET off )`
		647	`{`
		648	`IGNORE print_offset ( off, dump_buff, 0 ) ;`
		649	`dump_string () ;`
		650	`return ;`
		651	`}`
		652
		653
		654	`/*`
		655	`DUMP AN INTEGER CONSTANT`
		656
		657	`This routine adds the integer constant n to the dump file.`
		658	`*/`
		659
		660	`static void dump_nat`
		661	`PROTO_N ( ( n, neg ) )`
		662	`PROTO_T ( NAT n X int neg )`
		663	`{`
		664	`if ( !IS_NULL_nat ( n ) ) {`
		665	`FILE *f = dump_file ;`
		666	`ASSERT ( ORDER_nat == 5 ) ;`
		667	`switch ( TAG_nat ( n ) ) {`
		668	`case nat_small_tag : {`
		669	`/* Small literals */`
		670	`unsigned v = DEREF_unsigned ( nat_small_value ( n ) ) ;`
		671	`int s = ( neg ? '-' : '+' ) ;`
		672	`fputc_v ( s, f ) ;`
		673	`fprintf_v ( f, "%u", v ) ;`
		674	`break ;`
		675	`}`
		676	`case nat_large_tag : {`
		677	`/* Large literals */`
		678	`unsigned long v = get_nat_value ( n ) ;`
		679	`int s = ( neg ? '-' : '+' ) ;`
		680	`fputc_v ( s, f ) ;`
		681	`fprintf_v ( f, "%lu", v ) ;`
		682	`break ;`
		683	`}`
		684	`case nat_neg_tag : {`
		685	`/* Negated literals */`
		686	`NAT m = DEREF_nat ( nat_neg_arg ( n ) ) ;`
		687	`dump_nat ( m, !neg ) ;`
		688	`break ;`
		689	`}`
		690	`case nat_calc_tag : {`
		691	`/* Calculated literals */`
		692	`EXP e = DEREF_exp ( nat_calc_value ( n ) ) ;`
		693	`dump_exp ( e ) ;`
		694	`break ;`
		695	`}`
		696	`case nat_token_tag : {`
		697	`/* Tokenised literals */`
		698	`IDENTIFIER id = DEREF_id ( nat_token_tok ( n ) ) ;`
		699	`LIST ( TOKEN ) args = DEREF_list ( nat_token_args ( n ) ) ;`
		700	`dump_tok_appl ( id, args ) ;`
		701	`break ;`
		702	`}`
		703	`}`
		704	`}`
		705	`return ;`
		706	`}`
		707
		708
		709	`/*`
		710	`DUMP A LIST OF TOKEN PARAMETERS`
		711
		712	`This routine adds the list of token parameters pids to the dump file.`
		713	`*/`
		714
		715	`static void dump_params`
		716	`PROTO_N ( ( pids ) )`
		717	`PROTO_T ( LIST ( IDENTIFIER ) pids )`
		718	`{`
		719	`int started = 0 ;`
		720	`FILE *f = dump_file ;`
		721	`while ( !IS_NULL_list ( pids ) ) {`
		722	`IDENTIFIER pid = DEREF_id ( HEAD_list ( pids ) ) ;`
		723	`if ( !IS_NULL_id ( pid ) ) {`
		724	`if ( IS_id_token ( pid ) ) {`
		725	`pid = DEREF_id ( id_token_alt ( pid ) ) ;`
		726	`}`
		727	`if ( started ) fputc_v ( MANGLE_comma, f ) ;`
		728	`dump_id ( pid ) ;`
		729	`started = 1 ;`
		730	`}`
		731	`pids = TAIL_list ( pids ) ;`
		732	`}`
		733	`return ;`
		734	`}`
		735
		736
		737	`/*`
		738	`DUMP A TOKEN SORT`
		739
		740	`This routine adds the token sort tok to the dump file.`
		741	`*/`
		742
		743	`static void dump_sort`
		744	`PROTO_N ( ( tok ) )`
		745	`PROTO_T ( TOKEN tok )`
		746	`{`
		747	`FILE *f = dump_file ;`
		748	`ASSERT ( ORDER_tok == 10 ) ;`
		749	`switch ( TAG_tok ( tok ) ) {`
		750	`case tok_exp_tag : {`
		751	`/* Expression tokens */`
		752	`TYPE t = DEREF_type ( tok_exp_type ( tok ) ) ;`
		753	`int c = DEREF_int ( tok_exp_constant ( tok ) ) ;`
		754	`if ( c ) {`
		755	`fputs_v ( "ZEC", f ) ;`
		756	`} else {`
		757	`CV_SPEC cv = DEREF_cv ( type_qual ( t ) ) ;`
		758	`if ( cv & cv_lvalue ) {`
		759	`fputs_v ( "ZEL", f ) ;`
		760	`} else {`
		761	`fputs_v ( "ZER", f ) ;`
		762	`}`
		763	`}`
		764	`dump_type ( t ) ;`
		765	`break ;`
		766	`}`
		767	`case tok_stmt_tag : {`
		768	`/* Statement tokens */`
		769	`fputs_v ( "ZS", f ) ;`
		770	`break ;`
		771	`}`
		772	`case tok_nat_tag : {`
		773	`/* Integer constant tokens */`
		774	`fputs_v ( "ZN", f ) ;`
		775	`break ;`
		776	`}`
		777	`case tok_snat_tag : {`
		778	`/* Integer constant tokens */`
		779	`fputs_v ( "ZI", f ) ;`
		780	`break ;`
		781	`}`
		782	`case tok_type_tag : {`
		783	`/* Type tokens */`
		784	`int c ;`
		785	`BASE_TYPE bt = DEREF_btype ( tok_type_kind ( tok ) ) ;`
		786	`if ( bt & btype_float ) {`
		787	`if ( bt & btype_int ) {`
		788	`c = 'A' ;`
		789	`} else {`
		790	`c = 'F' ;`
		791	`}`
		792	`} else if ( bt & btype_int ) {`
		793	`c = 'I' ;`
		794	`} else if ( bt & btype_class ) {`
		795	`c = 'S' ;`
		796	`} else if ( bt & btype_struct ) {`
		797	`c = 'S' ;`
		798	`} else if ( bt & btype_union ) {`
		799	`c = 'U' ;`
		800	`} else {`
		801	`c = 'O' ;`
		802	`}`
		803	`fputs_v ( "ZT", f ) ;`
		804	`fputc_v ( c, f ) ;`
		805	`break ;`
		806	`}`
		807	`case tok_func_tag : {`
		808	`/* Function tokens */`
		809	`TYPE t = DEREF_type ( tok_func_type ( tok ) ) ;`
		810	`fputs_v ( "ZF", f ) ;`
		811	`dump_type ( t ) ;`
		812	`break ;`
		813	`}`
		814	`case tok_member_tag : {`
		815	`/* Member tokens */`
		816	`TYPE t = DEREF_type ( tok_member_type ( tok ) ) ;`
		817	`TYPE s = DEREF_type ( tok_member_of ( tok ) ) ;`
		818	`fputs_v ( "ZM", f ) ;`
		819	`dump_type ( t ) ;`
		820	`fputc_v ( MANGLE_colon, f ) ;`
		821	`dump_type ( s ) ;`
		822	`break ;`
		823	`}`
		824	`case tok_class_tag : {`
		825	`/* Template parameter tokens */`
		826	`TYPE t = DEREF_type ( tok_class_type ( tok ) ) ;`
		827	`TOKEN sort = DEREF_tok ( type_templ_sort ( t ) ) ;`
		828	`fputs_v ( "ZT", f ) ;`
		829	`dump_sort ( sort ) ;`
		830	`break ;`
		831	`}`
		832	`case tok_proc_tag : {`
		833	`/* Procedure tokens */`
		834	`TOKEN res = DEREF_tok ( tok_proc_res ( tok ) ) ;`
		835	`LIST ( IDENTIFIER ) bids = DEREF_list ( tok_proc_bids ( tok ) ) ;`
		836	`LIST ( IDENTIFIER ) pids = DEREF_list ( tok_proc_pids ( tok ) ) ;`
		837	`if ( EQ_list ( bids, pids ) ) {`
		838	`fputs_v ( "ZPS", f ) ;`
		839	`dump_params ( bids ) ;`
		840	`} else {`
		841	`fputs_v ( "ZPG", f ) ;`
		842	`dump_params ( bids ) ;`
		843	`fputs_v ( ";", f ) ;`
		844	`dump_params ( pids ) ;`
		845	`}`
		846	`fputc_v ( MANGLE_colon, f ) ;`
		847	`dump_sort ( res ) ;`
		848	`break ;`
		849	`}`
		850	`case tok_templ_tag : {`
		851	`/* Template tokens */`
		852	`LIST ( IDENTIFIER ) pids = DEREF_list ( tok_templ_pids ( tok ) ) ;`
		853	`fputc_v ( MANGLE_template, f ) ;`
		854	`dump_params ( pids ) ;`
		855	`fputc_v ( MANGLE_colon, f ) ;`
		856	`break ;`
		857	`}`
		858	`}`
		859	`return ;`
		860	`}`
		861
		862
		863	`/*`
		864	`DUMP AN INTEGRAL TYPE`
		865
		866	`This routine adds the integral type it to the dump file. Note that`
		867	`for this and the other type dumping routines the representation`
		868	`chosen bears a marked resemblance to the C++ name mangling scheme,`
		869	`and uses the same MANGLE_* macros. This is primarily to avoid having`
		870	`to think up two different forms.`
		871	`*/`
		872
		873	`static void dump_itype`
		874	`PROTO_N ( ( it ) )`
		875	`PROTO_T ( INT_TYPE it )`
		876	`{`
		877	`FILE *f = dump_file ;`
		878	`ASSERT ( ORDER_itype == 6 ) ;`
		879	`switch ( TAG_itype ( it ) ) {`
		880	`case itype_basic_tag : {`
		881	`/* Basic integral types */`
		882	`BUILTIN_TYPE n = DEREF_ntype ( itype_basic_no ( it ) ) ;`
		883	`fputs_v ( mangle_ntype [n], f ) ;`
		884	`break ;`
		885	`}`
		886	`case itype_bitfield_tag : {`
		887	`/* Bitfield types */`
		888	`NAT n = DEREF_nat ( itype_bitfield_size ( it ) ) ;`
		889	`TYPE s = DEREF_type ( itype_bitfield_sub ( it ) ) ;`
		890	`fputc_v ( MANGLE_bitfield, f ) ;`
		891	`dump_nat ( n, 0 ) ;`
		892	`fputc_v ( MANGLE_colon, f ) ;`
		893	`dump_type ( s ) ;`
		894	`break ;`
		895	`}`
		896	`case itype_promote_tag : {`
		897	`/* Promotion types */`
		898	`INT_TYPE is = DEREF_itype ( itype_promote_arg ( it ) ) ;`
		899	`fputc_v ( MANGLE_promote, f ) ;`
		900	`dump_itype ( is ) ;`
		901	`break ;`
		902	`}`
		903	`case itype_arith_tag : {`
		904	`/* Arithmetic types */`
		905	`INT_TYPE is = DEREF_itype ( itype_arith_arg1 ( it ) ) ;`
		906	`INT_TYPE ir = DEREF_itype ( itype_arith_arg2 ( it ) ) ;`
		907	`fputc_v ( MANGLE_arith, f ) ;`
		908	`dump_itype ( is ) ;`
		909	`fputc_v ( MANGLE_colon, f ) ;`
		910	`dump_itype ( ir ) ;`
		911	`break ;`
		912	`}`
		913	`case itype_literal_tag : {`
		914	`/* Literal types */`
		915	`NAT n = DEREF_nat ( itype_literal_nat ( it ) ) ;`
		916	`string s = mangle_literal ( it ) ;`
		917	`fputs_v ( strlit ( s ), f ) ;`
		918	`dump_nat ( n, 0 ) ;`
		919	`break ;`
		920	`}`
		921	`case itype_token_tag : {`
		922	`/* Tokenised types */`
		923	`BUILTIN_TYPE n = DEREF_ntype ( itype_unprom ( it ) ) ;`
		924	`if ( n == ntype_none \|\| n == ntype_ellipsis ) {`
		925	`IDENTIFIER id ;`
		926	`LIST ( TOKEN ) args ;`
		927	`id = DEREF_id ( itype_token_tok ( it ) ) ;`
		928	`args = DEREF_list ( itype_token_args ( it ) ) ;`
		929	`dump_tok_appl ( id, args ) ;`
		930	`} else {`
		931	`fputc_v ( MANGLE_promote, f ) ;`
		932	`fputs_v ( mangle_ntype [n], f ) ;`
		933	`}`
		934	`break ;`
		935	`}`
		936	`}`
		937	`return ;`
		938	`}`
		939
		940
		941	`/*`
		942	`DUMP A FLOATING POINT TYPE`
		943
		944	`This routine adds the floating point type ft to the dump file.`
		945	`*/`
		946
		947	`static void dump_ftype`
		948	`PROTO_N ( ( ft ) )`
		949	`PROTO_T ( FLOAT_TYPE ft )`
		950	`{`
		951	`FILE *f = dump_file ;`
		952	`ASSERT ( ORDER_ftype == 4 ) ;`
		953	`switch ( TAG_ftype ( ft ) ) {`
		954	`case ftype_basic_tag : {`
		955	`/* Basic floating types */`
		956	`BUILTIN_TYPE n = DEREF_ntype ( ftype_basic_no ( ft ) ) ;`
		957	`fputs_v ( mangle_ntype [n], f ) ;`
		958	`break ;`
		959	`}`
		960	`case ftype_arg_promote_tag : {`
		961	`/* Promotion types */`
		962	`FLOAT_TYPE fs = DEREF_ftype ( ftype_arg_promote_arg ( ft ) ) ;`
		963	`fputc_v ( MANGLE_promote, f ) ;`
		964	`dump_ftype ( fs ) ;`
		965	`break ;`
		966	`}`
		967	`case ftype_arith_tag : {`
		968	`/* Arithmetic types */`
		969	`FLOAT_TYPE fs = DEREF_ftype ( ftype_arith_arg1 ( ft ) ) ;`
		970	`FLOAT_TYPE fr = DEREF_ftype ( ftype_arith_arg2 ( ft ) ) ;`
		971	`fputc_v ( MANGLE_arith, f ) ;`
		972	`dump_ftype ( fs ) ;`
		973	`fputc_v ( MANGLE_colon, f ) ;`
		974	`dump_ftype ( fr ) ;`
		975	`break ;`
		976	`}`
		977	`case ftype_token_tag : {`
		978	`/* Tokenised types */`
		979	`IDENTIFIER id = DEREF_id ( ftype_token_tok ( ft ) ) ;`
		980	`LIST ( TOKEN ) args = DEREF_list ( ftype_token_args ( ft ) ) ;`
		981	`dump_tok_appl ( id, args ) ;`
		982	`break ;`
		983	`}`
		984	`}`
		985	`return ;`
		986	`}`
		987
		988
		989	`/*`
		990	`DUMP A CLASS TYPE`
		991
		992	`This routine adds the class type ct to the dump file.`
		993	`*/`
		994
		995	`static void dump_ctype`
		996	`PROTO_N ( ( ct ) )`
		997	`PROTO_T ( CLASS_TYPE ct )`
		998	`{`
		999	`IDENTIFIER cid = DEREF_id ( ctype_name ( ct ) ) ;`
		1000	`dump_id ( cid ) ;`
		1001	`return ;`
		1002	`}`
		1003
		1004
		1005	`/*`
		1006	`DUMP AN ENUMERATION TYPE`
		1007
		1008	`This routine adds the enumeration type et to the dump file.`
		1009	`*/`
		1010
		1011	`static void dump_etype`
		1012	`PROTO_N ( ( et ) )`
		1013	`PROTO_T ( ENUM_TYPE et )`
		1014	`{`
		1015	`IDENTIFIER eid = DEREF_id ( etype_name ( et ) ) ;`
		1016	`dump_id ( eid ) ;`
		1017	`return ;`
		1018	`}`
		1019
		1020
		1021	`/*`
		1022	`DUMP A CONST-VOLATILE QUALIFIER`
		1023
		1024	`This routine adds the const-volatile qualifier cv to the dump file.`
		1025	`*/`
		1026
		1027	`static void dump_cv`
		1028	`PROTO_N ( ( cv ) )`
		1029	`PROTO_T ( CV_SPEC cv )`
		1030	`{`
		1031	`if ( cv & cv_const ) fputc_v ( MANGLE_const, dump_file ) ;`
		1032	`if ( cv & cv_volatile ) fputc_v ( MANGLE_volatile, dump_file ) ;`
		1033	`return ;`
		1034	`}`
		1035
		1036
		1037	`/*`
		1038	`DUMP A LIST OF TYPES`
		1039
		1040	`This routine adds the list of types p to the dump file.`
		1041	`*/`
		1042
		1043	`static void dump_type_list`
		1044	`PROTO_N ( ( p, ell, started ) )`
		1045	`PROTO_T ( LIST ( TYPE ) p X int ell X int started )`
		1046	`{`
		1047	`while ( !IS_NULL_list ( p ) ) {`
		1048	`TYPE t = DEREF_type ( HEAD_list ( p ) ) ;`
		1049	`if ( !IS_NULL_type ( t ) ) {`
		1050	`if ( started ) fputc_v ( MANGLE_comma, dump_file ) ;`
		1051	`if ( ell & FUNC_PARAMS ) t = unpromote_type ( t ) ;`
		1052	`dump_type ( t ) ;`
		1053	`started = 1 ;`
		1054	`}`
		1055	`p = TAIL_list ( p ) ;`
		1056	`}`
		1057	`return ;`
		1058	`}`
		1059
		1060
		1061	`/*`
		1062	`DUMP A TYPE`
		1063
		1064	`This routine adds the type t to the dump file.`
		1065	`*/`
		1066
		1067	`static void dump_type`
		1068	`PROTO_N ( ( t ) )`
		1069	`PROTO_T ( TYPE t )`
		1070	`{`
		1071	`CV_SPEC qual = DEREF_cv ( type_qual ( t ) ) ;`
		1072	`IDENTIFIER tid = DEREF_id ( type_name ( t ) ) ;`
		1073	`dump_cv ( qual ) ;`
		1074	`if ( !IS_NULL_id ( tid ) ) {`
		1075	`switch ( TAG_id ( tid ) ) {`
		1076	`case id_class_alias_tag :`
		1077	`case id_enum_alias_tag :`
		1078	`case id_type_alias_tag : {`
		1079	`dump_id ( tid ) ;`
		1080	`return ;`
		1081	`}`
		1082	`}`
		1083	`}`
		1084	`ASSERT ( ORDER_type == 18 ) ;`
		1085	`switch ( TAG_type ( t ) ) {`
		1086
		1087	`case type_pre_tag : {`
		1088	`/* Pre-types */`
		1089	`if ( !IS_NULL_id ( tid ) ) {`
		1090	`dump_id ( tid ) ;`
		1091	`} else {`
		1092	`BASE_TYPE bt = DEREF_btype ( type_pre_rep ( t ) ) ;`
		1093	`if ( bt == btype_ellipsis ) {`
		1094	`fputs_v ( "Q<...>", dump_file ) ;`
		1095	`} else {`
		1096	`fputc_v ( MANGLE_error, dump_file ) ;`
		1097	`}`
		1098	`}`
		1099	`break ;`
		1100	`}`
		1101
		1102	`case type_integer_tag : {`
		1103	`/* Integral types */`
		1104	`INT_TYPE it = DEREF_itype ( type_integer_rep ( t ) ) ;`
		1105	`dump_itype ( it ) ;`
		1106	`break ;`
		1107	`}`
		1108
		1109	`case type_floating_tag : {`
		1110	`/* Floating point types */`
		1111	`FLOAT_TYPE ft = DEREF_ftype ( type_floating_rep ( t ) ) ;`
		1112	`dump_ftype ( ft ) ;`
		1113	`break ;`
		1114	`}`
		1115
		1116	`case type_top_tag : {`
		1117	`/* Top type */`
		1118	`fputc_v ( MANGLE_void, dump_file ) ;`
		1119	`break ;`
		1120	`}`
		1121
		1122	`case type_bottom_tag : {`
		1123	`/* Bottom type */`
		1124	`fputc_v ( MANGLE_bottom, dump_file ) ;`
		1125	`break ;`
		1126	`}`
		1127
		1128	`case type_ptr_tag : {`
		1129	`/* Pointer types */`
		1130	`TYPE s = DEREF_type ( type_ptr_sub ( t ) ) ;`
		1131	`fputc_v ( MANGLE_ptr, dump_file ) ;`
		1132	`dump_type ( s ) ;`
		1133	`break ;`
		1134	`}`
		1135
		1136	`case type_ref_tag : {`
		1137	`/* Reference types */`
		1138	`TYPE s = DEREF_type ( type_ref_sub ( t ) ) ;`
		1139	`fputc_v ( MANGLE_ref, dump_file ) ;`
		1140	`dump_type ( s ) ;`
		1141	`break ;`
		1142	`}`
		1143
		1144	`case type_ptr_mem_tag : {`
		1145	`/* Pointer to member types */`
		1146	`CLASS_TYPE ct = DEREF_ctype ( type_ptr_mem_of ( t ) ) ;`
		1147	`TYPE s = DEREF_type ( type_ptr_mem_sub ( t ) ) ;`
		1148	`fputc_v ( MANGLE_ptr_mem, dump_file ) ;`
		1149	`dump_ctype ( ct ) ;`
		1150	`fputc_v ( MANGLE_colon, dump_file ) ;`
		1151	`dump_type ( s ) ;`
		1152	`break ;`
		1153	`}`
		1154
		1155	`case type_func_tag : {`
		1156	`/* Function types */`
		1157	`FILE *f = dump_file ;`
		1158	`TYPE r = DEREF_type ( type_func_ret ( t ) ) ;`
		1159	`LIST ( TYPE ) p = DEREF_list ( type_func_ptypes ( t ) ) ;`
		1160	`LIST ( TYPE ) e = DEREF_list ( type_func_except ( t ) ) ;`
		1161	`int ell = DEREF_int ( type_func_ellipsis ( t ) ) ;`
		1162	`CV_SPEC mqual = DEREF_cv ( type_func_mqual ( t ) ) ;`
		1163	`if ( ell & FUNC_WEAK ) {`
		1164	`fputc_v ( MANGLE_weak, f ) ;`
		1165	`} else {`
		1166	`fputc_v ( MANGLE_func, f ) ;`
		1167	`}`
		1168	`dump_type ( r ) ;`
		1169	`dump_type_list ( p, ell, 1 ) ;`
		1170	`if ( ell & FUNC_VAR_PARAMS ) {`
		1171	`fputc_v ( MANGLE_dot, f ) ;`
		1172	`} else {`
		1173	`fputc_v ( MANGLE_colon, f ) ;`
		1174	`}`
		1175	`if ( !EQ_list ( e, univ_type_set ) ) {`
		1176	`/* Output exception specifiers */`
		1177	`fputc_v ( '(', f ) ;`
		1178	`dump_type_list ( e, FUNC_NONE, 0 ) ;`
		1179	`fputc_v ( ')', f ) ;`
		1180	`}`
		1181	`dump_cv ( mqual ) ;`
		1182	`if ( ell & FUNC_NO_PARAMS ) {`
		1183	`fputc_v ( MANGLE_dot, f ) ;`
		1184	`} else {`
		1185	`fputc_v ( MANGLE_colon, f ) ;`
		1186	`}`
		1187	`break ;`
		1188	`}`
		1189
		1190	`case type_array_tag : {`
		1191	`/* Array types */`
		1192	`TYPE s = DEREF_type ( type_array_sub ( t ) ) ;`
		1193	`NAT n = DEREF_nat ( type_array_size ( t ) ) ;`
		1194	`fputc_v ( MANGLE_array, dump_file ) ;`
		1195	`if ( !IS_NULL_nat ( n ) ) dump_nat ( n, 0 ) ;`
		1196	`fputc_v ( MANGLE_colon, dump_file ) ;`
		1197	`dump_type ( s ) ;`
		1198	`break ;`
		1199	`}`
		1200
		1201	`case type_bitfield_tag : {`
		1202	`/* Bitfield types */`
		1203	`INT_TYPE it = DEREF_itype ( type_bitfield_defn ( t ) ) ;`
		1204	`dump_itype ( it ) ;`
		1205	`break ;`
		1206	`}`
		1207
		1208	`case type_compound_tag : {`
		1209	`/* Class types */`
		1210	`CLASS_TYPE ct = DEREF_ctype ( type_compound_defn ( t ) ) ;`
		1211	`dump_ctype ( ct ) ;`
		1212	`break ;`
		1213	`}`
		1214
		1215	`case type_enumerate_tag : {`
		1216	`/* Enumeration types */`
		1217	`ENUM_TYPE et = DEREF_etype ( type_enumerate_defn ( t ) ) ;`
		1218	`dump_etype ( et ) ;`
		1219	`break ;`
		1220	`}`
		1221
		1222	`case type_token_tag : {`
		1223	`/* Tokenised types */`
		1224	`IDENTIFIER id = DEREF_id ( type_token_tok ( t ) ) ;`
		1225	`LIST ( TOKEN ) args = DEREF_list ( type_token_args ( t ) ) ;`
		1226	`dump_tok_appl ( id, args ) ;`
		1227	`break ;`
		1228	`}`
		1229
		1230	`case type_templ_tag : {`
		1231	`/* Template types */`
		1232	`TYPE s = DEREF_type ( type_templ_defn ( t ) ) ;`
		1233	`TOKEN sort = DEREF_tok ( type_templ_sort ( t ) ) ;`
		1234	`dump_sort ( sort ) ;`
		1235	`dump_type ( s ) ;`
		1236	`break ;`
		1237	`}`
		1238
		1239	`case type_instance_tag : {`
		1240	`/* Template instance types */`
		1241	`IDENTIFIER id = DEREF_id ( type_name ( t ) ) ;`
		1242	`dump_id ( id ) ;`
		1243	`break ;`
		1244	`}`
		1245
		1246	`default : {`
		1247	`/* Other types */`
		1248	`fputc_v ( MANGLE_error, dump_file ) ;`
		1249	`break ;`
		1250	`}`
		1251	`}`
		1252	`return ;`
		1253	`}`
		1254
		1255
		1256	`/*`
		1257	`DUMP A GRAPH`
		1258
		1259	`This routine adds the graph gr and all its subgraphs to the dump file.`
		1260	`*/`
		1261
		1262	`static void dump_graph`
		1263	`PROTO_N ( ( gr ) )`
		1264	`PROTO_T ( GRAPH gr )`
		1265	`{`
		1266	`FILE *f = dump_file ;`
		1267	`unsigned n = DEREF_unsigned ( graph_no ( gr ) ) ;`
		1268	`DECL_SPEC ds = DEREF_dspec ( graph_access ( gr ) ) ;`
		1269	`if ( ds & dspec_main ) {`
		1270	`/* First instance of base */`
		1271	`DECL_SPEC acc = ( ds & dspec_access ) ;`
		1272	`CLASS_TYPE ct = DEREF_ctype ( graph_head ( gr ) ) ;`
		1273	`LIST ( GRAPH ) br = DEREF_list ( graph_tails ( gr ) ) ;`
		1274	`fprintf_v ( f, "%u=", n ) ;`
		1275
		1276	`/* Dump access */`
		1277	`if ( ds & dspec_virtual ) fputc_v ( 'V', f ) ;`
		1278	`if ( acc != dspec_public ) {`
		1279	`gr = DEREF_graph ( graph_equal ( gr ) ) ;`
		1280	`while ( !IS_NULL_graph ( gr ) ) {`
		1281	`ds = DEREF_dspec ( graph_access ( gr ) ) ;`
		1282	`ds &= dspec_access ;`
		1283	`if ( ds < acc ) acc = ds ;`
		1284	`if ( acc == dspec_public ) break ;`
		1285	`gr = DEREF_graph ( graph_equal ( gr ) ) ;`
		1286	`}`
		1287	`}`
		1288	`dump_access ( acc ) ;`
		1289
		1290	`/* Dump base classes */`
		1291	`dump_ctype ( ct ) ;`
		1292	`if ( !IS_NULL_list ( br ) ) {`
		1293	`fputs_v ( " ( ", f ) ;`
		1294	`while ( !IS_NULL_list ( br ) ) {`
		1295	`GRAPH gs = DEREF_graph ( HEAD_list ( br ) ) ;`
		1296	`dump_graph ( gs ) ;`
		1297	`fputc_v ( ' ', f ) ;`
		1298	`br = TAIL_list ( br ) ;`
		1299	`}`
		1300	`fputc_v ( ')', f ) ;`
		1301	`}`
		1302
		1303	`} else {`
		1304	`/* Subsequent instances of base */`
		1305	`fprintf_v ( f, "%u:", n ) ;`
		1306	`}`
		1307	`return ;`
		1308	`}`
		1309
		1310	`/*`
		1311	`DUMP A TOKEN APPLICATION`
		1312
		1313	`This routine adds the token application id ( args ) to the dump file.`
		1314	`*/`
		1315
		1316	`static void dump_tok_appl`
		1317	`PROTO_N ( ( id, args ) )`
		1318	`PROTO_T ( IDENTIFIER id X LIST ( TOKEN ) args )`
		1319	`{`
		1320	`if ( IS_id_token ( id ) ) {`
		1321	`IDENTIFIER alt = DEREF_id ( id_token_alt ( id ) ) ;`
		1322	`if ( !IS_NULL_id ( alt ) ) id = alt ;`
		1323	`}`
		1324	`if ( IS_NULL_list ( args ) ) {`
		1325	`dump_id ( id ) ;`
		1326	`} else {`
		1327	`FILE *f = dump_file ;`
		1328	`fputc_v ( 'T', f ) ;`
		1329	`dump_id ( id ) ;`
		1330	`while ( !IS_NULL_list ( args ) ) {`
		1331	`TOKEN arg = DEREF_tok ( HEAD_list ( args ) ) ;`
		1332	`fputc_v ( MANGLE_comma, f ) ;`
		1333	`if ( !IS_NULL_tok ( arg ) ) {`
		1334	`ASSERT ( ORDER_tok == 10 ) ;`
		1335	`switch ( TAG_tok ( arg ) ) {`
		1336	`case tok_exp_tag : {`
		1337	`EXP e = DEREF_exp ( tok_exp_value ( arg ) ) ;`
		1338	`fputc_v ( 'E', f ) ;`
		1339	`if ( !IS_NULL_exp ( e ) ) dump_exp ( e ) ;`
		1340	`break ;`
		1341	`}`
		1342	`case tok_stmt_tag : {`
		1343	`EXP e = DEREF_exp ( tok_stmt_value ( arg ) ) ;`
		1344	`fputc_v ( 'S', f ) ;`
		1345	`if ( !IS_NULL_exp ( e ) ) dump_exp ( e ) ;`
		1346	`break ;`
		1347	`}`
		1348	`case tok_nat_tag : {`
		1349	`NAT n = DEREF_nat ( tok_nat_value ( arg ) ) ;`
		1350	`fputc_v ( 'N', f ) ;`
		1351	`if ( !IS_NULL_nat ( n ) ) dump_nat ( n, 0 ) ;`
		1352	`break ;`
		1353	`}`
		1354	`case tok_snat_tag : {`
		1355	`NAT n = DEREF_nat ( tok_snat_value ( arg ) ) ;`
		1356	`fputc_v ( 'I', f ) ;`
		1357	`if ( !IS_NULL_nat ( n ) ) dump_nat ( n, 0 ) ;`
		1358	`break ;`
		1359	`}`
		1360	`case tok_type_tag : {`
		1361	`TYPE t = DEREF_type ( tok_type_value ( arg ) ) ;`
		1362	`fputc_v ( 'T', f ) ;`
		1363	`if ( !IS_NULL_type ( t ) ) dump_type ( t ) ;`
		1364	`break ;`
		1365	`}`
		1366	`case tok_func_tag : {`
		1367	`IDENTIFIER fid = DEREF_id ( tok_func_defn ( arg ) ) ;`
		1368	`fputc_v ( 'F', f ) ;`
		1369	`if ( !IS_NULL_id ( fid ) ) dump_id ( fid ) ;`
		1370	`break ;`
		1371	`}`
		1372	`case tok_member_tag : {`
		1373	`OFFSET off = DEREF_off ( tok_member_value ( arg ) ) ;`
		1374	`fputc_v ( 'M', f ) ;`
		1375	`if ( !IS_NULL_off ( off ) ) dump_off ( off ) ;`
		1376	`break ;`
		1377	`}`
		1378	`case tok_class_tag : {`
		1379	`IDENTIFIER tid = DEREF_id ( tok_class_value ( arg ) ) ;`
		1380	`fputc_v ( 'C', f ) ;`
		1381	`if ( !IS_NULL_id ( tid ) ) dump_id ( tid ) ;`
		1382	`break ;`
		1383	`}`
		1384	`}`
		1385	`}`
		1386	`args = TAIL_list ( args ) ;`
		1387	`}`
		1388	`fputc_v ( MANGLE_colon, f ) ;`
		1389	`}`
		1390	`return ;`
		1391	`}`
		1392
		1393
		1394	`/*`
		1395	`DUMP A BASE CLASS GRAPH`
		1396
		1397	`This routine adds the base class graph associated with the class type`
		1398	`ct to the dump file.`
		1399	`*/`
		1400
		1401	`void dump_base`
		1402	`PROTO_N ( ( ct ) )`
		1403	`PROTO_T ( CLASS_TYPE ct )`
		1404	`{`
		1405	`unsigned n = DEREF_unsigned ( ctype_no_bases ( ct ) ) ;`
		1406	`if ( n > 1 ) {`
		1407	`FILE *f = dump_file ;`
		1408	`if ( f ) {`
		1409	`CONST char *key ;`
		1410	`GRAPH gr = DEREF_graph ( ctype_base ( ct ) ) ;`
		1411	`CLASS_INFO ci = DEREF_cinfo ( ctype_info ( ct ) ) ;`
		1412	`if ( ci & cinfo_union ) {`
		1413	`key = "TU" ;`
		1414	`} else if ( ci & cinfo_struct ) {`
		1415	`key = "TS" ;`
		1416	`} else {`
		1417	`key = "TC" ;`
		1418	`}`
		1419	`fprintf_v ( f, "B%s\t%u\t", key, n ) ;`
		1420	`dump_graph ( gr ) ;`
		1421	`fputc_v ( '\n', f ) ;`
		1422	`}`
		1423	`}`
		1424	`return ;`
		1425	`}`
		1426
		1427
		1428	`/*`
		1429	`DUMP AN OVERRIDING VIRTUAL FUNCTION`
		1430
		1431	`This routine dumps the fact that the virtual function id overrides`
		1432	`the virtual function fid.`
		1433	`*/`
		1434
		1435	`void dump_override`
		1436	`PROTO_N ( ( id, fid ) )`
		1437	`PROTO_T ( IDENTIFIER id X IDENTIFIER fid )`
		1438	`{`
		1439	`FILE *f = dump_file ;`
		1440	`if ( f ) {`
		1441	`fputs_v ( "O\t", f ) ;`
		1442	`dump_id ( id ) ;`
		1443	`fputc_v ( '\t', f ) ;`
		1444	`dump_id ( fid ) ;`
		1445	`fputc_v ( '\n', f ) ;`
		1446	`}`
		1447	`return ;`
		1448	`}`
		1449
		1450
		1451	`/*`
		1452	`DUMP A USING DECLARATION`
		1453
		1454	`This routine dumps the fact that a using declaration has been used to`
		1455	`set up the alias id for cid.`
		1456	`*/`
		1457
		1458	`void dump_alias`
		1459	`PROTO_N ( ( id, cid, loc ) )`
		1460	`PROTO_T ( IDENTIFIER id X IDENTIFIER cid X LOCATION *loc )`
		1461	`{`
		1462	`ulong n = DEREF_ulong ( id_dump ( cid ) ) ;`
		1463	`COPY_ulong ( id_dump ( id ), n ) ;`
		1464	`/* NOT YET IMPLEMENTED */`
		1465	`UNUSED ( loc ) ;`
		1466	`return ;`
		1467	`}`
		1468
		1469
		1470	`/*`
		1471	`DUMP A USING DIRECTIVE`
		1472
		1473	`This routine dumps the fact that the namespace ns has been the subject`
		1474	`of a using directive in the namespace cns.`
		1475	`*/`
		1476
		1477	`void dump_using`
		1478	`PROTO_N ( ( ns, cns, loc ) )`
		1479	`PROTO_T ( NAMESPACE ns X NAMESPACE cns X LOCATION *loc )`
		1480	`{`
		1481	`/* NOT YET IMPLEMENTED */`
		1482	`UNUSED ( ns ) ;`
		1483	`UNUSED ( cns ) ;`
		1484	`UNUSED ( loc ) ;`
		1485	`return ;`
		1486	`}`
		1487
		1488
		1489	`/*`
		1490	`TABLE OF ERROR NUMBERS`
		1491
		1492	`This array contains a table of flags indicating whether each error`
		1493	`has been output or not.`
		1494	`*/`
		1495
		1496	`static char *err_output = NULL ;`
		1497
		1498
		1499	`/*`
		1500	`DUMP AN ERROR`
		1501
		1502	`This routine adds the error e of severity sev to the dump file. It`
		1503	`returns false if the dump has already been closed or e is an internal`
		1504	`compiler error.`
		1505	`*/`
		1506
		1507	`int dump_error`
		1508	`PROTO_N ( ( e, loc, sev, cnt ) )`
		1509	`PROTO_T ( ERROR e X LOCATION *loc X int sev X int cnt )`
		1510	`{`
		1511	`if ( IS_err_simple ( e ) ) {`
		1512	`/* Simple error message */`
		1513	`FILE *f = dump_file ;`
		1514	`int n = DEREF_int ( err_simple_number ( e ) ) ;`
		1515	`ERR_DATA *msg = ERR_CATALOG + n ;`
		1516	`CONST char *sig = msg->signature ;`
		1517	`ERR_PROPS props = msg->props ;`
		1518
		1519	`/* Dump start of error */`
		1520	`if ( f == NULL ) return ( 0 ) ;`
		1521	`if ( props & ERR_PROP_compiler ) return ( 0 ) ;`
		1522	`if ( loc ) {`
		1523	`/* First error component */`
		1524	`CONST char *err ;`
		1525	`switch ( sev ) {`
		1526	`case ERROR_FATAL : err = "EF" ; break ;`
		1527	`case ERROR_INTERNAL : err = "EI" ; break ;`
		1528	`case ERROR_WARNING : err = "EW" ; break ;`
		1529	`default : err = "ES" ; break ;`
		1530	`}`
		1531	`fprintf_v ( f, "%s\t", err ) ;`
		1532	`dump_loc ( loc ) ;`
		1533	`fputc_v ( '\t', f ) ;`
		1534	`} else {`
		1535	`/* Subsequent error component */`
		1536	`fputs_v ( "EC\t", f ) ;`
		1537	`}`
		1538
		1539	`/* Dump error number */`
		1540	`if ( err_output [n] ) {`
		1541	`fprintf_v ( f, "%d", n ) ;`
		1542	`} else {`
		1543	`CONST char *name = msg->name ;`
		1544	`fprintf_v ( f, "%d = <%s.%s>", n, ERR_NAME, name ) ;`
		1545	`err_output [n] = 1 ;`
		1546	`}`
		1547
		1548	`/* Dump error arguments */`
		1549	`if ( sig == NULL ) {`
		1550	`fprintf_v ( f, "\t0\t%d\n", cnt ) ;`
		1551	`} else {`
		1552	`unsigned a ;`
		1553	`unsigned na = ( unsigned ) strlen ( sig ) ;`
		1554	`fprintf_v ( f, "\t%u\t%d\n", na, cnt ) ;`
		1555	`for ( a = 0 ; a < na ; a++ ) {`
		1556	`switch ( sig [a] ) {`
		1557	`case ERR_KEY_ACCESS : {`
		1558	`ACCESS acc ;`
		1559	`acc = DEREF_dspec ( err_arg ( e, a, ACCESS ) ) ;`
		1560	`IGNORE print_access ( acc, dump_buff, 0 ) ;`
		1561	`fputs_v ( "EAS\t", f ) ;`
		1562	`dump_string () ;`
		1563	`break ;`
		1564	`}`
		1565	`case ERR_KEY_BASE_TYPE : {`
		1566	`BASE_TYPE bt ;`
		1567	`bt = DEREF_btype ( err_arg ( e, a, BASE_TYPE ) ) ;`
		1568	`IGNORE print_btype ( bt, dump_buff, 0 ) ;`
		1569	`fputs_v ( "EAS\t", f ) ;`
		1570	`dump_string () ;`
		1571	`break ;`
		1572	`}`
		1573	`case ERR_KEY_CLASS_TYPE : {`
		1574	`CLASS_TYPE ct ;`
		1575	`ct = DEREF_ctype ( err_arg ( e, a, CLASS_TYPE ) ) ;`
		1576	`fputs_v ( "EAT\t", f ) ;`
		1577	`dump_ctype ( ct ) ;`
		1578	`break ;`
		1579	`}`
		1580	`case ERR_KEY_CV_SPEC : {`
		1581	`CV_SPEC cv = DEREF_cv ( err_arg ( e, a, CV_SPEC ) ) ;`
		1582	`IGNORE print_cv ( cv, dump_buff, 0 ) ;`
		1583	`fputs_v ( "EAS\t", f ) ;`
		1584	`dump_string () ;`
		1585	`break ;`
		1586	`}`
		1587	`case ERR_KEY_DECL_SPEC : {`
		1588	`DECL_SPEC ds ;`
		1589	`ds = DEREF_dspec ( err_arg ( e, a, DECL_SPEC ) ) ;`
		1590	`IGNORE print_dspec ( ds, dump_buff, 0 ) ;`
		1591	`fputs_v ( "EAS\t", f ) ;`
		1592	`dump_string () ;`
		1593	`break ;`
		1594	`}`
		1595	`case ERR_KEY_FLOAT : {`
		1596	`FLOAT flt = DEREF_flt ( err_arg ( e, a, FLOAT ) ) ;`
		1597	`IGNORE print_flt ( flt, dump_buff, 0 ) ;`
		1598	`fputs_v ( "EAS\t", f ) ;`
		1599	`dump_string () ;`
		1600	`break ;`
		1601	`}`
		1602	`case ERR_KEY_HASHID : {`
		1603	`HASHID nm ;`
		1604	`nm = DEREF_hashid ( err_arg ( e, a, HASHID ) ) ;`
		1605	`fputs_v ( "EAH\t", f ) ;`
		1606	`dump_hashid ( nm ) ;`
		1607	`break ;`
		1608	`}`
		1609	`case ERR_KEY_IDENTIFIER :`
		1610	`case ERR_KEY_LONG_ID : {`
		1611	`IDENTIFIER id ;`
		1612	`id = DEREF_id ( err_arg ( e, a, IDENTIFIER ) ) ;`
		1613	`fputs_v ( "EAI\t", f ) ;`
		1614	`dump_id ( id ) ;`
		1615	`break ;`
		1616	`}`
		1617	`case ERR_KEY_LEX : {`
		1618	`LEX t = DEREF_int ( err_arg ( e, a, LEX ) ) ;`
		1619	`fputs_v ( "EAS\t", f ) ;`
		1620	`dump_lex ( t ) ;`
		1621	`break ;`
		1622	`}`
		1623	`case ERR_KEY_NAMESPACE : {`
		1624	`NAMESPACE ns ;`
		1625	`ns = DEREF_nspace ( err_arg ( e, a, NAMESPACE ) ) ;`
		1626	`fputs_v ( "EAC\t", f ) ;`
		1627	`dump_nspace ( ns, 0 ) ;`
		1628	`break ;`
		1629	`}`
		1630	`case ERR_KEY_NAT : {`
		1631	`NAT nat = DEREF_nat ( err_arg ( e, a, NAT ) ) ;`
		1632	`fputs_v ( "EAN\t", f ) ;`
		1633	`dump_nat ( nat, 0 ) ;`
		1634	`break ;`
		1635	`}`
		1636	`case ERR_KEY_PPTOKEN_P : {`
		1637	`PPTOKEN_P tok ;`
		1638	`tok = DEREF_pptok ( err_arg ( e, a, PPTOKEN_P ) ) ;`
		1639	`IGNORE print_pptok ( tok, dump_buff, 0 ) ;`
		1640	`fputs_v ( "EAS\t", f ) ;`
		1641	`dump_string () ;`
		1642	`break ;`
		1643	`}`
		1644	`case ERR_KEY_PTR_LOC : {`
		1645	`PTR_LOC ploc ;`
		1646	`LOCATION aloc ;`
		1647	`ploc = DEREF_ptr ( err_arg ( e, a, PTR_LOC ) ) ;`
		1648	`DEREF_loc ( ploc, aloc ) ;`
		1649	`fputs_v ( "EAL\t", f ) ;`
		1650	`dump_loc ( &aloc ) ;`
		1651	`break ;`
		1652	`}`
		1653	`case ERR_KEY_QUALIFIER : {`
		1654	`CONST char *s ;`
		1655	`QUALIFIER qual ;`
		1656	`qual = DEREF_qual ( err_arg ( e, a, QUALIFIER ) ) ;`
		1657	`if ( qual == qual_full \|\| qual == qual_top ) {`
		1658	`s = "::" ;`
		1659	`} else {`
		1660	`s = "" ;`
		1661	`}`
		1662	`fprintf_v ( f, "EAS\t<%s>", s ) ;`
		1663	`break ;`
		1664	`}`
		1665	`case ERR_KEY_STRING : {`
		1666	`STRING str = DEREF_str ( err_arg ( e, a, STRING ) ) ;`
		1667	`IGNORE print_str ( str, dump_buff, 0 ) ;`
		1668	`fputs_v ( "EAS\t", f ) ;`
		1669	`dump_string () ;`
		1670	`break ;`
		1671	`}`
		1672	`case ERR_KEY_TYPE : {`
		1673	`TYPE t = DEREF_type ( err_arg ( e, a, TYPE ) ) ;`
		1674	`fputs_v ( "EAT\t", f ) ;`
		1675	`dump_type ( t ) ;`
		1676	`break ;`
		1677	`}`
		1678	`case ERR_KEY_cint : {`
		1679	`cint i = DEREF_int ( err_arg ( e, a, cint ) ) ;`
		1680	`fprintf_v ( f, "EAV\t%d", i ) ;`
		1681	`break ;`
		1682	`}`
		1683	`case ERR_KEY_plural : {`
		1684	`plural i ;`
		1685	`i = DEREF_unsigned ( err_arg ( e, a, plural ) ) ;`
		1686	`if ( i == 1 ) {`
		1687	`fputs_v ( "EAS\t<>", f ) ;`
		1688	`} else {`
		1689	`fputs_v ( "EAS\t<s>", f ) ;`
		1690	`}`
		1691	`break ;`
		1692	`}`
		1693	`case ERR_KEY_cstring :`
		1694	`case ERR_KEY_string : {`
		1695	`string s ;`
		1696	`s = DEREF_string ( err_arg ( e, a, string ) ) ;`
		1697	`if ( s ) {`
		1698	`unsigned d = ( unsigned ) ustrlen ( s ) ;`
		1699	`fprintf_v ( f, "EAS\t&%u<%s>", d, strlit ( s ) ) ;`
		1700	`} else {`
		1701	`fputs_v ( "EAS\t<>", f ) ;`
		1702	`}`
		1703	`break ;`
		1704	`}`
		1705	`case ERR_KEY_ulong :`
		1706	`case ERR_KEY_ucint : {`
		1707	`ulong u = DEREF_ulong ( err_arg ( e, a, ulong ) ) ;`
		1708	`fprintf_v ( f, "EAV\t%lu", u ) ;`
		1709	`break ;`
		1710	`}`
		1711	`case ERR_KEY_unsigned : {`
		1712	`unsigned u ;`
		1713	`u = DEREF_unsigned ( err_arg ( e, a, unsigned ) ) ;`
		1714	`fprintf_v ( f, "EAV\t%u", u ) ;`
		1715	`break ;`
		1716	`}`
		1717	`default : {`
		1718	`fputs_v ( "EAS\t<>", f ) ;`
		1719	`break ;`
		1720	`}`
		1721	`}`
		1722	`fputc_v ( '\n', f ) ;`
		1723	`}`
		1724	`}`
		1725
		1726	`} else {`
		1727	`/* Composite error message */`
		1728	`ERROR e1 = DEREF_err ( err_compound_head ( e ) ) ;`
		1729	`ERROR e2 = DEREF_err ( err_compound_tail ( e ) ) ;`
		1730	`if ( !dump_error ( e1, loc, sev, 1 ) ) return ( 0 ) ;`
		1731	`if ( !dump_error ( e2, NIL ( LOCATION ), sev, cnt ) ) return ( 0 ) ;`
		1732	`}`
		1733	`return ( 1 ) ;`
		1734	`}`
		1735
		1736
		1737	`/*`
		1738	`DUMP A VARIABLE DESTRUCTOR CALL`
		1739
		1740	`This routine adds the call of the destructor for the variable id to`
		1741	`the dump file.`
		1742	`*/`
		1743
		1744	`void dump_destr`
		1745	`PROTO_N ( ( id, loc ) )`
		1746	`PROTO_T ( IDENTIFIER id X LOCATION *loc )`
		1747	`{`
		1748	`EXP d = DEREF_exp ( id_variable_etc_term ( id ) ) ;`
		1749	`if ( !IS_NULL_exp ( d ) ) {`
		1750	`unsigned tag = TAG_exp ( d ) ;`
		1751	`while ( tag == exp_paren_tag ) {`
		1752	`d = DEREF_exp ( exp_paren_arg ( d ) ) ;`
		1753	`if ( IS_NULL_exp ( d ) ) return ;`
		1754	`tag = TAG_exp ( d ) ;`
		1755	`}`
		1756	`while ( tag == exp_nof_tag ) {`
		1757	`d = DEREF_exp ( exp_nof_pad ( d ) ) ;`
		1758	`tag = TAG_exp ( d ) ;`
		1759	`}`
		1760	`while ( tag == exp_destr_tag ) {`
		1761	`d = DEREF_exp ( exp_destr_call ( d ) ) ;`
		1762	`tag = TAG_exp ( d ) ;`
		1763	`}`
		1764	`if ( tag == exp_func_id_tag ) {`
		1765	`IDENTIFIER fn = DEREF_id ( exp_func_id_id ( d ) ) ;`
		1766	`dump_use ( id, loc, 0 ) ;`
		1767	`dump_call ( fn, loc, 0 ) ;`
		1768	`}`
		1769	`}`
		1770	`return ;`
		1771	`}`
		1772
		1773
		1774	`/*`
		1775	`DUMP AN IDENTIFIER DECLARATION`
		1776
		1777	`This routine adds the declaration of the identifier id to the dump`
		1778	`file. The parameter def is 1 for a definition, 2 for a tentative`
		1779	`definition, and 0 for a declaration.`
		1780	`*/`
		1781
		1782	`void dump_declare`
		1783	`PROTO_N ( ( id, loc, def ) )`
		1784	`PROTO_T ( IDENTIFIER id X LOCATION *loc X int def )`
		1785	`{`
		1786	`FILE *f = dump_file ;`
		1787	`CONST char *key = dump_key ( id, def ) ;`
		1788	`if ( key && f ) {`
		1789	`/* Dump identifier key */`
		1790	`char d = 'M' ;`
		1791	`int destr = 0 ;`
		1792	`DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;`
		1793	`if ( dump_implicit \|\| dump_template ) fputc_v ( 'I', f ) ;`
		1794	`switch ( def ) {`
		1795	`case 1 : d = 'D' ; break ;`
		1796	`case 2 : d = 'T' ; break ;`
		1797	`}`
		1798
		1799	`/* Dump location and identifier information */`
		1800	`fprintf_v ( f, "%c%s\t", d, key ) ;`
		1801	`dump_loc ( loc ) ;`
		1802	`fputc_v ( '\t', f ) ;`
		1803	`dump_id ( id ) ;`
		1804	`fputc_v ( '\t', f ) ;`
		1805
		1806	`/* Dump identifier specific information */`
		1807	`switch ( TAG_id ( id ) ) {`
		1808	`case id_obj_macro_tag : {`
		1809	`/* Object-like macros */`
		1810	`fputs_v ( "ZUO", f ) ;`
		1811	`break ;`
		1812	`}`
		1813	`case id_func_macro_tag : {`
		1814	`/* Function-like macros */`
		1815	`unsigned n ;`
		1816	`n = DEREF_unsigned ( id_func_macro_no_params ( id ) ) ;`
		1817	`fprintf_v ( f, "ZUF%u", n ) ;`
		1818	`break ;`
		1819	`}`
		1820	`case id_builtin_tag : {`
		1821	`/* Built-in operators */`
		1822	`TYPE r = DEREF_type ( id_builtin_ret ( id ) ) ;`
		1823	`LIST ( TYPE ) p = DEREF_list ( id_builtin_ptypes ( id ) ) ;`
		1824	`fputc_v ( MANGLE_func, f ) ;`
		1825	`dump_type ( r ) ;`
		1826	`dump_type_list ( p, FUNC_NONE, 1 ) ;`
		1827	`fputc_v ( MANGLE_colon, f ) ;`
		1828	`fputc_v ( MANGLE_colon, f ) ;`
		1829	`break ;`
		1830	`}`
		1831	`case id_class_name_tag :`
		1832	`case id_enum_name_tag :`
		1833	`case id_class_alias_tag :`
		1834	`case id_enum_alias_tag :`
		1835	`case id_type_alias_tag : {`
		1836	`/* Type aliases */`
		1837	`TYPE t = DEREF_type ( id_class_name_etc_defn ( id ) ) ;`
		1838	`if ( ds & dspec_token ) {`
		1839	`/* Tokenised types */`
		1840	`IDENTIFIER tid = find_token ( id ) ;`
		1841	`if ( IS_id_token ( tid ) ) {`
		1842	`TOKEN tok = DEREF_tok ( id_token_sort ( tid ) ) ;`
		1843	`dump_sort ( tok ) ;`
		1844	`break ;`
		1845	`}`
		1846	`}`
		1847	`dump_type ( t ) ;`
		1848	`break ;`
		1849	`}`
		1850	`case id_nspace_name_tag : {`
		1851	`/* Namespace names */`
		1852	`fputc_v ( '*', f ) ;`
		1853	`break ;`
		1854	`}`
		1855	`case id_nspace_alias_tag : {`
		1856	`/* Namespace aliases */`
		1857	`NAMESPACE ns = DEREF_nspace ( id_nspace_alias_defn ( id ) ) ;`
		1858	`dump_nspace ( ns, 0 ) ;`
		1859	`break ;`
		1860	`}`
		1861	`case id_variable_tag :`
		1862	`case id_parameter_tag :`
		1863	`case id_stat_member_tag : {`
		1864	`/* Variables */`
		1865	`TYPE t = DEREF_type ( id_variable_etc_type ( id ) ) ;`
		1866	`dump_type ( t ) ;`
		1867	`if ( !( ds & dspec_auto ) ) destr = def ;`
		1868	`break ;`
		1869	`}`
		1870	`case id_weak_param_tag : {`
		1871	`/* Non-prototype function parameters */`
		1872	`dump_type ( type_sint ) ;`
		1873	`break ;`
		1874	`}`
		1875	`case id_function_tag :`
		1876	`case id_mem_func_tag :`
		1877	`case id_stat_mem_func_tag : {`
		1878	`/* Functions */`
		1879	`TYPE t = DEREF_type ( id_function_etc_type ( id ) ) ;`
		1880	`IDENTIFIER over = DEREF_id ( id_function_etc_over ( id ) ) ;`
		1881	`dump_type ( t ) ;`
		1882	`if ( !IS_NULL_id ( over ) ) {`
		1883	`fputc_v ( '\t', f ) ;`
		1884	`dump_id ( over ) ;`
		1885	`}`
		1886	`break ;`
		1887	`}`
		1888	`case id_member_tag : {`
		1889	`/* Data members */`
		1890	`TYPE t = DEREF_type ( id_member_type ( id ) ) ;`
		1891	`dump_type ( t ) ;`
		1892	`break ;`
		1893	`}`
		1894	`case id_enumerator_tag : {`
		1895	`/* Enumerators */`
		1896	`TYPE t = DEREF_type ( id_enumerator_etype ( id ) ) ;`
		1897	`dump_type ( t ) ;`
		1898	`break ;`
		1899	`}`
		1900	`case id_token_tag : {`
		1901	`/* Tokens */`
		1902	`TOKEN tok = DEREF_tok ( id_token_sort ( id ) ) ;`
		1903	`dump_sort ( tok ) ;`
		1904	`break ;`
		1905	`}`
		1906	`default : {`
		1907	`/* Other identifiers */`
		1908	`fputc_v ( '*', f ) ;`
		1909	`break ;`
		1910	`}`
		1911	`}`
		1912	`fputc_v ( '\n', f ) ;`
		1913
		1914	`/* Deal with destructors */`
		1915	`if ( destr && do_usage ) dump_destr ( id, loc ) ;`
		1916	`}`
		1917	`dump_implicit = 0 ;`
		1918	`return ;`
		1919	`}`
		1920
		1921
		1922	`/*`
		1923	`DUMP AN IDENTIFIER UNDEFINITION`
		1924
		1925	`This routine adds the undefinition (indicating the end of a scope)`
		1926	`of the identifier id to the dump file.`
		1927	`*/`
		1928
		1929	`void dump_undefine`
		1930	`PROTO_N ( ( id, loc, def ) )`
		1931	`PROTO_T ( IDENTIFIER id X LOCATION *loc X int def )`
		1932	`{`
		1933	`FILE *f = dump_file ;`
		1934	`CONST char *key = dump_key ( id, def ) ;`
		1935	`if ( key && f ) {`
		1936	`if ( def ) {`
		1937	`fprintf_v ( f, "U%s\t", key ) ;`
		1938	`} else {`
		1939	`fprintf_v ( f, "Q%s\t", key ) ;`
		1940	`}`
		1941	`dump_loc ( loc ) ;`
		1942	`fputc_v ( '\t', f ) ;`
		1943	`dump_id ( id ) ;`
		1944	`fputc_v ( '\n', f ) ;`
		1945	`}`
		1946	`return ;`
		1947	`}`
		1948
		1949
		1950	`/*`
		1951	`DUMP AN IDENTIFIER USE`
		1952
		1953	`This routine adds the use of the identifier id to the dump file.`
		1954	`expl is true for an explicit use.`
		1955	`*/`
		1956
		1957	`void dump_use`
		1958	`PROTO_N ( ( id, loc, expl ) )`
		1959	`PROTO_T ( IDENTIFIER id X LOCATION *loc X int expl )`
		1960	`{`
		1961	`FILE *f = dump_file ;`
		1962	`CONST char *key = dump_key ( id, 1 ) ;`
		1963	`if ( key && f ) {`
		1964	`if ( !expl ) fputc_v ( 'I', f ) ;`
		1965	`fprintf_v ( f, "L%s\t", key ) ;`
		1966	`dump_loc ( loc ) ;`
		1967	`fputc_v ( '\t', f ) ;`
		1968	`dump_id ( id ) ;`
		1969	`fputc_v ( '\n', f ) ;`
		1970	`}`
		1971	`return ;`
		1972	`}`
		1973
		1974
		1975	`/*`
		1976	`DUMP AN IDENTIFIER CALL`
		1977
		1978	`This routine adds the call of the identifier id to the dump file.`
		1979	`expl is true for an explicit call.`
		1980	`*/`
		1981
		1982	`void dump_call`
		1983	`PROTO_N ( ( id, loc, expl ) )`
		1984	`PROTO_T ( IDENTIFIER id X LOCATION *loc X int expl )`
		1985	`{`
		1986	`FILE *f = dump_file ;`
		1987	`CONST char *key = dump_key ( id, 1 ) ;`
		1988	`if ( key && f ) {`
		1989	`if ( !expl ) fputc_v ( 'I', f ) ;`
		1990	`fprintf_v ( f, "C%s\t", key ) ;`
		1991	`dump_loc ( loc ) ;`
		1992	`fputc_v ( '\t', f ) ;`
		1993	`dump_id ( id ) ;`
		1994	`fputc_v ( '\n', f ) ;`
		1995	`}`
		1996	`return ;`
		1997	`}`
		1998
		1999
		2000	`/*`
		2001	`DUMP A TEMPLATE INSTANCE`
		2002
		2003	`This routine adds the association of the identifier id and the`
		2004	`template instance form to the dump file.`
		2005	`*/`
		2006
		2007	`void dump_instance`
		2008	`PROTO_N ( ( id, form, spec ) )`
		2009	`PROTO_T ( IDENTIFIER id X TYPE form X TYPE spec )`
		2010	`{`
		2011	`FILE *f = dump_file ;`
		2012	`CONST char *key = dump_key ( id, 1 ) ;`
		2013	`if ( key && f ) {`
		2014	`fprintf_v ( f, "Z%s\t", key ) ;`
		2015	`dump_id ( id ) ;`
		2016	`fputc_v ( '\t', f ) ;`
		2017	`dump_type ( form ) ;`
		2018	`if ( !EQ_type ( form, spec ) ) {`
		2019	`fputc_v ( '\t', f ) ;`
		2020	`dump_type ( spec ) ;`
		2021	`fputc_v ( '\n', f ) ;`
		2022	`} else {`
		2023	`fputs_v ( "\t*\n", f ) ;`
		2024	`}`
		2025	`}`
		2026	`return ;`
		2027	`}`
		2028
		2029
		2030	`/*`
		2031	`DUMP A TOKEN NAME`
		2032
		2033	`This routine adds the association of the identifier id and the external`
		2034	`token name tok to the dump file.`
		2035	`*/`
		2036
		2037	`void dump_token`
		2038	`PROTO_N ( ( id, tok ) )`
		2039	`PROTO_T ( IDENTIFIER id X IDENTIFIER tok )`
		2040	`{`
		2041	`FILE *f = dump_file ;`
		2042	`CONST char *key = dump_key ( id, 1 ) ;`
		2043	`if ( key && f ) {`
		2044	`HASHID nm = DEREF_hashid ( id_name ( tok ) ) ;`
		2045	`if ( IS_hashid_name_etc ( nm ) ) {`
		2046	`string s = DEREF_string ( hashid_name_etc_text ( nm ) ) ;`
		2047	`unsigned n = ( unsigned ) ustrlen ( s ) ;`
		2048	`fprintf_v ( f, "X%s\t", key ) ;`
		2049	`dump_id ( id ) ;`
		2050	`fprintf_v ( f, "\t&%u<%s>\n", n, strlit ( s ) ) ;`
		2051	`}`
		2052	`}`
		2053	`return ;`
		2054	`}`
		2055
		2056
		2057	`/*`
		2058	`DUMP A TOKEN PARAMETER`
		2059
		2060	`This routine adds the declaration of the token or template parameter`
		2061	`id to the dump file.`
		2062	`*/`
		2063
		2064	`void dump_token_param`
		2065	`PROTO_N ( ( id ) )`
		2066	`PROTO_T ( IDENTIFIER id )`
		2067	`{`
		2068	`dump_declare ( id, &crt_loc, 0 ) ;`
		2069	`if ( IS_id_token ( id ) ) {`
		2070	`IDENTIFIER alt = DEREF_id ( id_token_alt ( id ) ) ;`
		2071	`ulong n = DEREF_ulong ( id_dump ( id ) ) ;`
		2072	`COPY_ulong ( id_dump ( alt ), n ) ;`
		2073	`}`
		2074	`return ;`
		2075	`}`
		2076
		2077
		2078	`/*`
		2079	`DUMP A BUILT-IN OPERATOR`
		2080
		2081	`This routine adds the declaration of the built-in operator id to the`
		2082	`dump file.`
		2083	`*/`
		2084
		2085	`void dump_builtin`
		2086	`PROTO_N ( ( id ) )`
		2087	`PROTO_T ( IDENTIFIER id )`
		2088	`{`
		2089	`if ( IS_id_builtin ( id ) ) {`
		2090	`dump_implicit = 1 ;`
		2091	`dump_declare ( id, &crt_loc, 0 ) ;`
		2092	`}`
		2093	`return ;`
		2094	`}`
		2095
		2096
		2097	`/*`
		2098	`DUMP A PROMOTION TYPE`
		2099
		2100	`This routine adds the fact that the promotion of the integral type`
		2101	`it is ip to the dump file.`
		2102	`*/`
		2103
		2104	`void dump_promote`
		2105	`PROTO_N ( ( it, ip ) )`
		2106	`PROTO_T ( INT_TYPE it X INT_TYPE ip )`
		2107	`{`
		2108	`FILE *f = dump_file ;`
		2109	`if ( f ) {`
		2110	`fputs_v ( "P\t", f ) ;`
		2111	`dump_itype ( it ) ;`
		2112	`fputc_v ( MANGLE_colon, f ) ;`
		2113	`dump_itype ( ip ) ;`
		2114	`fputc_v ( '\n', f ) ;`
		2115	`}`
		2116	`return ;`
		2117	`}`
		2118
		2119
		2120	`/*`
		2121	`DUMP THE START OF A SCOPE`
		2122
		2123	`This routine adds the start of the scope ns (which may have an associated`
		2124	`name, id) to the dump file. pns gives the enclosing scope, if known.`
		2125	`*/`
		2126
		2127	`void dump_begin_scope`
		2128	`PROTO_N ( ( id, ns, pns, loc ) )`
		2129	`PROTO_T ( IDENTIFIER id X NAMESPACE ns X NAMESPACE pns X LOCATION *loc )`
		2130	`{`
		2131	`FILE *f = dump_file ;`
		2132	`if ( !IS_NULL_nspace ( ns ) && f ) {`
		2133	`ulong n ;`
		2134	`HASHID nm ;`
		2135	`if ( !IS_NULL_id ( id ) ) {`
		2136	`/* Named scope */`
		2137	`fputs_v ( "SSH\t", f ) ;`
		2138	`n = DEREF_ulong ( id_dump ( id ) ) ;`
		2139	`if ( n != LINK_NONE ) {`
		2140	`/* Already used */`
		2141	`dump_loc ( loc ) ;`
		2142	`fprintf_v ( f, "\t%lu\n", n ) ;`
		2143	`return ;`
		2144	`}`
		2145	`n = dump_id_next++ ;`
		2146	`COPY_ulong ( id_dump ( id ), n ) ;`
		2147	`nm = DEREF_hashid ( id_name ( id ) ) ;`
		2148	`} else {`
		2149	`/* Unnamed scope */`
		2150	`fputs_v ( "SSB\t", f ) ;`
		2151	`n = dump_id_next++ ;`
		2152	`nm = NULL_hashid ;`
		2153	`}`
		2154	`dump_loc ( loc ) ;`
		2155	`fprintf_v ( f, "\t%lu = ", n ) ;`
		2156	`dump_hashid ( nm ) ;`
		2157	`fputc_v ( '\t', f ) ;`
		2158	`dump_nspace ( pns, 1 ) ;`
		2159	`fputc_v ( '\n', f ) ;`
		2160	`COPY_ulong ( nspace_dump ( ns ), n ) ;`
		2161	`}`
		2162	`return ;`
		2163	`}`
		2164
		2165
		2166	`/*`
		2167	`DUMP THE END OF A SCOPE`
		2168
		2169	`This routine adds the end of the scope ns (which may have an associated`
		2170	`name, id) to the dump file.`
		2171	`*/`
		2172
		2173	`void dump_end_scope`
		2174	`PROTO_N ( ( id, ns, loc ) )`
		2175	`PROTO_T ( IDENTIFIER id X NAMESPACE ns X LOCATION *loc )`
		2176	`{`
		2177	`FILE *f = dump_file ;`
		2178	`if ( !IS_NULL_nspace ( ns ) && f ) {`
		2179	`ulong n = DEREF_ulong ( nspace_dump ( ns ) ) ;`
		2180	`if ( !IS_NULL_id ( id ) ) {`
		2181	`fputs_v ( "SEH\t", f ) ;`
		2182	`} else {`
		2183	`fputs_v ( "SEB\t", f ) ;`
		2184	`}`
		2185	`dump_loc ( loc ) ;`
		2186	`fprintf_v ( f, "\t%lu\n", n ) ;`
		2187	`}`
		2188	`return ;`
		2189	`}`
		2190
		2191
		2192	`/*`
		2193	`DUMP A STRING LITERAL`
		2194
		2195	`This routine adds the string literal of type kind given by the start`
		2196	`and end points s and e to the dump file.`
		2197	`*/`
		2198
		2199	`void dump_string_lit`
		2200	`PROTO_N ( ( s, e, kind ) )`
		2201	`PROTO_T ( string s X string e X unsigned kind )`
		2202	`{`
		2203	`FILE *f = dump_file ;`
		2204	`if ( f ) {`
		2205	`unsigned long n = ( unsigned long ) ( e - s ) ;`
		2206	`fputc_v ( 'A', f ) ;`
		2207	`if ( kind & STRING_CHAR ) fputc_v ( 'C', f ) ;`
		2208	`if ( kind & STRING_WIDE ) fputc_v ( 'L', f ) ;`
		2209	`fputc_v ( '\t', f ) ;`
		2210	`dump_loc ( &crt_loc ) ;`
		2211	`fprintf_v ( f, "\t&%lu<", n ) ;`
		2212	`while ( s != e ) {`
		2213	`int c = ( int ) *( s++ ) ;`
		2214	`fputc_v ( c, f ) ;`
		2215	`}`
		2216	`fputs_v ( ">\n", f ) ;`
		2217	`}`
		2218	`return ;`
		2219	`}`
		2220
		2221
		2222	`/*`
		2223	`DUMP THE START OF A FILE`
		2224
		2225	`This routine adds the start of the file loc to the dump file. dir`
		2226	`gives the directory in which the file was found.`
		2227	`*/`
		2228
		2229	`void dump_start`
		2230	`PROTO_N ( ( loc, dir ) )`
		2231	`PROTO_T ( LOCATION loc X INCL_DIR dir )`
		2232	`{`
		2233	`FILE *f = dump_file ;`
		2234	`if ( f ) {`
		2235	`fputs_v ( "FS\t", f ) ;`
		2236	`dump_loc ( loc ) ;`
		2237	`if ( dir ) {`
		2238	`fprintf_v ( f, "\t%lu\n", dir->no ) ;`
		2239	`} else {`
		2240	`fputs_v ( "\t*\n", f ) ;`
		2241	`}`
		2242	`}`
		2243	`return ;`
		2244	`}`
		2245
		2246
		2247	`/*`
		2248	`DUMP THE END OF A FILE`
		2249
		2250	`This routine adds the end of the file loc to the dump file.`
		2251	`*/`
		2252
		2253	`void dump_end`
		2254	`PROTO_N ( ( loc ) )`
		2255	`PROTO_T ( LOCATION *loc )`
		2256	`{`
		2257	`FILE *f = dump_file ;`
		2258	`if ( f ) {`
		2259	`fputs_v ( "FE\t", f ) ;`
		2260	`dump_loc ( loc ) ;`
		2261	`fputc_v ( '\n', f ) ;`
		2262	`}`
		2263	`return ;`
		2264	`}`
		2265
		2266
		2267	`/*`
		2268	`DUMP A FILE INCLUSION`
		2269
		2270	`This routine adds a file inclusion to the dump file. loc gives the`
		2271	`location of the '#include' directive, the following file start gives`
		2272	`the file included. st is as in start_include, plus 4 for the`
		2273	`resumption of a file after a file has been included. q is either '"',`
		2274	`'>' or ']' depending on the type of inclusion.`
		2275	`*/`
		2276
		2277	`void dump_include`
		2278	`PROTO_N ( ( loc, nm, st, q ) )`
		2279	`PROTO_T ( LOCATION *loc X string nm X int st X int q )`
		2280	`{`
		2281	`FILE *f = dump_file ;`
		2282	`if ( f ) {`
		2283	`CONST char *incl ;`
		2284	`switch ( st ) {`
		2285	`case 2 : incl = "FIS" ; break ;`
		2286	`case 3 : incl = "FIE" ; break ;`
		2287	`case 4 : incl = "FIR" ; nm = NULL ; break ;`
		2288	`default : {`
		2289	`if ( q == char_quote ) {`
		2290	`incl = "FIQ" ;`
		2291	`} else if ( q == char_close_square ) {`
		2292	`incl = "FIN" ;`
		2293	`} else {`
		2294	`incl = "FIA" ;`
		2295	`}`
		2296	`break ;`
		2297	`}`
		2298	`}`
		2299	`fprintf_v ( f, "%s\t", incl ) ;`
		2300	`dump_loc ( loc ) ;`
		2301	`if ( nm ) {`
		2302	`/* Output included name */`
		2303	`unsigned n = ( unsigned ) ustrlen ( nm ) ;`
		2304	`fprintf_v ( f, "\t&%u<%s>", n, strlit ( nm ) ) ;`
		2305	`}`
		2306	`fputc_v ( '\n', f ) ;`
		2307	`}`
		2308	`return ;`
		2309	`}`
		2310
		2311
		2312	`/*`
		2313	`OPEN DUMP FILE`
		2314
		2315	`This routine opens the dump file nm with dump options given by opt.`
		2316	`This corresponds to the command-line option '-dopt=nm'.`
		2317	`*/`
		2318
		2319	`void init_dump`
		2320	`PROTO_N ( ( nm, opt ) )`
		2321	`PROTO_T ( string nm X string opt )`
		2322	`{`
		2323	`if ( nm ) {`
		2324	`/* Open dump file */`
		2325	`FILE *f ;`
		2326	`char *p ;`
		2327	`character c ;`
		2328	`unsigned i, n ;`
		2329	`int do_all = 0 ;`
		2330	`output_name [ OUTPUT_DUMP ] = nm ;`
		2331	`if ( !open_output ( OUTPUT_DUMP, text_mode ) ) {`
		2332	`fail ( ERR_fail_dump ( nm ) ) ;`
		2333	`term_error ( 0 ) ;`
		2334	`return ;`
		2335	`}`
		2336	`f = output_file [ OUTPUT_DUMP ] ;`
		2337	`fprintf_v ( f, "# Dump file for %s %s\n", progname, progvers ) ;`
		2338	`fprintf_v ( f, "V\t%lu\t%lu\t", DUMP_major, DUMP_minor ) ;`
		2339	`fprintf_v ( f, "<%s>\n", LANGUAGE_NAME ) ;`
		2340	`dump_file = f ;`
		2341
		2342	`/* Set dump options */`
		2343	`do_dump = 1 ;`
		2344	`while ( c = *( opt++ ), ( c && c != '=' ) ) {`
		2345	`switch ( c ) {`
		2346	`case 'a' : do_all = 1 ; break ;`
		2347	`case 'c' : do_string = 1 ; break ;`
		2348	`case 'e' : do_error = 1 ; break ;`
		2349	`case 'h' : do_header = 1 ; break ;`
		2350	`case 'k' : do_keyword = 1 ; break ;`
		2351	`case 'l' : do_local = 1 ; break ;`
		2352	`case 'm' : do_macro = 1 ; break ;`
		2353	`case 'p' : break ;`
		2354	`case 's' : do_scope = 1 ; break ;`
		2355	`case 'u' : do_usage = 1 ; break ;`
		2356	`default : {`
		2357	`/* Unknown dump options */`
		2358	`CONST char *err = "Unknown dump option, '%c'" ;`
		2359	`error ( ERROR_WARNING, err, ( int ) c ) ;`
		2360	`break ;`
		2361	`}`
		2362	`}`
		2363	`}`
		2364	`if ( do_all ) {`
		2365	`/* Enable all dump options */`
		2366	`do_error = 1 ;`
		2367	`do_header = 1 ;`
		2368	`do_local = 1 ;`
		2369	`do_macro = 1 ;`
		2370	`do_usage = 1 ;`
		2371	`}`
		2372
		2373	`/* Allocate table of error numbers */`
		2374	`n = catalog_size ;`
		2375	`p = xmalloc_nof ( char, n ) ;`
		2376	`for ( i = 0 ; i < n ; i++ ) p [i] = 0 ;`
		2377	`err_output = p ;`
		2378	`last_input = ustrlit ( "" ) ;`
		2379	`last_file = ustrlit ( "" ) ;`
		2380
		2381	`/* Output file inclusion directories */`
		2382	`if ( do_header ) {`
		2383	`ulong r = 0 ;`
		2384	`INCL_DIR *d = dir_path ;`
		2385	`while ( d != NULL ) {`
		2386	`string s = d->path ;`
		2387	`if ( s ) {`
		2388	`unsigned m = ( unsigned ) ustrlen ( s ) ;`
		2389	`fprintf_v ( f, "FD\t%lu = &%u<%s>", r, m, strlit ( s ) ) ;`
		2390	`s = d->name ;`
		2391	`if ( s ) {`
		2392	`m = ( unsigned ) ustrlen ( s ) ;`
		2393	`fprintf_v ( f, "\t&%u<%s>", m, strlit ( s ) ) ;`
		2394	`}`
		2395	`fputc_v ( '\n', f ) ;`
		2396	`}`
		2397	`d->no = r++ ;`
		2398	`d = d->next ;`
		2399	`}`
		2400	`}`
		2401	`if ( do_usage \|\| do_scope ) record_location = 1 ;`
		2402	`if ( do_error ) max_errors = ULONG_MAX ;`
		2403	`}`
		2404	`return ;`
		2405	`}`
		2406
		2407
		2408	`/*`
		2409	`CLOSE DUMP FILE`
		2410
		2411	`This routine closes the dump file.`
		2412	`*/`
		2413
		2414	`void term_dump`
		2415	`PROTO_Z ()`
		2416	`{`
		2417	`if ( do_dump ) {`
		2418	`FILE *f = dump_file ;`
		2419	`if ( f ) {`
		2420	`dump_file = NULL ;`
		2421	`fputs_v ( "# End of dump file\n", f ) ;`
		2422	`close_output ( OUTPUT_DUMP ) ;`
		2423	`}`
		2424	`do_dump = 0 ;`
		2425	`}`
		2426	`return ;`
		2427	`}`

Subversion Repositories tendra.SVN

(root)/branches/tendra5/src/producers/common/output/dump.c – Rev 5