WebSVN – tendra.SVN – Blame – /trunk/src/installers/common/diag/dg_fns.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	`/**********************************************************************`
		32	$Author: pwe $
		33	$Date: 1998/03/11 11:03:30 $
		34	$Revision: 1.2 $
		35	$Log: dg_fns.c,v $
		36	`* Revision 1.2 1998/03/11 11:03:30 pwe`
		37	`* DWARF optimisation info`
		38	`*`
		39	`* Revision 1.1.1.1 1998/01/17 15:55:46 release`
		40	`* First version to be checked into rolling release.`
		41	`*`
		42	`* Revision 1.9 1998/01/11 18:44:53 pwe`
		43	`* consistent new/old diags`
		44	`*`
		45	`* Revision 1.8 1998/01/09 14:43:06 pwe`
		46	`* info for global STABS`
		47	`*`
		48	`* Revision 1.7 1998/01/09 09:29:45 pwe`
		49	`* prep restructure`
		50	`*`
		51	`* Revision 1.6 1997/12/04 19:36:24 pwe`
		52	`* ANDF-DE V1.9`
		53	`*`
		54	`* Revision 1.5 1997/11/06 09:17:39 pwe`
		55	`* ANDF-DE V1.8`
		56	`*`
		57	`* Revision 1.4 1997/10/28 10:12:31 pwe`
		58	`* local location support`
		59	`*`
		60	`* Revision 1.3 1997/10/23 09:21:04 pwe`
		61	`* ANDF-DE V1.7 and extra diags`
		62	`*`
		63	`* Revision 1.2 1997/10/10 18:16:37 pwe`
		64	`* prep ANDF-DE revision`
		65	`*`
		66	`* Revision 1.1 1997/08/23 13:26:46 pwe`
		67	`* initial ANDF-DE`
		68	`*`
		69	`***********************************************************************/`
		70
		71
		72	`#include "config.h"`
		73	`#include "common_types.h"`
		74	`#include "readglob.h"`
		75	`#include "table_fns.h"`
		76	`#include "basicread.h"`
		77	`#include "install_fns.h"`
		78	`#include "sortmacs.h"`
		79	`#include "expmacs.h"`
		80	`#include "tags.h"`
		81	`#include "main_reads.h"`
		82	`#include "natmacs.h"`
		83	`#include "dg_fns.h"`
		84	`#include "dg_aux.h"`
		85	`#include "dg_globs.h"`
		86	`#include "xalloc.h"`
		87	`#include "toktypes.h"`
		88	`#include "flags.h"`
		89	`#include "externs.h"`
		90
		91
		92	`dg_filename all_files = (dg_filename)0;`
		93	`dg_compilation all_comp_units = (dg_compilation)0;`
		94
		95
		96
		97	`string_list new_string_list`
		98	`PROTO_N ( (n) )`
		99	`PROTO_T ( int n )`
		100	`{`
		101	`string_list ans;`
		102	`ans.len = n;`
		103	`ans.array = (char *)xcalloc(n, sizeof(char ));`
		104	`return ans;`
		105	`}`
		106
		107	`string_list add_string_list`
		108	`PROTO_N ( (list, elem, index) )`
		109	`PROTO_T ( string_list list X string elem X int index )`
		110	`{`
		111	`list.array[index] = elem.ints.chars;`
		112	`return list;`
		113	`}`
		114
		115	`bool_option no_bool_option;`
		116
		117	`bool_option yes_bool_option`
		118	`PROTO_N ( (elem) )`
		119	`PROTO_T ( bool elem )`
		120	`{`
		121	`bool_option res;`
		122	`res.val = elem;`
		123	`res.present = 1;`
		124	`return res;`
		125	`}`
		126
		127	`void init_bool_option`
		128	`PROTO_Z ()`
		129	`{`
		130	`no_bool_option.present = 0;`
		131	`return;`
		132	`}`
		133
		134	`shape_option no_shape_option;`
		135
		136	`shape_option yes_shape_option`
		137	`PROTO_N ( (elem) )`
		138	`PROTO_T ( shape elem )`
		139	`{`
		140	`shape_option res;`
		141	`res.val = elem;`
		142	`res.present = 1;`
		143	`return res;`
		144	`}`
		145
		146	`void init_shape_option`
		147	`PROTO_Z ()`
		148	`{`
		149	`no_shape_option.present = 0;`
		150	`return;`
		151	`}`
		152
		153	`token_option no_token_option;`
		154
		155	`token_option yes_token_option`
		156	`PROTO_N ( (elem) )`
		157	`PROTO_T ( token elem )`
		158	`{`
		159	`token_option res;`
		160	`res.val = elem;`
		161	`res.present = 1;`
		162	`return res;`
		163	`}`
		164
		165	`void init_token_option`
		166	`PROTO_Z ()`
		167	`{`
		168	`no_token_option.present = 0;`
		169	`return;`
		170	`}`
		171
		172
		173
		174	`int unit_no_of_dgtags;`
		175	`dgtag_struct ** unit_ind_dgtags;`
		176	`dgtag_struct * unit_dgtagtab;`
		177
		178
		179	`dg f_dg_apply_token`
		180	`PROTO_N ( (token_value, token_args) )`
		181	`PROTO_T ( token token_value X bitstream token_args )`
		182	`{`
		183	`tokval v;`
		184	`v = apply_tok(token_value, token_args, DG_SORT, (tokval*)0);`
		185	`return v.tk_dg;`
		186	`}`
		187
		188	`dg f_dummy_dg;`
		189
		190	`dg f_make_tag_dg`
		191	`PROTO_N ( (tg, diag) )`
		192	`PROTO_T ( dg_tag tg X dg diag )`
		193	`{`
		194	`if (tg->key) failer ("dg_tag defined twice");`
		195	`tg->key = DGK_INFO;`
		196	`tg->p.info = diag;`
		197	`diag->this_tag = tg;`
		198	`return diag;`
		199	`}`
		200
		201	`dg f_list_dg`
		202	`PROTO_N ( (args) )`
		203	`PROTO_T ( dg_list args )`
		204	`{`
		205	`return args;`
		206	`}`
		207
		208	`dg f_params_dg`
		209	`PROTO_N ( (params, outer_env) )`
		210	`PROTO_T ( dg_name_list params X exp_option outer_env )`
		211	`{`
		212	`dg ans = new_dg_info(DGA_PARAMS);`
		213	`ans->data.i_param.args = params;`
		214	`if (outer_env.present)`
		215	`ans->data.i_param.o_env = diaginfo_exp (outer_env.val);`
		216	`else`
		217	`ans->data.i_param.o_env = nilexp;`
		218	`ans->data.i_param.b_start = 0;`
		219	`return ans;`
		220	`}`
		221
		222	`dg f_source_language_dg`
		223	`PROTO_N ( (language) )`
		224	`PROTO_T ( nat language )`
		225	`{`
		226	`dg ans = new_dg_info(DGA_COMP);`
		227	`ans->data.i_comp.is_tag = 0;`
		228	`ans->data.i_comp.corl.comp_lang = language.nat_val.small_nat;`
		229	`return ans;`
		230	`}`
		231
		232	`dg f_compilation_dg`
		233	`PROTO_N ( (comp_unit) )`
		234	`PROTO_T ( dg_tag comp_unit )`
		235	`{`
		236	`dg ans = new_dg_info(DGA_COMP);`
		237	`ans->data.i_comp.is_tag = 1;`
		238	`ans->data.i_comp.corl.comp_tag = comp_unit;`
		239	`return ans;`
		240	`}`
		241
		242	`dg f_sourcepos_dg`
		243	`PROTO_N ( (span) )`
		244	`PROTO_T ( dg_sourcepos span )`
		245	`{`
		246	`dg ans = new_dg_info(DGA_SRC);`
		247	`ans->data.i_src.is_stmt = 0;`
		248	`ans->data.i_src.startpos = shorten_sourcepos(span);`
		249	`ans->data.i_src.endpos = end_sourcepos(span);`
		250	`return ans;`
		251	`}`
		252
		253	`dg f_name_decl_dg`
		254	`PROTO_N ( (dname) )`
		255	`PROTO_T ( dg_name dname )`
		256	`{`
		257	`dg ans = new_dg_info(DGA_NAME);`
		258	`ans->data.i_nam.dnam = dname;`
		259	`return ans;`
		260	`}`
		261
		262	`dg f_lexical_block_dg`
		263	`PROTO_N ( (idname, src_pos) )`
		264	`PROTO_T ( dg_idname_option idname X dg_sourcepos src_pos )`
		265	`{`
		266	`dg ans = new_dg_info(DGA_SCOPE);`
		267	`ans->data.i_scope.lexname = idname_chars(idname);`
		268	`ans->data.i_scope.lexpos = shorten_sourcepos(src_pos);`
		269	`ans->data.i_scope.endpos = end_sourcepos(src_pos);`
		270	`ans->data.i_scope.begin_st = (long)0;`
		271	`return ans;`
		272	`}`
		273
		274	`dg f_inline_call_dg`
		275	`PROTO_N ( (proc, act_params, call_kind) )`
		276	`PROTO_T ( dg_tag proc X dg_name_list act_params X nat_option call_kind )`
		277	`{`
		278	`dg ans = new_dg_info(DGA_INL_CALL);`
		279	`ans->data.i_inl.proc = proc;`
		280	`ans->data.i_inl.args = act_params;`
		281	`if (call_kind.present)`
		282	`ans->data.i_inl.ck = call_kind.val.nat_val.small_nat;`
		283	`else`
		284	`ans->data.i_inl.ck = 0;`
		285	`ans->data.i_inl.resref = nildiag;`
		286	`proc->any_inl = 1;`
		287	`return ans;`
		288	`}`
		289
		290	`dg f_inline_result_dg`
		291	`PROTO_N ( (inline_id) )`
		292	`PROTO_T ( dg_tag inline_id )`
		293	`{`
		294	`dg ans = new_dg_info(DGA_INL_RES);`
		295	`ans->data.i_res.call = inline_id;`
		296	`ans->data.i_res.res.k = NO_WH;`
		297	`ans->data.i_res.next = (dg_info)0;`
		298	`return ans;`
		299	`}`
		300
		301	`dg f_singlestep_dg`
		302	`PROTO_N ( (src_pos) )`
		303	`PROTO_T ( dg_sourcepos src_pos )`
		304	`{`
		305	`dg ans = new_dg_info(DGA_SRC);`
		306	`ans->data.i_src.is_stmt = 1;`
		307	`ans->data.i_src.startpos = shorten_sourcepos(src_pos);`
		308	`ans->data.i_src.endpos.file = 0;`
		309	`return ans;`
		310	`}`
		311
		312	`dg f_with_dg`
		313	`PROTO_N ( (type, obtain_value) )`
		314	`PROTO_T ( dg_type type X exp obtain_value )`
		315	`{`
		316	`dg ans = new_dg_info(DGA_SRC);`
		317	`ans->data.i_with.w_typ = type;`
		318	`ans->data.i_with.w_exp = diaginfo_exp (obtain_value);`
		319	`return ans;`
		320	`}`
		321
		322	`dg f_exception_scope_dg`
		323	`PROTO_N ( (handlers) )`
		324	`PROTO_T ( dg_tag_list handlers )`
		325	`{`
		326	`dg ans = new_dg_info(DGA_X_TRY);`
		327	`ans->data.i_try.hl = handlers;`
		328	`return ans;`
		329	`}`
		330
		331	`dg f_exception_handler_dg`
		332	`PROTO_N ( (ex) )`
		333	`PROTO_T ( dg_name_option ex )`
		334	`{`
		335	`dg ans = new_dg_info(DGA_X_CATCH);`
		336	`ans->data.i_catch.ex = ex;`
		337	`return ans;`
		338	`}`
		339
		340	`dg f_abortable_part_dg`
		341	`PROTO_N ( (src_pos, no_code) )`
		342	`PROTO_T ( dg_sourcepos src_pos X bool no_code )`
		343	`{`
		344	`dg ans = new_dg_info(DGA_RVS);`
		345	`ans->data.i_rvs.rvs_key = DGR_ABTL;`
		346	`ans->data.i_rvs.n_code = (no_code ? 0 : 2);`
		347	`ans->data.i_rvs.has_iv = 0;`
		348	`ans->data.i_rvs.alt = 0;`
		349	`ans->data.i_rvs.pos = shorten_sourcepos (src_pos);`
		350	`ans->data.i_rvs.u.tg = (dg_tag)0;`
		351	`ans->data.i_rvs.en = (dg_tag)0;`
		352	`return ans;`
		353	`}`
		354
		355	`dg f_accept_dg`
		356	`PROTO_N ( (src_pos, entry, params, no_code, alt) )`
		357	`PROTO_T ( dg_sourcepos src_pos X dg_tag entry X dg_name_list params X`
		358	`bool no_code X dg_tag_option alt )`
		359	`{`
		360	`dg ans = new_dg_info(DGA_RVS);`
		361	`ans->data.i_rvs.rvs_key = DGR_ACC;`
		362	`ans->data.i_rvs.n_code = (no_code ? 0 : 2);`
		363	`ans->data.i_rvs.has_iv = 0;`
		364	`ans->data.i_rvs.alt = (alt ? 1 : 0);`
		365	`ans->data.i_rvs.pos = shorten_sourcepos (src_pos);`
		366	`ans->data.i_rvs.u.tg = alt;`
		367	`ans->data.i_rvs.en = entry;`
		368	`ans->data.i_rvs.u2.p = params;`
		369	`return ans;`
		370	`}`
		371
		372	`dg f_barrier_dg`
		373	`PROTO_N ( (src_pos, entry) )`
		374	`PROTO_T ( dg_sourcepos src_pos X dg_tag entry )`
		375	`{`
		376	`dg ans = new_dg_info(DGA_BAR);`
		377	`ans->data.i_bar.pos = shorten_sourcepos (src_pos);`
		378	`ans->data.i_bar.entry = entry;`
		379	`return ans;`
		380	`}`
		381
		382	`dg f_branch_dg`
		383	`PROTO_N ( (stmt_src_pos) )`
		384	`PROTO_T ( dg_sourcepos stmt_src_pos )`
		385	`{`
		386	`dg ans = new_dg_info(DGA_BRANCH);`
		387	`ans->data.i_brn.pos = shorten_sourcepos(stmt_src_pos);`
		388	`return ans;`
		389	`}`
		390
		391	`dg f_call_dg`
		392	`PROTO_N ( (idname, src_pos, call_kind, module, basetype) )`
		393	`PROTO_T ( dg_idname_option idname X dg_sourcepos src_pos X`
		394	`nat_option call_kind X dg_tag_option module X`
		395	`dg_tag_option basetype )`
		396	`{`
		397	`dg ans = new_dg_info(DGA_CALL);`
		398	`ans->data.i_call.clnam = idname_chars (idname);`
		399	`ans->data.i_call.pos = shorten_sourcepos(src_pos);`
		400	`if (call_kind.present)`
		401	`ans->data.i_call.ck = call_kind.val.nat_val.small_nat;`
		402	`else`
		403	`ans->data.i_call.ck = 0;`
		404	`ans->data.i_call.p.k = NO_WH;`
		405	`UNUSED (module);`
		406	`UNUSED (basetype);`
		407	`return ans;`
		408	`}`
		409
		410	`dg f_destructor_dg`
		411	`PROTO_N ( (whence, obtain_value) )`
		412	`PROTO_T ( dg_sourcepos whence X exp_option obtain_value )`
		413	`{`
		414	`dg ans = new_dg_info(DGA_DEST);`
		415	`ans->data.i_dest.pos = shorten_sourcepos(whence);`
		416	`if (obtain_value.present)`
		417	`ans->data.i_dest.val = diaginfo_exp (obtain_value.val);`
		418	`else`
		419	`ans->data.i_dest.val = nilexp;`
		420	`return ans;`
		421	`}`
		422
		423	`dg f_inlined_dg`
		424	`PROTO_N ( (d, origin) )`
		425	`PROTO_T ( dg d X dg_tag origin )`
		426	`{`
		427	`UNUSED (origin);`
		428	`/* inlined_dg not yet supported */`
		429	`return d;`
		430	`}`
		431
		432	`dg f_jump_dg`
		433	`PROTO_N ( (stmt_src_pos) )`
		434	`PROTO_T ( dg_sourcepos stmt_src_pos )`
		435	`{`
		436	`dg ans = new_dg_info(DGA_JUMP);`
		437	`ans->data.i_tst.pos = shorten_sourcepos(stmt_src_pos);`
		438	`return ans;`
		439	`}`
		440
		441	`dg f_label_dg`
		442	`PROTO_N ( (idname, src_pos) )`
		443	`PROTO_T ( dg_idname idname X dg_sourcepos src_pos )`
		444	`{`
		445	`dg ans = new_dg_info(DGA_LAB);`
		446	`ans->data.i_scope.lexname = idname_chars(idname);`
		447	`ans->data.i_scope.lexpos = shorten_sourcepos(src_pos);`
		448	`return ans;`
		449	`}`
		450
		451	`dg f_long_jump_dg`
		452	`PROTO_N ( (stmt_src_pos) )`
		453	`PROTO_T ( dg_sourcepos stmt_src_pos )`
		454	`{`
		455	`dg ans = new_dg_info(DGA_LJ);`
		456	`ans->data.i_lj.pos = shorten_sourcepos(stmt_src_pos);`
		457	`return ans;`
		458	`}`
		459
		460	`dg f_raise_dg`
		461	`PROTO_N ( (stmt_src_pos, ex, value) )`
		462	`PROTO_T ( dg_sourcepos stmt_src_pos X dg_type_option ex X exp_option value )`
		463	`{`
		464	`dg ans = new_dg_info(DGA_X_RAISE);`
		465	`ans->data.i_raise.pos = shorten_sourcepos(stmt_src_pos);`
		466	`ans->data.i_raise.x_typ = ex;`
		467	`if (value.present)`
		468	`ans->data.i_raise.x_val = diaginfo_exp (value.val);`
		469	`else`
		470	`ans->data.i_raise.x_val = nilexp;`
		471	`return ans;`
		472	`}`
		473
		474	`dg f_requeue_dg`
		475	`PROTO_N ( (stmt_src_pos, entry, with_abort) )`
		476	`PROTO_T ( dg_sourcepos stmt_src_pos X dg_tag entry X bool with_abort )`
		477	`{`
		478	`dg ans = new_dg_info(DGA_RVS);`
		479	`ans->data.i_rvs.rvs_key = DGR_REQUE;`
		480	`ans->data.i_rvs.n_code = 2;`
		481	`ans->data.i_rvs.has_iv = 0;`
		482	`ans->data.i_rvs.alt = 0;`
		483	`ans->data.i_rvs.w_abort = with_abort;`
		484	`ans->data.i_rvs.pos = shorten_sourcepos (stmt_src_pos);`
		485	`ans->data.i_rvs.u.tg = (dg_tag)0;`
		486	`ans->data.i_rvs.en = entry;`
		487	`return ans;`
		488	`}`
		489
		490	`dg f_rts_call_dg`
		491	`PROTO_N ( (src_pos, call_kind, entry, alt) )`
		492	`PROTO_T ( dg_sourcepos src_pos X nat call_kind X`
		493	`dg_tag_option entry X dg_tag_option alt )`
		494	`{`
		495	`dg ans = new_dg_info(DGA_RVS);`
		496	`ans->data.i_rvs.rvs_key = DGR_RTS;`
		497	`ans->data.i_rvs.n_code = 1;`
		498	`ans->data.i_rvs.has_iv = 0;`
		499	`ans->data.i_rvs.alt = (alt ? 1 : 0);`
		500	`ans->data.i_rvs.kind = call_kind.nat_val.small_nat;`
		501	`ans->data.i_rvs.pos = shorten_sourcepos (src_pos);`
		502	`ans->data.i_rvs.u.tg = alt;`
		503	`ans->data.i_rvs.en = entry;`
		504	`return ans;`
		505	`}`
		506
		507	`dg f_select_dg`
		508	`PROTO_N ( (src_pos, async) )`
		509	`PROTO_T ( dg_sourcepos src_pos X bool async )`
		510	`{`
		511	`dg ans = new_dg_info(DGA_RVS);`
		512	`ans->data.i_rvs.rvs_key = DGR_SEL;`
		513	`ans->data.i_rvs.n_code = (async ? 2 : 1);`
		514	`ans->data.i_rvs.has_iv = 0;`
		515	`ans->data.i_rvs.alt = 0;`
		516	`ans->data.i_rvs.async = async;`
		517	`ans->data.i_rvs.pos = shorten_sourcepos (src_pos);`
		518	`ans->data.i_rvs.u.tg = (dg_tag)0;`
		519	`return ans;`
		520	`}`
		521
		522	`dg f_select_alternative_dg`
		523	`PROTO_N ( (src_pos, alt_kind, no_code, alt_value) )`
		524	`PROTO_T ( dg_sourcepos src_pos X nat alt_kind X bool no_code X exp alt_value )`
		525	`{`
		526	`dg ans = new_dg_info(DGA_RVS);`
		527	`ans->data.i_rvs.rvs_key = DGR_ALT;`
		528	`ans->data.i_rvs.n_code = (no_code ? 0 : 2);`
		529	`ans->data.i_rvs.has_iv = 0;`
		530	`ans->data.i_rvs.alt = 0;`
		531	`ans->data.i_rvs.kind = alt_kind.nat_val.small_nat;`
		532	`ans->data.i_rvs.pos = shorten_sourcepos (src_pos);`
		533	`ans->data.i_rvs.u.tg = (dg_tag)0;`
		534	`ans->data.i_rvs.u2.e = diaginfo_exp (alt_value);`
		535	`return ans;`
		536	`}`
		537
		538	`dg f_select_guard_dg`
		539	`PROTO_N ( (src_pos, alt) )`
		540	`PROTO_T ( dg_sourcepos src_pos X dg_tag alt )`
		541	`{`
		542	`dg ans = new_dg_info(DGA_RVS);`
		543	`ans->data.i_rvs.rvs_key = DGR_SGD;`
		544	`ans->data.i_rvs.n_code = 2;`
		545	`ans->data.i_rvs.has_iv = 0;`
		546	`ans->data.i_rvs.alt = (alt ? 1 : 0);`
		547	`ans->data.i_rvs.pos = shorten_sourcepos (src_pos);`
		548	`ans->data.i_rvs.u.tg = alt;`
		549	`return ans;`
		550	`}`
		551
		552	`dg f_statement_part_dg`
		553	`PROTO_N ( (lb) )`
		554	`PROTO_T ( dg_tag lb )`
		555	`{`
		556	`dg ans = new_dg_info(DGA_BEG);`
		557	`ans->data.i_tg = lb;`
		558	`return ans;`
		559	`}`
		560
		561	`dg f_test_dg`
		562	`PROTO_N ( (src_pos, inverted) )`
		563	`PROTO_T ( dg_sourcepos src_pos X bool inverted )`
		564	`{`
		565	`dg ans = new_dg_info(DGA_TEST);`
		566	`ans->data.i_tst.pos = shorten_sourcepos (src_pos);`
		567	`ans->data.i_tst.inv = inverted;`
		568	`return ans;`
		569	`}`
		570
		571	`dg f_triggering_alternative_dg`
		572	`PROTO_N ( (src_pos, alt_kind, no_code) )`
		573	`PROTO_T ( dg_sourcepos src_pos X nat alt_kind X bool no_code )`
		574	`{`
		575	`dg ans = new_dg_info(DGA_RVS);`
		576	`ans->data.i_rvs.rvs_key = DGR_TRIG;`
		577	`ans->data.i_rvs.n_code = (no_code ? 0 : 2);`
		578	`ans->data.i_rvs.has_iv = 0;`
		579	`ans->data.i_rvs.alt = 0;`
		580	`ans->data.i_rvs.kind = alt_kind.nat_val.small_nat;`
		581	`ans->data.i_rvs.pos = shorten_sourcepos (src_pos);`
		582	`ans->data.i_rvs.u.tg = (dg_tag)0;`
		583	`return ans;`
		584	`}`
		585
		586	`void init_dg`
		587	`PROTO_Z ()`
		588	`{`
		589	`return;`
		590	`}`
		591
		592	`dg_comp_props f_dummy_dg_comp_props;`
		593
		594	`dg_comp_props f_make_dg_compunit`
		595	`PROTO_N ( (no_labels, comp_unit, l) )`
		596	`PROTO_T ( tdfint no_labels X dg_compilation comp_unit X dg_append_list l )`
		597	`{`
		598	`UNUSED (no_labels);`
		599	`UNUSED (comp_unit);`
		600	`UNUSED (l);`
		601	`return f_dummy_dg_comp_props; /* dummy, never called */`
		602	`}`
		603
		604	`void init_dg_comp_props`
		605	`PROTO_Z ()`
		606	`{`
		607	`return;`
		608	`}`
		609
		610	`dg_tag f_dummy_dg_tag;`
		611
		612	`dg_tag f_make_dg_tag`
		613	`PROTO_N ( (num) )`
		614	`PROTO_T ( tdfint num )`
		615	`{`
		616	`int index = natint(num);`
		617	`if (index >= unit_no_of_dgtags)`
		618	`failer("make_dg_tag out of range");`
		619	`return unit_ind_dgtags[index];`
		620	`}`
		621
		622	`void init_dg_tag`
		623	`PROTO_Z ()`
		624	`{`
		625	`return;`
		626	`}`
		627
		628	`dg_name f_dummy_dg_name;`
		629
		630	`dg_name f_dg_name_apply_token`
		631	`PROTO_N ( (token_value, token_args) )`
		632	`PROTO_T ( token token_value X bitstream token_args )`
		633	`{`
		634	`tokval v;`
		635	`v = apply_tok(token_value, token_args, DG_NAME_SORT, (tokval*)0);`
		636	`return v.tk_dg_name;`
		637	`}`
		638
		639	`dg_name f_dg_tag_name`
		640	`PROTO_N ( (tg, nam) )`
		641	`PROTO_T ( dg_tag tg X dg_name nam )`
		642	`{`
		643	`if (tg->key) failer ("dg_tag defined twice");`
		644	`tg->key = DGK_NAME;`
		645	`tg->p.nam = nam;`
		646	`if (!nam->mor)`
		647	`extend_dg_name (nam);`
		648	`nam->mor->this_tag = tg;`
		649	`return nam;`
		650	`}`
		651
		652	`dg_name f_dg_object_name`
		653	`PROTO_N ( (idname, whence, type, obtain_value, accessibility) )`
		654	`PROTO_T ( dg_idname idname X dg_sourcepos whence X dg_type type X`
		655	`exp_option obtain_value X dg_accessibility_option accessibility )`
		656	`{`
		657	`dg_name ans = new_dg_name(DGN_OBJECT);`
		658	`ans->idnam = idname;`
		659	`ans->whence = shorten_sourcepos (whence);`
		660	`ans->data.n_obj.typ = type;`
		661	`#ifdef NEWDIAGS`
		662	`if (obtain_value.present) {`
		663	`exp acc = obtain_value.val;`
		664	`ans->data.n_obj.obtain_val = diaginfo_exp (acc);`
		665	`set_obj_ref (ans); /* globals only */`
		666	`#if 0`
		667	`if (name(acc) == cont_tag && name(son(acc)) == name_tag &&`
		668	`isglob(son(son(acc))) && isvar(son(son(acc))))`
		669	`brog(son(son(acc)))->dec_u.dec_val.diag_info = ans;`
		670	`#endif`
		671	`}`
		672	`else`
		673	`ans->data.n_obj.obtain_val = nilexp;`
		674	`#endif`
		675	`if (accessibility != DG_ACC_NONE) {`
		676	`extend_dg_name (ans);`
		677	`ans->mor->acc = accessibility;`
		678	`}`
		679	`return ans;`
		680	`}`
		681
		682	`dg_name f_dg_proc_name`
		683	`PROTO_N ( (idname, whence, type, obtain_value, accessibility,`
		684	`virtuality, isinline, exceptions, elaboration) )`
		685	`PROTO_T ( dg_idname idname X dg_sourcepos whence X dg_type type X`
		686	`exp_option obtain_value X dg_accessibility_option accessibility X`
		687	`dg_virtuality_option virtuality X bool isinline X`
		688	`dg_type_list_option exceptions X dg_tag_option elaboration )`
		689	`{`
		690	`dg_name ans = new_dg_name(DGN_PROC);`
		691	`ans->idnam = idname;`
		692	`ans->whence = shorten_sourcepos (whence);`
		693	`ans->data.n_proc.typ = type;`
		694	`#ifdef NEWDIAGS`
		695	`if (obtain_value.present) {`
		696	`exp acc = obtain_value.val;`
		697	`ans->data.n_proc.obtain_val = diaginfo_exp (acc);`
		698	`if (name(acc) == name_tag && isglob(son(acc)))`
		699	`brog(son(acc))->dec_u.dec_val.diag_info = ans;`
		700	`}`
		701	`else`
		702	`ans->data.n_proc.obtain_val = nilexp;`
		703	`ans->data.n_proc.params = (dg_info)0;`
		704	`if (accessibility != DG_ACC_NONE \|\| virtuality != DG_VIRT_NONE`
		705	`\|\| isinline \|\| extra_diags \|\| elaboration \|\| exceptions.len >= 0) {`
		706	`extend_dg_name (ans);`
		707	`ans->mor->acc = accessibility;`
		708	`ans->mor->virt = virtuality;`
		709	`ans->mor->isinline = isinline;`
		710	`ans->mor->end_pos = end_sourcepos (whence);`
		711	`ans->mor->elabn = elaboration;`
		712	`ans->mor->exptns = exceptions;`
		713	`}`
		714	`#endif`
		715	`return ans;`
		716	`}`
		717
		718	`dg_name f_dg_inlined_name`
		719	`PROTO_N ( (nam, origin) )`
		720	`PROTO_T ( dg_name nam X dg_tag origin )`
		721	`{`
		722	`if (!nam->mor)`
		723	`extend_dg_name (nam);`
		724	`nam->mor->inline_ref = origin;`
		725	`return nam;`
		726	`}`
		727
		728	`dg_name f_dg_constant_name`
		729	`PROTO_N ( (nam) )`
		730	`PROTO_T ( dg_name nam )`
		731	`{`
		732	`if (!nam->mor)`
		733	`extend_dg_name (nam);`
		734	`nam->mor->isconst = 1;`
		735	`return nam;`
		736	`}`
		737
		738	`dg_name f_dg_type_name`
		739	`PROTO_N ( (idname, whence, accessibility, type, new_type,`
		740	`ada_derived, constraints) )`
		741	`PROTO_T ( dg_idname_option idname X dg_sourcepos whence X`
		742	`dg_accessibility_option accessibility X dg_type_option type X`
		743	`bool new_type X bool_option ada_derived X`
		744	`dg_constraint_list_option constraints )`
		745	`{`
		746	`dg_name ans = new_dg_name(DGN_TYPE);`
		747	`ans->idnam = idname;`
		748	`ans->whence = shorten_sourcepos (whence);`
		749	`ans->data.n_typ.raw = type;`
		750	`if (idname.id_key == DG_ID_NONE)`
		751	`ans->data.n_typ.named = type;`
		752	`else`
		753	`ans->data.n_typ.named = (dg_type)0;`
		754	`if (accessibility != DG_ACC_NONE \|\| new_type \|\|`
		755	`(ada_derived.present && ada_derived.val)) {`
		756	`extend_dg_name (ans);`
		757	`ans->mor->acc = accessibility;`
		758	`ans->mor->isnew = new_type;`
		759	`if (ada_derived.present)`
		760	`ans->mor->aderiv = ada_derived.val;`
		761	`}`
		762	`ans->data.n_typ.constraints = constraints;`
		763	`return ans;`
		764	`}`
		765
		766	`dg_name f_dg_subunit_name`
		767	`PROTO_N ( (parent, nam, subunit_kind, accessibility) )`
		768	`PROTO_T ( dg_tag parent X dg_name nam X nat subunit_kind X dg_accessibility_option accessibility )`
		769	`{`
		770	`dg_name ans = new_dg_name(DGN_SUBUNIT);`
		771	`ans->data.n_sub.parent = parent;`
		772	`ans->data.n_sub.sub = nam;`
		773	`switch (subunit_kind.nat_val.small_nat) {`
		774	`case 1: /* SUK_child */`
		775	`ans->data.n_sub.child = 1;`
		776	`ans->data.n_sub.split = 0;`
		777	`break;`
		778	`case 2: /* SUK_separate */`
		779	`ans->data.n_sub.child = 0;`
		780	`ans->data.n_sub.split = 0;`
		781	`ans->data.n_sub.acc = accessibility;`
		782	`break;`
		783	`case 3: /* SUK_split_module */`
		784	`ans->data.n_sub.child = 0;`
		785	`ans->data.n_sub.split = 1;`
		786	`break;`
		787	`default:`
		788	`failer ("unexpected SUK_kind");`
		789	`}`
		790	`return ans;`
		791	`}`
		792
		793	`dg_name f_dg_program_name`
		794	`PROTO_N ( (idname, whence, obtain_value) )`
		795	`PROTO_T ( dg_idname idname X dg_sourcepos whence X exp obtain_value )`
		796	`{`
		797	`dg_name ans = new_dg_name(DGN_PROC);`
		798	`ans->idnam = idname;`
		799	`ans->whence = shorten_sourcepos (whence);`
		800	`ans->data.n_proc.typ = (dg_type)0;`
		801	`ans->data.n_proc.obtain_val = diaginfo_exp (obtain_value);`
		802	`ans->data.n_proc.params = (dg_info)0;`
		803	`extend_dg_name (ans);`
		804	`ans->mor->prognm = 1;`
		805	`return ans;`
		806	`}`
		807
		808	`dg_name f_dg_entry_family_name`
		809	`PROTO_N ( (proc, family) )`
		810	`PROTO_T ( dg_name proc X dg_dim family )`
		811	`{`
		812	`if (!proc->mor)`
		813	`extend_dg_name (proc);`
		814	`proc->mor->en_family = (dg_dim *)xmalloc (sizeof(dg_dim));`
		815	`*(proc->mor->en_family) = family;`
		816	`return proc;`
		817	`}`
		818
		819	`dg_name f_dg_entry_name`
		820	`PROTO_N ( (idname, whence, type, accessibility, family) )`
		821	`PROTO_T ( dg_idname idname X dg_sourcepos whence X dg_type type X`
		822	`dg_accessibility_option accessibility X dg_dim_option family )`
		823	`{`
		824	`dg_name ans = new_dg_name(DGN_ENTRY);`
		825	`ans->idnam = idname;`
		826	`ans->whence = shorten_sourcepos (whence);`
		827	`ans->data.n_proc.typ = type;`
		828	`if (accessibility != DG_ACC_NONE \|\| family.d_key != DG_DIM_NONE) {`
		829	`extend_dg_name (ans);`
		830	`ans->mor->acc = accessibility;`
		831	`if (family.d_key != DG_DIM_NONE) {`
		832	`ans->mor->en_family = (dg_dim *)xmalloc (sizeof(dg_dim));`
		833	`*(ans->mor->en_family) = family;`
		834	`}`
		835	`}`
		836	`return ans;`
		837	`}`
		838
		839	`dg_name f_dg_is_spec_name`
		840	`PROTO_N ( (nam, is_separate) )`
		841	`PROTO_T ( dg_name nam X bool_option is_separate )`
		842	`{`
		843	`if (!nam->mor)`
		844	`extend_dg_name (nam);`
		845	`nam->mor->isspec = 1;`
		846	`if (is_separate.present && is_separate.val)`
		847	`nam->mor->issep = 1;`
		848	`return nam;`
		849	`}`
		850
		851
		852	`dg_name f_dg_module_name`
		853	`PROTO_N ( (idname, whence, memlist, init, elaboration) )`
		854	`PROTO_T ( dg_idname idname X dg_sourcepos whence X dg_namelist memlist X`
		855	`exp_option init X dg_tag_option elaboration )`
		856	`{`
		857	`dg_name ans = new_dg_name(DGN_MODULE);`
		858	`ans->idnam = idname;`
		859	`ans->whence = shorten_sourcepos (whence);`
		860	`ans->data.n_mod.members = memlist.list;`
		861	`#ifdef NEWDIAGS`
		862	`if (memlist.tg)`
		863	`memlist.tg->p.nl = &(ans->data.n_mod.members);`
		864	`if (init.present) {`
		865	`exp acc = init.val;`
		866	`ans->data.n_mod.init = diaginfo_exp (acc);`
		867	`if (name(acc) == name_tag && isglob(son(acc)))`
		868	`brog(son(acc))->dec_u.dec_val.diag_info = ans;`
		869	`}`
		870	`else`
		871	`ans->data.n_mod.init = nilexp;`
		872	`#endif`
		873	`if (elaboration) {`
		874	`extend_dg_name (ans);`
		875	`ans->mor->elabn = elaboration;`
		876	`}`
		877	`return ans;`
		878	`}`
		879
		880	`dg_name f_dg_namespace_name`
		881	`PROTO_N ( (idname, whence, members) )`
		882	`PROTO_T ( dg_idname idname X dg_sourcepos whence X dg_namelist members )`
		883	`{`
		884	`dg_name ans = new_dg_name(DGN_NSP);`
		885	`ans->idnam = idname;`
		886	`ans->whence = shorten_sourcepos (whence);`
		887	`ans->data.n_mod.members = members.list;`
		888	`if (members.tg)`
		889	`members.tg->p.nl = &(ans->data.n_mod.members);`
		890	`ans->data.n_mod.init = nilexp;`
		891	`return ans;`
		892	`}`
		893
		894	`dg_name f_dg_rep_clause_name`
		895	`PROTO_N ( (item, location) )`
		896	`PROTO_T ( dg_name item X exp location )`
		897	`{`
		898	`if (!item->mor)`
		899	`extend_dg_name (item);`
		900	`item->mor->repn = diaginfo_exp (location);`
		901	`return item;`
		902	`}`
		903
		904	`dg_name f_dg_spec_ref_name`
		905	`PROTO_N ( (specification, nam) )`
		906	`PROTO_T ( dg_tag specification X dg_name nam )`
		907	`{`
		908	`if (!nam->mor)`
		909	`extend_dg_name (nam);`
		910	`nam->mor->refspec = specification;`
		911	`return nam;`
		912	`}`
		913
		914	`dg_name f_dg_visibility_name`
		915	`PROTO_N ( (dname, import_kind, idname, src_pos, accessibility, type) )`
		916	`PROTO_T ( dg_tag dname X nat import_kind X dg_idname_option idname X`
		917	`dg_sourcepos_option src_pos X`
		918	`dg_accessibility_option accessibility X dg_type_option type )`
		919	`{`
		920	`dg_name ans = new_dg_name(DGN_IMPORT);`
		921	`ans->idnam = idname;`
		922	`ans->whence = shorten_sourcepos (src_pos);`
		923	`ans->data.n_imp.import = dname;`
		924	`ans->data.n_imp.ik = import_kind.nat_val.small_nat;`
		925	`if (accessibility != DG_ACC_NONE ) {`
		926	`extend_dg_name (ans);`
		927	`ans->mor->acc = accessibility;`
		928	`}`
		929	`ans->data.n_imp.i_typ = type;`
		930	`return ans;`
		931	`}`
		932
		933	`void init_dg_name`
		934	`PROTO_Z ()`
		935	`{`
		936	`return;`
		937	`}`
		938
		939	`dg_type f_dummy_dg_type;`
		940
		941	`dg_type f_dg_type_apply_token`
		942	`PROTO_N ( (token_value, token_args) )`
		943	`PROTO_T ( token token_value X bitstream token_args )`
		944	`{`
		945	`tokval v;`
		946	`v = apply_tok(token_value, token_args, DG_TYPE_SORT, (tokval*)0);`
		947	`return v.tk_dg_type;`
		948	`}`
		949
		950	`dg_type f_dg_tag_type`
		951	`PROTO_N ( (tg, type) )`
		952	`PROTO_T ( dg_tag tg X dg_type type )`
		953	`{`
		954	`if (tg->key && tg->key != DGK_TYPE) failer ("dg_tag defined twice");`
		955	`tg->key = DGK_TYPE;`
		956	`tg->p.typ = type;`
		957	`return type;`
		958	`}`
		959
		960	`dg_type f_dg_named_type`
		961	`PROTO_N ( (dname) )`
		962	`PROTO_T ( dg_tag dname )`
		963	`{`
		964	`dg_type ans;`
		965	`if (dname->key == DGK_TYPE)`
		966	`return dname->p.typ;`
		967	`if (dname->key == DGK_NAME && dname->p.nam->key == DGN_TYPE`
		968	`&& dname->p.nam->data.n_typ.named)`
		969	`return dname->p.nam->data.n_typ.named;`
		970	`ans = new_dg_type(DGT_TAGGED);`
		971	`ans->data.t_tag = dname;`
		972	`if (dname->key == DGK_NONE && dname->outref.k == LAB_STR) {`
		973	`dname->key = DGK_TYPE;`
		974	`dname->p.typ = ans;`
		975	`ans->outref = dname->outref;`
		976	`}`
		977	`else`
		978	`if (dname->key == DGK_NAME && dname->p.nam->key == DGN_TYPE)`
		979	`dname->p.nam->data.n_typ.named = ans;`
		980	`return ans;`
		981	`}`
		982
		983	`dg_type f_dg_is_spec_type`
		984	`PROTO_N ( (type) )`
		985	`PROTO_T ( dg_type type )`
		986	`{`
		987	`if (!type->mor)`
		988	`extend_dg_type (type);`
		989	`type->mor->isspec = 1;`
		990	`return type;`
		991	`}`
		992
		993	`dg_type f_dg_spec_ref_type`
		994	`PROTO_N ( (specification, type) )`
		995	`PROTO_T ( dg_tag specification X dg_type type )`
		996	`{`
		997	`if (!type->mor)`
		998	`extend_dg_type (type);`
		999	`type->mor->refspec = specification;`
		1000	`return type;`
		1001	`}`
		1002
		1003	`dg_type f_dg_modular_type`
		1004	`PROTO_N ( (rep_type, size) )`
		1005	`PROTO_T ( dg_type rep_type X exp size )`
		1006	`{`
		1007	`dg_type ans = new_dg_type(DGT_MOD);`
		1008	`ans->data.t_adanum.rept = rep_type;`
		1009	`ans->data.t_adanum.digits = diaginfo_exp (size);`
		1010	`return ans;`
		1011	`}`
		1012
		1013	`dg_type f_dg_qualified_type`
		1014	`PROTO_N ( (qualifier, type) )`
		1015	`PROTO_T ( dg_qualifier qualifier X dg_type type )`
		1016	`{`
		1017	`return get_qual_dg_type (qualifier, type);`
		1018	`}`
		1019
		1020	`dg_type f_dg_pointer_type`
		1021	`PROTO_N ( (type, heap_only) )`
		1022	`PROTO_T ( dg_type type X bool_option heap_only )`
		1023	`{`
		1024	`if (heap_only.present && heap_only.val)`
		1025	`return get_qual_dg_type (DG_HPPTR_T, type);`
		1026	`return get_qual_dg_type (DG_PTR_T, type);`
		1027	`}`
		1028
		1029	`dg_type f_dg_reference_type`
		1030	`PROTO_N ( (type) )`
		1031	`PROTO_T ( dg_type type )`
		1032	`{`
		1033	`return get_qual_dg_type (DG_REF_T, type);`
		1034	`}`
		1035
		1036	`dg_type f_dg_packed_type`
		1037	`PROTO_N ( (type, sha) )`
		1038	`PROTO_T ( dg_type type X shape sha )`
		1039	`{`
		1040	`UNUSED (sha);`
		1041	`return get_qual_dg_type (DG_PACK_T, type);`
		1042	`}`
		1043
		1044	`dg_type f_dg_array_type`
		1045	`PROTO_N ( (element_type, stride, row_major, dimensions) )`
		1046	`PROTO_T ( dg_type element_type X exp stride X bool_option row_major X`
		1047	`dg_dim_list dimensions )`
		1048	`{`
		1049	`dg_type ans = new_dg_type(DGT_ARRAY);`
		1050	`ans->data.t_arr.elem_type = element_type;`
		1051	`ans->data.t_arr.stride = diaginfo_exp (stride);`
		1052	`ans->data.t_arr.rowm = (row_major.present ? row_major.val : 1);`
		1053	`ans->data.t_arr.dims = dimensions;`
		1054	`return ans;`
		1055	`}`
		1056
		1057	`dg_type f_dg_bitfield_type`
		1058	`PROTO_N ( (type, bv, sha) )`
		1059	`PROTO_T ( dg_type type X bitfield_variety bv X shape sha )`
		1060	`{`
		1061	`return get_dg_bitfield_type (type, sha, bv);`
		1062	`}`
		1063
		1064	`dg_type f_dg_enum_type`
		1065	`PROTO_N ( (values, tagname, src_pos, sha, new_type) )`
		1066	`PROTO_T ( dg_enum_list values X dg_idname_option tagname X`
		1067	`dg_sourcepos_option src_pos X shape sha X bool new_type )`
		1068	`{`
		1069	`dg_type ans = new_dg_type(DGT_ENUM);`
		1070	`ans->data.t_enum.tnam = idname_chars (tagname);`
		1071	`ans->data.t_enum.tpos = shorten_sourcepos (src_pos);`
		1072	`ans->data.t_enum.values = values;`
		1073	`ans->data.t_enum.sha = sha;`
		1074	`if (new_type) {`
		1075	`extend_dg_type (ans);`
		1076	`ans->mor->isnew = new_type;`
		1077	`}`
		1078	`return ans;`
		1079	`}`
		1080
		1081	`dg_type f_dg_string_type`
		1082	`PROTO_N ( (character_type, lower_bound, length) )`
		1083	`PROTO_T ( dg_tag character_type X exp lower_bound X exp length )`
		1084	`{`
		1085	`dg_type ans = new_dg_type(DGT_STRING);`
		1086	`ans->data.t_string.ct = character_type;`
		1087	`ans->data.t_string.lb = diaginfo_exp (lower_bound);`
		1088	`ans->data.t_string.length = diaginfo_exp (length);`
		1089	`return ans;`
		1090	`}`
		1091
		1092	`dg_type f_dg_struct_type`
		1093	`PROTO_N ( (fields, sha, tagname, src_pos, varpart, is_union, new_type) )`
		1094	`PROTO_T ( dg_classmem_list fields X shape_option sha X`
		1095	`dg_idname_option tagname X dg_sourcepos_option src_pos X`
		1096	`dg_varpart_option varpart X bool is_union X bool new_type )`
		1097	`{`
		1098	`dg_type ans = new_dg_type(DGT_STRUCT);`
		1099	`ans->data.t_struct.idnam = tagname;`
		1100	`ans->data.t_struct.tpos = shorten_sourcepos (src_pos);`
		1101	`ans->data.t_struct.is_union = is_union;`
		1102	`if (sha.present)`
		1103	`ans->data.t_struct.sha = sha.val;`
		1104	`else`
		1105	`ans->data.t_struct.sha = (shape)0;`
		1106	`ans->data.t_struct.u.fields = fields;`
		1107	`if (new_type) {`
		1108	`extend_dg_type (ans);`
		1109	`ans->mor->isnew = new_type;`
		1110	`}`
		1111	`ans->data.t_struct.vpart = varpart;`
		1112	`return ans;`
		1113	`}`
		1114
		1115	`dg_type f_dg_void_type = (dg_type)0;`
		1116
		1117	`dg_type f_dg_set_type`
		1118	`PROTO_N ( (element_type, sha) )`
		1119	`PROTO_T ( dg_type element_type X shape sha )`
		1120	`{`
		1121	`dg_type ans = new_dg_type(DGT_CONS);`
		1122	`ans->data.t_cons.c_key = DG_SET_T;`
		1123	`ans->data.t_cons.typ = element_type;`
		1124	`ans->data.t_cons.sha = sha;`
		1125	`return ans;`
		1126	`}`
		1127
		1128	`dg_type f_dg_subrange_type`
		1129	`PROTO_N ( (rep_type, low, high) )`
		1130	`PROTO_T ( dg_type rep_type X dg_bound low X dg_bound high )`
		1131	`{`
		1132	`dg_type ans = new_dg_type(DGT_SUBR);`
		1133	`ans->data.t_subr.d_key = DG_DIM_BOUNDS;`
		1134	`ans->data.t_subr.low_ref = low.is_ref;`
		1135	`ans->data.t_subr.hi_ref = high.is_ref;`
		1136	`ans->data.t_subr.hi_cnt = 0;`
		1137	`ans->data.t_subr.count = -1;`
		1138	`ans->data.t_subr.d_typ = rep_type;`
		1139	`ans->data.t_subr.sha = low.sha;`
		1140	`ans->data.t_subr.lower = low.u;`
		1141	`ans->data.t_subr.upper = high.u;`
		1142	`return ans;`
		1143	`}`
		1144
		1145	`dg_type f_dg_proc_type`
		1146	`PROTO_N ( (params, result_type, prototype, call_convention,`
		1147	`language, prcprops) )`
		1148	`PROTO_T ( dg_param_list params X dg_type result_type X`
		1149	`bool_option prototype X nat_option call_convention X`
		1150	`nat_option language X procprops_option prcprops )`
		1151	`{`
		1152	`dg_type ans = new_dg_type(DGT_PROC);`
		1153	`ans->data.t_proc.params = params;`
		1154	`ans->data.t_proc.res_type = result_type;`
		1155	`ans->data.t_proc.prps = prcprops;`
		1156	`if (prototype.present) {`
		1157	`ans->data.t_proc.knowpro = 1;`
		1158	`ans->data.t_proc.yespro = prototype.val;`
		1159	`}`
		1160	`else`
		1161	`ans->data.t_proc.knowpro = 0;`
		1162	`if (call_convention.present)`
		1163	`ans->data.t_proc.ccv = (unsigned) call_convention.val.nat_val.small_nat;`
		1164	`else`
		1165	`ans->data.t_proc.ccv = 0;`
		1166	`if (language.present)`
		1167	`ans->data.t_proc.lang = (unsigned) language.val.nat_val.small_nat;`
		1168	`else`
		1169	`ans->data.t_proc.lang = 0;`
		1170	`return ans;`
		1171	`}`
		1172
		1173	`dg_type f_dg_file_type`
		1174	`PROTO_N ( (elem_type, sha) )`
		1175	`PROTO_T ( dg_type elem_type X shape sha )`
		1176	`{`
		1177	`dg_type ans = new_dg_type(DGT_CONS);`
		1178	`ans->data.t_cons.c_key = DG_FILE_T;`
		1179	`ans->data.t_cons.typ = elem_type;`
		1180	`ans->data.t_cons.sha = sha;`
		1181	`return ans;`
		1182	`}`
		1183
		1184	`dg_type f_dg_class_type`
		1185	`PROTO_N ( (inheritance, members, varpart, friends, sha, vtable_static,`
		1186	`vtable_dynamic, tagname, src_pos, is_union, rtti_static,`
		1187	`rtti_dynamic, new_type, ada_derived) )`
		1188	`PROTO_T ( dg_class_base_list inheritance X dg_classmem_list members X`
		1189	`dg_varpart_option varpart X dg_tag_list friends X`
		1190	`shape_option sha X dg_tag_option vtable_static X`
		1191	`dg_tag_option vtable_dynamic X dg_idname_option tagname X`
		1192	`dg_sourcepos_option src_pos X bool is_union X`
		1193	`dg_tag_option rtti_static X dg_tag_option rtti_dynamic X`
		1194	`bool new_type X bool_option ada_derived )`
		1195	`{`
		1196	`dg_type ans = new_dg_type(DGT_CLASS);`
		1197	`ans->data.t_struct.idnam = tagname;`
		1198	`ans->data.t_struct.tpos = shorten_sourcepos (src_pos);`
		1199	`ans->data.t_struct.is_union = is_union;`
		1200	`if (sha.present)`
		1201	`ans->data.t_struct.sha = sha.val;`
		1202	`else`
		1203	`ans->data.t_struct.sha = (shape)0;`
		1204	`ans->data.t_struct.u.cd = (class_data *)xmalloc (sizeof(class_data));`
		1205	`if (new_type \|\| (ada_derived.present && ada_derived.val)) {`
		1206	`extend_dg_type (ans);`
		1207	`ans->mor->isnew = new_type;`
		1208	`if (ada_derived.present)`
		1209	`ans->mor->aderiv = ada_derived.val;`
		1210	`}`
		1211	`ans->data.t_struct.u.cd->inherits = inheritance;`
		1212	`ans->data.t_struct.u.cd->members = members;`
		1213	`ans->data.t_struct.u.cd->friends = friends;`
		1214	`ans->data.t_struct.u.cd->vt_s = vtable_static;`
		1215	`ans->data.t_struct.u.cd->vt_d = vtable_dynamic;`
		1216	`ans->data.t_struct.u.cd->rtti_s = rtti_static;`
		1217	`ans->data.t_struct.u.cd->rtti_d = rtti_dynamic;`
		1218	`ans->data.t_struct.vpart = varpart;`
		1219	`return ans;`
		1220	`}`
		1221
		1222	`dg_type f_dg_ptr_memdata_type`
		1223	`PROTO_N ( (cls, memtype, sha, pdm_type) )`
		1224	`PROTO_T ( dg_tag cls X dg_type memtype X shape sha X dg_tag_option pdm_type )`
		1225	`{`
		1226	`dg_type ans = new_dg_type(DGT_PMEM);`
		1227	`ans->data.t_pmem.pclass = cls;`
		1228	`ans->data.t_pmem.memtyp = memtype;`
		1229	`ans->data.t_pmem.sha = sha;`
		1230	`UNUSED (pdm_type);`
		1231	`return ans;`
		1232	`}`
		1233
		1234	`dg_type f_dg_ptr_memfn_type`
		1235	`PROTO_N ( (cls, memtype, sha, pfn_type) )`
		1236	`PROTO_T ( dg_tag cls X dg_type memtype X shape sha X dg_tag_option pfn_type )`
		1237	`{`
		1238	`dg_type ans = new_dg_type(DGT_PMEM);`
		1239	`ans->data.t_pmem.pclass = cls;`
		1240	`ans->data.t_pmem.memtyp = memtype;`
		1241	`ans->data.t_pmem.sha = sha;`
		1242	`UNUSED (pfn_type);`
		1243	`return ans;`
		1244	`}`
		1245
		1246	`dg_type f_dg_task_type`
		1247	`PROTO_N ( (idname, whence, entries, task_id, tcb, members, varpart,`
		1248	`sha, new_type, elaboration) )`
		1249	`PROTO_T ( dg_idname idname X dg_sourcepos whence X dg_name_list entries X`
		1250	`dg_tag task_id X dg_tag tcb X dg_classmem_list members X`
		1251	`dg_varpart_option varpart X shape_option sha X`
		1252	`bool new_type X dg_tag_option elaboration )`
		1253	`{`
		1254	`dg_type ans = new_dg_type(DGT_A_TASK);`
		1255	`ans->data.t_struct.idnam = idname;`
		1256	`ans->data.t_struct.tpos = shorten_sourcepos (whence);`
		1257	`ans->data.t_struct.is_union = 0;`
		1258	`if (sha.present)`
		1259	`ans->data.t_struct.sha = sha.val;`
		1260	`else`
		1261	`ans->data.t_struct.sha = (shape)0;`
		1262	`ans->data.t_struct.u.td = (task_data *)xmalloc (sizeof(task_data));`
		1263	`if (new_type \|\| elaboration) {`
		1264	`extend_dg_type (ans);`
		1265	`ans->mor->isnew = new_type;`
		1266	`ans->mor->elabn = elaboration;`
		1267	`}`
		1268	`ans->data.t_struct.u.td->entries = entries;`
		1269	`ans->data.t_struct.u.td->id = task_id;`
		1270	`ans->data.t_struct.u.td->cb = tcb;`
		1271	`ans->data.t_struct.u.td->members = members;`
		1272	`ans->data.t_struct.vpart = varpart;`
		1273	`return ans;`
		1274	`}`
		1275
		1276	`dg_type f_dg_address_type`
		1277	`PROTO_N ( (idname, sha) )`
		1278	`PROTO_T ( dg_idname idname X shape sha )`
		1279	`{`
		1280	`dg_type ans = new_dg_type(DGT_BASIC);`
		1281	`ans->data.t_bas.b_key = DG_ADR_T;`
		1282	`ans->data.t_bas.tnam = idname_chars (idname);`
		1283	`ans->data.t_bas.b_sh = sha;`
		1284	`return ans;`
		1285	`}`
		1286
		1287	`dg_type f_dg_boolean_type`
		1288	`PROTO_N ( (idname, var) )`
		1289	`PROTO_T ( dg_idname idname X variety var )`
		1290	`{`
		1291	`dg_type ans = new_dg_type(DGT_BASIC);`
		1292	`ans->data.t_bas.b_key = DG_BOOL_T;`
		1293	`ans->data.t_bas.tnam = idname_chars (idname);`
		1294	`ans->data.t_bas.b_sh = f_integer (var);`
		1295	`return ans;`
		1296	`}`
		1297
		1298	`dg_type f_dg_complex_float_type`
		1299	`PROTO_N ( (idname, var) )`
		1300	`PROTO_T ( dg_idname idname X floating_variety var )`
		1301	`{`
		1302	`dg_type ans = new_dg_type(DGT_BASIC);`
		1303	`ans->data.t_bas.b_key = DG_FLOAT_T;`
		1304	`ans->data.t_bas.tnam = idname_chars (idname);`
		1305	`ans->data.t_bas.b_sh = f_floating (var);`
		1306	`return ans;`
		1307	`}`
		1308
		1309	`dg_type f_dg_float_type`
		1310	`PROTO_N ( (idname, var) )`
		1311	`PROTO_T ( dg_idname idname X floating_variety var )`
		1312	`{`
		1313	`dg_type ans = new_dg_type(DGT_BASIC);`
		1314	`ans->data.t_bas.b_key = DG_FLOAT_T;`
		1315	`ans->data.t_bas.tnam = idname_chars (idname);`
		1316	`ans->data.t_bas.b_sh = f_floating (var);`
		1317	`return ans;`
		1318	`}`
		1319
		1320	`dg_type f_dg_floating_digits_type`
		1321	`PROTO_N ( (rep_type, digits) )`
		1322	`PROTO_T ( dg_type rep_type X exp digits )`
		1323	`{`
		1324	`dg_type ans = new_dg_type(DGT_FLDIG);`
		1325	`ans->data.t_adanum.rept = rep_type;`
		1326	`ans->data.t_adanum.digits = diaginfo_exp (digits);`
		1327	`return ans;`
		1328	`}`
		1329
		1330	`dg_type f_dg_fixed_point_type`
		1331	`PROTO_N ( (rep_type, small, delta, digits) )`
		1332	`PROTO_T ( dg_type rep_type X exp small X exp_option delta X exp_option digits )`
		1333	`{`
		1334	`dg_type ans = new_dg_type(DGT_FIXED);`
		1335	`ans->data.t_adanum.rept = rep_type;`
		1336	`ans->data.t_adanum.small = diaginfo_exp (small);`
		1337	`if (delta.present)`
		1338	`ans->data.t_adanum.delta = diaginfo_exp (delta.val);`
		1339	`else`
		1340	`ans->data.t_adanum.delta = nilexp;`
		1341	`if (digits.present)`
		1342	`ans->data.t_adanum.digits = diaginfo_exp (digits.val);`
		1343	`else`
		1344	`ans->data.t_adanum.digits = nilexp;`
		1345	`return ans;`
		1346	`}`
		1347
		1348	`dg_type f_dg_integer_type`
		1349	`PROTO_N ( (idname, var) )`
		1350	`PROTO_T ( dg_idname idname X variety var )`
		1351	`{`
		1352	`dg_type ans = new_dg_type(DGT_BASIC);`
		1353	`ans->data.t_bas.b_key = DG_INT_T;`
		1354	`ans->data.t_bas.tnam = idname_chars (idname);`
		1355	`ans->data.t_bas.b_sh = f_integer (var);`
		1356	`return ans;`
		1357	`}`
		1358
		1359	`dg_type f_dg_char_type`
		1360	`PROTO_N ( (idname, var) )`
		1361	`PROTO_T ( dg_idname idname X variety var )`
		1362	`{`
		1363	`dg_type ans = new_dg_type(DGT_BASIC);`
		1364	`ans->data.t_bas.b_key = DG_CHAR_T;`
		1365	`ans->data.t_bas.tnam = idname_chars (idname);`
		1366	`ans->data.t_bas.b_sh = f_integer (var);`
		1367	`return ans;`
		1368	`}`
		1369
		1370	`dg_type f_dg_inlined_type`
		1371	`PROTO_N ( (type, origin) )`
		1372	`PROTO_T ( dg_type type X dg_tag origin )`
		1373	`{`
		1374	`if (!type->mor)`
		1375	`extend_dg_type (type);`
		1376	`type->mor->inline_ref = origin;`
		1377	`return type;`
		1378	`}`
		1379
		1380	`dg_type f_dg_synchronous_type`
		1381	`PROTO_N ( (idname, whence, entries, socb, members, varpart, sha,`
		1382	`new_type, elaboration) )`
		1383	`PROTO_T ( dg_idname idname X dg_sourcepos whence X dg_name_list entries X`
		1384	`dg_tag socb X dg_classmem_list members X`
		1385	`dg_varpart_option varpart X shape_option sha X bool new_type X`
		1386	`dg_tag_option elaboration )`
		1387	`{`
		1388	`dg_type ans = new_dg_type(DGT_A_SYNCH);`
		1389	`ans->data.t_struct.idnam = idname;`
		1390	`ans->data.t_struct.tpos = shorten_sourcepos (whence);`
		1391	`ans->data.t_struct.is_union = 0;`
		1392	`if (sha.present)`
		1393	`ans->data.t_struct.sha = sha.val;`
		1394	`else`
		1395	`ans->data.t_struct.sha = (shape)0;`
		1396	`ans->data.t_struct.u.td = (task_data *)xmalloc (sizeof(task_data));`
		1397	`if (new_type \|\| elaboration) {`
		1398	`extend_dg_type (ans);`
		1399	`ans->mor->isnew = new_type;`
		1400	`ans->mor->elabn = elaboration;`
		1401	`}`
		1402	`ans->data.t_struct.u.td->entries = entries;`
		1403	`ans->data.t_struct.u.td->id = (dg_tag)0;`
		1404	`ans->data.t_struct.u.td->cb = socb;`
		1405	`ans->data.t_struct.u.td->members = members;`
		1406	`ans->data.t_struct.vpart = varpart;`
		1407	`return ans;`
		1408	`}`
		1409
		1410
		1411	`dg_type f_dg_unknown_type`
		1412	`PROTO_N ( (sha) )`
		1413	`PROTO_T ( shape sha )`
		1414	`{`
		1415	`dg_type ans = new_dg_type(DGT_UNKNOWN);`
		1416	`UNUSED (sha);`
		1417	`return ans;`
		1418	`}`
		1419
		1420	`void init_dg_type`
		1421	`PROTO_Z ()`
		1422	`{`
		1423	`return;`
		1424	`}`
		1425
		1426	`dg_class_base f_dummy_dg_class_base;`
		1427
		1428	`dg_class_base f_make_dg_class_base`
		1429	`PROTO_N ( (base, whence, location, accessibility, virtuality) )`
		1430	`PROTO_T ( dg_tag base X dg_sourcepos_option whence X`
		1431	`token_option location X dg_accessibility_option accessibility X`
		1432	`dg_virtuality_option virtuality )`
		1433	`{`
		1434	`dg_class_base ans;`
		1435	`ans.base = base;`
		1436	`ans.pos = shorten_sourcepos (whence);`
		1437	`if (location.present) {`
		1438	`shape ptr_sh = f_pointer (f_alignment (ulongsh));`
		1439	`ans.location = relative_exp (ptr_sh, location.val);`
		1440	`}`
		1441	`else`
		1442	`ans.location = nilexp;`
		1443	`ans.acc = accessibility;`
		1444	`ans.virt = virtuality;`
		1445	`return ans;`
		1446	`}`
		1447
		1448	`void init_dg_class_base`
		1449	`PROTO_Z ()`
		1450	`{`
		1451	`return;`
		1452	`}`
		1453
		1454	`dg_classmem f_dummy_dg_classmem;`
		1455
		1456	`dg_classmem f_dg_tag_classmem`
		1457	`PROTO_N ( (tg, mem) )`
		1458	`PROTO_T ( dg_tag tg X dg_classmem mem )`
		1459	`{`
		1460	`if (tg->key) failer ("dg_tag defined twice");`
		1461	`tg->key = DGK_CLASSMEM;`
		1462	`mem.tg = tg;`
		1463	`return mem;`
		1464	`}`
		1465
		1466	`dg_classmem f_dg_field_classmem`
		1467	`PROTO_N ( (idname, src_pos, offset, field_type, accessibility,`
		1468	`discr, deflt) )`
		1469	`PROTO_T ( dg_idname idname X dg_sourcepos src_pos X exp offset X`
		1470	`dg_type field_type X dg_accessibility_option accessibility X`
		1471	`bool_option discr X dg_default_option deflt )`
		1472	`{`
		1473	`int is_discr = 0;`
		1474	`dg_classmem ans;`
		1475	`ans.cm_key = DG_CM_FIELD;`
		1476	`ans.d.cm_f.fnam = idname_chars (idname);`
		1477	`ans.d.cm_f.f_pos = shorten_sourcepos (src_pos);`
		1478	`ans.d.cm_f.f_typ = field_type;`
		1479	`ans.d.cm_f.f_offset = diaginfo_exp (offset);`
		1480	`ans.d.cm_f.acc = accessibility;`
		1481	`if (discr.present)`
		1482	`is_discr = discr.val;`
		1483	`ans.d.cm_f.discr = is_discr;`
		1484	`ans.d.cm_f.dflt = deflt;`
		1485	`ans.tg = (dg_tag)0;`
		1486	`return ans;`
		1487	`}`
		1488
		1489	`dg_classmem f_dg_function_classmem`
		1490	`PROTO_N ( (fn, vtable_slot) )`
		1491	`PROTO_T ( dg_name fn X exp_option vtable_slot )`
		1492	`{`
		1493	`dg_classmem ans;`
		1494	`ans.cm_key = DG_CM_FN;`
		1495	`ans.d.cm_fn.fn = fn;`
		1496	`if (vtable_slot.present)`
		1497	`ans.d.cm_fn.slot = diaginfo_exp (vtable_slot.val);`
		1498	`else`
		1499	`ans.d.cm_fn.slot = nilexp;`
		1500	`ans.tg = (dg_tag)0;`
		1501	`return ans;`
		1502	`}`
		1503
		1504	`dg_classmem f_dg_indirect_classmem`
		1505	`PROTO_N ( (idname, src_pos, location, cmem_type) )`
		1506	`PROTO_T ( dg_idname idname X dg_sourcepos src_pos X token location X`
		1507	`dg_type cmem_type )`
		1508	`{`
		1509	`dg_classmem ans;`
		1510	`ans.cm_key = DG_CM_INDIRECT;`
		1511	`ans.d.cm_ind.nam = idname_chars (idname);`
		1512	`ans.d.cm_ind.pos = shorten_sourcepos (src_pos);`
		1513	`ans.d.cm_ind.typ = cmem_type;`
		1514	`ans.d.cm_ind.ind_loc = relative_exp (f_pointer (f_alignment (ulongsh)), location);`
		1515	`ans.tg = (dg_tag)0;`
		1516	`return ans;`
		1517	`}`
		1518
		1519	`dg_classmem f_dg_name_classmem`
		1520	`PROTO_N ( (nam) )`
		1521	`PROTO_T ( dg_name nam )`
		1522	`{`
		1523	`dg_classmem ans;`
		1524	`ans.cm_key = DG_CM_STAT;`
		1525	`ans.d.cm_stat = nam;`
		1526	`ans.tg = (dg_tag)0;`
		1527	`return ans;`
		1528	`}`
		1529
		1530	`void init_dg_classmem`
		1531	`PROTO_Z ()`
		1532	`{`
		1533	`return;`
		1534	`}`
		1535
		1536	`dg_qualifier f_dummy_dg_qualifier;`
		1537
		1538	`dg_qualifier f_dg_const_qualifier = DG_CONST_T;`
		1539
		1540	`dg_qualifier f_dg_volatile_qualifier = DG_VOL_T;`
		1541
		1542	`dg_qualifier f_dg_aliased_qualifier = DG_ALIAS_T;`
		1543
		1544	`dg_qualifier f_dg_class_wide_qualifier = DG_CLWID_T;`
		1545
		1546	`dg_qualifier f_dg_limited_qualifier = DG_LIM_T;`
		1547
		1548	`void init_dg_qualifier`
		1549	`PROTO_Z ()`
		1550	`{`
		1551	`return;`
		1552	`}`
		1553
		1554	`dg_bound f_dummy_dg_bound;`
		1555
		1556	`dg_bound f_dg_dynamic_bound`
		1557	`PROTO_N ( (bound, sha) )`
		1558	`PROTO_T ( dg_tag bound X shape sha )`
		1559	`{`
		1560	`dg_bound ans;`
		1561	`ans.is_ref = 1;`
		1562	`ans.u.tg = bound;`
		1563	`ans.sha = sha;`
		1564	`return ans;`
		1565	`}`
		1566
		1567	`dg_bound f_dg_static_bound`
		1568	`PROTO_N ( (bound) )`
		1569	`PROTO_T ( exp bound )`
		1570	`{`
		1571	`dg_bound ans;`
		1572	`if (name(bound) != val_tag)`
		1573	`failer ("not a constant");`
		1574	`ans.is_ref = 0;`
		1575	`ans.u.x = diaginfo_exp (bound);`
		1576	`ans.sha = sh(bound);`
		1577	`return ans;`
		1578	`}`
		1579
		1580	`dg_bound f_dg_unknown_bound`
		1581	`PROTO_N ( (sha) )`
		1582	`PROTO_T ( shape sha )`
		1583	`{`
		1584	`dg_bound ans;`
		1585	`ans.is_ref = 1;`
		1586	`ans.u.tg = (dg_tag)0;`
		1587	`ans.sha = sha;`
		1588	`return ans;`
		1589	`}`
		1590
		1591	`void init_dg_bound`
		1592	`PROTO_Z ()`
		1593	`{`
		1594	`return;`
		1595	`}`
		1596
		1597	`dg_dim f_dummy_dg_dim;`
		1598
		1599	`dg_dim f_dg_dim_apply_token`
		1600	`PROTO_N ( (token_value, token_args) )`
		1601	`PROTO_T ( token token_value X bitstream token_args )`
		1602	`{`
		1603	`tokval v;`
		1604	`v = apply_tok(token_value, token_args, DG_DIM_SORT, (tokval*)0);`
		1605	`return v.tk_dg_dim;`
		1606	`}`
		1607
		1608	`dg_dim f_dg_tag_dim`
		1609	`PROTO_N ( (tg, d) )`
		1610	`PROTO_T ( dg_tag tg X dg_dim d )`
		1611	`{`
		1612	`if (tg->key) failer ("dg_tag defined twice");`
		1613	`tg->key = DGK_DIM;`
		1614	`d.tg = tg;`
		1615	`return d;`
		1616	`}`
		1617
		1618	`dg_dim f_dg_bounds_dim`
		1619	`PROTO_N ( (low, high, index_type) )`
		1620	`PROTO_T ( dg_bound low X dg_bound high X dg_type index_type )`
		1621	`{`
		1622	`dg_dim ans;`
		1623	`ans.d_key = DG_DIM_BOUNDS;`
		1624	`ans.low_ref = low.is_ref;`
		1625	`ans.hi_ref = high.is_ref;`
		1626	`ans.hi_cnt = 0;`
		1627	`ans.d_typ = index_type;`
		1628	`ans.sha = low.sha;`
		1629	`ans.lower = low.u;`
		1630	`ans.upper = high.u;`
		1631	`if (low.is_ref \|\| high.is_ref)`
		1632	`ans.count = -1;`
		1633	`else`
		1634	`ans.count = (long)(no(son(high.u.x)) - no(son(low.u.x)) + 1);`
		1635	`ans.tg = (dg_tag)0;`
		1636	`return ans;`
		1637	`}`
		1638
		1639	`dg_dim f_dg_count_dim`
		1640	`PROTO_N ( (low, count, index_type) )`
		1641	`PROTO_T ( dg_bound low X dg_bound count X dg_type index_type )`
		1642	`{`
		1643	`dg_dim ans;`
		1644	`ans.d_key = DG_DIM_BOUNDS;`
		1645	`ans.low_ref = low.is_ref;`
		1646	`ans.hi_ref = count.is_ref;`
		1647	`ans.hi_cnt = 1;`
		1648	`ans.d_typ = index_type;`
		1649	`ans.sha = low.sha;`
		1650	`ans.lower = low.u;`
		1651	`ans.upper = count.u;`
		1652	`if (count.is_ref)`
		1653	`ans.count = -1;`
		1654	`else`
		1655	`ans.count = (long)(no(son(count.u.x)));`
		1656	`ans.tg = (dg_tag)0;`
		1657	`return ans;`
		1658	`}`
		1659
		1660	`dg_dim f_dg_type_dim`
		1661	`PROTO_N ( (type, n) )`
		1662	`PROTO_T ( dg_type type X nat_option n )`
		1663	`{`
		1664	`dg_dim ans;`
		1665	`ans.d_key = DG_DIM_TYPE;`
		1666	`ans.d_typ = type;`
		1667	`if (n.present)`
		1668	`ans.count = (long)n.val.nat_val.small_nat;`
		1669	`else`
		1670	`ans.count = -1;`
		1671	`ans.tg = (dg_tag)0;`
		1672	`return ans;`
		1673	`}`
		1674
		1675	`dg_dim f_dg_unspecified_dim;`
		1676
		1677	`void init_dg_dim`
		1678	`PROTO_Z ()`
		1679	`{`
		1680	`f_dg_unspecified_dim.d_key = DG_DIM_NONE;`
		1681	`f_dg_unspecified_dim.low_ref = f_dg_unspecified_dim.hi_ref = 1;`
		1682	`f_dg_unspecified_dim.hi_cnt = 0;`
		1683	`f_dg_unspecified_dim.count = -1;`
		1684	`f_dg_unspecified_dim.d_typ = (dg_type)0;`
		1685	`f_dg_unspecified_dim.sha = f_top;`
		1686	`f_dg_unspecified_dim.lower.tg = f_dg_unspecified_dim.upper.tg = (dg_tag)0;`
		1687	`f_dg_unspecified_dim.tg = (dg_tag)0;`
		1688	`return;`
		1689	`}`
		1690
		1691	`dg_enum f_dummy_dg_enum;`
		1692
		1693	`dg_enum f_make_dg_enum`
		1694	`PROTO_N ( (value, idname, src_pos) )`
		1695	`PROTO_T ( exp value X dg_idname idname X dg_sourcepos src_pos )`
		1696	`{`
		1697	`dg_enum ans;`
		1698	`if (!value \|\| name(value) != val_tag)`
		1699	`failer ("enum value not const");`
		1700	`ans.enam = idname_chars (idname);`
		1701	`ans.pos = shorten_sourcepos (src_pos);`
		1702	`ans.value = diaginfo_exp (value);`
		1703	`ans.is_chn = 0;`
		1704	`ans.tg = (dg_tag)0;`
		1705	`return ans;`
		1706	`}`
		1707
		1708	`dg_enum f_dg_char_enum`
		1709	`PROTO_N ( (value, idchar, src_pos) )`
		1710	`PROTO_T ( exp value X nat idchar X dg_sourcepos src_pos )`
		1711	`{`
		1712	`dg_enum ans;`
		1713	`if (!value \|\| name(value) != val_tag)`
		1714	`failer ("enum value not const");`
		1715	`ans.chn = idchar.nat_val.small_nat;`
		1716	`ans.pos = shorten_sourcepos (src_pos);`
		1717	`ans.value = diaginfo_exp (value);`
		1718	`ans.is_chn = 1;`
		1719	`ans.tg = (dg_tag)0;`
		1720	`return ans;`
		1721	`}`
		1722
		1723	`dg_enum f_dg_tag_enum`
		1724	`PROTO_N ( (tg, e) )`
		1725	`PROTO_T ( dg_tag tg X dg_enum e )`
		1726	`{`
		1727	`if (tg->key) failer ("dg_tag defined twice");`
		1728	`tg->key = DGK_ENUM;`
		1729	`e.tg = tg;`
		1730	`return e;`
		1731	`}`
		1732
		1733	`void init_dg_enum`
		1734	`PROTO_Z ()`
		1735	`{`
		1736	`return;`
		1737	`}`
		1738
		1739	`dg_param f_dummy_dg_param;`
		1740
		1741	`dg_param f_dg_object_param`
		1742	`PROTO_N ( (idname, src_pos, mode, param_type, deflt) )`
		1743	`PROTO_T ( dg_idname_option idname X dg_sourcepos_option src_pos X`
		1744	`dg_param_mode_option mode X dg_type param_type X`
		1745	`dg_default_option deflt )`
		1746	`{`
		1747	`dg_param ans;`
		1748	`ans.pnam = idname_chars (idname);`
		1749	`ans.ppos = shorten_sourcepos (src_pos);`
		1750	`ans.pmode = mode;`
		1751	`ans.p_typ = param_type;`
		1752	`ans.p_dflt = deflt;`
		1753	`return ans;`
		1754	`}`
		1755
		1756	`dg_param f_dg_type_param`
		1757	`PROTO_N ( (idname, src_pos, fparams) )`
		1758	`PROTO_T ( dg_idname_option idname X dg_sourcepos_option src_pos X dg_param_list fparams )`
		1759	`{`
		1760	`failer ("dg_type_param not yet supported");`
		1761	`UNUSED (idname);`
		1762	`UNUSED (src_pos);`
		1763	`UNUSED (fparams);`
		1764	`return f_dummy_dg_param;`
		1765	`}`
		1766
		1767	`void init_dg_param`
		1768	`PROTO_Z ()`
		1769	`{`
		1770	`return;`
		1771	`}`
		1772
		1773	`dg_param_mode f_dummy_dg_param_mode;`
		1774
		1775	`dg_param_mode f_dg_in_mode = DG_IN_MODE;`
		1776
		1777	`dg_param_mode f_dg_out_mode = DG_OUT_MODE;`
		1778
		1779	`dg_param_mode f_dg_inout_mode = DG_INOUT_MODE;`
		1780
		1781	`void init_dg_param_mode`
		1782	`PROTO_Z ()`
		1783	`{`
		1784	`return;`
		1785	`}`
		1786
		1787	`dg_accessibility f_dummy_dg_accessibility;`
		1788
		1789	`dg_accessibility f_dg_public_accessibility = DG_ACC_PUB;`
		1790
		1791	`dg_accessibility f_dg_private_accessibility = DG_ACC_PRIV;`
		1792
		1793	`dg_accessibility f_dg_protected_accessibility = DG_ACC_PROT;`
		1794
		1795	`dg_accessibility f_dg_local_accessibility = DG_ACC_LOC;`
		1796
		1797	`void init_dg_accessibility`
		1798	`PROTO_Z ()`
		1799	`{`
		1800	`return;`
		1801	`}`
		1802
		1803	`dg_virtuality f_dummy_dg_virtuality;`
		1804
		1805	`dg_virtuality f_dg_virtual_virtuality = DG_VIRT_VIRT;`
		1806
		1807	`dg_virtuality f_dg_abstract_virtuality = DG_VIRT_PURE;`
		1808
		1809	`void init_dg_virtuality`
		1810	`PROTO_Z ()`
		1811	`{`
		1812	`return;`
		1813	`}`
		1814
		1815	`dg_filename f_dummy_dg_filename;`
		1816
		1817	`dg_filename f_dg_filename_apply_token`
		1818	`PROTO_N ( (token_value, token_args) )`
		1819	`PROTO_T ( token token_value X bitstream token_args )`
		1820	`{`
		1821	`tokval v;`
		1822	`v = apply_tok(token_value, token_args, DG_FILENAME_SORT, (tokval*)0);`
		1823	`return v.tk_dg_filename;`
		1824	`}`
		1825
		1826	`dg_filename f_make_dg_filename`
		1827	`PROTO_N ( (date, machine, path, file) )`
		1828	`PROTO_T ( nat date X string machine X string path X string file )`
		1829	`{`
		1830	`return get_filename ((long)(date.nat_val.small_nat), machine.ints.chars,`
		1831	`path.ints.chars, file.ints.chars);`
		1832	`}`
		1833
		1834	`void init_dg_filename`
		1835	`PROTO_Z ()`
		1836	`{`
		1837	`return;`
		1838	`}`
		1839
		1840	`dg_sourcepos f_dummy_dg_sourcepos;`
		1841
		1842	`dg_sourcepos f_dg_span_sourcepos`
		1843	`PROTO_N ( (file, from_line, from_column, to_file, to_line, to_column) )`
		1844	`PROTO_T ( dg_filename file X nat from_line X nat from_column X`
		1845	`dg_filename_option to_file X nat to_line X nat to_column )`
		1846	`{`
		1847	`dg_sourcepos ans;`
		1848	`ans.sp_key = SP_SPAN;`
		1849	`ans.file = file;`
		1850	`if (!(ans.to_file = to_file))`
		1851	`ans.to_file = file;`
		1852	`ans.from_line = from_line.nat_val.small_nat;`
		1853	`ans.from_column = (short)from_column.nat_val.small_nat;`
		1854	`ans.to_line = to_line.nat_val.small_nat;`
		1855	`ans.to_column = (short)to_column.nat_val.small_nat;`
		1856	`return ans;`
		1857	`}`
		1858
		1859	`dg_sourcepos f_dg_mark_sourcepos`
		1860	`PROTO_N ( (file, line, column) )`
		1861	`PROTO_T ( dg_filename file X nat line X nat column )`
		1862	`{`
		1863	`dg_sourcepos ans;`
		1864	`ans.sp_key = SP_SHORT;`
		1865	`ans.file = file;`
		1866	`ans.from_line = line.nat_val.small_nat;`
		1867	`ans.from_column = (short)column.nat_val.small_nat;`
		1868	`return ans;`
		1869	`}`
		1870
		1871	`dg_sourcepos f_dg_file_sourcepos`
		1872	`PROTO_N ( (file) )`
		1873	`PROTO_T ( dg_filename file )`
		1874	`{`
		1875	`dg_sourcepos ans;`
		1876	`ans.sp_key = SP_FILE;`
		1877	`ans.file = file;`
		1878	`return ans;`
		1879	`}`
		1880
		1881	`dg_sourcepos f_dg_global_sourcepos;`
		1882
		1883	`dg_sourcepos f_dg_null_sourcepos;`
		1884
		1885	`void init_dg_sourcepos`
		1886	`PROTO_Z ()`
		1887	`{`
		1888	`f_dg_global_sourcepos.sp_key = SP_GLOB;`
		1889	`f_dg_null_sourcepos.sp_key = SP_NULL;`
		1890	`return;`
		1891	`}`
		1892
		1893	`dg_compilation f_dummy_dg_compilation;`
		1894
		1895	`dg_compilation f_dg_tag_compilation`
		1896	`PROTO_N ( (tg, comp) )`
		1897	`PROTO_T ( dg_tag tg X dg_compilation comp )`
		1898	`{`
		1899	`if (tg->key) failer ("dg_tag defined twice");`
		1900	`tg->key = DGK_COMP;`
		1901	`tg->p.comp = comp;`
		1902	`return comp;`
		1903	`}`
		1904
		1905	`dg_compilation f_make_dg_compilation`
		1906	`PROTO_N ( (primary_file, comp_unit_deps, macros, comp_dir, date,`
		1907	`language, id_case, producer, options, dnames) )`
		1908	`PROTO_T ( dg_filename primary_file X string_list comp_unit_deps X`
		1909	`dg_macro_list macros X dg_filename comp_dir X nat date X`
		1910	`nat language X nat id_case X string producer X`
		1911	`string_list options X dg_namelist dnames )`
		1912	`{`
		1913	`dg_compilation ans = (dg_compilation) xmalloc (sizeof (struct dg_comp_t));`
		1914	`ans->prim_file = primary_file;`
		1915	`ans->comp_deps = comp_unit_deps;`
		1916	`ans->date = date.nat_val.small_nat;`
		1917	`ans->language = language.nat_val.small_nat;`
		1918	`ans->id_case = id_case.nat_val.small_nat;`
		1919	`ans->producer = producer.ints.chars;`
		1920	`ans->comp_dir = comp_dir;`
		1921	`ans->options = options;`
		1922	`ans->dn_list = dnames.list;`
		1923	`if (dnames.tg)`
		1924	`dnames.tg->p.nl = &(ans->dn_list);`
		1925	`ans->another = (dg_compilation)0;`
		1926	`ans->macros = macros;`
		1927	`return ans;`
		1928	`}`
		1929
		1930	`void init_dg_compilation`
		1931	`PROTO_Z ()`
		1932	`{`
		1933	`return;`
		1934	`}`
		1935
		1936	`dg_constraint f_dummy_dg_constraint;`
		1937
		1938	`dg_constraint f_dg_type_constraint`
		1939	`PROTO_N ( (ref_member, type) )`
		1940	`PROTO_T ( dg_tag_option ref_member X dg_type type )`
		1941	`{`
		1942	`dg_constraint ans = (dg_constraint) xcalloc (1, sizeof (struct dg_con));`
		1943	`ans->refmem = ref_member;`
		1944	`ans->is_val = 0;`
		1945	`ans->u.typ = type;`
		1946	`ans->next = (dg_constraint)0;`
		1947	`return ans;`
		1948	`}`
		1949
		1950	`dg_constraint f_dg_value_constraint`
		1951	`PROTO_N ( (ref_member, value) )`
		1952	`PROTO_T ( dg_tag_option ref_member X exp value )`
		1953	`{`
		1954	`dg_constraint ans = (dg_constraint) xcalloc (1, sizeof (struct dg_con));`
		1955	`ans->refmem = ref_member;`
		1956	`ans->is_val = 1;`
		1957	`ans->u.val = value;`
		1958	`ans->next = (dg_constraint)0;`
		1959	`return ans;`
		1960	`}`
		1961
		1962	`void init_dg_constraint`
		1963	`PROTO_Z ()`
		1964	`{`
		1965	`return;`
		1966	`}`
		1967
		1968	`dg_default f_dummy_dg_default;`
		1969
		1970	`dg_default f_make_dg_default`
		1971	`PROTO_N ( (value, src_span) )`
		1972	`PROTO_T ( exp_option value X dg_sourcepos_option src_span )`
		1973	`{`
		1974	`dg_default ans;`
		1975	`if (value.present)`
		1976	`ans.val = diaginfo_exp (value.val);`
		1977	`else`
		1978	`ans.val = nilexp;`
		1979	`ans.span = src_span;`
		1980	`ans.lab = (long)0;`
		1981	`return ans;`
		1982	`}`
		1983
		1984	`void init_dg_default`
		1985	`PROTO_Z ()`
		1986	`{`
		1987	`return;`
		1988	`}`
		1989
		1990	`dg_idname f_dummy_dg_idname;`
		1991
		1992	`dg_idname f_dg_idname_apply_token`
		1993	`PROTO_N ( (token_value, token_args) )`
		1994	`PROTO_T ( token token_value X bitstream token_args )`
		1995	`{`
		1996	`tokval v;`
		1997	`v = apply_tok(token_value, token_args, DG_IDNAME_SORT, (tokval*)0);`
		1998	`return v.tk_dg_idname;`
		1999	`}`
		2000
		2001	`dg_idname f_dg_sourcestring_idname`
		2002	`PROTO_N ( (src_name) )`
		2003	`PROTO_T ( string src_name )`
		2004	`{`
		2005	`dg_idname ans;`
		2006	`ans.id_key = DG_ID_SRC;`
		2007	`ans.idd.nam = src_name.ints.chars;`
		2008	`return ans;`
		2009	`}`
		2010
		2011	`dg_idname f_dg_anonymous_idname`
		2012	`PROTO_N ( (descr) )`
		2013	`PROTO_T ( string_option descr )`
		2014	`{`
		2015	`dg_idname ans;`
		2016	`ans.id_key = DG_ID_ANON;`
		2017	`UNUSED (descr);`
		2018	`ans.idd.nam = "";`
		2019	`return ans;`
		2020	`}`
		2021
		2022	`dg_idname f_dg_artificial_idname`
		2023	`PROTO_N ( (aname) )`
		2024	`PROTO_T ( string_option aname )`
		2025	`{`
		2026	`dg_idname ans;`
		2027	`ans.id_key = DG_ID_ARTFL;`
		2028	`if (aname.present)`
		2029	`ans.idd.nam = aname.val.ints.chars;`
		2030	`else`
		2031	`ans.idd.nam = "";`
		2032	`return ans;`
		2033	`}`
		2034
		2035	`dg_idname f_dg_instance_idname`
		2036	`PROTO_N ( (idname, spec, whence, aparams) )`
		2037	`PROTO_T ( dg_idname_option idname X dg_idname spec X`
		2038	`dg_sourcepos whence X dg_name_list aparams )`
		2039	`{`
		2040	`dg_idname ans;`
		2041	`ans.id_key = DG_ID_INST;`
		2042	`ans.idd.instance = (dg_instantn *) xcalloc (1, sizeof (dg_instantn));`
		2043	`ans.idd.instance->nam = idname;`
		2044	`ans.idd.instance->spec = spec;`
		2045	`ans.idd.instance->whence = shorten_sourcepos (whence);`
		2046	`ans.idd.instance->params = aparams;`
		2047	`if (ans.idd.instance->nam.id_key == DG_ID_INST \|\|`
		2048	`ans.idd.instance->spec.id_key == DG_ID_INST)`
		2049	`failer ("multiple instantiation");`
		2050	`return ans;`
		2051	`}`
		2052
		2053	`dg_idname f_dg_external_idname`
		2054	`PROTO_N ( (src_name) )`
		2055	`PROTO_T ( string src_name )`
		2056	`{`
		2057	`dg_idname ans;`
		2058	`ans.id_key = DG_ID_EXT;`
		2059	`ans.idd.nam = src_name.ints.chars;`
		2060	`return ans;`
		2061	`}`
		2062
		2063	`void init_dg_idname`
		2064	`PROTO_Z ()`
		2065	`{`
		2066	`return;`
		2067	`}`
		2068
		2069	`dg_varpart f_dummy_dg_varpart;`
		2070
		2071	`dg_varpart f_dg_discrim_varpart`
		2072	`PROTO_N ( (discrim, variants) )`
		2073	`PROTO_T ( dg_classmem discrim X dg_variant_list variants )`
		2074	`{`
		2075	`dg_varpart ans;`
		2076	`ans.v_key = DG_V_D;`
		2077	`ans.u.d = discrim;`
		2078	`ans.vnts = variants;`
		2079	`return ans;`
		2080	`}`
		2081
		2082	`dg_varpart f_dg_sibl_discrim_varpart`
		2083	`PROTO_N ( (discrim, variants) )`
		2084	`PROTO_T ( dg_tag discrim X dg_variant_list variants )`
		2085	`{`
		2086	`dg_varpart ans;`
		2087	`ans.v_key = DG_V_S;`
		2088	`ans.u.s = discrim;`
		2089	`ans.vnts = variants;`
		2090	`return ans;`
		2091	`}`
		2092
		2093	`dg_varpart f_dg_undiscrim_varpart`
		2094	`PROTO_N ( (tag_type, variants) )`
		2095	`PROTO_T ( dg_type tag_type X dg_variant_list variants )`
		2096	`{`
		2097	`dg_varpart ans;`
		2098	`ans.v_key = DG_V_T;`
		2099	`ans.u.t = tag_type;`
		2100	`ans.vnts = variants;`
		2101	`return ans;`
		2102	`}`
		2103
		2104	`void init_dg_varpart`
		2105	`PROTO_Z ()`
		2106	`{`
		2107	`return;`
		2108	`}`
		2109
		2110	`dg_variant f_dummy_dg_variant;`
		2111
		2112	`dg_variant f_make_dg_variant`
		2113	`PROTO_N ( (discr, fields) )`
		2114	`PROTO_T ( dg_discrim_list discr X dg_classmem_list fields )`
		2115	`{`
		2116	`dg_variant ans;`
		2117	`ans.discr = discr;`
		2118	`ans.fields = fields;`
		2119	`return ans;`
		2120	`}`
		2121
		2122	`void init_dg_variant`
		2123	`PROTO_Z ()`
		2124	`{`
		2125	`return;`
		2126	`}`
		2127
		2128	`dg_discrim f_dummy_dg_discrim;`
		2129
		2130	`dg_discrim f_make_dg_discrim`
		2131	`PROTO_N ( (lower, upper) )`
		2132	`PROTO_T ( exp lower X exp upper )`
		2133	`{`
		2134	`dg_discrim ans;`
		2135	`if (name(lower) != val_tag \|\| name(upper) != val_tag \|\|`
		2136	`sh(lower) != sh(upper))`
		2137	`failer ("malformed discriminant");`
		2138	`ans.lower = diaginfo_exp (lower);`
		2139	`ans.upper = diaginfo_exp (upper);`
		2140	`return ans;`
		2141	`}`
		2142
		2143	`void init_dg_discrim`
		2144	`PROTO_Z ()`
		2145	`{`
		2146	`return;`
		2147	`}`
		2148
		2149	`dg_macro f_dummy_dg_macro;`
		2150
		2151	`dg_macro f_dg_function_macro`
		2152	`PROTO_N ( (src_pos, idname, param, def) )`
		2153	`PROTO_T ( dg_sourcepos src_pos X dg_idname idname X`
		2154	`dg_idname_list param X string def )`
		2155	`{`
		2156	`dg_macro ans;`
		2157	`ans.key = DGM_FN;`
		2158	`ans.pos = shorten_sourcepos (src_pos);`
		2159	`ans.u.d.nam = idname_chars (idname);`
		2160	`ans.u.d.defn = def.ints.chars;`
		2161	`ans.u.d.pms = param;`
		2162	`return ans;`
		2163	`}`
		2164
		2165	`dg_macro f_dg_include_macro`
		2166	`PROTO_N ( (src_pos, file, macros) )`
		2167	`PROTO_T ( dg_sourcepos src_pos X dg_filename file X dg_macro_list macros )`
		2168	`{`
		2169	`dg_macro ans;`
		2170	`ans.key = DGM_INC;`
		2171	`ans.pos = shorten_sourcepos (src_pos);`
		2172	`ans.u.i.file = file;`
		2173	`ans.u.i.macs = macros;`
		2174	`return ans;`
		2175	`}`
		2176
		2177	`dg_macro f_dg_object_macro`
		2178	`PROTO_N ( (src_pos, idname, def) )`
		2179	`PROTO_T ( dg_sourcepos src_pos X dg_idname idname X string def )`
		2180	`{`
		2181	`dg_macro ans;`
		2182	`ans.key = DGM_OBJ;`
		2183	`ans.pos = shorten_sourcepos (src_pos);`
		2184	`ans.u.d.nam = idname_chars (idname);`
		2185	`ans.u.d.defn = def.ints.chars;`
		2186	`return ans;`
		2187	`}`
		2188
		2189	`dg_macro f_dg_undef_macro`
		2190	`PROTO_N ( (src_pos, idname) )`
		2191	`PROTO_T ( dg_sourcepos src_pos X dg_idname idname )`
		2192	`{`
		2193	`dg_macro ans;`
		2194	`ans.key = DGM_UNDEF;`
		2195	`ans.pos = shorten_sourcepos (src_pos);`
		2196	`ans.u.d.nam = idname_chars (idname);`
		2197	`return ans;`
		2198	`}`
		2199
		2200	`void init_dg_macro`
		2201	`PROTO_Z ()`
		2202	`{`
		2203	`return;`
		2204	`}`
		2205
		2206	`dg_list new_dg_list`
		2207	`PROTO_N ( (n) )`
		2208	`PROTO_T ( int n )`
		2209	`{`
		2210	`UNUSED (n);`
		2211	`return (dg_list)(0);`
		2212	`}`
		2213
		2214	`dg_list add_dg_list`
		2215	`PROTO_N ( (list, elem, index) )`
		2216	`PROTO_T ( dg_list list X dg elem X int index )`
		2217	`{`
		2218	`if (elem && elem->more == elem) { /* self ref => copy */`
		2219	`dg ans = new_dg_info (elem->key);`
		2220	`elem = ans;`
		2221	`}`
		2222	`if (list) {`
		2223	`dg x = list;`
		2224	`while (x->more) x = x->more;`
		2225	`x->more = elem;`
		2226	`return list;`
		2227	`}`
		2228	`return elem;`
		2229	`}`
		2230
		2231	`dg_name_list new_dg_name_list`
		2232	`PROTO_N ( (n) )`
		2233	`PROTO_T ( int n )`
		2234	`{`
		2235	`return (dg_name)0;`
		2236	`}`
		2237
		2238	`dg_name_list add_dg_name_list`
		2239	`PROTO_N ( (list, elem, index) )`
		2240	`PROTO_T ( dg_name_list list X dg_name elem X int index )`
		2241	`{`
		2242	`if (list) {`
		2243	`dg_name x = list;`
		2244	`while (x->next) x = x->next;`
		2245	`x->next = elem;`
		2246	`return list;`
		2247	`}`
		2248	`return elem;`
		2249	`}`
		2250
		2251	`dg_tag_list new_dg_tag_list`
		2252	`PROTO_N ( (n) )`
		2253	`PROTO_T ( int n )`
		2254	`{`
		2255	`dg_tag_list ans;`
		2256	`ans.len = n;`
		2257	`ans.array = (dg_tag *)xcalloc(n, sizeof(dg_tag));`
		2258	`return ans;`
		2259	`}`
		2260
		2261	`dg_tag_list add_dg_tag_list`
		2262	`PROTO_N ( (list, elem, index) )`
		2263	`PROTO_T ( dg_tag_list list X dg_tag elem X int index )`
		2264	`{`
		2265	`list.array[index] = elem;`
		2266	`return list;`
		2267	`}`
		2268
		2269	`dg_type_list new_dg_type_list`
		2270	`PROTO_N ( (n) )`
		2271	`PROTO_T ( int n )`
		2272	`{`
		2273	`dg_type_list ans;`
		2274	`ans.len = n;`
		2275	`ans.array = (dg_type *)xcalloc(n, sizeof(dg_type));`
		2276	`return ans;`
		2277	`}`
		2278
		2279	`dg_type_list add_dg_type_list`
		2280	`PROTO_N ( (list, elem, index) )`
		2281	`PROTO_T ( dg_type_list list X dg_type elem X int index )`
		2282	`{`
		2283	`list.array[index] = elem;`
		2284	`return list;`
		2285	`}`
		2286
		2287	`dg_param_list new_dg_param_list`
		2288	`PROTO_N ( (n) )`
		2289	`PROTO_T ( int n )`
		2290	`{`
		2291	`dg_param_list ans;`
		2292	`ans.len = n;`
		2293	`ans.array = (dg_param *) xcalloc (n, sizeof (dg_param));`
		2294	`return ans;`
		2295	`}`
		2296
		2297	`dg_param_list add_dg_param_list`
		2298	`PROTO_N ( (list, elem, index) )`
		2299	`PROTO_T ( dg_param_list list X dg_param elem X int index )`
		2300	`{`
		2301	`list.array[index] = elem;`
		2302	`return list;`
		2303	`}`
		2304
		2305	`dg_dim_list new_dg_dim_list`
		2306	`PROTO_N ( (n) )`
		2307	`PROTO_T ( int n )`
		2308	`{`
		2309	`dg_dim_list ans;`
		2310	`ans.len = n;`
		2311	`ans.array = (dg_dim *)xcalloc(n, sizeof(dg_dim));`
		2312	`return ans;`
		2313	`}`
		2314
		2315	`dg_dim_list add_dg_dim_list`
		2316	`PROTO_N ( (list, elem, index) )`
		2317	`PROTO_T ( dg_dim_list list X dg_dim elem X int index )`
		2318	`{`
		2319	`list.array[index] = elem;`
		2320	`return list;`
		2321	`}`
		2322
		2323	`dg_enum_list new_dg_enum_list`
		2324	`PROTO_N ( (n) )`
		2325	`PROTO_T ( int n )`
		2326	`{`
		2327	`dg_enum_list ans;`
		2328	`ans.len = n;`
		2329	`ans.array = (dg_enum *)xcalloc(n, sizeof(dg_enum));`
		2330	`return ans;`
		2331	`}`
		2332
		2333	`dg_enum_list add_dg_enum_list`
		2334	`PROTO_N ( (list, elem, index) )`
		2335	`PROTO_T ( dg_enum_list list X dg_enum elem X int index )`
		2336	`{`
		2337	`list.array[index] = elem;`
		2338	`return list;`
		2339	`}`
		2340
		2341	`dg_class_base_list new_dg_class_base_list`
		2342	`PROTO_N ( (n) )`
		2343	`PROTO_T ( int n )`
		2344	`{`
		2345	`dg_class_base_list ans;`
		2346	`ans.len = n;`
		2347	`ans.array = (dg_class_base *)xcalloc(n, sizeof(dg_class_base));`
		2348	`return ans;`
		2349	`}`
		2350
		2351	`dg_class_base_list add_dg_class_base_list`
		2352	`PROTO_N ( (list, elem, index) )`
		2353	`PROTO_T ( dg_class_base_list list X dg_class_base elem X int index )`
		2354	`{`
		2355	`list.array[index] = elem;`
		2356	`return list;`
		2357	`}`
		2358
		2359	`dg_classmem_list new_dg_classmem_list`
		2360	`PROTO_N ( (n) )`
		2361	`PROTO_T ( int n )`
		2362	`{`
		2363	`dg_classmem_list ans;`
		2364	`ans.len = n;`
		2365	`ans.array = (dg_classmem *)xcalloc(n, sizeof(dg_classmem));`
		2366	`return ans;`
		2367	`}`
		2368
		2369	`dg_classmem_list add_dg_classmem_list`
		2370	`PROTO_N ( (list, elem, index) )`
		2371	`PROTO_T ( dg_classmem_list list X dg_classmem elem X int index )`
		2372	`{`
		2373	`list.array[index] = elem;`
		2374	`return list;`
		2375	`}`
		2376
		2377	`dg_variant_list new_dg_variant_list`
		2378	`PROTO_N ( (n) )`
		2379	`PROTO_T ( int n )`
		2380	`{`
		2381	`dg_variant_list ans;`
		2382	`ans.len = n;`
		2383	`ans.array = (dg_variant *)xcalloc(n, sizeof(dg_variant));`
		2384	`return ans;`
		2385	`}`
		2386
		2387	`dg_variant_list add_dg_variant_list`
		2388	`PROTO_N ( (list, elem, index) )`
		2389	`PROTO_T ( dg_variant_list list X dg_variant elem X int index )`
		2390	`{`
		2391	`list.array[index] = elem;`
		2392	`return list;`
		2393	`}`
		2394
		2395	`dg_discrim_list new_dg_discrim_list`
		2396	`PROTO_N ( (n) )`
		2397	`PROTO_T ( int n )`
		2398	`{`
		2399	`dg_discrim_list ans;`
		2400	`ans.len = n;`
		2401	`ans.array = (dg_discrim *)xcalloc(n, sizeof(dg_discrim));`
		2402	`return ans;`
		2403	`}`
		2404
		2405	`dg_discrim_list add_dg_discrim_list`
		2406	`PROTO_N ( (list, elem, index) )`
		2407	`PROTO_T ( dg_discrim_list list X dg_discrim elem X int index )`
		2408	`{`
		2409	`list.array[index] = elem;`
		2410	`return list;`
		2411	`}`
		2412
		2413	`dg_constraint_list new_dg_constraint_list`
		2414	`PROTO_N ( (n) )`
		2415	`PROTO_T ( int n )`
		2416	`{`
		2417	`return (dg_constraint)0;`
		2418	`}`
		2419
		2420	`dg_constraint_list add_dg_constraint_list`
		2421	`PROTO_N ( (list, elem, index) )`
		2422	`PROTO_T ( dg_constraint_list list X dg_constraint elem X int index )`
		2423	`{`
		2424	`if (list) {`
		2425	`dg_constraint x = list;`
		2426	`while (x->next) x = x->next;`
		2427	`x->next = elem;`
		2428	`return list;`
		2429	`}`
		2430	`return elem;`
		2431	`}`
		2432
		2433	`dg_namelist f_dummy_dg_namelist;`
		2434
		2435	`dg_namelist f_make_dg_namelist`
		2436	`PROTO_N ( (items) )`
		2437	`PROTO_T ( dg_name_list items )`
		2438	`{`
		2439	`dg_namelist ans;`
		2440	`ans.list = items;`
		2441	`ans.tg = (dg_tag)0;`
		2442	`return ans;`
		2443	`}`
		2444
		2445	`dg_namelist f_dg_tag_namelist`
		2446	`PROTO_N ( (tg, nl) )`
		2447	`PROTO_T ( dg_tag tg X dg_namelist nl )`
		2448	`{`
		2449	`if (tg->key) failer ("dg_tag defined twice");`
		2450	`tg->key = DGK_NAMELIST;`
		2451	`nl.tg = tg;`
		2452	`return nl;`
		2453	`}`
		2454
		2455	`void init_dg_namelist`
		2456	`PROTO_Z ()`
		2457	`{`
		2458	`return;`
		2459	`}`
		2460
		2461	`dg_append f_dummy_dg_append;`
		2462
		2463	`dg_append f_dg_name_append`
		2464	`PROTO_N ( (tg, nam) )`
		2465	`PROTO_T ( dg_tag tg X dg_name nam )`
		2466	`{`
		2467	`if (tg->key != DGK_NAMELIST) failer("wrong dg_tag");`
		2468	`(tg->p.nl) = add_dg_name_list ((tg->p.nl), nam, 0);`
		2469	`return f_dummy_dg_append;`
		2470	`}`
		2471
		2472	`void init_dg_append`
		2473	`PROTO_Z ()`
		2474	`{`
		2475	`return;`
		2476	`}`
		2477
		2478	`dg_append_list new_dg_append_list`
		2479	`PROTO_N ( (n) )`
		2480	`PROTO_T ( int n )`
		2481	`{`
		2482	`return (dg_append_list)0;`
		2483	`}`
		2484
		2485	`dg_append_list add_dg_append_list`
		2486	`PROTO_N ( (list, elem, index) )`
		2487	`PROTO_T ( dg_append_list list X dg_append elem X int index )`
		2488	`{`
		2489	`return list;`
		2490	`}`
		2491
		2492	`dg_macro_list new_dg_macro_list`
		2493	`PROTO_N ( (n) )`
		2494	`PROTO_T ( int n )`
		2495	`{`
		2496	`dg_macro_list ans;`
		2497	`ans.len = n;`
		2498	`ans.array = (dg_macro *)xcalloc(n, sizeof(dg_macro));`
		2499	`return ans;`
		2500	`}`
		2501
		2502	`dg_macro_list add_dg_macro_list`
		2503	`PROTO_N ( (list, elem, index) )`
		2504	`PROTO_T ( dg_macro_list list X dg_macro elem X int index )`
		2505	`{`
		2506	`list.array[index] = elem;`
		2507	`return list;`
		2508	`}`
		2509
		2510	`dg_idname_list new_dg_idname_list`
		2511	`PROTO_N ( (n) )`
		2512	`PROTO_T ( int n )`
		2513	`{`
		2514	`return new_string_list (n);`
		2515	`}`
		2516
		2517	`dg_idname_list add_dg_idname_list`
		2518	`PROTO_N ( (list, elem, index) )`
		2519	`PROTO_T ( dg_idname_list list X dg_idname elem X int index )`
		2520	`{`
		2521	`list.array[index] = idname_chars (elem);`
		2522	`return list;`
		2523	`}`
		2524
		2525	`dg_idname_option no_dg_idname_option;`
		2526
		2527	`dg_idname_option yes_dg_idname_option`
		2528	`PROTO_N ( (elem) )`
		2529	`PROTO_T ( dg_idname elem )`
		2530	`{`
		2531	`return elem;`
		2532	`}`
		2533
		2534	`void init_dg_idname_option`
		2535	`PROTO_Z ()`
		2536	`{`
		2537	`no_dg_idname_option.id_key = DG_ID_NONE;`
		2538	`no_dg_idname_option.idd.nam = "";`
		2539	`return;`
		2540	`}`
		2541
		2542	`dg_name_option no_dg_name_option = (dg_name)0;`
		2543
		2544	`dg_name_option yes_dg_name_option`
		2545	`PROTO_N ( (elem) )`
		2546	`PROTO_T ( dg_name elem )`
		2547	`{`
		2548	`return elem;`
		2549	`}`
		2550
		2551	`void init_dg_name_option`
		2552	`PROTO_Z ()`
		2553	`{`
		2554	`return;`
		2555	`}`
		2556
		2557	`dg_accessibility_option no_dg_accessibility_option = DG_ACC_NONE;`
		2558
		2559	`dg_accessibility_option yes_dg_accessibility_option`
		2560	`PROTO_N ( (elem) )`
		2561	`PROTO_T ( dg_accessibility elem )`
		2562	`{`
		2563	`return elem;`
		2564	`}`
		2565
		2566	`void init_dg_accessibility_option`
		2567	`PROTO_Z ()`
		2568	`{`
		2569	`return;`
		2570	`}`
		2571
		2572	`dg_tag_option no_dg_tag_option = (dg_tag)0;`
		2573
		2574	`dg_tag_option yes_dg_tag_option`
		2575	`PROTO_N ( (elem) )`
		2576	`PROTO_T ( dg_tag elem )`
		2577	`{`
		2578	`return elem;`
		2579	`}`
		2580
		2581	`void init_dg_tag_option`
		2582	`PROTO_Z ()`
		2583	`{`
		2584	`return;`
		2585	`}`
		2586
		2587	`dg_virtuality_option no_dg_virtuality_option = DG_VIRT_NONE;`
		2588
		2589	`dg_virtuality_option yes_dg_virtuality_option`
		2590	`PROTO_N ( (elem) )`
		2591	`PROTO_T ( dg_virtuality elem )`
		2592	`{`
		2593	`return elem;`
		2594	`}`
		2595
		2596	`void init_dg_virtuality_option`
		2597	`PROTO_Z ()`
		2598	`{`
		2599	`return;`
		2600	`}`
		2601
		2602	`dg_sourcepos_option no_dg_sourcepos_option;`
		2603
		2604	`dg_sourcepos_option yes_dg_sourcepos_option`
		2605	`PROTO_N ( (elem) )`
		2606	`PROTO_T ( dg_sourcepos elem )`
		2607	`{`
		2608	`return elem;`
		2609	`}`
		2610
		2611	`void init_dg_sourcepos_option`
		2612	`PROTO_Z ()`
		2613	`{`
		2614	`no_dg_sourcepos_option.sp_key = SP_NULL;`
		2615	`no_short_sourcepos = shorten_sourcepos (no_dg_sourcepos_option);`
		2616	`return;`
		2617	`}`
		2618
		2619	`dg_type_option no_dg_type_option = (dg_type)0;`
		2620
		2621	`dg_type_option yes_dg_type_option`
		2622	`PROTO_N ( (elem) )`
		2623	`PROTO_T ( dg_type elem )`
		2624	`{`
		2625	`return elem;`
		2626	`}`
		2627
		2628	`void init_dg_type_option`
		2629	`PROTO_Z ()`
		2630	`{`
		2631	`return;`
		2632	`}`
		2633
		2634	`dg_type_list_option no_dg_type_list_option;`
		2635
		2636	`dg_type_list_option yes_dg_type_list_option`
		2637	`PROTO_N ( (elem) )`
		2638	`PROTO_T ( dg_type_list elem )`
		2639	`{`
		2640	`return elem;`
		2641	`}`
		2642
		2643	`void init_dg_type_list_option`
		2644	`PROTO_Z ()`
		2645	`{`
		2646	`no_dg_type_list_option.len = -1;`
		2647	`no_dg_type_list_option.array = (dg_type *)0;`
		2648	`return;`
		2649	`}`
		2650
		2651	`dg_constraint_list_option no_dg_constraint_list_option = (dg_constraint)0;`
		2652
		2653	`dg_constraint_list_option yes_dg_constraint_list_option`
		2654	`PROTO_N ( (elem) )`
		2655	`PROTO_T ( dg_constraint_list elem )`
		2656	`{`
		2657	`return elem;`
		2658	`}`
		2659
		2660	`void init_dg_constraint_list_option`
		2661	`PROTO_Z ()`
		2662	`{`
		2663	`return;`
		2664	`}`
		2665
		2666	`dg_varpart_option no_dg_varpart_option = (dg_varpart_option)0;`
		2667
		2668	`dg_varpart_option yes_dg_varpart_option`
		2669	`PROTO_N ( (elem) )`
		2670	`PROTO_T ( dg_varpart elem )`
		2671	`{`
		2672	`dg_varpart_option ans = (dg_varpart_option)xcalloc(1, sizeof(dg_varpart));`
		2673	`*ans = elem;`
		2674	`return ans;`
		2675	`}`
		2676
		2677	`void init_dg_varpart_option`
		2678	`PROTO_Z ()`
		2679	`{`
		2680	`return;`
		2681	`}`
		2682
		2683	`dg_param_mode_option no_dg_param_mode_option = DG_NO_MODE;`
		2684
		2685	`dg_param_mode_option yes_dg_param_mode_option`
		2686	`PROTO_N ( (elem) )`
		2687	`PROTO_T ( dg_param_mode elem )`
		2688	`{`
		2689	`return elem;`
		2690	`}`
		2691
		2692	`void init_dg_param_mode_option`
		2693	`PROTO_Z ()`
		2694	`{`
		2695	`return;`
		2696	`}`
		2697
		2698	`dg_dim_option no_dg_dim_option;`
		2699
		2700	`dg_dim_option yes_dg_dim_option`
		2701	`PROTO_N ( (elem) )`
		2702	`PROTO_T ( dg_dim elem )`
		2703	`{`
		2704	`failer ("dg_dim_option not done yet");`
		2705	`return no_dg_dim_option;`
		2706	`}`
		2707
		2708	`void init_dg_dim_option`
		2709	`PROTO_Z ()`
		2710	`{`
		2711	`return;`
		2712	`}`
		2713
		2714	`dg_filename_option no_dg_filename_option = (dg_filename)0;`
		2715
		2716	`dg_filename_option yes_dg_filename_option`
		2717	`PROTO_N ( (elem) )`
		2718	`PROTO_T ( dg_filename elem )`
		2719	`{`
		2720	`return elem;`
		2721	`}`
		2722
		2723	`void init_dg_filename_option`
		2724	`PROTO_Z ()`
		2725	`{`
		2726	`return;`
		2727	`}`
		2728
		2729
		2730	`dg_default_option no_dg_default_option = (dg_default *)0;`
		2731
		2732	`dg_default_option yes_dg_default_option`
		2733	`PROTO_N ( (elem) )`
		2734	`PROTO_T ( dg_default elem )`
		2735	`{`
		2736	`dg_default_option ans = (dg_default_option)xcalloc(1, sizeof(dg_default));`
		2737	`*ans = elem;`
		2738	`return ans;`
		2739	`}`
		2740
		2741	`void init_dg_default_option`
		2742	`PROTO_Z ()`
		2743	`{`
		2744	`return;`
		2745	`}`
		2746
		2747
		2748
		2749	`void init_capsule_dgtags`
		2750	`PROTO_Z ()`
		2751	`{`
		2752	`/* the space has been calloced in read_fns */`
		2753
		2754	`int i;`
		2755	`for (i = 0; i < capsule_no_of_dgtags; ++i)`
		2756	`{`
		2757	`init_dgtag (&capsule_dgtab[i]);`
		2758	`}`
		2759	`return;`
		2760	`}`
		2761
		2762	`void init_unit_dgtags`
		2763	`PROTO_N ( (n) )`
		2764	`PROTO_T ( int n )`
		2765	`{`
		2766
		2767	`int i;`
		2768
		2769	`unit_dgtagtab = (dgtag_struct *) xcalloc(unit_no_of_dgtags - n,`
		2770	`sizeof(dgtag_struct));`
		2771
		2772	`for (i = 0; i < unit_no_of_dgtags - n; ++i)`
		2773	`{`
		2774	`init_dgtag (&unit_dgtagtab[i]);`
		2775	`}`
		2776	`return;`
		2777	`}`
		2778
		2779	`void start_make_dg_comp_unit`
		2780	`PROTO_N ( (toks, tags, als, dgnames) )`
		2781	`PROTO_T ( int toks X int tags X int als X int dgnames )`
		2782	`{`
		2783	`int i;`
		2784
		2785	`unit_no_of_tokens = toks;`
		2786	`unit_ind_tokens = (tok_define * *)xcalloc(unit_no_of_tokens,`
		2787	`sizeof(tok_define *));`
		2788	`for (i = 0; i < unit_no_of_tokens; ++i)`
		2789	`unit_ind_tokens[i] = (tok_define*)0;`
		2790
		2791	`unit_no_of_tags = tags;`
		2792	`unit_ind_tags = (dec * *)xcalloc(unit_no_of_tags,`
		2793	`sizeof(dec *));`
		2794	`for (i = 0; i < unit_no_of_tags; ++i)`
		2795	`unit_ind_tags[i] = (dec*)0;`
		2796
		2797	`unit_no_of_als = als;`
		2798	`unit_ind_als = (aldef * *)xcalloc(unit_no_of_als,`
		2799	`sizeof(aldef *));`
		2800	`for (i = 0; i < unit_no_of_als; ++i)`
		2801	`unit_ind_als[i] = (aldef*)0;`
		2802
		2803	`unit_no_of_dgtags = dgnames;`
		2804	`unit_ind_dgtags = (dgtag_struct * *)xcalloc(unit_no_of_dgtags,`
		2805	`sizeof(dgtag_struct *));`
		2806	`for (i = 0; i < unit_no_of_dgtags; ++i)`
		2807	`unit_ind_dgtags[i] = (dgtag_struct *)0;`
		2808
		2809	`return;`
		2810	`}`
		2811
		2812	`void f_make_dg_comp_unit`
		2813	`PROTO_Z ()`
		2814	`{`
		2815	`int i;`
		2816	`int j = 0;`
		2817	`int no_of_labels;`
		2818	`#ifdef NEWDIAGS`
		2819	`int was_within_diags;`
		2820	`#endif`
		2821
		2822	`for (i = 0; i < unit_no_of_tokens; ++i)`
		2823	`{`
		2824	`if (unit_ind_tokens[i] == (tok_define*)0)`
		2825	`unit_ind_tokens[i] = &unit_toktab[j++];`
		2826	`};`
		2827
		2828	`j = 0;`
		2829	`for (i = 0; i < unit_no_of_tags; ++i)`
		2830	`{`
		2831	`if (unit_ind_tags[i] == (dec*)0)`
		2832	`unit_ind_tags[i] = &unit_tagtab[j++];`
		2833	`};`
		2834
		2835	`j = 0;`
		2836	`for (i = 0; i < unit_no_of_als; ++i)`
		2837	`{`
		2838	`if (unit_ind_als[i] == (aldef*)0)`
		2839	`unit_ind_als[i] = &unit_altab[j++];`
		2840	`};`
		2841
		2842	`j=0;`
		2843	`for (i = 0; i < unit_no_of_dgtags; ++i)`
		2844	`{`
		2845	`if (unit_ind_dgtags[i] == (dgtag_struct *)0)`
		2846	`unit_ind_dgtags[i] = &unit_dgtagtab[j++];`
		2847	`};`
		2848
		2849	`#ifdef NEWDIAGS`
		2850	`was_within_diags = within_diags;`
		2851	`within_diags = 1;`
		2852	`#endif`
		2853	`{`
		2854	`dg_compilation * comp_unit_ptr = &all_comp_units;`
		2855	`while (* comp_unit_ptr)`
		2856	`comp_unit_ptr = &(* comp_unit_ptr)->another;`
		2857	`start_bytestream();`
		2858	`no_of_labels = small_dtdfint();`
		2859	`unit_no_of_labels = no_of_labels;`
		2860	`unit_labtab = (exp*)xcalloc(unit_no_of_labels, sizeof(exp));`
		2861	`(* comp_unit_ptr) = d_dg_compilation();`
		2862	`IGNORE d_dg_append_list();`
		2863	`end_bytestream();`
		2864	`}`
		2865	`#ifdef NEWDIAGS`
		2866	`within_diags = was_within_diags;`
		2867	`#endif`
		2868	`return;`
		2869	`}`
		2870
		2871	`void f_make_dglink`
		2872	`PROTO_N ( (i, ext) )`
		2873	`PROTO_T ( tdfint i X tdfint ext )`
		2874	`{`
		2875	`unit_ind_dgtags[natint(i)] =`
		2876	`&capsule_dgtab[natint(ext)];`
		2877	`return;`
		2878	`}`
		2879
		2880	`linkextern f_make_dgtagextern`
		2881	`PROTO_N ( (internal, ext) )`
		2882	`PROTO_T ( tdfint internal X external ext )`
		2883	`{`
		2884	`dg_tag tg = &capsule_dgtab[natint(internal)];`
		2885	`tg->outref.k = LAB_STR;`
		2886	`tg->outref.u.s = external_to_string(ext);`
		2887	`return 0;`
		2888	`}`
		2889
		2890
		2891	`exp f_dg_exp`
		2892	`PROTO_N ( (body, diagnostic) )`
		2893	`PROTO_T ( exp body X dg diagnostic )`
		2894	`{`
		2895	`#ifdef NEWDIAGS`
		2896	`dgf(body) = add_dg_list (add_dg_list (new_dg_list (2), diagnostic, 0), dgf(body), 1);`
		2897	`#endif`
		2898	`return body;`
		2899	`}`
		2900
		2901	`exp read_dg_exp`
		2902	`PROTO_N ( (body) )`
		2903	`PROTO_T ( exp body )`
		2904	`{`
		2905	`dg diag;`
		2906	`#ifdef NEWDIAGS`
		2907	`int was_within_diags = within_diags;`
		2908	`within_diags = 1;`
		2909	`diag = d_dg();`
		2910	`within_diags = was_within_diags;`
		2911	`#endif`
		2912	`return f_dg_exp (body, diag);`
		2913	`}`
		2914

Subversion Repositories tendra.SVN

(root)/trunk/src/installers/common/diag/dg_fns.c – Rev 2