WebSVN – tendra.SVN – Blame – //branches/tendra4/src/installers/hppa/common/hppadiags.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	`VERSION INFORMATION`
		33	`===================`
		34
		35	`--------------------------------------------------------------------------`
		36	$Header: /u/g/release/CVSROOT/Source/src/installers/hppa/common/hppadiags.c,v 1.1.1.1 1998/01/17 15:56:02 release Exp $
		37	`--------------------------------------------------------------------------`
		38	$Log: hppadiags.c,v $
		39	`* Revision 1.1.1.1 1998/01/17 15:56:02 release`
		40	`* First version to be checked into rolling release.`
		41	`*`
		42	`* Revision 1.4 1996/08/06 10:50:06 wfs`
		43	`* bug fixes to pic code, enum diagnostics enabled.`
		44	`*`
		45	`* Revision 1.3 1996/03/28 10:53:09 wfs`
		46	`* Bug fixes to scan(), peephole optimisations in proc.c, and enum diagnostics.`
		47	`*`
		48	`* Revision 1.2 1995/12/18 13:11:30 wfs`
		49	`* Put hppatrans uder cvs control. Major Changes made since last release`
		50	`* include:`
		51	`* (i) PIC code generation.`
		52	`* (ii) Profiling.`
		53	`* (iii) Dynamic Initialization.`
		54	`* (iv) Debugging of Exception Handling and Diagnostics.`
		55	`*`
		56	`* Revision 5.11 1995/11/08 10:23:50 wfs`
		57	`* Minor changes for compatability with original "hpux_symtab.h" file +`
		58	`* extra warning messages.`
		59	`*`
		60	`* Revision 5.10 1995/11/03 13:24:28 wfs`
		61	`* Reset "typeno" after each call of " pos_of_dnttpos_of_dnttpointer". Cosmetic`
		62	`* changes.`
		63	`*`
		64	`* Revision 5.9 1995/10/30 12:58:57 wfs`
		65	`* Standardized the format of the warning messages.`
		66	`*`
		67	`* Revision 5.8 1995/10/25 14:30:42 wfs`
		68	`* Incorrect identifier for proc name was being output (in stab_proc()).`
		69	`*`
		70	`* Revision 5.7 1995/10/24 15:17:57 wfs`
		71	`* Fixed a bug in "pos_of_dnttpointer()".`
		72	`*`
		73	`* Revision 5.6 1995/10/20 13:53:51 wfs`
		74	`* Changes for gcc compilation.`
		75	`*`
		76	`* Revision 5.5 1995/10/09 13:13:46 wfs`
		77	`* Added an "SLT_EXIT" entry when closing functions - without this XDB`
		78	`* cannot properly trace return's. Cosmetic changes.`
		79	`*`
		80	`* Revision 5.4 1995/09/26 12:44:52 wfs`
		81	`* Moved "SLT_EXIT" in a case statement.`
		82	`*`
		83	`* Revision 5.3 1995/09/26 08:17:49 wfs`
		84	`* Added missing "#ifdef _SYMTAB_INCLUDED"'s.`
		85	`*`
		86	`* Revision 5.2 1995/09/25 11:46:04 wfs`
		87	`* Added "#ifdef _SYMTAB_INCLUDED" provisios around any code which refers`
		88	`* to "hpux-symtab.h". We cannot legally distribute this header file.`
		89	`* Added a procedure which will calculate where in the DNTT table a`
		90	`* struct typedef is to be entered without actually emitting the entry.`
		91	`* This is required whenever we have a struct typedef with a field being`
		92	`* a pointer to a struct of the type in question.`
		93	`*`
		94	`* Revision 5.1 1995/09/15 12:25:21 wfs`
		95	`* Numerous minor changes made to stop gcc complaining.`
		96	`*`
		97	`* Revision 5.0 1995/08/25 13:42:58 wfs`
		98	`* Preperation for August 25 Glue release`
		99	`*`
		100	`* Revision 3.4 1995/08/25 09:32:55 wfs`
		101	`* A major revision. XDB stuff added.`
		102	`*`
		103	`* Revision 3.4 1995/08/25 09:32:55 wfs`
		104	`* A major revision. XDB stuff added.`
		105	`*`
		106	`* Revision 3.1 95/04/10 16:26:44 16:26:44 wfs (William Simmonds)`
		107	`* Apr95 tape version.`
		108	`*`
		109	`* Revision 3.0 95/03/30 11:17:22 11:17:22 wfs (William Simmonds)`
		110	`* Mar95 tape version with CRCR95_178 bug fix.`
		111	`*`
		112	`* Revision 2.0 95/03/15 15:27:08 15:27:08 wfs (William Simmonds)`
		113	`* spec 3.1 changes implemented, tests outstanding.`
		114	`*`
		115	`* Revision 1.7 1995/01/11 16:40:35 john`
		116	`* Fixed bug in diagnostics (for change request CR95_40)`
		117	`*`
		118	`* Revision 1.6 1995/01/11 09:59:32 john`
		119	`* Fixed bug in diagnostics (for change request CR94_224)`
		120	`*`
		121	`* Revision 1.5 1994/07/07 16:11:33 djch`
		122	`* Jul94 tape`
		123	`*`
		124	`* Revision 1.4 1994/07/04 08:29:06 djch`
		125	`* added extra parameter to stab_scope_open`
		126
		127	`d (section number). -ve values used to control`
		128	`* not putting out stabd (sometimes) in solaris; line #s go in the stabs.`
		129	`* added assert(0) to catch uninitialized items.`
		130	`*`
		131	`* Revision 1.3 1994/06/22 09:48:33 djch`
		132	`* Changes for solaris - line #s in functions are relative to start of fns,`
		133	`* global decls have line # in the stabs, and no stabn, and local labels are .LL,`
		134	`* not LL`
		135	`*`
		136	`* Revision 1.2 1994/05/13 13:08:39 djch`
		137	`* Incorporates improvements from expt version`
		138	`* changed format strings to remove longs..`
		139	`*`
		140	`* Revision 1.1 1994/05/03 14:49:53 djch`
		141	`* Initial revision`
		142	`*`
		143	`* Revision 1.6 93/09/27 14:55:15 14:55:15 ra (Robert Andrews)`
		144	`* Only whitespace.`
		145	`*`
		146	`* Revision 1.5 93/08/27 11:37:55 11:37:55 ra (Robert Andrews)`
		147	`* A couple of lint-like changes.`
		148	`*`
		149	`* Revision 1.4 93/08/13 14:45:51 14:45:51 ra (Robert Andrews)`
		150	`* Allow the stabs for long double to vary depending on DOUBLE_SZ.`
		151	`*`
		152	`* Revision 1.3 93/07/05 18:26:29 18:26:29 ra (Robert Andrews)`
		153	`* A couple of minor corrections. Introduced stab_ptrs to avoid duplication`
		154	`* of basic pointer types.`
		155	`*`
		156	`* Revision 1.2 93/06/29 14:32:54 14:32:54 ra (Robert Andrews)`
		157	`* Fairly major rewrite and reformat. There were a number of errors which`
		158	`* meant that the diagnostics were not previously working.`
		159	`*`
		160	`* Revision 1.1 93/06/24 14:59:22 14:59:22 ra (Robert Andrews)`
		161	`* Initial revision`
		162	`*`
		163	`--------------------------------------------------------------------------`
		164	`*/`
		165
		166
		167	`#define HPPATRANS_CODE`
		168	`#include "config.h"`
		169	`#if FS_STDARG`
		170	`#include <stdarg.h>`
		171	`#else`
		172	`#include <varargs.h>`
		173	`#endif`
		174	`#include "addrtypes.h"`
		175	`#include "frames.h"`
		176	`#include "exptypes.h"`
		177	`#include "shapemacs.h"`
		178	`#include "expmacs.h"`
		179	`#include "codetypes.h"`
		180	`#include "installtypes.h"`
		181	`#include "toktypes.h"`
		182	`#include "exp.h"`
		183	`#include "exptypes.h"`
		184	`#include "proctypes.h"`
		185	`#include "procrec.h"`
		186	`#include "tags.h"`
		187	`#include "bitsmacs.h"`
		188	`#include "diagtypes.h"`
		189	`#include "xalloc.h"`
		190	`#include "diag_fns.h"`
		191	`#include "locate.h"`
		192	`#include "diagglob.h"`
		193	`#include "mark_scope.h"`
		194	`#include "xalloc.h"`
		195	`#include "comment.h"`
		196	`#include "myassert.h"`
		197	`#include "translat.h"`
		198	`#include "machine.h"`
		199	`#include "szs_als.h"`
		200	`#include "install_fns.h"`
		201	`#include "installglob.h"`
		202	`#include "externs.h"`
		203	`#include "out.h"`
		204	`#include "hppadiags.h"`
		205
		206	`#ifdef _SYMTAB_INCLUDED`
		207	`#undef _SYMTAB_INCLUDED`
		208	`#include "hpux-symtab.h"`
		209	`#endif`
		210
		211
		212
		213	`extern bool last_param PROTO_S ( ( exp ) ) ;`
		214
		215
		216	`/*`
		217	`FORWARD DECLARATIONS`
		218	`*/`
		219
		220	`static void stab_scope_open PROTO_S ( ( long ) ) ;`
		221	`static void stab_scope_close PROTO_S ( ( long ) ) ;`
		222
		223	`#ifdef _SYMTAB_INCLUDED`
		224	`static int last_lno = 0;`
		225	`#endif`
		226
		227	`/*`
		228	`ARRAY OF DIAGNOSTIC SCOPES`
		229	`*/`
		230
		231	`#define MAX_LEX_LEVEL 256`
		232	`static long bracket_level = 1 ;`
		233	`static long BB_id = 0;`
		234	`static long BE_id = 0;`
		235	`static int last_LBRAC_stab = 0;`
		236
		237	`/*`
		238	`DIAGNOSTICS FILE`
		239	`*/`
		240
		241	`static FILE *dg_file;`
		242	`static char dg_file_name[L_tmpnam];`
		243
		244
		245	`/*`
		246	`BASIC TYPE NUMBERS`
		247	`*/`
		248
		249	`#define STAB_SCHAR 4`
		250	`#define STAB_UCHAR 6`
		251	`#define STAB_SSHRT 2`
		252	`#define STAB_USHRT 3`
		253	`#define STAB_SLONG 1`
		254	`#define STAB_ULONG 8`
		255	`#define STAB_FLOAT 10`
		256	`#define STAB_DBL 11`
		257	`#define STAB_LDBL 12`
		258	`#define STAB_VOID 13`
		259	`#define NO_STABS 14`
		260
		261
		262	`/*`
		263	`BASIC POINTERS`
		264	`*/`
		265
		266	`static long stab_ptrs [ NO_STABS ] = {`
		267	`0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0`
		268	`} ;`
		269
		270
		271	`/*`
		272	`CURRENT TYPE NUMBER`
		273	`*/`
		274
		275	`static long typeno = NO_STABS ;`
		276
		277
		278	`/*`
		279	`SIZE OF LAST STAB TYPE OUTPUT`
		280	`*/`
		281
		282	`static long last_type_sz = 0 ;`
		283
		284
		285	`/*`
		286	`CURRENT LINE NUMBER AND FILE NUMBER`
		287	`*/`
		288
		289	`long currentlno = -1 ;`
		290	`long currentfile = -1 ;`
		291
		292	`#ifndef _SYMTAB_INCLUDED`
		293
		294	`typedef int DNTTPOINTER;`
		295
		296	`#endif`
		297
		298	`static DNTTPOINTER NIL;`
		299
		300	`/*`
		301	`ARRAY OF TYPE SIZES`
		302	`*/`
		303
		304
		305	`/* Information about previously defined types. */`
		306
		307	`typedef struct { int sz; DNTTPOINTER p; } type_info_t;`
		308
		309	`static type_info_t *type_info ;`
		310	`static int no_type_info = 0 ;`
		311
		312
		313	`/*`
		314	`SETTING AND GETTING TYPE SIZES`
		315	`*/`
		316
		317	`#define set_stab_size( i ) type_info [ ( i ) ].sz = last_type_sz`
		318	`#define get_stab_size( i ) ( type_info [ ( i ) ].sz )`
		319
		320
		321	`/*`
		322	`GET THE NEXT TYPE NUMBER`
		323	`*/`
		324
		325	`static long next_typen`
		326	`PROTO_Z ()`
		327	`{`
		328	`if ( typeno >= no_type_info ) {`
		329	`int i, n = no_type_info, m = n + 100 ;`
		330	`type_info = ( type_info_t* ) xrealloc ( type_info, m * sizeof ( type_info_t ) ) ;`
		331	`for ( i = n ; i < m ; i++ ) type_info [i].sz = 0 ;`
		332	`no_type_info = m ;`
		333	`}`
		334	`return ( typeno++ ) ;`
		335	`}`
		336
		337
		338	`/*`
		339	`ARRAY OF FILE DESCRIPTORS`
		340	`*/`
		341
		342	`static filename *fds = null ;`
		343	`static int szfds = 0 ;`
		344	`static int nofds = 0 ;`
		345
		346
		347	`/* tdfstring -> nul terminated C string (char ) /`
		348	`#define CSTRING(tdfstring) ((tdfstring).ints.chars)`
		349
		350	`/* tdf exp -> C int */`
		351	`#define EXPINT(exp) (assert(name(exp) == val_tag) , no(exp))`
		352
		353	`/* tdf nat -> C int */`
		354	`#define NATINT(n) ((n).nat_val.small_nat)`
		355
		356
		357
		358	`#ifdef _SYMTAB_INCLUDED`
		359	`/**************************** XDB stuff *******************************/`
		360
		361	`static FILE VT_,SLT_,LNTT_,GNTT_ ;`
		362
		363	`static char VT_name[L_tmpnam], SLT_name[L_tmpnam],`
		364	`LNTT_name[L_tmpnam], GNTT_name[L_tmpnam] ;`
		365
		366	`static DNTTPOINTER DNTT_BEGIN_entry[1024];`
		367
		368	`static int level_of_DNTT_BEGINs = -1;`
		369
		370	`#define last_DNTT_BEGIN_entry() DNTT_BEGIN_entry[level_of_DNTT_BEGINs]`
		371	`#define LNTT 1`
		372	`#define GNTT 0`
		373
		374	`static DNTTPOINTER lntt_next;`
		375	`static DNTTPOINTER gntt_next;`
		376	`static SLTPOINTER slt_next = 0;`
		377	`static VTPOINTER vt_next = VTNIL;`
		378
		379	`struct vt_entry_t { long findex;`
		380	`VTPOINTER vtp;`
		381	`struct vt_entry_t *prev; };`
		382
		383	`typedef struct vt_entry_t *vt_entry;`
		384
		385	`vt_entry last_vt_entry = (vt_entry)0;`
		386
		387	`VTPOINTER is_vt_entry`
		388	`PROTO_N ( ( findex ) )`
		389	`PROTO_T ( long findex )`
		390	`{`
		391	`vt_entry current = last_vt_entry;`
		392	`while ( current != (vt_entry)0 )`
		393	`{`
		394	`if ( current->findex == findex )`
		395	`return current->vtp;`
		396	`else`
		397	`current = current->prev;`
		398	`}`
		399	`return VTNIL;`
		400	`}`
		401
		402	`#define EXTENSION_BIT( p ) ( (p)&(1<<31) )`
		403
		404	`void output_LNTT`
		405	`PROTO_N ( ( e ) )`
		406	`PROTO_T ( union dnttentry e )`
		407	`{`
		408	`KINDTYPE kind = e.dfunc.kind;`
		409	`if (kind==K_SVAR)`
		410	`{`
		411	`fprintf(LNTT_,"\t.WORD\t%lu,%lu,%s",e.dgeneric.word[0], e.dgeneric.word[1], (char*)e.dgeneric.word[2]);`
		412	`}`
		413	`else`
		414	`{`
		415	`fprintf(LNTT_,"\t.WORD\t%lu,%lu,%lu",e.dgeneric.word[0], e.dgeneric.word[1], e.dgeneric.word[2]);`
		416	`}`
		417
		418	`switch ( kind )`
		419	`{`
		420	`case K_MODULE:`
		421	`case K_WITH:`
		422	`case K_FPARAM:`
		423	`case K_SVAR:`
		424	`case K_DVAR:`
		425	`case K_CONST:`
		426	`case K_MEMENUM:`
		427	`case K_SUBRANGE:`
		428	`case K_ARRAY:`
		429	`case K_STRUCT:`
		430	`case K_FIELD:`
		431	`case K_VARIANT:`
		432	`case K_FILE:`
		433	`case K_FUNCTYPE:`
		434	`{`
		435	`if ( EXTENSION_BIT(e.dgeneric.word[3])==0 )`
		436	`{`
		437	`fprintf(stderr,"hppatrans warning: trans made an error whilst compiling XDB diagnostics tables (extension bit not set)\n");`
		438	`}`
		439	`else`
		440	`{`
		441	`fprintf(LNTT_,",%lu,%lu,%lu",e.dgeneric.word[3],e.dgeneric.word[4], e.dgeneric.word[5]);`
		442	`}`
		443	`break;`
		444	`}`
		445	`case K_FUNCTION:`
		446	`case K_ENTRY:`
		447	`case K_BLOCKDATA:`
		448	`case K_COBSTRUCT:`
		449	`{`
		450	`if ( EXTENSION_BIT(e.dgeneric.word[3])==0 )`
		451	`{`
		452	`fprintf(stderr,"hppatrans warning: trans made an error whilst compiling XDB diagnostics tables (extension bit not set)\n");`
		453	`break;`
		454	`}`
		455	`else`
		456	`{`
		457	`fprintf(LNTT_,",%lu,%lu,%s",e.dgeneric.word[3],e.dgeneric.word[4], (char*)e.dgeneric.word[5]);`
		458	`}`
		459	`if ( EXTENSION_BIT(e.dgeneric.word[6])==0 )`
		460	`{`
		461	`fprintf(stderr,"hppatrans warning: trans made an error whilst compiling XDB diagnostics tables (extension bit not set)\n");`
		462	`}`
		463	`else`
		464	`{`
		465	`fprintf(LNTT_,",%lu,%s,%s",e.dgeneric.word[6], (char)e.dgeneric.word[7],(char)e.dgeneric.word[8]);`
		466	`}`
		467	`}`
		468	`default:`
		469	`break;`
		470	`}`
		471	`fprintf(LNTT_,"\n");`
		472	`}`
		473
		474
		475	`void output_GNTT`
		476	`PROTO_N ( ( e ) )`
		477	`PROTO_T ( union dnttentry e )`
		478	`{`
		479	`KINDTYPE kind = e.dfunc.kind;`
		480	`if (kind==K_SVAR)`
		481	`{`
		482	`fprintf(GNTT_,"\t.WORD\t%lu,%lu,%s",e.dgeneric.word[0], e.dgeneric.word[1], (char*)e.dgeneric.word[2]);`
		483	`if ( EXTENSION_BIT(e.dgeneric.word[3])==0 )`
		484	`{`
		485	`fprintf(stderr,"hppatrans warning: trans made an error whilst compiling XDB diagnostics tables (extension bit not set)\n");`
		486	`}`
		487	`else`
		488	`{`
		489	`fprintf(GNTT_,",%lu,%lu,%lu",e.dgeneric.word[3],e.dgeneric.word[4], e.dgeneric.word[5]);`
		490	`}`
		491	`}`
		492	`else`
		493	`{`
		494	`fprintf(GNTT_,"\t.WORD\t%lu,%lu,%lu",e.dgeneric.word[0], e.dgeneric.word[1], e.dgeneric.word[2]);`
		495	`}`
		496	`if (e.dgeneric.word[6]&(1<<31))`
		497	`{`
		498	`fprintf(GNTT_,",%lu,%lu,%lu",e.dgeneric.word[6],e.dgeneric.word[7], e.dgeneric.word[8]);`
		499	`}`
		500	`fprintf(GNTT_,"\n");`
		501	`}`
		502
		503
		504	`DNTTPOINTER make_DNTTP_IMMEDIATE`
		505	`PROTO_V ( ( BASETYPE type, ... ) )`
		506	`{`
		507	`DNTTPOINTER p;`
		508	`va_list ap;`
		509	`#if FS_STDARG`
		510	`va_start(ap,type);`
		511	`#else`
		512	`BASETYPE type;`
		513	`va_start(ap);`
		514	`type = va_arg(ap, BASETYPE);`
		515	`#endif`
		516	`p.dntti.extension = 1;`
		517	`p.dntti.immediate = 1;`
		518	`p.dntti.global = 0;`
		519	`p.dntti.type = type;`
		520	`switch( type )`
		521	`{`
		522	`case T_UNDEFINED:`
		523	`{`
		524	`p.dntti.bitlength = 32;`
		525	`break;`
		526	`}`
		527	`case T_BOOLEAN:`
		528	`{`
		529	`p.dntti.bitlength = 1;`
		530	`break;`
		531	`}`
		532	`case T_CHAR:`
		533	`case T_INT:`
		534	`case T_UNS_INT:`
		535	`case T_LONG:`
		536	`case T_UNS_LONG:`
		537	`case T_REAL:`
		538	`case T_COMPLEX:`
		539	`{`
		540	`p.dntti.bitlength = va_arg(ap,BITS);`
		541	`break;`
		542	`}`
		543	`}`
		544	`return p;`
		545	`}`
		546
		547
		548	`void make_vtentry`
		549	`PROTO_T ( ( e X record X findex ) )`
		550	`PROTO_T ( char *e X int record X long findex )`
		551	`{`
		552	`int len = 0;`
		553	`fprintf(VT_,"\t.STRINGZ\t\"");`
		554	`while (e[len++])`
		555	`{`
		556	`fprintf(VT_,"%c",e[len-1]);`
		557	`}`
		558	`if ( record )`
		559	`{`
		560	`vt_entry next = (vt_entry) malloc(sizeof(struct vt_entry_t));`
		561	`if ( last_vt_entry == (vt_entry)0 )`
		562	`{`
		563	`last_vt_entry = next;`
		564	`last_vt_entry->prev = (vt_entry)0;`
		565	`}`
		566	`else`
		567	`{`
		568	`next->prev = last_vt_entry;`
		569	`last_vt_entry = next;`
		570	`}`
		571	`next->findex = findex;`
		572	`next->vtp = vt_next;`
		573	`}`
		574	`vt_next+=len;`
		575	`fprintf(VT_,"\"\n");`
		576	`}`
		577
		578
		579	`void make_sltentry`
		580	`PROTO_V ( ( SLTTYPE sltdesc, ... ) )`
		581	`{`
		582	`va_list ap;`
		583	`union sltentry e;`
		584	`#if FS_STDARG`
		585	`va_start(ap,sltdesc);`
		586	`#else`
		587	`SLTTYPE sltdesc;`
		588	`va_start(ap);`
		589	`sltdesc = va_arg(ap, SLTTYPE);`
		590	`#endif`
		591	`e.sgeneric.word[0] = 0;`
		592	`e.sgeneric.word[1] = 0;`
		593	`switch(sltdesc)`
		594	`{`
		595	`case SLT_SRCFILE:`
		596	`case SLT_MODULE:`
		597	`case SLT_FUNCTION:`
		598	`case SLT_ENTRY:`
		599	`case SLT_BEGIN:`
		600	`case SLT_END:`
		601	`case SLT_WITH:`
		602	`case SLT_MARKER:`
		603	`{`
		604	`/* A "special" entry */`
		605	`e.sspec.sltdesc = sltdesc;`
		606	`e.sspec.line = va_arg(ap,BITS);`
		607	`e.sspec.backptr = va_arg(ap,DNTTPOINTER);`
		608	`fprintf(SLT_,"\t.WORD\t%lu,%lu\n",e.sgeneric.word[0], e.sgeneric.word[1]);`
		609	`break;`
		610	`}`
		611	`case SLT_EXIT:`
		612	`case SLT_NORMAL:`
		613	`{`
		614	`/* A "normal" entry */`
		615	`e.snorm.sltdesc = SLT_NORMAL;`
		616	`e.snorm.line = va_arg(ap,BITS);`
		617	`e.snorm.address = va_arg(ap,ADDRESS);`
		618	`fprintf(SLT_,"\t.WORD\t%lu,%s\n",e.sgeneric.word[0], (char*)e.sgeneric.word[1]);`
		619	`break;`
		620	`}`
		621	`case SLT_ASSIST:`
		622	`{`
		623	`/* An "assist" entry */`
		624	`e.sasst.sltdesc = SLT_ASSIST;`
		625	`e.sasst.unused = 0;`
		626	`e.sasst.address = va_arg(ap,ADDRESS);`
		627	`fprintf(SLT_,"\t.WORD\t%lu,%lu\n",e.sgeneric.word[0], e.sgeneric.word[1]);`
		628	`break;`
		629	`}`
		630	`}`
		631	`slt_next++;`
		632	`}`
		633
		634
		635	`DNTTPOINTER make_dnttentry`
		636	`PROTO_V ( ( KINDTYPE kind, ... ) )`
		637	`{`
		638	`va_list ap;`
		639	`union dnttentry e;`
		640	`DNTTPOINTER dnttpointer;`
		641	`#if FS_STDARG`
		642	`va_start(ap,kind);`
		643	`#else`
		644	`KINDTYPE kind;`
		645	`va_start(ap);`
		646	`kind = va_arg(ap, KINDTYPE);`
		647	`#endif`
		648	`e.dsfile.extension = 0;`
		649	`e.dsfile.kind = K_SRCFILE;`
		650	`e.dsfile.language = 0;`
		651	`dnttpointer = lntt_next;`
		652	`switch(kind)`
		653	`{`
		654	`case K_SRCFILE:`
		655	`{`
		656	`e.dsfile.extension = 0;`
		657	`e.dsfile.kind = K_SRCFILE;`
		658	`e.dsfile.language = va_arg(ap,LANGTYPE);`
		659	`e.dsfile.unused = 0;`
		660	`e.dsfile.name = va_arg(ap,VTPOINTER);`
		661	`e.dsfile.address = va_arg(ap,SLTPOINTER);`
		662	`output_LNTT(e);`
		663	`lntt_next.word++;`
		664	`break;`
		665	`}`
		666	`case K_MODULE:`
		667	`{`
		668	`DNTT_BEGIN_entry[++level_of_DNTT_BEGINs] = lntt_next;`
		669	`e.dmodule.extension = 0;`
		670	`e.dmodule.kind = K_MODULE;`
		671	`e.dmodule.unused = 0;`
		672	`e.dmodule.name = va_arg(ap,VTPOINTER);`
		673	`e.dmodule.alias = va_arg(ap,VTPOINTER);`
		674	`e.dmodule.dummy = NIL;`
		675	`e.dmodule.address = va_arg(ap,SLTPOINTER);`
		676	`e.dgeneric.word[5] = 0;`
		677	`output_LNTT(e);`
		678	`lntt_next.word+=2;`
		679	`break;`
		680	`}`
		681	`case K_FUNCTION:`
		682	`case K_ENTRY:`
		683	`case K_BLOCKDATA:`
		684	`{`
		685	`if (kind==K_FUNCTION)`
		686	`DNTT_BEGIN_entry[++level_of_DNTT_BEGINs] = lntt_next;`
		687	`e.dfunc.extension = 0;`
		688	`e.dfunc.kind = kind;`
		689	`e.dfunc.public = va_arg(ap,BITS);`
		690	`e.dfunc.language = va_arg(ap,LANGTYPE);`
		691	`e.dfunc.level = va_arg(ap,BITS);`
		692	`e.dfunc.optimize = va_arg(ap,BITS);`
		693	`e.dfunc.varargs = va_arg(ap,BITS);`
		694	`e.dfunc.info = va_arg(ap,BITS);`
		695	`e.dfunc.unused = 0;`
		696	`e.dfunc.name = va_arg(ap,VTPOINTER);`
		697	`e.dfunc.alias = va_arg(ap,VTPOINTER);`
		698	`e.dfunc.firstparam = va_arg(ap,DNTTPOINTER);`
		699	`e.dfunc.address = va_arg(ap,SLTPOINTER);`
		700	`e.dfunc.entryaddr = va_arg(ap,ADDRESS);`
		701	`e.dfunc.retval = va_arg(ap,DNTTPOINTER);`
		702	`e.dfunc.lowaddr = va_arg(ap,ADDRESS);`
		703	`e.dfunc.hiaddr = va_arg(ap,ADDRESS);`
		704	`output_LNTT(e);`
		705	`lntt_next.word+=3;`
		706	`break;`
		707	`}`
		708	`case K_BEGIN:`
		709	`{`
		710	`DNTT_BEGIN_entry[++level_of_DNTT_BEGINs] = lntt_next;`
		711	`e.dbegin.extension = 0;`
		712	`e.dbegin.kind = K_BEGIN;`
		713	`e.dbegin.unused = 0;`
		714	`e.dbegin.address = va_arg(ap,SLTPOINTER);`
		715	`e.dgeneric.word[2] = 0;`
		716	`output_LNTT(e);`
		717	`lntt_next.word++;`
		718	`break;`
		719	`}`
		720	`case K_END:`
		721	`{`
		722	`e.dend.extension = 0;`
		723	`e.dend.kind = K_END;`
		724	`e.dend.endkind = va_arg(ap,KINDTYPE);`
		725	`e.dend.unused = 0;`
		726	`e.dend.address = va_arg(ap,SLTPOINTER);`
		727	`e.dend.beginscope = va_arg(ap,DNTTPOINTER);`
		728	`output_LNTT(e);`
		729	`lntt_next.word++;`
		730	`level_of_DNTT_BEGINs--;`
		731	`break;`
		732	`}`
		733	`case K_IMPORT:`
		734	`{`
		735	`e.dimport.extension = 0;`
		736	`e.dimport.kind = K_IMPORT;`
		737	`e.dimport.explicit = va_arg(ap,BITS);`
		738	`e.dimport.unused = 0;`
		739	`e.dimport.module = va_arg(ap,VTPOINTER);`
		740	`e.dimport.item = va_arg(ap,VTPOINTER);`
		741	`output_LNTT(e);`
		742	`lntt_next.word++;`
		743	`break;`
		744	`}`
		745	`case K_LABEL:`
		746	`{`
		747	`e.dlabel.extension = 0;`
		748	`e.dlabel.kind = K_LABEL;`
		749	`e.dlabel.unused = 0;`
		750	`e.dlabel.name = va_arg(ap,VTPOINTER);`
		751	`e.dlabel.address = va_arg(ap,SLTPOINTER);`
		752	`output_LNTT(e);`
		753	`lntt_next.word++;`
		754	`break;`
		755	`}`
		756	`case K_WITH:`
		757	`{`
		758	`e.dwith.extension = 0;`
		759	`e.dwith.kind = K_WITH;`
		760	`e.dwith.addrtype = va_arg(ap,BITS);`
		761	`e.dwith.indirect = va_arg(ap,BITS);`
		762	`e.dwith.longaddr = va_arg(ap,BITS);`
		763	`e.dwith.nestlevel = va_arg(ap,BITS);`
		764	`e.dwith.unused = 0;`
		765	`e.dwith.location = va_arg(ap,long);`
		766	`e.dwith.address = va_arg(ap,SLTPOINTER);`
		767	`e.dwith.type = va_arg(ap,DNTTPOINTER);`
		768	`e.dwith.name = va_arg(ap,VTPOINTER);`
		769	`e.dwith.offset = va_arg(ap,unsigned long);`
		770	`output_LNTT(e);`
		771	`lntt_next.word+=2;`
		772	`break;`
		773	`}`
		774	`case K_COMMON:`
		775	`{`
		776	`e.dcommon.extension = 0;`
		777	`e.dcommon.kind = K_COMMON;`
		778	`e.dcommon.unused = 0;`
		779	`e.dcommon.name = va_arg(ap,VTPOINTER);`
		780	`e.dcommon.alias = va_arg(ap,VTPOINTER);`
		781	`output_LNTT(e);`
		782	`lntt_next.word++;`
		783	`break;`
		784	`}`
		785	`case K_FPARAM:`
		786	`{`
		787	`e.dfparam.extension = 0;`
		788	`e.dfparam.kind = K_FPARAM;`
		789	`e.dfparam.regparam = va_arg(ap,BITS);`
		790	`e.dfparam.indirect = va_arg(ap,BITS);`
		791	`e.dfparam.longaddr = va_arg(ap,BITS);`
		792	`e.dfparam.copyparam = va_arg(ap,BITS);`
		793	`e.dfparam.unused = 0;`
		794	`e.dfparam.name = va_arg(ap,VTPOINTER);`
		795	`e.dfparam.location = va_arg(ap,DYNTYPE);`
		796	`e.dfparam.type = va_arg(ap,DNTTPOINTER);`
		797	`e.dfparam.nextparam = va_arg(ap,DNTTPOINTER);`
		798	`e.dfparam.misc = 0;`
		799	`output_LNTT(e);`
		800	`lntt_next.word+=2;`
		801	`break;`
		802	`}`
		803	`case K_SVAR:`
		804	`{`
		805	`int which_table;`
		806	`e.dsvar.extension = 0;`
		807	`e.dsvar.kind = K_SVAR;`
		808	`e.dsvar.public = va_arg(ap,BITS);`
		809	`e.dsvar.indirect = va_arg(ap,BITS);`
		810	`e.dsvar.longaddr = va_arg(ap,BITS);`
		811	`e.dsvar.unused = 0;`
		812	`e.dsvar.name = va_arg(ap,VTPOINTER);`
		813	`e.dsvar.location = va_arg(ap,STATTYPE);`
		814	`e.dsvar.type = va_arg(ap,DNTTPOINTER);`
		815	`e.dsvar.offset = va_arg(ap,unsigned long);`
		816	`e.dsvar.displacement = va_arg(ap,unsigned long);`
		817	`which_table = va_arg(ap,int);`
		818	`if (which_table==LNTT)`
		819	`{`
		820	`output_LNTT(e);`
		821	`lntt_next.word+=2;`
		822	`}`
		823	`else`
		824	`{`
		825	`dnttpointer = gntt_next;`
		826	`output_GNTT(e);`
		827	`gntt_next.word+=2;`
		828	`}`
		829	`break;`
		830	`}`
		831	`case K_DVAR:`
		832	`{`
		833	`e.ddvar.extension = 0;`
		834	`e.ddvar.kind = K_DVAR;`
		835	`e.ddvar.public = va_arg(ap,BITS);`
		836	`e.ddvar.indirect = va_arg(ap,BITS);`
		837	`e.ddvar.regvar = va_arg(ap,BITS);`
		838	`e.ddvar.unused = 0;`
		839	`e.ddvar.name = va_arg(ap,VTPOINTER);`
		840	`e.ddvar.location = va_arg(ap,DYNTYPE);`
		841	`e.ddvar.type = va_arg(ap,DNTTPOINTER);`
		842	`e.ddvar.offset = 0;`
		843	`e.dgeneric.word[5] = 0;`
		844	`output_LNTT(e);`
		845	`lntt_next.word+=2;`
		846	`break;`
		847	`}`
		848	`case K_CONST:`
		849	`{`
		850	`e.dconst.extension = 0;`
		851	`e.dconst.kind = K_CONST;`
		852	`e.dconst.public = va_arg(ap,BITS);`
		853	`e.dconst.indirect = va_arg(ap,BITS);`
		854	`e.dconst.locdesc = va_arg(ap,LOCDESCTYPE);`
		855	`e.dconst.unused = 0;`
		856	`e.dconst.name = va_arg(ap,VTPOINTER);`
		857	`e.dconst.location = va_arg(ap,STATTYPE);`
		858	`e.dconst.type = va_arg(ap,DNTTPOINTER);`
		859	`e.dconst.offset = va_arg(ap,unsigned long);`
		860	`e.dconst.displacement = va_arg(ap,unsigned long);`
		861	`output_LNTT(e);`
		862	`lntt_next.word+=2;`
		863	`break;`
		864	`}`
		865	`case K_TYPEDEF:`
		866	`case K_TAGDEF:`
		867	`{`
		868	`e.dtype.extension = 0;`
		869	`e.dtype.kind = kind;`
		870	`e.dtype.public = va_arg(ap,BITS);`
		871	`e.dtype.typeinfo = va_arg(ap,BITS);`
		872	`e.dtype.unused = 0;`
		873	`e.dtype.name = va_arg(ap,VTPOINTER);`
		874	`e.dtype.type = va_arg(ap,DNTTPOINTER);`
		875	`output_LNTT(e);`
		876	`lntt_next.word++;`
		877	`break;`
		878	`}`
		879	`case K_POINTER:`
		880	`{`
		881	`e.dptr.extension = 0;`
		882	`e.dptr.kind = kind;`
		883	`e.dptr.unused = 0;`
		884	`e.dptr.pointsto = va_arg(ap,DNTTPOINTER);`
		885	`e.dptr.bitlength = va_arg(ap,unsigned long);`
		886	`output_LNTT(e);`
		887	`lntt_next.word++;`
		888	`break;`
		889	`}`
		890	`case K_ENUM:`
		891	`{`
		892	`e.denum.extension = 0;`
		893	`e.denum.kind = K_ENUM;`
		894	`e.denum.unused = 0;`
		895	`e.denum.firstmem = va_arg(ap,DNTTPOINTER);`
		896	`e.denum.bitlength = va_arg(ap,unsigned long);`
		897	`output_LNTT(e);`
		898	`lntt_next.word++;`
		899	`break;`
		900	`}`
		901	`case K_MEMENUM:`
		902	`{`
		903	`e.dmember.extension = 0;`
		904	`e.dmember.kind = K_MEMENUM;`
		905	`e.dmember.unused = 0;`
		906	`e.dmember.name = va_arg(ap,VTPOINTER);`
		907	`e.dmember.value = va_arg(ap,unsigned long);`
		908	`e.dmember.nextmem = va_arg(ap,DNTTPOINTER);`
		909	`e.dgeneric.word[4] = 0;`
		910	`e.dgeneric.word[5] = 0;`
		911	`output_LNTT(e);`
		912	`lntt_next.word+=2;`
		913	`break;`
		914	`}`
		915	`case K_SET:`
		916	`{`
		917	`e.dset.extension = 0;`
		918	`e.dset.kind = K_SET;`
		919	`e.dset.declaration = va_arg(ap,BITS);`
		920	`e.dset.unused = 0;`
		921	`e.dset.subtype = va_arg(ap,DNTTPOINTER);`
		922	`e.dset.bitlength = va_arg(ap,unsigned long);`
		923	`output_LNTT(e);`
		924	`lntt_next.word++;`
		925	`break;`
		926	`}`
		927	`case K_SUBRANGE:`
		928	`{`
		929	`e.dsubr.extension = 0;`
		930	`e.dsubr.kind = K_SUBRANGE;`
		931	`e.dsubr.dyn_low = va_arg(ap,BITS);`
		932	`e.dsubr.dyn_high = va_arg(ap,BITS);`
		933	`e.dsubr.unused = 0;`
		934	`e.dsubr.lowbound = va_arg(ap,long);`
		935	`e.dsubr.highbound = va_arg(ap,long);`
		936	`e.dsubr.subtype = va_arg(ap,DNTTPOINTER);`
		937	`e.dsubr.bitlength = va_arg(ap,unsigned long);`
		938	`e.dgeneric.word[5] = 0;`
		939	`output_LNTT(e);`
		940	`lntt_next.word+=2;`
		941	`break;`
		942	`}`
		943	`case K_ARRAY:`
		944	`{`
		945	`e.darray.extension = 0;`
		946	`e.darray.kind = K_ARRAY;`
		947	`e.darray.declaration = va_arg(ap,BITS);`
		948	`e.darray.dyn_low = va_arg(ap,BITS);`
		949	`e.darray.dyn_high = va_arg(ap,BITS);`
		950	`e.darray.arrayisbytes = va_arg(ap,BITS);`
		951	`e.darray.elemisbytes = va_arg(ap,BITS);`
		952	`e.darray.elemorder = va_arg(ap,BITS);`
		953	`e.darray.justified = va_arg(ap,BITS);`
		954	`e.darray.unused = 0;`
		955	`e.darray.arraylength = va_arg(ap,unsigned long);`
		956	`e.darray.indextype = va_arg(ap,DNTTPOINTER);`
		957	`e.darray.elemtype = va_arg(ap,DNTTPOINTER);`
		958	`e.darray.elemlength = va_arg(ap,unsigned long);`
		959	`e.dgeneric.word[5] = 0;`
		960	`output_LNTT(e);`
		961	`lntt_next.word+=2;`
		962	`break;`
		963	`}`
		964	`case K_STRUCT:`
		965	`{`
		966	`e.dstruct.extension = 0;`
		967	`e.dstruct.kind = K_STRUCT;`
		968	`e.dstruct.declaration = va_arg(ap,BITS);`
		969	`e.dstruct.unused = 0;`
		970	`e.dstruct.firstfield = va_arg(ap,DNTTPOINTER);`
		971	`e.dstruct.vartagfield = va_arg(ap,DNTTPOINTER);`
		972	`e.dstruct.varlist = va_arg(ap,DNTTPOINTER);`
		973	`e.dstruct.bitlength = va_arg(ap,unsigned long);`
		974	`e.dgeneric.word[5] = 0;`
		975	`output_LNTT(e);`
		976	`lntt_next.word+=2;`
		977	`break;`
		978	`}`
		979	`case K_UNION:`
		980	`{`
		981	`e.dunion.extension = 0;`
		982	`e.dunion.kind = K_UNION;`
		983	`e.dunion.unused = 0;`
		984	`e.dunion.firstfield = va_arg(ap,DNTTPOINTER);`
		985	`e.dunion.bitlength = va_arg(ap,unsigned long);`
		986	`output_LNTT(e);`
		987	`lntt_next.word++;`
		988	`break;`
		989	`}`
		990	`case K_FIELD:`
		991	`{`
		992	`e.dfield.extension = 0;`
		993	`e.dfield.kind = K_FIELD;`
		994	`e.dfield.unused = 0;`
		995	`e.dfield.name = va_arg(ap,VTPOINTER);`
		996	`e.dfield.bitoffset = va_arg(ap,unsigned long);`
		997	`e.dfield.type = va_arg(ap,DNTTPOINTER);`
		998	`e.dfield.bitlength = va_arg(ap,unsigned long);`
		999	`e.dfield.nextfield = va_arg(ap,DNTTPOINTER);`
		1000	`output_LNTT(e);`
		1001	`lntt_next.word+=2;`
		1002	`break;`
		1003	`}`
		1004	`case K_VARIANT:`
		1005	`{`
		1006	`e.dvariant.extension = 0;`
		1007	`e.dvariant.kind = K_VARIANT;`
		1008	`e.dvariant.unused = 0;`
		1009	`e.dvariant.lowvarvalue = va_arg(ap,long);`
		1010	`e.dvariant.hivarvalue = va_arg(ap,long);`
		1011	`e.dvariant.varstruct = va_arg(ap,DNTTPOINTER);`
		1012	`e.dvariant.bitoffset = va_arg(ap,unsigned long);`
		1013	`e.dvariant.nextvar = va_arg(ap,DNTTPOINTER);`
		1014	`output_LNTT(e);`
		1015	`lntt_next.word+=2;`
		1016	`break;`
		1017	`}`
		1018	`case K_FILE:`
		1019	`{`
		1020	`e.dfile.extension = 0;`
		1021	`e.dfile.kind = K_FILE;`
		1022	`e.dfile.ispacked = va_arg(ap,BITS);`
		1023	`e.dfile.unused = 0;`
		1024	`e.dfile.bitlength = va_arg(ap,unsigned long);`
		1025	`e.dfile.bitoffset = va_arg(ap,unsigned long);`
		1026	`e.dfile.elemtype = va_arg(ap,DNTTPOINTER);`
		1027	`e.dgeneric.word[4] = 0;`
		1028	`e.dgeneric.word[5] = 0;`
		1029	`output_LNTT(e);`
		1030	`lntt_next.word+=2;`
		1031	`break;`
		1032	`}`
		1033	`case K_FUNCTYPE:`
		1034	`{`
		1035	`e.dfunctype.extension = 0;`
		1036	`e.dfunctype.kind = K_FUNCTYPE;`
		1037	`e.dfunctype.varargs = va_arg(ap,BITS);`
		1038	`e.dfunctype.info = va_arg(ap,BITS);`
		1039	`e.dfunctype.unused = 0;`
		1040	`e.dfunctype.bitlength = va_arg(ap,unsigned long);`
		1041	`e.dfunctype.firstparam = va_arg(ap,DNTTPOINTER);`
		1042	`e.dfunctype.retval = va_arg(ap,DNTTPOINTER);`
		1043	`e.dgeneric.word[4] = 0;`
		1044	`e.dgeneric.word[5] = 0;`
		1045	`output_LNTT(e);`
		1046	`lntt_next.word+=2;`
		1047	`break;`
		1048	`}`
		1049	`case K_COBSTRUCT:`
		1050	`{`
		1051	`e.dcobstruct.extension = 0;`
		1052	`e.dcobstruct.kind = K_COBSTRUCT;`
		1053	`e.dcobstruct.hasoccurs = va_arg(ap,BITS);`
		1054	`e.dcobstruct.istable = va_arg(ap,BITS);`
		1055	`e.dcobstruct.unused = 0;`
		1056	`e.dcobstruct.parent = va_arg(ap,DNTTPOINTER);`
		1057	`e.dcobstruct.child = va_arg(ap,DNTTPOINTER);`
		1058	`e.dcobstruct.sibling = va_arg(ap,DNTTPOINTER);`
		1059	`e.dcobstruct.synonym = va_arg(ap,DNTTPOINTER);`
		1060	`e.dcobstruct.catusage = va_arg(ap,BITS);`
		1061	`e.dcobstruct.unused2 = 0;`
		1062	`e.dcobstruct.table = va_arg(ap,DNTTPOINTER);`
		1063	`e.dcobstruct.editpgm = va_arg(ap,VTPOINTER);`
		1064	`e.dcobstruct.bitlength = va_arg(ap,unsigned long);`
		1065	`output_LNTT(e);`
		1066	`lntt_next.word+=3;`
		1067	`break;`
		1068	`}`
		1069	`case K_SA:`
		1070	`{`
		1071	`e.dsa.extension = 0;`
		1072	`e.dsa.kind = K_SA;`
		1073	`e.dsa.base_kind = va_arg(ap,KINDTYPE);`
		1074	`e.dsa.unused = 0;`
		1075	`e.dsa.name = va_arg(ap,VTPOINTER);`
		1076	`e.dsa.extra = 0;`
		1077	`output_LNTT(e);`
		1078	`lntt_next.word++;`
		1079	`break;`
		1080	`}`
		1081	`case K_XREF:`
		1082	`{`
		1083	`e.dxref.extension = 0;`
		1084	`e.dxref.kind = K_XREF;`
		1085	`e.dxref.language = va_arg(ap,LANGTYPE);`
		1086	`e.dxref.unused = 0;`
		1087	`e.dxref.xreflist = va_arg(ap,XREFPOINTER);`
		1088	`e.dxref.extra = 0;`
		1089	`output_LNTT(e);`
		1090	`lntt_next.word++;`
		1091	`break;`
		1092	`}`
		1093	`}`
		1094	`return dnttpointer;`
		1095	`}`
		1096
		1097
		1098	`void output_DEBUG`
		1099	`PROTO_Z ()`
		1100	`{`
		1101	`int c ;`
		1102	`FILE *f ;`
		1103	`SLTPOINTER slt_prev = slt_next;`
		1104	`make_sltentry(SLT_END, currentlno, lntt_next);`
		1105	`make_dnttentry(K_END, K_MODULE, slt_prev, last_DNTT_BEGIN_entry());`
		1106	`fclose( VT_ );`
		1107	`fclose( SLT_ );`
		1108	`fclose( LNTT_ );`
		1109	`fclose( GNTT_ );`
		1110	`f = fopen( VT_name, "r" ) ;`
		1111	`if ( f == NULL ) {`
		1112	`fail ( "Can't open temporary diagnostics file" ) ;`
		1113	`exit ( EXIT_FAILURE ) ;`
		1114	`}`
		1115	`while( c = fgetc ( f ), c != EOF ) outc ( c );`
		1116	`outnl();`
		1117	`fclose( VT_ );`
		1118	`remove( VT_name );`
		1119	`f = fopen( SLT_name, "r" ) ;`
		1120	`if ( f == NULL ) {`
		1121	`fail ( "Can't open temporary diagnostics file" ) ;`
		1122	`exit ( EXIT_FAILURE ) ;`
		1123	`}`
		1124	`while( c = fgetc ( f ), c != EOF ) outc ( c );`
		1125	`outnl();`
		1126	`fclose( SLT_ );`
		1127	`remove( SLT_name );`
		1128	`f = fopen( LNTT_name, "r" ) ;`
		1129	`if ( f == NULL ) {`
		1130	`fail ( "Can't open temporary diagnostics file" ) ;`
		1131	`exit ( EXIT_FAILURE ) ;`
		1132	`}`
		1133	`while ( c = fgetc ( f ), c != EOF ) outc ( c );`
		1134	`outnl();`
		1135	`fclose( LNTT_ );`
		1136	`remove( LNTT_name );`
		1137	`f = fopen( GNTT_name, "r" ) ;`
		1138	`if ( f == NULL ) {`
		1139	`fail ( "Can't open temporary diagnostics file" ) ;`
		1140	`exit ( EXIT_FAILURE ) ;`
		1141	`}`
		1142	`while( c = fgetc ( f ), c != EOF ) outc ( c );`
		1143	`fclose( GNTT_ );`
		1144	`remove( GNTT_name );`
		1145
		1146	`fprintf(outf,"\n\t.SPACE\t$DEBUG$\n");`
		1147	`fprintf(outf,"\t.SUBSPA\t$HEADER$\n");`
		1148	`#if USE_XT`
		1149	`fprintf(outf,"\t.WORD\t%ld\n",(gntt_next.word * DNTTBLOCKSIZE) \|`
		1150	`extension_header); /* MSB indicates XT */`
		1151	`#else`
		1152	`fprintf(outf,"\t.WORD\t%ld\n",(gntt_next.word * DNTTBLOCKSIZE) \| 0 );`
		1153	`/* MSB indicates XT */`
		1154	`#endif`
		1155	`fprintf(outf,"\t.WORD\t%ld\n",lntt_next.word * DNTTBLOCKSIZE);`
		1156	`fprintf(outf,"\t.WORD\t%ld\n",slt_next * SLTBLOCKSIZE);`
		1157	`fprintf(outf,"\t.WORD\t%ld\n",vt_next);`
		1158	`#if USE_XT`
		1159	`fprintf(outf,"\t.WORD\t%ld\n",xt_next * XTBLOCKSIZE);`
		1160	`#endif`
		1161	`return ;`
		1162	`}`
		1163
		1164	`/*****************************************************************************/`
		1165	`#endif`
		1166
		1167	`/*`
		1168	`ADD A NEW FILE TO THE ARRAY OF FILE DESCRIPTORS`
		1169	`*/`
		1170
		1171	`void stab_collect_files`
		1172	`PROTO_N ( ( f ) )`
		1173	`PROTO_T ( filename f )`
		1174	`{`
		1175	`if ( fds == null ) {`
		1176	`szfds += 10 ;`
		1177	`fds = ( filename * ) xmalloc ( szfds * sizeof ( filename ) ) ;`
		1178	`} else if ( nofds >= szfds ) {`
		1179	`szfds += 10 ;`
		1180	`fds = ( filename * ) xrealloc ( fds, szfds * sizeof ( filename ) ) ;`
		1181	`}`
		1182	`fds [ nofds++ ] = f ;`
		1183	`return ;`
		1184	`}`
		1185
		1186
		1187	`/*`
		1188	`FIND THE FILE DESCRIPTOR CORRESPONDING TO A FILE NAME`
		1189	`*/`
		1190
		1191	`static long find_file`
		1192	`PROTO_N ( ( f ) )`
		1193	`PROTO_T ( char * f )`
		1194	`{`
		1195	`long i ;`
		1196	`for ( i = 0 ; i < nofds ; i++ ) {`
		1197	`if ( strcmp ( f, fds [i]->file.ints.chars ) == 0 ) return ( i ) ;`
		1198	`}`
		1199	`return ( 0 ) ;`
		1200	`}`
		1201
		1202
		1203	`static char *last_proc_lab = "<<No Proc>>";`
		1204
		1205	`/*`
		1206	`OUTPUT A FILE POSITION CONSTRUCT`
		1207	`*/`
		1208
		1209	`#define N_SLINE 0x44`
		1210	`#define N_DSLINE 0x46`
		1211	`#define N_BSLINE 0x48`
		1212	`#define N_LBRAC 0xc0`
		1213	`#define N_RBRAC 0xe0`
		1214
		1215	`void stabd`
		1216	`PROTO_N ( ( findex, lno, seg ) )`
		1217	`PROTO_T ( long findex X long lno X int seg )`
		1218	`{`
		1219	`long i ;`
		1220	`if ( findex == currentfile && lno == currentlno ) return ;`
		1221	`stab_file ( findex, 1 ) ;`
		1222	`if (seg != 0) /* 0 suppresses always */`
		1223	`{`
		1224	`if (seg > 0) /* -ve line nos are put out in the stabs */`
		1225	`{`
		1226	`i = next_lab();`
		1227	`if (xdb)`
		1228	`{`
		1229	`#ifdef _SYMTAB_INCLUDED`
		1230	`char address[128];`
		1231	`sprintf(address,"L$M%ld-%s",i,last_proc_lab);`
		1232	`make_sltentry(SLT_NORMAL, lno, (ADDRESS)address);`
		1233	`last_lno = lno;`
		1234	`#endif`
		1235	`}`
		1236	`else /* gdb */`
		1237	`{`
		1238	`fprintf(dg_file,"\t.stabn\t0x%x,0,%ld,L$M%ld-%s\n",seg,`
		1239	`lno,i,last_proc_lab) ;`
		1240	`}`
		1241	`fprintf(dg_file,"L$M%ld\n",i) ;`
		1242	`}`
		1243	`}`
		1244	`currentlno = lno ;`
		1245	`return ;`
		1246	`}`
		1247
		1248
		1249	`/*`
		1250	`OUTPUT INITIAL DIAGNOSTICS FOR A DIAGNOSE_TAG`
		1251	`*/`
		1252
		1253	`/* ARGSUSED */ void stab_begin`
		1254	`PROTO_N ( ( d, proc_no, e ) )`
		1255	`PROTO_T ( diag_info * d X int proc_no X exp e )`
		1256	`{`
		1257	`exp x ;`
		1258
		1259	`if ( d->key == DIAG_INFO_SOURCE ) {`
		1260	`sourcemark *s = &d->data.source.beg ;`
		1261	`long f = find_file ( s->file->file.ints.chars ) ;`
		1262	`stabd ( f, ( long ) s->line_no.nat_val.small_nat ,N_SLINE) ;`
		1263	`return ;`
		1264	`}`
		1265
		1266	`if ( d->key != DIAG_INFO_ID ) {`
		1267	`/* not implemented */`
		1268	`return ;`
		1269	`}`
		1270
		1271	`x = d->data.id_scope.access ;`
		1272	`/* MIPS */`
		1273	`if ( isglob ( son ( x ) ) \|\| no ( son ( x ) ) == 1 ) return;`
		1274
		1275	`mark_scope ( e ) ;`
		1276
		1277	`if ( props ( e ) & 0x80 ) {`
		1278	`stab_scope_open ( currentfile ) ;`
		1279	`stabd ( currentfile, ( long ) ( currentlno + 1 ), N_SLINE ) ;`
		1280	`}`
		1281
		1282	`stab_local ( d->data.id_scope.nme.ints.chars, d->data.id_scope.typ,`
		1283	`x, 0, currentfile ) ;`
		1284
		1285	`if ( last_param ( son ( x ) ) ) {`
		1286	`stabd ( currentfile, ( long ) ( currentlno + 1 ),N_SLINE) ;`
		1287	`}`
		1288	`return ;`
		1289	`}`
		1290
		1291
		1292	`/*`
		1293	`OUTPUT FINAL DIAGNOSTICS FOR A DIAGNOSE_TAG`
		1294	`*/`
		1295
		1296	`void stab_end`
		1297	`PROTO_N ( ( d, e ) )`
		1298	`PROTO_T ( diag_info * d X exp e )`
		1299	`{`
		1300	`if ( d->key == DIAG_INFO_SOURCE ) {`
		1301	`sourcemark *s = &d->data.source.end ;`
		1302	`long f = find_file ( s->file->file.ints.chars ) ;`
		1303	`long lno = s->line_no.nat_val.small_nat ;`
		1304	`stabd (f,lno,N_SLINE) ;`
		1305	`return ;`
		1306	`}`
		1307	`if ( d->key == DIAG_INFO_ID && props ( e ) & 0x80 ) {`
		1308	`stab_scope_close ( currentfile ) ;`
		1309	`return ;`
		1310	`}`
		1311	`return ;`
		1312	`}`
		1313
		1314
		1315	`/*`
		1316	`INITIALISE DIAGNOSTICS`
		1317	`*/`
		1318
		1319	`void init_stab`
		1320	`PROTO_Z ()`
		1321	`{`
		1322	`tmpnam ( dg_file_name ) ;`
		1323	`dg_file = fopen ( dg_file_name, "w+" ) ;`
		1324	`if ( dg_file == NULL ) {`
		1325	`fail ( "Can't open temporary diagnostics file" ) ;`
		1326	`exit ( EXIT_FAILURE ) ;`
		1327	`}`
		1328	`#ifdef _SYMTAB_INCLUDED`
		1329	`NIL.word = -1;`
		1330	`#else`
		1331	`NIL = 0;`
		1332	`#endif`
		1333	`if (xdb)`
		1334	`{`
		1335	`#ifdef _SYMTAB_INCLUDED`
		1336	`stab_types();`
		1337	`tmpnam( VT_name ) ;`
		1338	`VT_ = fopen ( VT_name, "w+" ) ;`
		1339	`if ( VT_ == NULL )`
		1340	`{`
		1341	`fail ( "Can't open temporary diagnostics file" ) ;`
		1342	`exit ( EXIT_FAILURE ) ;`
		1343	`}`
		1344	`tmpnam( SLT_name ) ;`
		1345	`SLT_ = fopen ( SLT_name, "w+" ) ;`
		1346	`if ( SLT_ == NULL )`
		1347	`{`
		1348	`fail ( "Can't open temporary diagnostics file" ) ;`
		1349	`exit ( EXIT_FAILURE ) ;`
		1350	`}`
		1351	`tmpnam( LNTT_name ) ;`
		1352	`LNTT_ = fopen ( LNTT_name, "w+" ) ;`
		1353	`if ( LNTT_ == NULL )`
		1354	`{`
		1355	`fail ( "Can't open temporary diagnostics file" ) ;`
		1356	`exit ( EXIT_FAILURE ) ;`
		1357	`}`
		1358	`tmpnam( GNTT_name ) ;`
		1359	`GNTT_ = fopen ( GNTT_name, "w+" ) ;`
		1360	`if ( GNTT_ == NULL )`
		1361	`{`
		1362	`fail ( "Can't open temporary diagnostics file" ) ;`
		1363	`exit ( EXIT_FAILURE ) ;`
		1364	`}`
		1365	`fprintf(VT_,"\t.SPACE\t$DEBUG$\n");`
		1366	`fprintf(VT_,"\t.SUBSPA\t$VT$\n");`
		1367	`fprintf(SLT_,"\t.SPACE\t$DEBUG$\n");`
		1368	`fprintf(SLT_,"\t.SUBSPA\t$SLT$\n");`
		1369	`fprintf(LNTT_,"\t.SPACE\t$DEBUG$\n");`
		1370	`fprintf(LNTT_,"\t.SUBSPA\t$LNTT$\n");`
		1371	`fprintf(GNTT_,"\t.SPACE\t$DEBUG$\n");`
		1372	`fprintf(GNTT_,"\t.SUBSPA\t$GNTT$\n");`
		1373	`make_vtentry("",0,0);`
		1374	`lntt_next.word = 1<<31; /* initialise .word field */`
		1375	`gntt_next.word = 1<<31; /* initialise .word field */`
		1376	`NIL.word = -1;`
		1377	`#endif`
		1378	`}`
		1379	`return ;`
		1380	`}`
		1381
		1382
		1383	`/*`
		1384	`INITIALIZE DIAGNOSTICS`
		1385	`*/`
		1386
		1387	`void init_stab_aux`
		1388	`PROTO_Z ()`
		1389	`{`
		1390	`int c ;`
		1391	`FILE *f ;`
		1392	`int i, j = 0 ;`
		1393	`for ( i = 0 ; i < nofds ; i++ ) {`
		1394	`char *s = fds [i]->file.ints.chars ;`
		1395	`int n = ( int ) strlen ( s ) ;`
		1396	`if ( n && s [ n - 1 ] != 'h' ) j = i ;`
		1397	`}`
		1398	`fclose ( dg_file ) ;`
		1399	`dg_file = outf ;`
		1400	`stab_file ( ( long ) j, 0 ) ;`
		1401	`if (gdb)`
		1402	`{`
		1403	`stab_types();`
		1404	`}`
		1405	`f = fopen ( dg_file_name, "r" ) ;`
		1406	`if ( f == NULL ) {`
		1407	`fail ( "Can't open temporary diagnostics file" ) ;`
		1408	`exit ( EXIT_FAILURE ) ;`
		1409	`}`
		1410	`while ( c = fgetc ( f ), c != EOF ) outc ( c ) ;`
		1411	`fclose ( f ) ;`
		1412	`remove ( dg_file_name ) ;`
		1413	`return ;`
		1414	`}`
		1415
		1416
		1417	`/*`
		1418	`FIND THE DIAGNOSTICS CORRESPONDING TO THE CURRENT DECLARATION`
		1419	`*/`
		1420
		1421	`/* ARGSUSED / static diag_descriptor find_dd`
		1422	`PROTO_N ( ( e ) )`
		1423	`PROTO_T ( exp e )`
		1424	`{`
		1425	`if ( diag_def == NULL ) return ( NULL ) ;`
		1426	`return ( diag_def->dec_u.dec_val.diag_info ) ;`
		1427	`}`
		1428
		1429
		1430	`/*`
		1431	`OUTPUT DIAGNOSTICS DIRECTIVE FOR A FILE`
		1432	`*/`
		1433
		1434	`void stab_file`
		1435	`PROTO_N ( ( findex, internal ) )`
		1436	`PROTO_T ( long findex X bool internal )`
		1437	`{`
		1438	`static long i = 0 ;`
		1439	`if ( findex == currentfile \|\| findex < 0 \|\| findex >= szfds ) {`
		1440	`return ;`
		1441	`}`
		1442
		1443	`if (gdb)`
		1444	`fprintf(dg_file,"\t.file\t\"%s\"\n",fds[ findex ]->file.ints.chars);`
		1445	`if (internal)`
		1446	`{`
		1447	`/* included file */`
		1448	`if (xdb)`
		1449	`{`
		1450	`#ifdef _SYMTAB_INCLUDED`
		1451	`SLTPOINTER slt_prev = slt_next;`
		1452	`VTPOINTER entry = is_vt_entry( findex );`
		1453	`make_sltentry(SLT_SRCFILE, currentlno, lntt_next);`
		1454	`make_dnttentry(K_SRCFILE, LANG_C, ( entry==VTNIL ? vt_next : entry ), slt_prev);`
		1455	`if ( entry==VTNIL )`
		1456	`make_vtentry(fds[ findex ]->file.ints.chars,1,findex);`
		1457	`#endif`
		1458	`}`
		1459	`else`
		1460	`fprintf ( dg_file,"\t.stabs\t\"%s\",0x84,0,0,L$M%ld\n",`
		1461	`fds[ findex ]->file.ints.chars, i ) ;`
		1462	`}`
		1463	`else`
		1464	`{`
		1465	`/* source file */`
		1466	`i = next_lab () ;`
		1467	`if (xdb)`
		1468	`{`
		1469	`#ifdef _SYMTAB_INCLUDED`
		1470	`SLTPOINTER slt_prev = slt_next;`
		1471	`VTPOINTER entry = is_vt_entry(findex);`
		1472	`make_sltentry(SLT_SRCFILE, currentlno, lntt_next);`
		1473	`make_dnttentry(K_SRCFILE, LANG_C, ( entry==VTNIL ? vt_next : entry ), slt_prev);`
		1474	`slt_prev = slt_next;`
		1475	`make_sltentry(SLT_MODULE, 1, lntt_next);`
		1476	`make_dnttentry(K_MODULE, VTNIL, VTNIL, slt_prev);`
		1477	`if ( entry==VTNIL )`
		1478	`make_vtentry(fds[ findex ]->file.ints.chars,1,findex);`
		1479	`#endif`
		1480	`}`
		1481	`else /* gdb */`
		1482	`{`
		1483	`fprintf ( dg_file, "\t.stabs\t\"%s\",0x64,0,0,L$M%ld\n",`
		1484	`fds[ findex ]->file.ints.chars, i ) ;`
		1485	`}`
		1486	`fprintf ( dg_file, "L$M%ld\n", i ) ;`
		1487	`}`
		1488	`currentfile = findex ;`
		1489	`return ;`
		1490	`}`
		1491
		1492
		1493	`/******************* START OF A DIAGNOSTICS SCOPE **********************/`
		1494
		1495	`static void stab_scope_open`
		1496	`PROTO_N ( ( findex ) )`
		1497	`PROTO_T ( long findex )`
		1498	`{`
		1499	`stab_file(findex,1);`
		1500	`/* nb. don't need to output bracket level */`
		1501	`if (xdb)`
		1502	`{`
		1503	`#ifdef _SYMTAB_INCLUDED`
		1504	`SLTPOINTER slt_prev = slt_next;`
		1505	`make_sltentry(SLT_BEGIN, (BITS)currentlno, lntt_next);`
		1506	`make_dnttentry(K_BEGIN, slt_prev);`
		1507	`#endif`
		1508	`}`
		1509	`else /* gdb */`
		1510	`{`
		1511	`if (last_LBRAC_stab==BB_id-1)`
		1512	`{`
		1513	`fprintf(dg_file,"\t.stabn\t0x%x,0,0,L$BB%ld-%s\n",N_LBRAC,BB_id,`
		1514	`last_proc_lab);`
		1515	`last_LBRAC_stab=BB_id;`
		1516	`}`
		1517	`BB_id++;`
		1518	`fprintf(dg_file,"L$BB%ld\n",BB_id);`
		1519	`}`
		1520	`bracket_level++;`
		1521	`}`
		1522
		1523
		1524	`/******************** END OF A DIAGNOSTICS SCOPE ***********************/`
		1525
		1526	`static void stab_scope_close`
		1527	`PROTO_N ( ( findex ) )`
		1528	`PROTO_T ( long findex )`
		1529	`{`
		1530	`bracket_level--;`
		1531	`if (bracket_level>MAX_LEX_LEVEL)`
		1532	`return;`
		1533	`/* nb. don't need to output bracket level */`
		1534	`if (xdb)`
		1535	`{`
		1536	`#ifdef _SYMTAB_INCLUDED`
		1537	`SLTPOINTER slt_prev = slt_next;`
		1538	`make_sltentry(SLT_END, currentlno, lntt_next);`
		1539	`make_dnttentry(K_END, K_BEGIN, slt_prev, last_DNTT_BEGIN_entry());`
		1540	`#endif`
		1541	`}`
		1542	`else /* gdb */`
		1543	`{`
		1544	`if (last_LBRAC_stab==BB_id-1)`
		1545	`{`
		1546	`fprintf(dg_file,"\t.stabn\t0x%x,0,0,L$BB%ld-%s\n",N_LBRAC,BB_id,`
		1547	`last_proc_lab);`
		1548	`last_LBRAC_stab = BB_id;`
		1549	`}`
		1550	`BE_id++;`
		1551	`fprintf(dg_file,"\t.stabn\t0x%x,0,0,L$BE%ld-%s\n",N_RBRAC,BE_id,`
		1552	`last_proc_lab);`
		1553	`fprintf(dg_file,"L$BE%ld\n",BE_id);`
		1554	`}`
		1555	`return;`
		1556	`}`
		1557
		1558
		1559	`/*`
		1560	`DEPTH COUNT FOR STAB TYPES`
		1561	`*/`
		1562
		1563	`/* static int max_depth = 64 ; */`
		1564	`static int depth_now = 0 ;`
		1565
		1566
		1567	`/************* OUTPUT THE DIAGNOSTICS FOR A SIMPLE SHAPE ***************/`
		1568
		1569	`static long out_sh_type`
		1570	`PROTO_N ( ( s ) )`
		1571	`PROTO_T ( shape s )`
		1572	`{`
		1573	`last_type_sz = shape_size ( s ) ;`
		1574	`switch ( name(s) )`
		1575	`{`
		1576	`case scharhd : return ( STAB_SCHAR ) ;`
		1577	`case ucharhd : return ( STAB_UCHAR ) ;`
		1578	`case swordhd : return ( STAB_SSHRT ) ;`
		1579	`case uwordhd : return ( STAB_USHRT ) ;`
		1580	`case slonghd : return ( STAB_SLONG ) ;`
		1581	`case ulonghd : return ( STAB_ULONG ) ;`
		1582	`case shrealhd : return ( STAB_FLOAT ) ;`
		1583	`case realhd : return ( STAB_DBL ) ;`
		1584	`case doublehd : return ( STAB_LDBL ) ;`
		1585	`}`
		1586	`return ( STAB_VOID ) ;`
		1587	`}`
		1588
		1589
		1590	`/********************* OUTPUT A DIAGNOSTICS TYPE ***********************/`
		1591
		1592
		1593	`#ifdef _SYMTAB_INCLUDED`
		1594
		1595
		1596	`struct outed_t { diag_type dt; struct outed_t *prev; };`
		1597	`typedef struct outed_t *outed;`
		1598
		1599	`static outed uo;`
		1600	`static DNTTPOINTER pos;`
		1601
		1602
		1603	`void undo_outed`
		1604	`PROTO_N ( ( dt ) )`
		1605	`PROTO_T ( diag_type dt )`
		1606	`{`
		1607	`outed p = (outed) malloc( sizeof( struct outed_t ) );`
		1608	`uo->prev = p;`
		1609	`p->dt = dt;`
		1610	`p->prev = (struct outed_t*) 0;`
		1611	`uo = p;`
		1612	`}`
		1613
		1614
		1615	`static DNTTPOINTER traverse_diag_type`
		1616	`PROTO_N ( ( dt ) )`
		1617	`PROTO_T ( diag_type dt )`
		1618	`{`
		1619	`if ( dt->been_outed )`
		1620	`{`
		1621	`last_type_sz = get_stab_size( dt->been_outed );`
		1622	`return pos;`
		1623	`}`
		1624
		1625	`#if 0`
		1626	`if ( depth_now >= max_depth )`
		1627	`{`
		1628	`return NIL ;`
		1629	`}`
		1630	`depth_now++ ;`
		1631	`#endif`
		1632
		1633	`switch( dt->key )`
		1634	`{`
		1635	`case DIAG_TYPE_PTR:`
		1636	`{`
		1637	`long non;`
		1638	`diag_type pdt = dt->data.ptr.object ;`
		1639	`if ( pdt->key == DIAG_TYPE_VARIETY )`
		1640	`{`
		1641	`long pn = out_sh_type( f_integer( pdt->data.var) );`
		1642	`non = stab_ptrs[pn];`
		1643	`if ( non==0 )`
		1644	`{`
		1645	`non = next_typen();`
		1646	`stab_ptrs[pn] = -non;`
		1647	`pos.word++;`
		1648	`}`
		1649	`}`
		1650	`else`
		1651	`{`
		1652	`non = next_typen();`
		1653	`traverse_diag_type( pdt );`
		1654	`pos.word++;`
		1655	`}`
		1656	`dt->been_outed = non;`
		1657	`undo_outed( dt );`
		1658	`last_type_sz = 32;`
		1659	`set_stab_size(non);`
		1660	`return pos;`
		1661	`}`
		1662
		1663	`case DIAG_TYPE_ARRAY:`
		1664	`{`
		1665	`long lwb = no( dt->data.array.lower_b );`
		1666	`long upb = no( dt->data.array.upper_b );`
		1667	`diag_type index_type = dt->data.array.index_type ;`
		1668	`diag_type element_type = dt->data.array.element_type ;`
		1669	`long non = next_typen();`
		1670	`dt->been_outed = non ;`
		1671	`undo_outed( dt );`
		1672	`traverse_diag_type( index_type );`
		1673	`pos.word+=2;`
		1674	`traverse_diag_type( element_type );`
		1675	`pos.word+=2;`
		1676	`last_type_sz *= ( upb-lwb+1 );`
		1677	`set_stab_size(non);`
		1678	`return pos;`
		1679	`break ;`
		1680	`}`
		1681
		1682	`case DIAG_TYPE_STRUCT:`
		1683	`case DIAG_TYPE_UNION:`
		1684	`{`
		1685	`int i;`
		1686	`shape s;`
		1687	`long non = next_typen();`
		1688	`diag_field_list fields;`
		1689	`dt->been_outed = non;`
		1690	`undo_outed( dt );`
		1691	`if ( dt->key == DIAG_TYPE_STRUCT )`
		1692	`{`
		1693	`fields = dt->data.t_struct.fields;`
		1694	`s = dt->data.t_struct.tdf_shape;`
		1695	`}`
		1696	`else`
		1697	`{`
		1698	`fields = dt->data.t_union.fields;`
		1699	`s = dt->data.t_union.tdf_shape;`
		1700	`}`
		1701	`for(i=0;i<fields->lastused;i++)`
		1702	`{`
		1703	`diag_field f = (fields->array)[i];`
		1704	`traverse_diag_type( f->field_type );`
		1705	`pos.word+=2;`
		1706	`}`
		1707	`if ( dt->key == DIAG_TYPE_STRUCT )`
		1708	`{`
		1709	`pos.word+=2;`
		1710	`}`
		1711	`else`
		1712	`{`
		1713	`pos.word++;`
		1714	`}`
		1715	`last_type_sz = shape_size(s);`
		1716	`set_stab_size(non);`
		1717	`return pos;`
		1718	`}`
		1719
		1720	`case DIAG_TYPE_FLOAT:`
		1721	`case DIAG_TYPE_VARIETY:`
		1722	`{`
		1723	`shape sha;`
		1724	`if ( dt->key==DIAG_TYPE_VARIETY )`
		1725	`{`
		1726	`sha = f_integer(dt->data.var);`
		1727	`}`
		1728	`else`
		1729	`{`
		1730	`sha = f_floating(dt->data.f_var);`
		1731	`}`
		1732	`dt->been_outed = out_sh_type( sha );`
		1733	`return pos;`
		1734	`}`
		1735
		1736	`case DIAG_TYPE_PROC:`
		1737	`{`
		1738	`diag_type result_type = dt->data.proc.result_type ;`
		1739	`long non1 = next_typen();`
		1740	`long non2 = next_typen();`
		1741	`dt->been_outed = non1;`
		1742	`undo_outed( dt );`
		1743	`pos.word++;`
		1744	`traverse_diag_type ( result_type ) ;`
		1745	`last_type_sz = 32 ;`
		1746	`set_stab_size ( non1 ) ;`
		1747	`set_stab_size ( non2 ) ;`
		1748	`return pos;`
		1749	`}`
		1750
		1751	`case DIAG_TYPE_LOC:`
		1752	`{`
		1753	`return traverse_diag_type ( dt->data.loc.object ) ;`
		1754	`}`
		1755
		1756	`case DIAG_TYPE_NULL:`
		1757	`{`
		1758	`last_type_sz = 0;`
		1759	`return pos;`
		1760	`}`
		1761
		1762	`case DIAG_TYPE_BITFIELD:`
		1763	`{`
		1764	`long sz = dt->data.bitfield.no_of_bits.nat_val.small_nat ;`
		1765	`last_type_sz = sz;`
		1766	`return pos;`
		1767	`}`
		1768
		1769	`case DIAG_TYPE_ENUM:`
		1770	`{`
		1771	`traverse_diag_type( dt->data.t_enum.base_type );`
		1772	`return pos;`
		1773	`}`
		1774
		1775	`default:`
		1776	`{`
		1777	`last_type_sz = 0 ;`
		1778	`return pos;`
		1779	`}`
		1780	`}`
		1781	`}`
		1782
		1783
		1784	`DNTTPOINTER pos_of_dnttpointer`
		1785	`PROTO_N ( ( dt ) )`
		1786	`PROTO_T ( diag_type dt )`
		1787	`{`
		1788	`outed p,f;`
		1789	`int s;`
		1790	`int t = typeno;`
		1791	`pos = lntt_next;`
		1792	`uo = (struct outed_t*) malloc( sizeof( struct outed_t ) );`
		1793	`uo->prev = (struct outed_t*) 0;`
		1794	`f = uo;`
		1795	`traverse_diag_type( dt );`
		1796	`while ( f->prev )`
		1797	`{`
		1798	`p = f->prev;`
		1799	`free( f );`
		1800	`p->dt->been_outed = 0;`
		1801	`f = p;`
		1802	`}`
		1803	`free( f );`
		1804	`for(s=0;s<NO_STABS;s++)`
		1805	`if ( stab_ptrs[s]<0 )`
		1806	`stab_ptrs[s] = 0;`
		1807	`typeno = t;`
		1808	`return pos;`
		1809	`}`
		1810
		1811
		1812	`#endif`
		1813
		1814
		1815	`#define OUT_DT_SHAPE( dt ) out_dt_shape ( ( depth_now = 0, dt ) )`
		1816
		1817	`static DNTTPOINTER out_dt_shape`
		1818	`PROTO_N ( ( dt ) )`
		1819	`PROTO_T ( diag_type dt )`
		1820	`{`
		1821	`if ( dt->been_outed )`
		1822	`{`
		1823	`last_type_sz = get_stab_size( dt->been_outed );`
		1824	`if (xdb)`
		1825	`{`
		1826	`#ifdef _SYMTAB_INCLUDED`
		1827	`return type_info[dt->been_outed].p;`
		1828	`#endif`
		1829	`}`
		1830	`else`
		1831	`{`
		1832	`fprintf(dg_file,"%d",(int) dt->been_outed);`
		1833	`}`
		1834	`return NIL ;`
		1835	`}`
		1836
		1837	`#if 0`
		1838	`if ( depth_now >= max_depth )`
		1839	`{`
		1840	`if (gdb)`
		1841	`fprintf( dg_file, "%d", STAB_SLONG ) ;`
		1842	`return NIL ;`
		1843	`}`
		1844	`depth_now++ ;`
		1845	`#endif`
		1846
		1847	`switch( dt->key )`
		1848	`{`
		1849	`case DIAG_TYPE_PTR:`
		1850	`{`
		1851	`DNTTPOINTER p = NIL;`
		1852	`long non;`
		1853	`diag_type pdt = dt->data.ptr.object ;`
		1854	`if ( pdt->key == DIAG_TYPE_VARIETY )`
		1855	`{`
		1856	`long pn = out_sh_type( f_integer( pdt->data.var) );`
		1857	`non = stab_ptrs[pn];`
		1858	`if ( non==0 )`
		1859	`{`
		1860	`non = next_typen();`
		1861	`stab_ptrs[pn] = non;`
		1862	`if (xdb)`
		1863	`{`
		1864	`#ifdef _SYMTAB_INCLUDED`
		1865	`p = make_dnttentry(K_POINTER, type_info[pn].p, 32);`
		1866	`#endif`
		1867	`}`
		1868	`else`
		1869	`{`
		1870	`fprintf(dg_file,"%ld=*%ld",non,pn);`
		1871	`}`
		1872	`}`
		1873	`else`
		1874	`{`
		1875	`if (xdb)`
		1876	`{`
		1877	`#ifdef _SYMTAB_INCLUDED`
		1878	`p = type_info[non].p;`
		1879	`#endif`
		1880	`}`
		1881	`else`
		1882	`{`
		1883	`fprintf(dg_file,"%ld",non);`
		1884	`}`
		1885	`}`
		1886	`}`
		1887	`else`
		1888	`{`
		1889	`non = next_typen();`
		1890	`if (xdb)`
		1891	`{`
		1892	`#ifdef _SYMTAB_INCLUDED`
		1893	`p = make_dnttentry(K_POINTER, out_dt_shape( dt->data.ptr.object ), 32);`
		1894	`#endif`
		1895	`}`
		1896	`else`
		1897	`{`
		1898	`fprintf(dg_file,"%ld=*",non);`
		1899	`out_dt_shape( dt->data.ptr.object );`
		1900	`}`
		1901	`}`
		1902	`dt->been_outed = non;`
		1903	`#ifdef _SYMTAB_INCLUDED`
		1904	`type_info[non].p = p;`
		1905	`#endif`
		1906	`last_type_sz = 32;`
		1907	`set_stab_size(non);`
		1908	`return p;`
		1909	`}`
		1910
		1911	`case DIAG_TYPE_ARRAY:`
		1912	`{`
		1913	`DNTTPOINTER indextype,elemtype,p=NIL;`
		1914	`#if 0`
		1915	`long str = no( dt->data.array.stride );`
		1916	`#endif`
		1917	`long lwb = no( dt->data.array.lower_b );`
		1918	`long upb = no( dt->data.array.upper_b );`
		1919	`diag_type index_type = dt->data.array.index_type ;`
		1920	`diag_type element_type = dt->data.array.element_type ;`
		1921	`long non = next_typen();`
		1922	`dt->been_outed = non ;`
		1923	`if (gdb)`
		1924	`{`
		1925	`fprintf(dg_file,"%ld=ar",non);`
		1926	`out_dt_shape( index_type );`
		1927	`fprintf (dg_file,";%ld;%ld;",lwb,upb);`
		1928	`}`
		1929	`else`
		1930	`{`
		1931	`#ifdef _SYMTAB_INCLUDED`
		1932	`indextype = make_dnttentry(K_SUBRANGE, 0, 0, lwb, upb, out_dt_shape( index_type ),`
		1933	`last_type_sz);`
		1934	`#endif`
		1935	`}`
		1936	`elemtype = out_dt_shape( element_type );`
		1937	`if (xdb)`
		1938	`{`
		1939	`#ifdef _SYMTAB_INCLUDED`
		1940	`unsigned long arraylength = (upb-lwb+1)<<2;`
		1941	`unsigned long elemlength = last_type_sz>>3;`
		1942	`p = make_dnttentry(K_ARRAY, 0, 0, 0, 1, 1, 0, 0, arraylength, indextype, elemtype, elemlength);`
		1943	`type_info[non].p = p;`
		1944	`#endif`
		1945	`}`
		1946	`last_type_sz *= ( upb-lwb+1 );`
		1947	`set_stab_size(non);`
		1948	`return p;`
		1949	`break ;`
		1950	`}`
		1951
		1952	`case DIAG_TYPE_STRUCT:`
		1953	`case DIAG_TYPE_UNION:`
		1954	`{`
		1955	`DNTTPOINTER p = NIL;`
		1956	`int i;`
		1957	`char su;`
		1958	`shape s;`
		1959	`long non = next_typen();`
		1960	`diag_field_list fields;`
		1961	`#ifdef _SYMTAB_INCLUDED`
		1962	`if (xdb)`
		1963	`p = pos_of_dnttpointer( dt );`
		1964	`#endif`
		1965	`dt->been_outed = non;`
		1966	`if ( dt->key == DIAG_TYPE_STRUCT )`
		1967	`{`
		1968	`fields = dt->data.t_struct.fields;`
		1969	`s = dt->data.t_struct.tdf_shape;`
		1970	`su = 's';`
		1971	`#ifdef _SYMTAB_INCLUDED`
		1972	`p.word-=2;`
		1973	`#endif`
		1974	`}`
		1975	`else`
		1976	`{`
		1977	`fields = dt->data.t_union.fields;`
		1978	`s = dt->data.t_union.tdf_shape;`
		1979	`su = 'u';`
		1980	`#ifdef _SYMTAB_INCLUDED`
		1981	`p.word--;`
		1982	`#endif`
		1983	`}`
		1984	`if (xdb)`
		1985	`{`
		1986	`#ifdef _SYMTAB_INCLUDED`
		1987	`DNTTPOINTER lastfield = NIL;`
		1988	`type_info[non].p = p;`
		1989	`for(i=0;i<fields->lastused;i++)`
		1990	`{`
		1991	`diag_field f = (fields->array)[i];`
		1992	`unsigned long bitoffset = no( f->where );`
		1993	`DNTTPOINTER type = out_dt_shape( f->field_type );`
		1994	`lastfield = make_dnttentry(K_FIELD, vt_next, bitoffset, type, last_type_sz, lastfield);`
		1995	`make_vtentry(f->field_name.ints.chars,0,0);`
		1996	`}`
		1997
		1998	`if ( lntt_next.word != p.word )`
		1999	`{`
		2000	`fprintf(stderr,"hppatrans warning: trans made an error whilst compiling XDB diagnostics tables\n");`
		2001	`}`
		2002
		2003	`if ( dt->key == DIAG_TYPE_STRUCT )`
		2004	`{`
		2005	`make_dnttentry(K_STRUCT, 0, lastfield, NIL, NIL, shape_size(s));`
		2006	`}`
		2007	`else`
		2008	`{`
		2009	`make_dnttentry(K_UNION, lastfield, shape_size(s));`
		2010	`}`
		2011	`#endif`
		2012	`}`
		2013	`else`
		2014	`{`
		2015	`fprintf(dg_file,"%ld=%c%d",non,su,shape_size(s)/8);`
		2016	`for(i=fields->lastused-1;i>=0;i--)`
		2017	`{`
		2018	`diag_field sf = (fields->array)[i];`
		2019	`unsigned long offset = no( sf->where );`
		2020	`#if 0`
		2021	`if ( depth_now >= max_depth )`
		2022	`return NIL;`
		2023	`depth_now++;`
		2024	`#endif`
		2025	`fprintf(dg_file,"%s:",sf->field_name.ints.chars);`
		2026	`out_dt_shape( sf->field_type );`
		2027	`fprintf(dg_file,",%ld,%ld;",offset,last_type_sz);`
		2028	`}`
		2029	`fprintf(dg_file,";");`
		2030	`}`
		2031	`last_type_sz = shape_size(s);`
		2032	`set_stab_size(non);`
		2033	`return p ;`
		2034	`}`
		2035
		2036	`case DIAG_TYPE_FLOAT:`
		2037	`case DIAG_TYPE_VARIETY:`
		2038	`{`
		2039	`shape sha;`
		2040	`if ( dt->key==DIAG_TYPE_VARIETY )`
		2041	`{`
		2042	`sha = f_integer(dt->data.var);`
		2043	`}`
		2044	`else`
		2045	`{`
		2046	`sha = f_floating(dt->data.f_var);`
		2047	`}`
		2048	`dt->been_outed = out_sh_type( sha );`
		2049	`if (xdb)`
		2050	`{`
		2051	`#ifdef _SYMTAB_INCLUDED`
		2052	`return type_info[dt->been_outed].p;`
		2053	`#endif`
		2054	`}`
		2055	`else`
		2056	`{`
		2057	`fprintf (dg_file,"%ld",dt->been_outed);`
		2058	`}`
		2059	`return NIL;`
		2060	`}`
		2061
		2062	`case DIAG_TYPE_PROC:`
		2063	`{`
		2064	`diag_type result_type = dt->data.proc.result_type ;`
		2065	`long non1 = next_typen();`
		2066	`long non2 = next_typen();`
		2067	`DNTTPOINTER p = NIL;`
		2068	`dt->been_outed = non1;`
		2069	`if (xdb)`
		2070	`{`
		2071	`#ifdef _SYMTAB_INCLUDED`
		2072	`p = make_dnttentry(K_POINTER, make_DNTTP_IMMEDIATE( T_FLABEL ), 32);`
		2073	`type_info[non1].p = p;`
		2074	`#endif`
		2075	`}`
		2076	`else`
		2077	`{`
		2078	`fprintf ( dg_file, "%ld=*%ld=f", non1, non2 ) ;`
		2079	`}`
		2080	`out_dt_shape ( result_type ) ;`
		2081	`last_type_sz = 32 ;`
		2082	`set_stab_size ( non1 ) ;`
		2083	`set_stab_size ( non2 ) ;`
		2084	`return p;`
		2085	`}`
		2086
		2087	`case DIAG_TYPE_LOC:`
		2088	`{`
		2089	`/* +++ use qualifier which gives "const"/"volatile" */`
		2090	`return out_dt_shape ( dt->data.loc.object ) ;`
		2091	`}`
		2092
		2093	`case DIAG_TYPE_NULL:`
		2094	`{`
		2095	`if (gdb)`
		2096	`fprintf(dg_file,"%d",STAB_VOID);`
		2097	`last_type_sz = 0;`
		2098	`return NIL;`
		2099	`}`
		2100
		2101	`case DIAG_TYPE_BITFIELD:`
		2102	`{`
		2103	`long sz = dt->data.bitfield.no_of_bits.nat_val.small_nat ;`
		2104	`last_type_sz = sz;`
		2105	`if (xdb)`
		2106	`{`
		2107	`#ifdef _SYMTAB_INCLUDED`
		2108
		2109	`return type_info[STAB_SLONG].p;`
		2110	`#endif`
		2111	`}`
		2112	`else`
		2113	`{`
		2114	`fprintf (dg_file,"%d",STAB_SLONG);`
		2115	`}`
		2116	`return NIL;`
		2117	`}`
		2118
		2119	`case DIAG_TYPE_ENUM:`
		2120	`{`
		2121	`#if 1`
		2122	`/* Currently tdfc (August 95) does not generate DIAG_TYPE_ENUM.`
		2123	`Enable and test this when DIAG_TYPE_ENUM is generated. */`
		2124
		2125	`/*`
		2126	`* TypeDef: e EnumList ; "Enumerated type (default size, 32 bits)"`
		2127	`* EnumList: Enum \| EnumList Enum`
		2128	`* Enum: NAME : OrdValue , "Enumerated scalar description"`
		2129	`* OrdValue: INTEGER "Associated numeric value"`
		2130	`*/`
		2131	`enum_values_list enumvals = dt->data.t_enum.values;`
		2132	`enum_values *enumarr = (enumvals->array);`
		2133	`int nvals = enumvals->len;`
		2134	`char *nm = dt->data.t_enum.nme.ints.chars;`
		2135	`int i;`
		2136	`DNTTPOINTER p = NIL;`
		2137	`long non;`
		2138	`if (xdb)`
		2139	`{`
		2140	`#ifdef _SYMTAB_INCLUDED`
		2141	`DNTTPOINTER firstmem;`
		2142	`if (nvals>0)`
		2143	`{`
		2144	`firstmem = lntt_next;`
		2145	`firstmem.word+=2;`
		2146	`}`
		2147	`else`
		2148	`{`
		2149	`firstmem = NIL;`
		2150	`}`
		2151	`make_dnttentry(K_TAGDEF,(BITS)1,(BITS)1,vt_next,lntt_next);`
		2152	`make_vtentry(nm,0,0);`
		2153	`p = make_dnttentry(K_ENUM, firstmem, 32);`
		2154	`for(i=0;i<nvals;i++)`
		2155	`{`
		2156	`DNTTPOINTER nextmem;`
		2157	`if (i==nvals-1)`
		2158	`{`
		2159	`nextmem = NIL;`
		2160	`}`
		2161	`else`
		2162	`{`
		2163	`nextmem = lntt_next;`
		2164	`nextmem.word+=2;`
		2165	`}`
		2166	`make_dnttentry(K_MEMENUM, vt_next, EXPINT(enumarr[i]->val), nextmem);`
		2167	`make_vtentry(CSTRING(enumarr[i]->nme),0,0);`
		2168	`}`
		2169	`#endif`
		2170	`}`
		2171	`else`
		2172	`{`
		2173	`fprintf(dg_file,"e");`
		2174	`for(i=0;i<nvals;i++)`
		2175	`{`
		2176	`fprintf(dg_file,"%s:%d,",CSTRING(enumarr[i]->nme), EXPINT(enumarr[i]->val));`
		2177	`}`
		2178	`fprintf(dg_file,";");`
		2179	`}`
		2180	`non = next_typen();`
		2181	`dt->been_outed = non;`
		2182	`type_info[non].p = p;`
		2183	`last_type_sz = 32;`
		2184	`set_stab_size(non);`
		2185	`return p;`
		2186	`#else`
		2187	`/* For now, simply output the base integer type */`
		2188	`out_dt_shape(dt->data.t_enum.base_type);`
		2189	`last_type_sz = 32;`
		2190	`#endif`
		2191	`break;`
		2192	`}`
		2193
		2194	`default:`
		2195	`{`
		2196	`if (gdb)`
		2197	`fprintf(dg_file,"%d",STAB_VOID);`
		2198	`last_type_sz = 0 ;`
		2199	`return NIL;`
		2200	`}`
		2201	`}`
		2202	`return NIL ;`
		2203	`}`
		2204
		2205
		2206	`/*`
		2207	`OUTPUT DIAGNOSTICS FOR A GLOBAL VARIABLE`
		2208	`*/`
		2209
		2210	`void stab_global`
		2211	`PROTO_N ( ( global, id, ext ) )`
		2212	`PROTO_T ( exp global X char * id X bool ext )`
		2213	`{`
		2214	`char *nm;`
		2215	`diag_descriptor *dd = find_dd ( global ) ;`
		2216
		2217	`if ( dd==NULL )`
		2218	`return;`
		2219	`nm = dd->data.id.nme.ints.chars;`
		2220	`stabd ( find_file ( dd->data.id.whence.file->file.ints.chars ),`
		2221	`( long ) dd->data.id.whence.line_no.nat_val.small_nat`
		2222	`, -N_DSLINE ) ;`
		2223	`if (xdb)`
		2224	`{`
		2225	`#ifdef _SYMTAB_INCLUDED`
		2226	`if (ext)`
		2227	`make_dnttentry(K_SVAR, 1, 0, 0, vt_next, (STATTYPE)nm, OUT_DT_SHAPE( dd->data.id.new_type ), 0, 0, GNTT);`
		2228	`else`
		2229	`make_dnttentry(K_SVAR, 0, 0, 0, vt_next, (STATTYPE)id, OUT_DT_SHAPE( dd->data.id.new_type ), 0, 0, LNTT);`
		2230	`make_vtentry(nm,0,0);`
		2231	`#endif`
		2232	`}`
		2233	`else`
		2234	`{`
		2235	`fprintf(dg_file,"\t.stabs\t\"%s:%c", nm, ( ext ? 'G' : 'S' ) ) ;`
		2236	`OUT_DT_SHAPE ( dd->data.id.new_type ) ;`
		2237	`fprintf(dg_file,"\",%#x,0,%d,%s\n",( ext ? 0x24 : ((no(global)!=0)?0x26:0x28) ),`
		2238	`dd->data.id.whence.line_no.nat_val.small_nat /0/,`
		2239	`id`
		2240	`) ;`
		2241	`}`
		2242	`return ;`
		2243	`}`
		2244
		2245
		2246	`/*`
		2247	`OUTPUT DIAGNOSTICS FOR A PROCEDURE`
		2248	`*/`
		2249
		2250	`void stab_proc`
		2251	`PROTO_N ( ( proc, id, public ) )`
		2252	`PROTO_T ( exp proc X char * id X bool public )`
		2253	`{`
		2254	`char *nm;`
		2255	`diag_descriptor *dd = find_dd ( proc ) ;`
		2256	`if ( dd == NULL )`
		2257	`return ;`
		2258	`stabd ( find_file ( dd->data.id.whence.file->file.ints.chars ) ,`
		2259	`( long ) dd->data.id.whence.line_no.nat_val.small_nat`
		2260	`,0) ;`
		2261	`nm = id;`
		2262	`if (gdb)`
		2263	`fprintf ( dg_file, "\t.stabs\t\"%s:%c",nm, ( public ? 'F' : 'f' ) ) ;`
		2264	`OUT_DT_SHAPE ( dd->data.id.new_type->data.proc.result_type ) ;`
		2265
		2266	`if (gdb)`
		2267	`fprintf ( dg_file,"\",0x24,0,%ld,%s\n",currentlno,id);`
		2268
		2269	`last_proc_lab = id; /* id is passed from translate_capsule,`
		2270	`so stays in scope while needed */`
		2271	`if (xdb)`
		2272	`{`
		2273	`#ifdef _SYMTAB_INCLUDED`
		2274	`DNTTPOINTER retval;`
		2275	`SLTPOINTER slt_prev;`
		2276	`BITS varargs;`
		2277	`VTPOINTER entry = is_vt_entry( currentfile );`
		2278	`slt_prev = slt_next;`
		2279	`make_sltentry(SLT_SRCFILE, 1, lntt_next);`
		2280	`make_dnttentry(K_SRCFILE, LANG_C, ( entry==VTNIL ? vt_next : entry ), slt_prev);`
		2281	`if ( entry==VTNIL )`
		2282	`make_vtentry(fds[ currentfile ]->file.ints.chars,1,currentfile);`
		2283
		2284	`slt_prev = slt_next;`
		2285	`make_sltentry(SLT_FUNCTION, currentlno, lntt_next);`
		2286	`retval = make_DNTTP_IMMEDIATE(T_INT);`
		2287	`varargs = (BITS) dd->data.id.new_type->data.proc.opt_args;`
		2288	`if (strcmp(nm,"main")==0)`
		2289	`{`
		2290	`make_dnttentry(K_FUNCTION, (BITS)public, LANG_C, (BITS)0, (BITS)0,`
		2291	`varargs, (BITS)0, vt_next, vt_next+5, NIL, slt_prev,`
		2292	`(ADDRESS)"main", retval, (ADDRESS)"main",`
		2293	`(ADDRESS)"_main_end_");`
		2294	`make_vtentry( "main",0,0 );`
		2295	`make_vtentry( "_MAIN_",0,0 );`
		2296	`}`
		2297	`else`
		2298	`{`
		2299	`char address = nm, lowaddr = nm, hiaddr[128];`
		2300	`sprintf(hiaddr,"_%s_end_",address);`
		2301	`make_dnttentry(K_FUNCTION, (BITS)public, LANG_C, (BITS)0, (BITS)0,`
		2302	`varargs, (BITS)0, vt_next, VTNIL, NIL, slt_prev,`
		2303	`(ADDRESS)address, retval, (ADDRESS)lowaddr,`
		2304	`(ADDRESS)hiaddr);`
		2305	`make_vtentry( nm,0,0 );`
		2306	`}`
		2307
		2308	`slt_prev = slt_next;`
		2309	`make_sltentry(SLT_BEGIN, (BITS)currentlno, lntt_next);`
		2310	`make_dnttentry(K_BEGIN, slt_prev);`
		2311	`#endif`
		2312	`}`
		2313
		2314	`return ;`
		2315	`}`
		2316
		2317	`#ifdef _SYMTAB_INCLUDED`
		2318	`void close_function_scope`
		2319	`PROTO_N ( ( res_label ) )`
		2320	`PROTO_T ( int res_label )`
		2321	`{`
		2322	`SLTPOINTER slt_prev = slt_next;`
		2323	`char address[128];`
		2324	`sprintf(address,"L$$%d-%s",res_label,last_proc_lab);`
		2325	`make_sltentry(SLT_EXIT, last_lno, (ADDRESS)address);`
		2326	`make_sltentry(SLT_END, last_lno, lntt_next);`
		2327	`make_dnttentry(K_END, K_BEGIN, slt_prev, last_DNTT_BEGIN_entry());`
		2328	`slt_prev = slt_next;`
		2329	`make_sltentry(SLT_END, last_lno, lntt_next);`
		2330	`make_dnttentry(K_END, K_FUNCTION, slt_prev, last_DNTT_BEGIN_entry());`
		2331	`}`
		2332	`#endif`
		2333
		2334	`/*`
		2335	`OUTPUT DIAGNOSTICS FOR A LOCAL VARIABLE`
		2336	`*/`
		2337
		2338	`/* ARGSUSED */ void stab_local`
		2339	`PROTO_N ( ( nm, dt, ldid, disp, findex ) )`
		2340	`PROTO_T ( char *nm X diag_type dt X exp ldid X long disp X long findex )`
		2341	`{`
		2342	`exp id = son (ldid) ;`
		2343	`disp += boff(id).offset ;`
		2344	`again:`
		2345	`if ( name(id) == ident_tag )`
		2346	`{`
		2347	`if ( ( props(id) & defer_bit ) == 0 )`
		2348	`{`
		2349	`/* +++ add assembler comment to say which reg is being used */`
		2350	`if ( isparam(id) )`
		2351	`{`
		2352	`if (xdb)`
		2353	`{`
		2354	`#ifdef _SYMTAB_INCLUDED`
		2355	`/* Seems as if parameters are treated like locals by xdb */`
		2356	`#if 0`
		2357	`make_dnttentry(K_FPARAM, 0, 0, 0, 0, vt_next, disp, OUT_DT_SHAPE( dt ), NIL);`
		2358	`#endif`
		2359	`make_dnttentry(K_DVAR, 0, 0, 0, vt_next, disp, OUT_DT_SHAPE( dt ), 0);`
		2360	`make_vtentry(nm,0,0);`
		2361	`#endif`
		2362	`}`
		2363	`else`
		2364	`{`
		2365	`fprintf( dg_file, "\t.stabs\t\"%s:p", nm ) ;`
		2366	`OUT_DT_SHAPE ( dt ) ;`
		2367	`fprintf( dg_file, "\",0xa0,0,%d,%ld\n",`
		2368	`#if 0`
		2369	`shape_size ( sh ( son ( id ) ) ) / 8,`
		2370	`#else`
		2371	`0,`
		2372	`#endif`
		2373	`disp+(frame_sz>>3) ) ;`
		2374	`}`
		2375	`return ;`
		2376	`}`
		2377	`else`
		2378	`{`
		2379	`if (xdb)`
		2380	`{`
		2381	`#ifdef _SYMTAB_INCLUDED`
		2382	`make_dnttentry(K_DVAR, 0, 0, 0, vt_next, disp,`
		2383	`OUT_DT_SHAPE( dt ),`
		2384	`0);`
		2385	`make_vtentry(nm,0,0);`
		2386	`#endif`
		2387	`}`
		2388	`else`
		2389	`{`
		2390	`fprintf ( dg_file, "\t.stabs\t\"%s:", nm ) ;`
		2391	`OUT_DT_SHAPE ( dt ) ;`
		2392	`fprintf (dg_file,"\",0x80,0,%ld,%ld\n",currentlno,disp+(frame_sz>>3)) ;`
		2393	`}`
		2394	`return ;`
		2395	`}`
		2396	`}`
		2397	`else`
		2398	`{`
		2399	`exp sn = son(id) ;`
		2400	`long d = disp ;`
		2401	`while ( sn != nilexp )`
		2402	`{`
		2403	`switch ( name(sn) )`
		2404	`{`
		2405	`case name_tag:`
		2406	`{`
		2407	`disp = d + no(sn) ;`
		2408	`id = son(sn) ;`
		2409	`if ( isvar(id) )`
		2410	`dt = dt->data.ptr.object ;`
		2411	`goto again ;`
		2412	`}`
		2413	`case reff_tag:`
		2414	`{`
		2415	`d += no(sn) ;`
		2416	`sn = son(sn) ;`
		2417	`break ;`
		2418	`}`
		2419	`case cont_tag:`
		2420	`{`
		2421	`sn = son(sn) ;`
		2422	`break ;`
		2423	`}`
		2424	`default:`
		2425	`{`
		2426	`return ;`
		2427	`}`
		2428	`}`
		2429	`}`
		2430	`}`
		2431	`}`
		2432	`return ;`
		2433	`}`
		2434
		2435
		2436	`/*`
		2437	`DEAL WITH BASIC TYPES`
		2438	`*/`
		2439
		2440	`void stab_types`
		2441	`PROTO_Z ()`
		2442	`{`
		2443	`no_type_info = NO_STABS ;`
		2444	`type_info = ( type_info_t * ) xmalloc ( NO_STABS * sizeof ( type_info_t ) ) ;`
		2445	`if (xdb)`
		2446	`{`
		2447	`#ifdef _SYMTAB_INCLUDED`
		2448	`type_info[STAB_SCHAR].p = make_DNTTP_IMMEDIATE( T_CHAR, 8 ) ;`
		2449	`type_info[STAB_UCHAR].p = make_DNTTP_IMMEDIATE( T_UNS_INT, 8 ) ;`
		2450	`type_info[STAB_SSHRT].p = make_DNTTP_IMMEDIATE( T_INT, 16 ) ;`
		2451	`type_info[STAB_USHRT].p = make_DNTTP_IMMEDIATE( T_UNS_INT, 16 ) ;`
		2452	`type_info[STAB_SLONG].p = make_DNTTP_IMMEDIATE( T_LONG, 32 ) ;`
		2453	`type_info[STAB_ULONG].p = make_DNTTP_IMMEDIATE( T_UNS_LONG, 32 ) ;`
		2454	`type_info[STAB_FLOAT].p = make_DNTTP_IMMEDIATE( T_REAL, 32 ) ;`
		2455	`type_info[STAB_DBL].p = make_DNTTP_IMMEDIATE( T_REAL, 64 ) ;`
		2456	`type_info[STAB_LDBL].p = make_DNTTP_IMMEDIATE( T_REAL, 128 ) ;`
		2457	`#endif`
		2458	`}`
		2459	`else`
		2460	`{`
		2461	`fputs ( "\t.stabs\t\"int:t1=r1;-2147483648;2147483647;\",0x80,0,0,0\n",`
		2462	`dg_file ) ;`
		2463	`fputs ( "\t.stabs\t\"short int:t2=r1;-32768;32767;\",0x80,0,0,0\n",`
		2464	`dg_file ) ;`
		2465	`fputs ( "\t.stabs\t\"short unsigned int:t3=r1;0;65535;\",0x80,0,0,0\n",`
		2466	`dg_file ) ;`
		2467	`fputs ( "\t.stabs\t\"char:t4=r4;0;127;\",0x80,0,0,0\n",`
		2468	`dg_file ) ;`
		2469	`fputs ( "\t.stabs\t\"signed char:t5=r1;-128;127;\",0x80,0,0,0\n",`
		2470	`dg_file ) ;`
		2471	`fputs ( "\t.stabs\t\"unsigned char:t6=r1;0;255;\",0x80,0,0,0\n",`
		2472	`dg_file ) ;`
		2473	`fputs ( "\t.stabs\t\"long int:t7=r1;-2147483648;2147483647;\",0x80,0,0,0\n",`
		2474	`dg_file ) ;`
		2475	`fputs ( "\t.stabs\t\"unsigned int:t8=r1;0;-1;\",0x80,0,0,0\n",`
		2476	`dg_file ) ;`
		2477	`fputs ( "\t.stabs\t\"long unsigned int:t9=r1;0;-1;\",0x80,0,0,0\n",`
		2478	`dg_file ) ;`
		2479	`fputs ( "\t.stabs\t\"float:t10=r1;4;0;\",0x80,0,0,0\n",`
		2480	`dg_file ) ;`
		2481	`fputs ( "\t.stabs\t\"double:t11=r1;8;0;\",0x80,0,0,0\n",`
		2482	`dg_file ) ;`
		2483	`fprintf ( dg_file,"\t.stabs\t\"long double:t12=r1;8;0;\",0x80,0,0,0\n");`
		2484	`fputs ( "\t.stabs\t\"void:t13=13\",0x80,0,0,0\n",`
		2485	`dg_file ) ;`
		2486	`}`
		2487	`type_info [0].sz = 0 ;`
		2488	`type_info [1].sz = 32 ;`
		2489	`type_info [2].sz = 16 ;`
		2490	`type_info [3].sz = 16 ;`
		2491	`type_info [4].sz = 8 ;`
		2492	`type_info [5].sz = 8 ;`
		2493	`type_info [6].sz = 8 ;`
		2494	`type_info [7].sz = 32 ;`
		2495	`type_info [8].sz = 32 ;`
		2496	`type_info [9].sz = 32 ;`
		2497	`type_info [10].sz = 32 ;`
		2498	`type_info [11].sz = 64 ;`
		2499	`type_info [12].sz = DOUBLE_SZ ;`
		2500	`type_info [13].sz = 0 ;`
		2501	`return ;`
		2502	`}`
		2503
		2504
		2505	`/*`
		2506	`DEAL WITH STRUCTURE AND UNION TAGS`
		2507	`*/`
		2508
		2509	`void stab_tagdefs`
		2510	`PROTO_Z ()`
		2511	`{`
		2512	`diag_tagdef **di = unit_ind_diagtags ;`
		2513	`unsigned int n = unit_no_of_diagtags ;`
		2514	`int i;`
		2515
		2516	`for ( i = 0 ; i < n ; i++ )`
		2517	`{`
		2518	`diag_type d = di [i]->d_type ;`
		2519	`switch ( d->key )`
		2520	`{`
		2521	`case DIAG_TYPE_STRUCT :`
		2522	`case DIAG_TYPE_UNION :`
		2523	`{`
		2524	`char *nme ;`
		2525	`if ( d->key == DIAG_TYPE_STRUCT ) {`
		2526	`nme = d->data.t_struct.nme.ints.chars ;`
		2527	`} else {`
		2528	`nme = d->data.t_union.nme.ints.chars ;`
		2529	`}`
		2530
		2531	`if ( nme && *nme )`
		2532	`{`
		2533	`if (gdb)`
		2534	`fprintf ( dg_file, "\t.stabs\t\"%s:", nme ) ;`
		2535	`}`
		2536	`else`
		2537	`if ( d->key == DIAG_TYPE_STRUCT )`
		2538	`{`
		2539	`/* static int s_count = 0 ; gcc complains */`
		2540	`if (gdb)`
		2541	`fprintf ( dg_file, "\t.stabs\t\"s:") ;`
		2542	`}`
		2543	`else`
		2544	`{`
		2545	`/* static int u_count = 0 ; gcc complains */`
		2546	`if (gdb)`
		2547	`fprintf ( dg_file, "\t.stabs\t\"u:") ;`
		2548	`}`
		2549	`if ( d->been_outed && 0 )`
		2550	`{`
		2551	`if (gdb)`
		2552	`fprintf ( dg_file, "%d", (int)d->been_outed ) ;`
		2553	`}`
		2554	`else`
		2555	`{`
		2556	`if (gdb)`
		2557	`fprintf ( dg_file, "T" ) ;`
		2558	`OUT_DT_SHAPE ( d ) ;`
		2559	`}`
		2560	`if (gdb)`
		2561	`fprintf ( dg_file, "\",0x80,0,0,0\n" ) ;`
		2562	`break ;`
		2563	`}`
		2564	`case DIAG_TYPE_UNINIT:`
		2565	`case DIAG_TYPE_INITED:`
		2566	`assert(0);`
		2567	`default:`
		2568	`break;`
		2569	`}`
		2570	`}`
		2571	`return ;`
		2572	`}`
		2573
		2574
		2575	`/*`
		2576	`DEAL WITH TYPEDEFS`
		2577	`*/`
		2578
		2579	`void stab_typedefs`
		2580	`PROTO_Z ()`
		2581	`{`
		2582	`diag_descriptor *di = unit_diagvar_tab.array ;`
		2583	`int i, n = unit_diagvar_tab.lastused ;`
		2584	`for ( i = 0 ; i < n ; i++ ) {`
		2585	`if ( di [i].key == DIAG_TYPEDEF_KEY )`
		2586	`{`
		2587	`long non = next_typen () ;`
		2588	`if (gdb)`
		2589	`fprintf ( dg_file, "\t.stabs\t\"%s:t%ld=",`
		2590	`di [i].data.typ.nme.ints.chars, non ) ;`
		2591	`OUT_DT_SHAPE ( di [i].data.typ.new_type ) ;`
		2592	`if (gdb)`
		2593	`fprintf ( dg_file, "\",0x80,0,0,0\n" ) ;`
		2594	`}`
		2595	`}`
		2596	`return ;`
		2597	`}`

Subversion Repositories tendra.SVN

(root)//branches/tendra4/src/installers/hppa/common/hppadiags.c – Rev 3