WebSVN – tendra.SVN – Blame – /branches/tendra5/src/installers/hppa/common/hppadiags.c

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

Subversion Repositories tendra.SVN

(root)/branches/tendra5/src/installers/hppa/common/hppadiags.c – Rev 6