WebSVN – tendra.SVN – Blame – /trunk/src/installers/power/common/diagout.c

Rev	Author	Line No.	Line
2	7u83	1	`/*`
7	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	`Copyright (c) 1993 Open Software Foundation, Inc.`
		33
		34
		35	`All Rights Reserved`
		36
		37
		38	`Permission to use, copy, modify, and distribute this software`
		39	`and its documentation for any purpose and without fee is hereby`
		40	`granted, provided that the above copyright notice appears in all`
		41	`copies and that both the copyright notice and this permission`
		42	`notice appear in supporting documentation.`
		43
		44
		45	`OSF DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING`
		46	`ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A`
		47	`PARTICULAR PURPOSE.`
		48
		49
		50	`IN NO EVENT SHALL OSF BE LIABLE FOR ANY SPECIAL, INDIRECT, OR`
		51	`CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM`
		52	`LOSS OF USE, DATA OR PROFITS, WHETHER IN ACTION OF CONTRACT,`
		53	`NEGLIGENCE, OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION`
		54	`WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.`
		55	`*/`
		56
		57	`/*`
		58	`Crown Copyright (c) 1997`
7	7u83	59
2	7u83	60	`This TenDRA(r) Computer Program is subject to Copyright`
		61	`owned by the United Kingdom Secretary of State for Defence`
		62	`acting through the Defence Evaluation and Research Agency`
		63	`(DERA). It is made available to Recipients with a`
		64	`royalty-free licence for its use, reproduction, transfer`
		65	`to other parties and amendment for any purpose not excluding`
		66	`product development provided that any such use et cetera`
		67	`shall be deemed to be acceptance of the following conditions:-`
7	7u83	68
2	7u83	69	`(1) Its Recipients shall ensure that this Notice is`
		70	`reproduced upon any copies or amended versions of it;`
7	7u83	71
2	7u83	72	`(2) Any amended version of it shall be clearly marked to`
		73	`show both the nature of and the organisation responsible`
		74	`for the relevant amendment or amendments;`
7	7u83	75
2	7u83	76	`(3) Its onward transfer from a recipient to another`
		77	`party shall be deemed to be that party's acceptance of`
		78	`these conditions;`
7	7u83	79
2	7u83	80	`(4) DERA gives no warranty or assurance as to its`
		81	`quality or suitability for any purpose and DERA accepts`
		82	`no liability whatsoever in relation to any use to which`
		83	`it may be put.`
		84	`*/`
		85
		86
		87
		88	`/**********************************************************************`
		89	$Author: release $
		90	$Date: 1998/02/04 15:48:42 $
		91	$Revision: 1.3 $
		92	$Log: diagout.c,v $
		93	`* Revision 1.3 1998/02/04 15:48:42 release`
		94	`* Added OSF copyright message.`
		95	`*`
		96	`* Revision 1.2 1998/02/04 10:43:52 release`
		97	`* Changes during testing.`
		98	`*`
		99	`* Revision 1.1.1.1 1998/01/17 15:55:56 release`
		100	`* First version to be checked into rolling release.`
		101	`*`
		102	`* Revision 1.2 1996/10/04 16:00:10 pwe`
		103	`* add banners and mod for PWE ownership`
		104	`*`
		105	`**********************************************************************/`
		106
		107
		108	`#include "config.h"`
		109	`#include "cross_config.h"`
		110	`#include <time.h>`
		111
		112	`#ifdef CROSS_INCLUDE`
		113	`#include CROSS_INCLUDE/dbxstclass.h>`
		114	`#include CROSS_INCLUDE/sys/debug.h>`
		115	`#else`
		116	`#include <dbxstclass.h>`
		117	`#include <sys/debug.h>`
		118	`#endif`
		119
		120	`#include "common_types.h"`
		121	`#include "memtdf.h"`
		122	`#include "installglob.h"`
		123	`#include "li_types.h"`
		124	`#include "diagtypes.h"`
		125	`#include "toktypes.h"`
		126	`#include "diag_fns.h"`
		127	`#include "diagglob.h"`
		128	`#include "mark_scope.h"`
		129	`#include "externs.h" /* for f_floating() */`
		130	`#include "translat.h"`
		131	`#include "machine.h"`
		132	`#include "szs_als.h"`
		133	`#include "install_fns.h"`
		134	`#include "xalloc.h"`
		135
		136	`#include "maxminmacs.h"`
		137	`#include "proc.h"`
		138
		139	`#include "comment.h"`
		140	`#include "myassert.h"`
		141	`#include "stack.h"`
		142	`#include "diagout.h"`
		143
		144
		145
		146	`/* configuration options */`
		147
		148	`/* maximum .bb/.eb nesting depth in output, negative value implies no limit */`
		149	`#ifndef MAX_BLOCK_DEPTH`
		150	`#define MAX_BLOCK_DEPTH 1 /* more than one seems to upset dbx */`
		151	`#endif`
		152
		153
		154
		155
		156	`/* special line number codes */`
		157	`#define UNKNOWN (-9999)`
		158	`#define NOT_IN_PROC (-9998)`
		159
		160
		161	`/* TypeId INTEGER number for standard TDF shapes */`
		162	`#define TYPEID_SCHAR 1`
		163	`#define TYPEID_UCHAR 2`
		164	`#define TYPEID_SWORD 3`
		165	`#define TYPEID_UWORD 4`
		166	`#define TYPEID_SLONG 5`
		167	`#define TYPEID_ULONG 6`
		168	`#define TYPEID_SHREAL 7`
		169	`#define TYPEID_REAL 8`
		170	`#define TYPEID_DOUBLE 9`
		171	`#define TYPEID_VOID 10`
		172	`#define TYPEID_TOKEN 11`
		173
		174
		175
		176	`/* tdfstring -> nul terminated C string (char ) /`
		177	`#define CSTRING(tdfstring) ((tdfstring).ints.chars)`
		178
		179	`/* tdf exp -> C int */`
7	7u83	180	`#define EXPINT(exp) (ASSERT(name(exp) == val_tag), no(exp))`
2	7u83	181
		182	`/* tdf nat -> C int */`
		183	`#define NATINT(n) ((n).nat_val.small_nat)`
		184
		185
		186
		187	`/*`
		188	`* Query and set "been_outed" field, which may hold`
		189	`* stabstring TypeNo if type has already been output.`
		190	`*/`
		191
7	7u83	192	`#define CLR_OUTED_NO(dt) ((dt) ->been_outed = (OUTPUT_REC)0)`
		193	`#define SET_OUTED_NO(dt,i) ((dt) ->been_outed = (OUTPUT_REC)(i))`
		194	`#define OUTED_NO(dt) ((int)(dt) ->been_outed)`
		195	`#define IS_OUTED(dt) ((dt) ->been_outed != 0)`
2	7u83	196
		197
		198	`/*`
		199	`* Params for stab_relativeline().`
		200	`*/`
		201
		202	`static CONST char line_stab[] = ".line"; /* line number */`
		203	`static CONST char bf_stab[] = ".bf"; /* begin function */`
		204	`static CONST char ef_stab[] = ".ef"; /* end function */`
		205	`static CONST char bb_stab[] = ".bb"; /* begin block */`
		206	`static CONST char eb_stab[] = ".eb"; /* end block */`
		207
		208
		209	`/*`
		210	`* Location in the source program`
		211	`*/`
		212
		213	`static int current_fileno; /* file number of last file output */`
		214	`static int current_lineno; /* the last line number output */`
		215	`static int files_stabbed; /* number of .file or .bi output */`
		216	`static int first_fileno;`
		217
		218	`static int current_procstart_lineno; /* line proc started on */`
		219
		220	`static int block_depth; /* .bb/.eb nesting depth */`
		221
		222	`static filename fds; / known files numbered from 0 */`
		223	`static int mainfile_fd = -1; /* index into fds of 'main source file' */`
		224	`static int szfds = 0; /* space malloc'd for fds */`
		225	`static int nofds = 0; /* how many are known */`
		226
		227
		228	`/*`
		229	`* Struct/union type information.`
		230	`* (See function OUTPUT_DIAG_TAGS)`
		231	`*/`
		232
7	7u83	233	`static diag_tagdef su_diags = (diag_tagdef )0;`
2	7u83	234	`static int no_of_sus = 0;`
		235	`static int leng_sus = 0;`
		236
		237	`/*`
		238	`* Typedef information`
		239	`* (See function OUTPUT_GLOBALS_TAB)`
		240	`*/`
		241
7	7u83	242	`static diag_descriptor typedef_diags = (diag_descriptor )0;`
2	7u83	243	`static int no_of_typedefs = 0;`
		244	`static int leng_typedefs = 0;`
		245
		246	`/*`
		247	`* Shapes we need, set in init_diag.`
		248	`*/`
		249
		250	`static shape voidsh; /* shape for void */`
		251	`static shape tokensh; /* shape for TDF tokenised type */`
		252
		253
		254	`/*`
		255	`* Static procs.`
		256	`*/`
		257
7	7u83	258	`static diag_descriptor *find_dd(exp);`
		259	`static int find_file(char *);`
		260	`static void stab_relativeline(CONST char *);`
		261	`static void stab_begin_block(void);`
		262	`static void stab_end_block(void);`
		263	`static void stabn(int, int);`
		264	`static void stab_file(int);`
		265	`static void diagbr_open(int);`
		266	`static void diagbr_close(int);`
		267	`static int next_typen(void);`
		268	`static int TypeNo_of_shape(shape);`
		269	`static bool eq_sutype(diag_type, diag_type);`
		270	`static bool eq_typedef_type(diag_descriptor ,diag_descriptor );`
		271	`static int size_dt(diag_type);`
		272	`static void out_dt_TypeDef_no_recurse(diag_type);`
		273	`static void out_dt_TypeDef(diag_type);`
		274	`static void out_dt_NewTypeId(diag_type, int);`
		275	`static void out_dt_TypeId(diag_type);`
		276	`static void stab_internal_types(diag_type, bool);`
		277	`static void stab_types(void);`
2	7u83	278
7	7u83	279	`static void number_and_stab_basicshapes(void);`
		280	`static void number_structs_and_unions(void);`
		281	`static void stab_structs_and_unions(void);`
		282	`static void number_typedefs(void);`
		283	`static void stab_typedefs(void);`
		284	`static void stab_basicshape(shape,char * ,int,int);`
2	7u83	285
7	7u83	286
2	7u83	287	`/*(See diag_config.h)`
		288	`* remember a filename so that find_file() can map onto filename number`
		289	`*/`
7	7u83	290	`void INSPECT_FILENAME(filename f)`
2	7u83	291	`{`
7	7u83	292	`FULLCOMMENT2("INSPECT_FILENAME %d: '%s'", nofds,(int)CSTRING(f->file));`
		293
		294	`if (fds == (filename *)0)`
2	7u83	295	`{`
7	7u83	296	`fds = (filename )xmalloc((szfds += 5) sizeof(filename));`
2	7u83	297	`}`
		298	`else if (nofds >= szfds)`
		299	`{`
7	7u83	300	`fds = (filename )xrealloc(fds,(szfds += 5) sizeof(filename));`
2	7u83	301	`}`
7	7u83	302
2	7u83	303	`fds[nofds] = f;`
		304
		305	`/*`
		306	`* The following is taken from trans386/dwarf/dwarf_out.c.`
		307	`* It works out the main source filename. There must be a better way. +++`
		308	`*/`
		309	`if (mainfile_fd < 0)`
		310	`{`
		311	`/* use heuristic to see if this is 'main source file' */`
		312	`char *lastdot = strrchr(CSTRING(f->file), '.');`
7	7u83	313
2	7u83	314	`/* XXX.h not considered 'main source file' */`
7	7u83	315	`if (lastdot != 0 && lastdot[1]!= 'h')`
2	7u83	316	`mainfile_fd = nofds;`
		317	`}`
		318
		319	`nofds++;`
		320	`return;`
		321	`}`
		322
		323	`/*(See diag_config.h)`
		324	`* outputs structs & unions from global level types`
		325	`*/`
7	7u83	326	`void OUTPUT_DIAG_TAGS(void)`
2	7u83	327	`{`
		328	`diag_tagdef **di = unit_ind_diagtags;`
		329	`unsigned int n = unit_no_of_diagtags;`
		330	`int i;`
		331	`int il = no_of_sus; /* There should be no clashes within a single unit so we save a bit of time here */`
7	7u83	332
2	7u83	333	`for (i = 0; i < n; ++i)`
		334	`{`
7	7u83	335	`diag_type d = di[i] ->d_type;`
		336
2	7u83	337	`switch (d->key)`
		338	`{`
		339	`case DIAG_TYPE_STRUCT:`
		340	`case DIAG_TYPE_UNION:`
		341	`{`
		342	`int j;`
7	7u83	343
2	7u83	344	`for (j = 0; j < il; j++)`
		345	`{`
		346	`/* Check we have not done already */`
7	7u83	347	`if (eq_sutype(d, su_diags[j] ->d_type))`
2	7u83	348	`{`
		349	`break;`
		350	`}`
		351	`}`
		352	`if (j != il)`
		353	`{`
		354	`break;`
		355	`}`
		356	`if (no_of_sus >= leng_sus)`
		357	`{`
7	7u83	358	`if (su_diags == (diag_tagdef **)0)`
2	7u83	359	`{`
7	7u83	360	`su_diags= (diag_tagdef*)xmalloc((leng_sus+=20)sizeof(diag_tagdef*));`
2	7u83	361	`}`
		362	`else`
		363	`{`
7	7u83	364	`su_diags= (diag_tagdef*)xrealloc(su_diags,(leng_sus+=20)sizeof(diag_tagdef*));`
2	7u83	365	`}`
		366	`}`
		367	`/* Set up the appropriate member of the su_diags array */`
		368	`su_diags[no_of_sus++] = di[i];`
		369	`break;`
		370	`}`
		371	`default:`
		372	`break;`
		373	`}`
		374	`}`
		375	`return;`
		376	`}`
		377	`/*`
		378	`* Collects information`
		379	`*/`
7	7u83	380	`void OUTPUT_GLOBALS_TAB(void)`
2	7u83	381	`{`
		382	`diag_descriptor * unit_typedef_array = unit_diagvar_tab.array;`
		383	`unsigned int no_of_typedefs_in_unit =unit_diagvar_tab.lastused;`
		384	`int i;`
		385	`int il = no_of_typedefs;`
7	7u83	386
		387	`for (i=0; i<=no_of_typedefs_in_unit; i++)`
2	7u83	388	`{`
		389	`diag_descriptor * dd = unit_typedef_array + i;`
7	7u83	390
2	7u83	391	`switch (dd->key)`
		392	`{`
		393	`case DIAG_TYPEDEF_KEY:`
		394	`{`
		395	`int j;`
7	7u83	396
2	7u83	397	`/* Check that we have not done already */`
7	7u83	398	`for (j=0; j < il; j++)`
2	7u83	399	`{`
7	7u83	400	`if (eq_typedef_type(dd,typedef_diags[j]))`
2	7u83	401	`{`
		402	`break;`
		403	`}`
		404	`}`
7	7u83	405	`if (j != il)`
2	7u83	406	`{`
		407	`break;`
		408	`}`
7	7u83	409
2	7u83	410	`/* We have a new one */`
		411	`if (no_of_typedefs >= leng_typedefs)`
7	7u83	412	`{`
		413	`if (typedef_diags == (diag_descriptor **)0)`
2	7u83	414	`{`
7	7u83	415	`typedef_diags = (diag_descriptor *)xmalloc((leng_typedefs+=20)sizeof(diag_descriptor *));`
2	7u83	416	`}`
		417	`else`
		418	`{`
		419	`typedef_diags = (diag_descriptor *)xrealloc(typedef_diags,(leng_typedefs+=20)sizeof(diag_descriptor *));`
		420	`}`
		421	`}`
7	7u83	422	`typedef_diags[no_of_typedefs++] =dd;`
2	7u83	423	`}`
		424	`break;`
		425	`default:`
		426	`break;`
		427	`}`
		428	`}`
		429	`}`
		430
7	7u83	431
		432	`static void number_and_stab_basicshapes(void)`
2	7u83	433	`{`
		434	`/* NOTE: char is unsigned char */`
		435	`stab_basicshape(scharsh ,"signed char" , TYPEID_SCHAR , TP_SCHAR);`
		436	`stab_basicshape(ucharsh ,"char" , TYPEID_UCHAR , TP_CHAR);`
		437	`stab_basicshape(swordsh ,"short" , TYPEID_SWORD , TP_SHORT);`
		438	`stab_basicshape(uwordsh ,"unsigned short", TYPEID_UWORD , TP_USHORT);`
		439	`stab_basicshape(slongsh ,"int" , TYPEID_SLONG , TP_LONG);`
		440	`stab_basicshape(ulongsh ,"unsigned int" , TYPEID_ULONG , TP_ULONG);`
		441	`stab_basicshape(shrealsh,"float" , TYPEID_SHREAL, TP_FLOAT);`
		442	`stab_basicshape(realsh ,"double" , TYPEID_REAL , TP_DOUBLE);`
		443	`stab_basicshape(doublesh,"long double" , TYPEID_DOUBLE, TP_LDOUBLE);`
		444	`stab_basicshape(voidsh ,"void" , TYPEID_VOID , TP_VOID);`
		445
		446	`#if 0`
		447	`/* this work fine with dbx and gdb, the type is given as "TOKENISED_TYPE" */`
		448	`stab_basicshape(tokensh, "TOKENISED_TYPE", TYPEID_TOKEN, TP_VOID);`
		449	`#else`
		450	`/*`
		451	`* ... but this is better`
		452	`* dbx gives type as "@TOKENISED_TYPE", gdb "struct <unknown>",`
		453	`* when value is printed, dbx says "[typeref]", gdb "<incomplete type>"`
		454	`*/`
		455	`{`
		456	`int n = next_typen(); /* use up the typen TYPEID_TOKEN */`
		457
		458	`ASSERT(TYPEID_TOKEN == n);`
		459
		460	`/*`
		461	`* TypeId: INTEGER = TypeDef "New type number described by TypeDef"`
		462	`* TypeDef: o NAME ; "Opaque type"`
		463	`*/`
		464	`fprintf(as_file, "\t.stabx\t\":t%d=oTOKENISED_TYPE;", TYPEID_TOKEN);`
		465	`fprintf(as_file, "\",%d,%d,%d\n", 0, C_DECL, 0);`
		466	`}`
		467	`#endif`
		468	`}`
		469
7	7u83	470	`static void number_structs_and_unions(void)`
2	7u83	471	`{`
		472	`int i;`
7	7u83	473
2	7u83	474	`for (i = 0; i < no_of_sus; ++i)`
		475	`{`
7	7u83	476	`SET_OUTED_NO(su_diags[i] ->d_type, next_typen());`
2	7u83	477	`}`
		478	`}`
7	7u83	479	`static void number_typedefs(void)`
2	7u83	480	`{`
		481	`int i;`
7	7u83	482
2	7u83	483	`for (i=0;i<no_of_typedefs; i++)`
		484	`{`
7	7u83	485	`if (!IS_OUTED(typedef_diags[i] ->data.typ.new_type))`
2	7u83	486	`{`
7	7u83	487	`SET_OUTED_NO(typedef_diags[i] ->data.typ.new_type,next_typen());`
2	7u83	488	`}`
		489	`}`
		490	`}`
7	7u83	491
		492	`static void stab_structs_and_unions(void)`
2	7u83	493	`{`
		494	`int i;`
7	7u83	495
2	7u83	496	`for (i = 0; i < no_of_sus; ++i)`
		497	`{`
		498	`int non;`
7	7u83	499	`diag_type dt = su_diags[i] ->d_type;`
2	7u83	500	`char *nme = (dt->key == DIAG_TYPE_STRUCT)`
		501	`? CSTRING(dt->data.t_struct.nme)`
		502	`: CSTRING(dt->data.t_union.nme);`
		503
7	7u83	504	`COMMENT2("su_diags: is_struct=%d nme='%s'", dt->key == DIAG_TYPE_STRUCT,(int)nme);`
2	7u83	505
		506	`stab_internal_types(dt, 0);`
		507
7	7u83	508	`if (nme == (char )0 \|\| nme == (char)0)`
2	7u83	509	`{`
		510	`/*`
		511	`* Output unnamed object here for 2 reasons:`
		512	`* 1) gdb (but not dbx) is confused by Typeid which includes a`
		513	`* full TypeDef and treats it as an anonymous struct.`
		514	`* It prefers TypeDef to refer to a previous TypeId INTEGER.`
		515	`* 2) It avoids very long stabstrings from unnamed object`
		516	`* being expanded on the fly.`
		517	`*/`
		518	`fprintf(as_file, "\t.stabx\t\":T"); /* Unnamed object */`
		519	`}`
		520	`else`
		521	`{`
		522	`fprintf(as_file, "\t.stabx\t\"%s:T", nme);`
		523	`}`
		524
		525	`non = OUTED_NO(dt);`
		526	`CLR_OUTED_NO(dt); /* avoid identity */`
		527	`out_dt_NewTypeId(dt, non);`
		528
		529	`fprintf(as_file, "\",%d,%d,%d\n", 0, C_DECL, 0);`
		530	`}`
7	7u83	531	`}`
		532	`static void stab_typedefs(void)`
2	7u83	533	`{`
		534	`int i;`
7	7u83	535	`for (i=0;i<no_of_typedefs;i++)`
2	7u83	536	`{`
		537	`diag_descriptor * dd = typedef_diags[i];`
		538	`int non;`
		539	`diag_type dt = dd->data.typ.new_type;`
		540	`stab_internal_types(dt,0);`
		541	`ASSERT(CSTRING(dd->data.typ.nme)[0]!=0);/* Not an empty string */`
		542
		543	`fprintf(as_file, "\t.stabx\t\"%s:t", CSTRING(dd->data.typ.nme));`
7	7u83	544
2	7u83	545	`non = OUTED_NO(dt);`
		546	`CLR_OUTED_NO(dt); /* avoid identity */`
		547	`out_dt_NewTypeId(dt, non);`
7	7u83	548
2	7u83	549	`fprintf(as_file, "\",%d,%d,%d\n", 0, C_DECL, 0);`
		550	`}`
		551	`}`
		552
		553	`/*`
		554	`* init_diag - used by translate_capsule() to initialise diagnostics.`
		555	`*/`
7	7u83	556	`void init_diag(void)`
2	7u83	557	`{`
7	7u83	558	`/*`
		559	`* Initialisation of diagnostics`
2	7u83	560	`*/`
		561	`current_fileno = UNKNOWN;`
		562	`current_procstart_lineno = NOT_IN_PROC;`
		563	`current_lineno = NOT_IN_PROC;`
		564	`files_stabbed = 0;`
		565	`first_fileno = -100;`
		566	`stab_file(mainfile_fd);`
		567	`voidsh = getshape(0, 0, 0, TOP_ALIGN, TOP_SZ, tophd);/* very dubious */`
		568	`tokensh = getshape(0, 0, 0, TOP_ALIGN, TOP_SZ, bothd);/* very dubious */`
		569	`stab_types();`
		570	`return;`
		571	`}`
		572
		573
		574	`/*`
		575	`* Correct the name for non externs (eg C static) to keep dbx happy.`
		576	`* gdb happily uses the stab info to override the assembler label,`
		577	`* but dbx does not. local_prefix names (eg S.999) upset dbx,`
		578	`* partcularly on stack tracebacks from 'where'. If we find that`
		579	`* the name is already in use, eg possibly from nested C static`
		580	`* we change the name to "S.NNN.name" to add meaning, but stay unique.`
		581	`*/`
7	7u83	582	`void fixup_name(exp global, dec * top_def, dec * crt_def)`
2	7u83	583	`{`
		584	`diag_descriptor *dd;`
		585	`dec *d;`
		586	`char id = crt_def->dec_u.dec_val.dec_id; / assembler label */`
		587	`char nm; / real name, or uniqued real name */`
		588
		589	`/*`
		590	`* Externs have correct name currently.`
		591	`* Any name not starting with local_prefix is special, leave it.`
		592	`*/`
		593	`if (crt_def->dec_u.dec_val.extnamed \|\|`
7	7u83	594	`id[0]!= local_prefix[0] \|\| id[1]!= local_prefix[1])`
2	7u83	595	`{`
		596	`return; /* externs have correct name currently */`
		597	`}`
		598
		599	`dd = find_dd(global);`
		600
7	7u83	601	`if (dd == (diag_descriptor *)0)`
2	7u83	602	`{`
		603	`/* eg string constant or currently static within proc */`
		604	`FULLCOMMENT("correct_name: no descriptor");`
		605	`return;`
		606	`}`
		607
		608	`nm = CSTRING(dd->data.id.nme);`
		609
		610	`/* search def chain to see if name is already used as assembler label */`
7	7u83	611	`for (d = top_def; d != crt_def && d != (dec *)0; d = d->def_next)`
2	7u83	612	`{`
		613	`if (strcmp(nm, d->dec_u.dec_val.dec_id) == 0)`
		614	`{`
		615
		616	`/*`
		617	`* Name already used, create new name to add meaning but stay unique:`
		618	`* "S.NNNN.name".`
		619	`*/`
		620	`int len1 = strlen(id);`
		621	`int len2 = strlen(nm);`
		622	`char *newid;`
		623
		624	`newid = (char *)xmalloc(len1 + 1 + len2 + 1);`
		625	`strcpy(newid, id);`
		626	`newid[len1] = '.';`
		627	`strcpy(&newid[len1 + 1], nm);`
		628	`nm = newid;`
		629	`break;`
		630	`}`
		631	`}`
		632
		633	`crt_def->dec_u.dec_val.dec_id = nm; /* change label to real identifier`
		634	`* name */`
		635	`}`
		636
		637
		638	`/*`
		639	`* output_diag - used by make_code() to implement "diagnose_tag".`
		640	`*/`
7	7u83	641	`void output_diag(diag_info * d, int proc_no, exp e)`
2	7u83	642	`{`
		643	`exp id;`
7	7u83	644
2	7u83	645	`FULLCOMMENT1("output_diag: key=%d", d->key);`
7	7u83	646
2	7u83	647	`if (d->key == DIAG_INFO_SOURCE)`
		648	`{`
		649	`sourcemark *s = &d->data.source.beg;`
		650	`int f = find_file(CSTRING(s->file->file));`
		651
		652	`stabn(f, NATINT(s->line_no));`
		653	`return;`
		654	`}`
		655
		656	`if (d->key != DIAG_INFO_ID)`
		657	`{`
		658	`FULLCOMMENT1("output_diag: unsupported key=%d", d->key);`
		659	`return;`
		660	`}`
		661
		662	`id = son(d->data.id_scope.access);`
		663
7	7u83	664	`FULLCOMMENT3("output_diag: DIAG_INFO_ID %s isglob(id) =%d no(id) =%d",`
		665	`(int)CSTRING(d->data.id_scope.nme), isglob(id), no(id));`
2	7u83	666
		667	`/* can't output global values as local names */`
		668	`if (isglob(id))`
		669	`{`
		670	`return;`
		671	`}`
7	7u83	672
2	7u83	673	`ASSERT(name(id) == ident_tag);`
		674
		675	`mark_scope(e);`
7	7u83	676	`FULLCOMMENT1("output_diag: DIAG_INFO_ID mark_scope props(e) =%#x", props(e));`
2	7u83	677
		678	`if (props(e) & 0x80)`
		679	`{`
		680	`diagbr_open(current_fileno);`
		681	`stabn(current_fileno, current_lineno + 1); /* don't have proper lineno */`
		682	`}`
		683
		684	`/* dbx is upset if a function does not have a begin block, make sure it does */`
		685	`if (!isparam(id) && block_depth == 0)`
		686	`{`
		687	`stab_begin_block();`
		688	`}`
		689	`stab_local(CSTRING(d->data.id_scope.nme), d->data.id_scope.typ,`
		690	`id, 0, current_fileno);`
7	7u83	691
2	7u83	692	`if (isparam(id) && last_caller_param(id))`
		693	`{`
		694	`if (block_depth == 0)`
		695	`{`
		696	`stab_begin_block();`
		697	`}`
		698	`#if 0`
		699	`stabn(current_fileno, current_lineno + 1); /* don't have proper lineno */`
		700	`#endif`
		701	`}`
		702	`return;`
		703	`}`
		704
		705
		706	`/*`
		707	`* output_end_scope - used by make_code() to make end of diagnose_tag scope.`
		708	`*/`
7	7u83	709	`void output_end_scope(diag_info * d, exp e)`
2	7u83	710	`{`
		711	`FULLCOMMENT1("output_end_scope key=%d", d->key);`
		712	`if (d->key == DIAG_INFO_SOURCE)`
		713	`{`
		714	`sourcemark *s = &d->data.source.end;`
		715	`int f = find_file(CSTRING(s->file->file));`
		716	`int lno = NATINT(s->line_no);`
		717
		718	`stabn(f, lno);`
		719	`return;`
		720	`}`
		721	`if (d->key == DIAG_INFO_ID && props(e) & 0x80)`
		722	`{`
		723	`diagbr_close(current_fileno);`
		724	`return;`
		725	`}`
		726	`}`
		727	`/*`
		728	`* find_dd`
		729	`*/`
7	7u83	730	`static diag_descriptor *find_dd(exp e)`
2	7u83	731	`{`
7	7u83	732	`if (diag_def==NULL)`
2	7u83	733	`{`
		734	`return NULL;`
		735	`}`
		736	`return diag_def->dec_u.dec_val.diag_info;`
		737	`}`
		738
		739
		740
7	7u83	741
2	7u83	742	`/*`
		743	`* get filename number`
		744	`*/`
7	7u83	745	`static int find_file(char *f)`
2	7u83	746	`{`
		747	`int i;`
		748
		749	`for (i = 0; i < nofds; i++)`
		750	`{`
7	7u83	751	`if (strcmp(f, CSTRING(fds[i] ->file)) == 0)`
2	7u83	752	`{`
		753	`return i;`
		754	`}`
		755	`}`
		756	`return 0;`
		757	`}`
		758
		759
		760
		761	`/*`
		762	`* ============================================================================`
		763	`* Procs to generate line number related stabs`
		764	`*/`
		765
		766
		767	`/*`
		768	`* output directive using proc start relative linenos`
		769	`*/`
7	7u83	770	`static void stab_relativeline(CONST char *directive)`
2	7u83	771	`{`
		772	`int lineinproc = current_lineno - current_procstart_lineno;`
		773
		774	`/* avoid nonsense line nos from unusual header or #line usage */`
		775	`if (lineinproc >= 0)`
		776	`{`
		777	`fprintf(as_file, "\t%s\t%d\n", directive, lineinproc + 1);`
		778	`}`
		779	`else if (directive != line_stab)`
		780	`{`
		781	`fprintf(as_file, "\t%s\t%d\n", directive, 1); /* must put out`
		782	`* something to match`
		783	`* begin/end */`
		784	`}`
		785	`return;`
		786	`}`
		787
		788
		789	`/*`
		790	`* output begin block directive`
		791	`*/`
7	7u83	792	`static void stab_begin_block(void)`
2	7u83	793	`{`
		794	`#if 0`
		795	`if (MAX_BLOCK_DEPTH < 0 \|\| block_depth < MAX_BLOCK_DEPTH)`
		796	`#endif`
		797	`{`
		798	`stab_relativeline(bb_stab);`
		799	`}`
		800	`block_depth++;`
		801	`return;`
		802	`}`
		803
		804	`/*`
		805	`* output end block directive`
		806	`*/`
7	7u83	807	`static void stab_end_block(void)`
2	7u83	808	`{`
		809	`if (block_depth >= 0)`
		810	`{`
		811	`#if 0`
		812	`if (MAX_BLOCK_DEPTH < 0 \|\| block_depth <= MAX_BLOCK_DEPTH)`
		813	`#endif`
		814	`{`
		815	`stab_relativeline(eb_stab);`
		816	`}`
		817	`block_depth--;`
		818	`}`
		819	`return;`
		820	`}`
		821
		822
		823	`/*`
		824	`* Generate stabs for current file and line number.`
		825	`* Note that line number stabs are relative to start of current proc.`
		826	`*/`
7	7u83	827	`static void stabn(int findex, int lno)`
2	7u83	828	`{`
		829	`if (findex == current_fileno && lno == current_lineno)`
		830	`{`
		831	`return;`
		832	`}`
		833	`if (findex != current_fileno)`
		834	`{`
		835	`stab_file(findex);`
		836	`}`
		837	`if (current_procstart_lineno == NOT_IN_PROC)`
		838	`{`
		839	`return;`
		840	`}`
7	7u83	841
2	7u83	842	`current_lineno = lno;`
		843	`stab_relativeline(line_stab);`
		844	`return;`
		845	`}`
		846	`/*`
7	7u83	847	`* stab_end_file ties up lose ends`
2	7u83	848	`*/`
7	7u83	849	`void stab_end_file(void)`
2	7u83	850	`{`
		851	`if (current_fileno != first_fileno)`
		852	`{`
		853	`COMMENT("stab_end_file: close the last include file with a .ei");`
		854	`/* close the last include file */`
7	7u83	855	`fprintf(as_file, "\t.ei\t\"%s\"\n", CSTRING(fds[current_fileno] ->file));`
2	7u83	856	`}`
		857	`return;`
		858	`}`
		859
		860	`/*`
		861	`* output file name if changed`
		862	`*/`
7	7u83	863	`static void stab_file(int findex)`
2	7u83	864	`{`
		865	`bool stabbed = 0;`
		866
		867	`if ((findex == current_fileno) \|\| (findex < 0) \|\| (findex >= szfds))`
		868	`{`
		869	`return;`
		870	`}`
7	7u83	871
2	7u83	872	`if (files_stabbed == 0)`
		873	`{`
		874	`/* .file */`
7	7u83	875	`fprintf(as_file, "\n\t.file\t\"%s\"\n", CSTRING(fds[findex] ->file));`
2	7u83	876	`stabbed = 1;`
		877	`first_fileno = findex;`
		878	`}`
		879	`else`
		880	`{`
		881	`/* .bi (begin include) if appropriate */`
		882
		883	`/*`
		884	`* +++ .bi/.ei causes dbx to core dump, see IBM problem fix (APAR)`
		885	`* +++ IX26109 bosadt: .bi/.ei placement doesn't match xlc, debuggers suffer`
		886	`* +++ so we leave them commented out currently.`
		887	`*/`
		888
		889	`/* first end previous .bi if needed */`
		890	`if (current_fileno != first_fileno)`
7	7u83	891	`{`
		892	`fprintf(as_file, "\t.ei\t\"%s\"\n", CSTRING(fds[current_fileno] ->file));`
2	7u83	893	`}`
7	7u83	894
2	7u83	895	`/* .bi if not same as original .file */`
		896	`if (findex != first_fileno)`
		897	`{`
7	7u83	898	`fprintf(as_file, "\n\t.bi\t\"%s\"\n", CSTRING(fds[findex] ->file));`
2	7u83	899	`stabbed = 1;`
		900	`}`
		901	`else`
		902	`{`
		903	`/* output a comment to indicate back to .file level */`
7	7u83	904	`fprintf(as_file, "\n#\t.file\t\"%s\"\n", CSTRING(fds[findex] ->file));`
2	7u83	905	`}`
		906	`}`
		907
		908	`files_stabbed++;`
		909
		910	`if (stabbed)`
		911	`{`
		912	`/* output TDF file machine */`
7	7u83	913	`char *mach = CSTRING(fds[findex] ->machine);`
		914	`time_t t = NATINT(fds[findex] ->date);`
2	7u83	915
		916	`/* output machine name if given */`
		917	`if (mach != 0 && *mach != '\0')`
		918	`{`
		919	`fprintf(as_file, "#\tMachine: \"%s\"\n", mach);`
		920	`}`
7	7u83	921
2	7u83	922	`/* output TDF file time (ctime appends extra '\n') */`
		923	`if (t != 0)`
		924	`{`
		925	`fprintf(as_file, "#\tSource file date: %s\n", ctime(&t));`
		926	`}`
		927	`}`
		928	`current_fileno = findex;`
		929	`return;`
		930	`}`
		931
		932
		933	`/*`
		934	`* start of a new lex level`
		935	`*/`
7	7u83	936	`static void diagbr_open(int findex)`
2	7u83	937	`{`
		938	`stab_file(findex);`
		939	`stab_begin_block();`
		940	`return;`
		941	`}`
		942
		943	`/*`
		944	`* end of a lex level`
		945	`*/`
7	7u83	946	`static void diagbr_close(int findex)`
2	7u83	947	`{`
		948	`stab_file(findex);`
		949	`stab_end_block();`
		950	`return;`
		951	`}`
		952
		953
		954
		955	`/*`
		956	`* ============================================================================`
		957	`* Procs to generate type or object related stabs`
		958	`*/`
		959
		960
		961	`/*`
		962	`* get the next type number to be used as a stabstring TypeId`
		963	`*/`
7	7u83	964	`static int next_typen(void)`
2	7u83	965	`{`
		966	`static int typeno = 0; /* types are numbered from 1 */`
		967
		968	`return ++typeno;`
		969	`}`
		970
		971
		972	`/*`
		973	`* return standard TypeNo output by stab_types() for simple shapes`
		974	`*/`
7	7u83	975	`static int TypeNo_of_shape(shape s)`
2	7u83	976	`{`
		977	`/* tokensh is special to this module, cannot use name(tokensh) */`
		978	`if (s == tokensh)`
		979	`{`
		980	`return TYPEID_TOKEN;`
		981	`}`
7	7u83	982
2	7u83	983	`switch (name(s))`
		984	`{`
		985	`case bothd: /FALLTHROUGH/`
		986	`case tophd: return TYPEID_VOID;`
		987	`case scharhd: return TYPEID_SCHAR;`
		988	`case ucharhd: return TYPEID_UCHAR;`
		989	`case swordhd: return TYPEID_SWORD;`
		990	`case uwordhd: return TYPEID_UWORD;`
		991	`case sizehd: /FALLTHROUGH/`
		992	`case slonghd: return TYPEID_SLONG;`
		993	`case ulonghd: return TYPEID_ULONG;`
		994	`case shrealhd: return TYPEID_SHREAL;`
		995	`case realhd: return TYPEID_REAL;`
		996	`case doublehd: return TYPEID_DOUBLE;`
7	7u83	997
2	7u83	998	`default:`
		999	`{`
		1000	`ASSERT(0); /* fail if debugging */`
		1001	`return TYPEID_VOID; /* return something that will work */`
		1002	`}`
7	7u83	1003	`/* NOTREACHED */`
2	7u83	1004	`}`
		1005	`}`
		1006
		1007
		1008	`/*`
		1009	`* Are two struct/union types structurally equivalent?`
		1010	`* That is, the same stab TypeDef would be generated.`
		1011	`*/`
7	7u83	1012	`static bool eq_sutype(diag_type a, diag_type b)`
2	7u83	1013	`{`
		1014	`diag_field_list fa;`
		1015	`diag_field_list fb;`
		1016	`int j;`
		1017
		1018	`if (a == b)`
		1019	`{`
		1020	`return 1;`
		1021	`}`
		1022	`if (a->key != b->key)`
		1023	`{`
		1024	`return 0;`
		1025	`}`
		1026	`if (a->key != DIAG_TYPE_STRUCT && a->key != DIAG_TYPE_UNION)`
		1027	`{`
		1028	`return 0;`
		1029	`}`
7	7u83	1030
2	7u83	1031	`if (strcmp(CSTRING(a->data.t_struct.nme), CSTRING(b->data.t_struct.nme)))`
		1032	`{`
		1033	`return 0;`
		1034	`}`
		1035	`fa = a->data.t_struct.fields;`
		1036	`fb = b->data.t_struct.fields;`
		1037	`if (fa->lastused != fb->lastused)`
		1038	`{`
		1039	`return 0;`
		1040	`}`
		1041	`for (j = fa->lastused - 1; j >= 0; j--)`
		1042	`{`
		1043	`diag_field sfa = (fa->array)[j];`
		1044	`diag_field sfb = (fb->array)[j];`
		1045
		1046	`if (strcmp(CSTRING(sfa->field_name), CSTRING(sfb->field_name)))`
		1047	`{`
		1048	`return 0;`
		1049	`}`
		1050	`}`
		1051	`return eq_shape(a->data.t_struct.tdf_shape, b->data.t_struct.tdf_shape);`
		1052	`}`
7	7u83	1053	`static bool eq_typedef_type(diag_descriptor * a, diag_descriptor * b)`
2	7u83	1054	`{`
7	7u83	1055	`if (a==b)`
2	7u83	1056	`{`
		1057	`return 1;`
		1058	`}`
7	7u83	1059
		1060	`if (strcmp(CSTRING(a->data.typ.nme),CSTRING(b->data.typ.nme)) ==0)`
2	7u83	1061	`{`
		1062	`return 1;`
		1063	`}`
		1064	`return 0;`
		1065	`}`
		1066
		1067
		1068
		1069	`/*`
		1070	`* size in bits of object represented by dt, or negative for unknown size`
		1071	`*/`
7	7u83	1072	`static int size_dt(diag_type dt)`
2	7u83	1073	`{`
		1074	`switch (dt->key)`
		1075	`{`
		1076	`case DIAG_TYPE_PTR:`
		1077	`{`
		1078	`return 32;`
		1079	`}`
		1080	`case DIAG_TYPE_ARRAY:`
		1081	`{`
		1082	`int stride = EXPINT(dt->data.array.stride);`
		1083	`int lwb = EXPINT(dt->data.array.lower_b);`
		1084	`int upb = EXPINT(dt->data.array.upper_b);`
		1085	`int nelements = upb - lwb + 1;`
7	7u83	1086
2	7u83	1087	`if (nelements < 0)`
		1088	`{`
		1089	`return 0; /* avoid negative size from "super-flat" arrays */`
		1090	`}`
7	7u83	1091
2	7u83	1092	`if (stride > 0)`
		1093	`{`
		1094	`ASSERT(stride >= size_dt(dt->data.array.element_type));`
		1095	`return nelements * stride;`
		1096	`}`
		1097	`else`
		1098	`{`
		1099	`/* stride not expected to be <= 0, but just in case ... */`
		1100	`return nelements * size_dt(dt->data.array.element_type);`
		1101	`}`
		1102	`/* NOTREACHED */`
		1103	`}`
		1104	`case DIAG_TYPE_STRUCT:`
		1105	`{`
		1106	`return shape_size(dt->data.t_struct.tdf_shape);`
		1107	`}`
		1108	`case DIAG_TYPE_UNION:`
		1109	`{`
		1110	`return shape_size(dt->data.t_union.tdf_shape);`
		1111	`}`
		1112	`case DIAG_TYPE_ENUM:`
		1113	`{`
		1114	`return size_dt(dt->data.t_enum.base_type);`
		1115	`}`
		1116	`case DIAG_TYPE_VARIETY:`
		1117	`{`
		1118	`return shape_size(dt->data.var);`
		1119	`}`
		1120	`case DIAG_TYPE_PROC:`
		1121	`{`
		1122	`return 32; /* ptr to proc */`
		1123	`}`
		1124	`case DIAG_TYPE_LOC:`
		1125	`{`
		1126	`return size_dt(dt->data.loc.object);`
		1127	`}`
		1128	`case DIAG_TYPE_FLOAT:`
		1129	`{`
		1130	`return shape_size(f_floating(dt->data.f_var)); /* shape for f_var */`
		1131	`}`
		1132	`case DIAG_TYPE_NULL:`
		1133	`{`
		1134	`return 0; /* void has no size */`
		1135	`}`
		1136	`case DIAG_TYPE_BITFIELD:`
		1137	`{`
		1138	`return NATINT(dt->data.bitfield.no_of_bits);`
		1139	`}`
		1140	`case DIAG_TYPE_UNINIT: /* from tokenised type */`
		1141	`case DIAG_TYPE_INITED:`
		1142	`{`
		1143	`return -1; /* +++ we should try to do better somehow */`
		1144	`}`
		1145	`default:`
		1146	`{`
		1147	`ASSERT(0); /* fail if in debug mode */`
		1148	`return -1;`
		1149	`}`
		1150	`}`
		1151	`}`
		1152
		1153
		1154	`/*`
		1155	`* output TypeDef, except as a INTEGER TypeId to avoid recursion`
		1156	`*/`
7	7u83	1157	`static void out_dt_TypeDef_no_recurse(diag_type dt)`
2	7u83	1158	`{`
		1159	`switch (dt->key)`
		1160	`{`
		1161	`case DIAG_TYPE_PTR:`
		1162	`{`
		1163	`/* TypeDef: * TypeId "Pointer of type TypeId" */`
		1164	`fprintf(as_file, "*");`
		1165	`out_dt_TypeId(dt->data.ptr.object);`
		1166	`break;`
		1167	`}`
		1168	`case DIAG_TYPE_ARRAY:`
		1169	`{`
		1170	`int stride = EXPINT(dt->data.array.stride);`
		1171	`int lwb = EXPINT(dt->data.array.lower_b);`
		1172	`int upb = EXPINT(dt->data.array.upper_b);`
		1173	`diag_type index_type = dt->data.array.index_type;`
		1174	`diag_type element_type = dt->data.array.element_type;`
7	7u83	1175
2	7u83	1176	`ASSERT(stride >= size_dt(element_type));`
7	7u83	1177
2	7u83	1178	`#if 0`
		1179	`/* +++ maybe this works better thab Packed array with dbx/gdb, try it */`
		1180	`if (stride == 1 && lwb == 0 && upb < 32)`
		1181	`{`
		1182	`/* represent as bitfield */`
		1183	`fprintf(as_file, "r%d;0;4294967295;", TYPEID_SLONG);`
		1184	`break;`
		1185	`}`
		1186	`#endif`
7	7u83	1187
2	7u83	1188	`/*`
		1189	`* TypeDef: Array`
		1190	`* Array: a TypeDef ; TypeId "Array"`
		1191	`* \| P TypeDef ; TypeId "Packed array"`
		1192	`* \| A TypeId "Open array of TypeId"`
		1193	`* where TypeDef: Subrange`
		1194	`* Subrange: r TypeId ; Bound ; Bound`
		1195	`* Bound: INTEGER "Constant bound"`
		1196	`*/`
		1197	`if (stride == 1)`
		1198	`{`
7	7u83	1199	`fprintf(as_file, "Pr"); /* Packed Array - should never happen for C */`
2	7u83	1200	`}`
		1201	`else`
		1202	`{`
		1203	`fprintf(as_file, "ar");`
		1204	`}`
		1205	`out_dt_TypeId(index_type);`
		1206	`fprintf(as_file, ";%d;%d;", lwb, upb);`
		1207	`out_dt_TypeId(element_type);`
		1208	`break;`
		1209	`}`
		1210	`case DIAG_TYPE_STRUCT:`
		1211	`case DIAG_TYPE_UNION:`
		1212	`{`
		1213	`int i;`
		1214	`char su;`
		1215	`diag_field_list fields;`
		1216	`shape s;`
7	7u83	1217
2	7u83	1218	`/* TypeDef: Record */`
		1219
		1220	`if (dt->key == DIAG_TYPE_STRUCT)`
		1221	`{`
		1222	`fields = dt->data.t_struct.fields;`
		1223	`s = dt->data.t_struct.tdf_shape;`
		1224
		1225	`/* Record: s NumBytes FieldList ; "Structure or record definition" */`
		1226	`su = 's';`
		1227	`}`
		1228	`else`
		1229	`{ /* dt->key == DIAG_TYPE_UNION */`
7	7u83	1230	`fields = (diag_field_list)dt->data.t_union.fields;`
2	7u83	1231	`s = dt->data.t_union.tdf_shape;`
		1232	`/* Record: u NumBytes FieldList ; "Union" */`
		1233	`su = 'u';`
		1234	`}`
		1235
		1236	`/* NumBytes: INTEGER */`
		1237	`fprintf(as_file, "%c%d", su, shape_size(s) / 8);`
		1238
		1239	`/* FieldList: Field \| FieldList Field */`
		1240	`for (i = fields->lastused - 1; i >= 0; i--)`
		1241	`{`
		1242	`int size;`
		1243	`diag_field sf = (fields->array)[i];`
		1244	`int offset = EXPINT(sf->where);`
		1245
		1246	`/* Field: NAME : TypeId , BitOffset , NumBits ; */`
		1247	`ASSERT(CSTRING(sf->field_name)[0]!=0);`
		1248	`fprintf(as_file, "%s:", CSTRING(sf->field_name));`
		1249	`out_dt_TypeId(sf->field_type);`
		1250
		1251	`size = size_dt(sf->field_type);`
		1252
		1253	`#ifdef DO_ASSERT`
		1254	`/* check object size <= field size */`
		1255	`if (size > 0)`
		1256	`{`
		1257	`int next_start;`
		1258	`int sizetonext;`
		1259
		1260	`if (dt->key == DIAG_TYPE_UNION \|\| i == 0)`
		1261	`{`
		1262	`next_start = shape_size(s);`
		1263	`}`
		1264	`else`
		1265	`{`
7	7u83	1266	`next_start = EXPINT(((fields->array)[i - 1]) ->where);`
2	7u83	1267	`}`
		1268	`sizetonext = next_start - offset;`
		1269
		1270	`ASSERT(size <= sizetonext);`
		1271	`}`
		1272	`#endif`
		1273
		1274	`if (size < 0) /* eg from tokenised type */`
		1275	`{`
		1276	`/* guess: space to next field, or end */`
		1277	`int next_start;`
		1278
		1279	`if (dt->key == DIAG_TYPE_UNION \|\| i == 0)`
		1280	`next_start = shape_size(s);`
		1281	`else`
7	7u83	1282	`next_start = EXPINT(((fields->array)[i - 1]) ->where);`
2	7u83	1283	`size = next_start - offset;`
		1284	`}`
		1285
		1286	`if (size < 0)`
		1287	`{`
		1288	`size = 32; /* desperate guess */`
		1289	`}`
7	7u83	1290
2	7u83	1291	`/*`
		1292	`* BitOffset: INTEGER "Offset in bits from beginning of structure"`
		1293	`* NumBits: INTEGER "Number of bits in item"`
		1294	`*/`
		1295	`fprintf(as_file, ",%d,%d;", offset, size); /* bitoff,bitsz */`
		1296	`}`
		1297	`fprintf(as_file, ";");`
		1298	`break;`
		1299	`}`
		1300
		1301	`case DIAG_TYPE_ENUM:`
		1302	`{`
		1303	`#if 1`
		1304	`/* simply output the base integer type */`
		1305	`out_dt_TypeDef(dt->data.t_enum.base_type);`
		1306	`#else`
		1307
		1308	`/*`
		1309	`* +++ currently tdfc (Jan 93) does not generate DIAG_TYPE_ENUM`
		1310	`* +++ enable and test this when DIAG_TYPE_ENUM is generated`
		1311	`*/`
		1312
		1313	`/*`
		1314	`* TypeDef: e EnumList ; "Enumerated type (default size, 32 bits)"`
		1315	`* EnumList: Enum \| EnumList Enum`
		1316	`* Enum: NAME : OrdValue , "Enumerated scalar description"`
		1317	`* OrdValue: INTEGER "Associated numeric value"`
		1318	`*/`
		1319	`enum_values_list enumvals = dt->data.t_enum.values;`
		1320	`enum_values enumarr = *(enumvals->array);`
		1321	`int nvals = enumvals->len;`
		1322	`int i;`
		1323
		1324	`ASSERT(size_dt(dt->data.t_enum.base_type) == 32);`
		1325
		1326	`fprintf(as_file, "e");`
		1327	`for (i = 0; i < nvals; i++)`
		1328	`{`
		1329	`fprintf(as_file, "%s:%d,", CSTRING(enumarr[i].nme), EXPINT(enumarr[i].val));`
		1330	`}`
		1331	`fprintf(as_file, ";");`
		1332	`#endif`
		1333	`break;`
		1334	`}`
		1335
		1336	`case DIAG_TYPE_VARIETY:`
		1337	`{`
		1338	`int i = TypeNo_of_shape(dt->data.var);`
		1339
		1340	`/*`
		1341	`* TypeDef: INTEGER "Type number of a previously defined type"`
		1342	`*/`
		1343	`fprintf(as_file, "%d", i);`
		1344	`SET_OUTED_NO(dt, i);`
		1345	`break;`
		1346	`}`
		1347
		1348	`case DIAG_TYPE_PROC:`
		1349	`{`
		1350	`diag_type result_type = dt->data.proc.result_type;`
		1351	`int non;`
		1352
		1353	`/*`
		1354	`* In general DIAG_TYPE_PROC in C terms means a pointer to a proc:`
		1355	`* TypeDef: * TypeId "Pointer of type TypeId"`
		1356	`*/`
		1357
		1358	`fprintf(as_file, "*");`
		1359
		1360	`/* TypeId: INTEGER = TypeDef */`
		1361	`/* we need a new typeno to match the TypeId syntax */`
		1362	`non = next_typen();`
		1363	`fprintf(as_file, "%d=", non);`
		1364
		1365	`/*`
		1366	`* TypeDef: ProcedureType "For function types rather than declarations"`
		1367	`* ProcedureType: f TypeId ; "Function returning type TypeId"`
		1368	`* +++ generate parameter info as well, though IBM stabsyntax says this is for Modula-2:`
		1369	`* +++ ProcedureType: f TypeId , NumParams ; TParamList ;`
		1370	`* "Function of N parameters returning type TypeId"`
		1371	`*/`
		1372	`fprintf(as_file, "f");`
		1373	`out_dt_TypeId(result_type);`
		1374	`break;`
		1375	`}`
		1376
		1377	`case DIAG_TYPE_LOC:`
		1378	`{`
		1379	`/* simply output type of object */`
		1380
		1381	`/* +++ use data.loc.qualifier.is_const and data.loc.qualifier.is_volatile if useful */`
		1382	`out_dt_TypeDef(dt->data.loc.object);`
		1383	`break;`
		1384	`}`
		1385
		1386	`case DIAG_TYPE_FLOAT:`
		1387	`{`
		1388	`/* simply output standard type number */`
		1389	`int i = TypeNo_of_shape(f_floating(dt->data.f_var)); /* shape for f_var */`
		1390
		1391	`/*`
		1392	`* TypeDef: INTEGER "Type number of a previously defined type"`
		1393	`*/`
		1394	`fprintf(as_file, "%d", i);`
		1395	`SET_OUTED_NO(dt, i);`
		1396	`break;`
		1397	`}`
		1398
		1399	`case DIAG_TYPE_NULL:`
		1400	`{`
		1401
		1402	`/*`
		1403	`* TypeDef: INTEGER "Type number of a previously defined type"`
		1404	`*/`
		1405	`fprintf(as_file, "%d", TYPEID_VOID); /* use "void" for the null`
		1406	`* type */`
		1407	`SET_OUTED_NO(dt, TYPEID_VOID);`
		1408	`break;`
		1409	`}`
		1410
		1411	`case DIAG_TYPE_BITFIELD:`
		1412	`{`
		1413	`#if 1`
		1414
		1415	`/*`
		1416	`* Rely on struct field processing to provide the bitfield size,`
		1417	`* which works very well for C. Simply output the base type.`
		1418	`*/`
		1419	`out_dt_TypeDef(dt->data.bitfield.result_type);`
		1420	`#else`
		1421	`/* +++ this is wrong, TypeId where TypeDef expected, fix and try again */`
		1422	`/* this breaks gdb 4.9, and dbx ignores TypeAttr */`
		1423
		1424	`/*`
		1425	`* TypeId: INTEGER = TypeAttrs TypeDef`
		1426	`* "New type with special type attributes"`
		1427	`* TypeAttrs: @ TypeAttrList ; "Any additional information; ignored by dbx"`
		1428	`* TypeAttrList: TypeAttrList ; @ TypeAttr \| TypeAttr`
		1429	`* TypeAttr: s INTEGER "Size in bits"`
		1430	`*/`
		1431	`fprintf(as_file, "@s%d;", NATINT(dt->data.bitfield.no_of_bits));`
		1432	`out_dt_TypeDef(dt->data.bitfield.result_type);`
		1433	`#endif`
		1434	`break;`
		1435	`}`
		1436
		1437	`case DIAG_TYPE_UNINIT: /* from tokenised type */`
		1438	`case DIAG_TYPE_INITED:`
		1439	`{`
		1440
		1441	`/*`
		1442	`* TypeDef: INTEGER "Type number of a previously defined type"`
		1443	`*/`
		1444	`fprintf(as_file, "%d", TYPEID_TOKEN);`
		1445	`break;`
		1446	`}`
		1447	`default:`
		1448	`{`
		1449	`/* nothing expected now, but maybe there will be extensions */`
		1450	`ASSERT(0); /* fail if in debug mode */`
		1451	`/* We must output something here to satisfy the syntax */`
		1452
		1453	`/*`
		1454	`* TypeDef: INTEGER "Type number of a previously defined type"`
		1455	`*/`
		1456	`fprintf(as_file, "%d", TYPEID_VOID);`
		1457	`break;`
		1458	`}`
		1459	`}`
		1460	`}`
		1461
		1462
		1463	`/*`
		1464	`* generate TypeDef stabstring`
		1465	`*/`
7	7u83	1466	`static void out_dt_TypeDef(diag_type dt)`
2	7u83	1467	`{`
		1468	`if (IS_OUTED(dt))`
		1469	`{`
		1470
		1471	`/*`
		1472	`* TypeDef: INTEGER "Type number of a previously defined type"`
		1473	`*/`
		1474	`fprintf(as_file, "%d", OUTED_NO(dt));`
		1475	`}`
		1476	`else`
		1477	`{`
		1478	`/* any of the other expansions of TypeDef */`
		1479	`out_dt_TypeDef_no_recurse(dt);`
		1480	`}`
		1481	`}`
		1482
		1483
		1484	`/*`
		1485	`* generate TypeId stabstring defining new type number`
		1486	`* TypeId: INTEGER = TypeDef "New type number described by TypeDef"`
		1487	`*/`
7	7u83	1488	`static void out_dt_NewTypeId(diag_type dt, int non)`
2	7u83	1489	`{`
		1490	`fprintf(as_file, "%d=", non);`
		1491
		1492	`if (IS_OUTED(dt))`
		1493	`{`
		1494	`out_dt_TypeDef(dt);`
		1495	`}`
		1496	`else`
		1497	`{`
		1498	`/*`
		1499	`* We have to take care to handle recursive type correctly. Record the new`
		1500	`* type number so indirect refs (by PTR of PROC) do not lead to infinite`
		1501	`* recursion. But we need to avoid simply identifying whole type to`
		1502	`* itself; out_dt_TypeDef_no_recurse() avoids this problem.`
		1503	`*/`
		1504	`SET_OUTED_NO(dt, non); /* record typeno for future use */`
		1505	`out_dt_TypeDef_no_recurse(dt);`
		1506	`}`
		1507	`}`
		1508
		1509
		1510	`/*`
		1511	`* generate TypeId stabstring`
		1512	`*/`
7	7u83	1513	`static void out_dt_TypeId(diag_type dt)`
2	7u83	1514	`{`
		1515	`if (IS_OUTED(dt))`
		1516	`{`
		1517
		1518	`/*`
		1519	`* TypeId: INTEGER "Type number of previously defined type"`
		1520	`*/`
		1521	`fprintf(as_file, "%d", OUTED_NO(dt));`
		1522	`return;`
		1523	`}`
		1524
		1525	`switch (dt->key)`
		1526	`{`
		1527	`case DIAG_TYPE_VARIETY:`
		1528	`case DIAG_TYPE_FLOAT:`
		1529	`case DIAG_TYPE_NULL:`
		1530	`case DIAG_TYPE_UNINIT: /* from tokenised type */`
		1531	`case DIAG_TYPE_INITED: /* from tokenised type */`
		1532	`{`
		1533
		1534	`/*`
		1535	`* Simple types have preallocated TypeId INTEGER, out_dt_TypeDef()`
		1536	`* or for these cases out_dt_TypeDef_no_recurse() will output it.`
		1537	`*/`
		1538
		1539	`/*`
		1540	`* TypeId: INTEGER "Type number of previously defined type"`
		1541	`*/`
		1542	`out_dt_TypeDef_no_recurse(dt); /* for these keys, we assume TypeDef`
		1543	`* expands to INTEGER */`
		1544	`break;`
		1545	`}`
		1546
		1547	`case DIAG_TYPE_LOC:`
		1548	`{`
		1549
		1550	`/* look down to object, so maybe avoiding allocating another TypeId INTEGER */`
		1551	`out_dt_TypeId(dt->data.loc.object);`
		1552	`break;`
		1553	`}`
		1554
		1555	`default:`
		1556	`{`
		1557	`/* no existing TypeNo that we know of, stabsyntax requires a new one */`
		1558
		1559	`/*`
		1560	`* TypeId: INTEGER = TypeDef "New type number described by TypeDef"`
		1561	`*/`
		1562	`out_dt_NewTypeId(dt, next_typen());`
		1563	`break;`
		1564	`}`
		1565	`}`
		1566	`}`
		1567
		1568	`/*`
		1569	`* Output .bs (begin static block) which must precede stab_global`
		1570	`* for tags which have data initialisers. If such stabs are output`
		1571	`* outside .bs/.be gdb and dbx cannot locate tag.`
		1572	`*/`
7	7u83	1573	`void stab_bs(char *sectname)`
2	7u83	1574	`{`
		1575	`fprintf(as_file, "\t.bs\t%s\n", sectname);`
		1576	`}`
		1577
		1578	`/*`
		1579	`* Output .es (end static block).`
		1580	`*/`
7	7u83	1581	`void stab_es(char *sectname)`
2	7u83	1582	`{`
		1583	`fprintf(as_file, "\t.es\n");`
		1584	`}`
		1585
		1586
		1587	`/*`
		1588	`* Produce diagnostic for ident_tag variable "id" defined by "global";`
		1589	`* called from translat(). "ext" tells whether "id" is "static".`
		1590	`*/`
7	7u83	1591	`void stab_global(exp global, char *id, bool ext)`
2	7u83	1592	`{`
		1593	`diag_descriptor *dd = find_dd(global);`
		1594
7	7u83	1595	`if (dd == (diag_descriptor *)0)`
2	7u83	1596	`return;`
		1597
		1598	`/* +++ inefficient */`
		1599	`stab_file(find_file(CSTRING(dd->data.id.whence.file->file)));`
		1600
		1601	`/*`
		1602	`* Stabstring: NAME : Class "Name of object followed by object classification"`
		1603	`* Class: Variable "Variable in program"`
		1604	`* Variable: G TypeId "Global (external) variable of type TypeId"`
		1605	`* \| S TypeId "Module variable of type TypeId (C static global)"`
		1606	`*/`
		1607	`ASSERT(CSTRING(dd->data.id.nme)[0]!=0);`
		1608	`fprintf(as_file, "\t.stabx\t\"%s:%c",`
		1609	`CSTRING(dd->data.id.nme),`
7	7u83	1610	`(ext ? 'G' : 'S'));`
2	7u83	1611	`out_dt_TypeId(dd->data.id.new_type);`
		1612	`fprintf(as_file, "\",%s,%d,%d\n",`
		1613	`id,`
7	7u83	1614	`(ext ? C_GSYM : C_STSYM),`
2	7u83	1615	`0);`
		1616	`}`
		1617
		1618
		1619	`/*`
		1620	`* switch to correct file prior to proc prelude`
		1621	`*/`
7	7u83	1622	`void stab_proc1(exp proc, char *id, bool ext)`
2	7u83	1623	`{`
		1624	`diag_descriptor *dd = find_dd(proc);`
		1625
		1626	`block_depth = 0;`
		1627
7	7u83	1628	`if (dd == (diag_descriptor *)0)`
2	7u83	1629	`{`
		1630	`COMMENT("stab_proc1: no descriptor"); /* should never happen */`
		1631	`current_procstart_lineno = NOT_IN_PROC;`
		1632	`current_lineno = NOT_IN_PROC;`
		1633	`return;`
		1634	`}`
		1635
		1636	`current_procstart_lineno = NATINT(dd->data.id.whence.line_no);`
		1637	`current_lineno = current_procstart_lineno;`
		1638
		1639	`/* +++ inefficient */`
		1640	`stab_file(find_file(CSTRING(dd->data.id.whence.file->file)));`
		1641	`}`
		1642
		1643
		1644	`/*`
		1645	`* stap proc, after label defined`
		1646	`*/`
7	7u83	1647	`void stab_proc2(exp proc, char *id, bool ext)`
2	7u83	1648	`{`
		1649	`diag_descriptor *dd = find_dd(proc);`
		1650	`char *nm;`
		1651	`diag_type dt;`
		1652
7	7u83	1653	`if (dd == (diag_descriptor *)0)`
2	7u83	1654	`{`
		1655	`COMMENT("stab_proc2: no descriptor"); /* should never happen */`
		1656	`return;`
		1657	`}`
		1658
		1659	`dt = dd->data.id.new_type;`
		1660	`nm = CSTRING(dd->data.id.nme); /* source proc name, id is just the`
		1661	`* assembler label */`
		1662	`ASSERT(nm[0]!=0);`
		1663
		1664	`/* first a .stabx for the proc descriptor */`
		1665
		1666	`/*`
		1667	`* Stabstring: NAME : Class`
		1668	`* Class: Procedure "Subprogram declaration"`
		1669	`* Procedure: Proc "Procedure at current scoping level"`
		1670	`* Proc: F TypeID "External function of type TypeID"`
		1671	`* \| f TypeID "Private function of type TypeID"`
		1672	`* \| P "External procedure"`
		1673	`* \| Q "Private procedure"`
		1674	`*/`
		1675
		1676	`/* +++ when gdb understands, maybe use "P" or "Q" for proc returning void */`
		1677
7	7u83	1678	`fprintf(as_file, "\t.stabx\t\"%s:%c", nm,(ext ? 'F' : 'f'));`
2	7u83	1679
		1680	`/*`
		1681	`* The meaning of TypeId is not clear from the stabstring syntax document,`
		1682	`* dbx and gdb work best if it is the result type.`
		1683	`*/`
		1684	`switch (dt->key)`
		1685	`{`
		1686	`case DIAG_TYPE_PROC:`
		1687	`{`
		1688	`out_dt_TypeId(dt->data.proc.result_type);`
		1689	`break;`
		1690	`}`
		1691	`default:`
		1692	`{`
		1693	`/* should never happen, but if it does ... */`
		1694	`fail("stab_proc2: Should never happen");`
		1695	`out_dt_TypeId(dt);`
		1696	`break;`
		1697	`}`
		1698	`}`
		1699
		1700	`fprintf(as_file, "\",.%s,%d,%d\n", id, C_FUN, 0);`
		1701
		1702	`#if 1`
		1703
		1704	`/*`
		1705	`* Then a .function for the proc body. The 5th arg (function length) is not`
		1706	`* documented in assembler manual, but gcc generates it and it enable gdb to`
		1707	`* trace down stack properly.`
		1708	`*/`
		1709	`fprintf(as_file, "\t.function\t.%s,.%s,16,044,E.%s-.%s\n", id, id, id, id);`
		1710	`#else`
		1711	`fprintf(as_file, "\t.function\t.%s,.%s,16,044\n", id, id);`
		1712	`#endif`
		1713
		1714	`/* the proc start line number */`
		1715	`fprintf(as_file, "\t%s\t%d\n", bf_stab ,current_procstart_lineno);`
		1716
		1717	`/* now mork line 1 */`
		1718	`/stab_relativeline(line_stab);/`
		1719	`}`
		1720
		1721
		1722	`/*`
		1723	`* diagnostics for proc end`
		1724	`*/`
7	7u83	1725	`void stab_endproc(exp proc, char *id, bool ext)`
2	7u83	1726	`{`
		1727	`/* end all open blocks */`
		1728	`while (block_depth > 0)`
		1729	`stab_end_block();`
		1730
		1731	`stab_relativeline(ef_stab);`
		1732	`fprintf(as_file, "E.%s:\n", id); /* proc end label */`
		1733
		1734	`current_procstart_lineno = NOT_IN_PROC;`
		1735
		1736	`/* output AIX traceback table, see header file sys/debug.h */`
		1737	`{`
		1738	`static struct tbtable_short zero_tbtable_short;`
		1739	`struct tbtable_short tbtable_sht;`
		1740	`diag_descriptor *dd = find_dd(proc);`
		1741	`char *nm;`
		1742	`int i;`
		1743
7	7u83	1744	`if (dd == (diag_descriptor *)0)`
2	7u83	1745	`{`
		1746	`COMMENT("stab_endproc: no descriptor"); /* should never happen */`
		1747	`return;`
7	7u83	1748
2	7u83	1749	`}`
		1750
		1751	`nm = CSTRING(dd->data.id.nme); /* source proc name, id is just the`
		1752	`* assembler label */`
		1753	`ASSERT(nm[0]!=0);`
		1754	`tbtable_sht = zero_tbtable_short;`
		1755
		1756	`/* +++ set up tbtable_sht more fully */`
		1757
		1758	`tbtable_sht.lang = TB_C; /* lang C +++ */`
		1759	`tbtable_sht.has_tboff = 1; /* optional tb_offset always given */`
		1760	`tbtable_sht.name_present = 1; /* optional proc name always given */`
		1761	`tbtable_sht.saves_lr =`
		1762	`!p_leaf; /* non-leaf procs store link reg */`
		1763	`tbtable_sht.stores_bc =`
		1764	`!p_leaf; /* non-leaf procs store stack backchain */`
		1765
		1766	`/* number of float regs saved */`
		1767	`if (p_sfreg_first_save != FR_NO_REG)`
		1768	`tbtable_sht.fpr_saved = FR_31 + 1 - p_sfreg_first_save;`
7	7u83	1769
2	7u83	1770	`/* number of fixed regs saved */`
		1771	`if (p_sreg_first_save != R_NO_REG)`
		1772	`tbtable_sht.gpr_saved = R_31 + 1 - p_sreg_first_save;`
7	7u83	1773
2	7u83	1774	`/* number of fixed and float params passed in regs */`
		1775	`tbtable_sht.fixedparms = p_fixed_params;`
		1776	`tbtable_sht.floatparms = p_float_params;`
		1777
		1778	`tbtable_sht.parmsonstk = 1; /* -g always stores parameters on stack */`
		1779
		1780	`/* 0 signifies start of traceback table */`
		1781	`fprintf(as_file, "#\ttraceback table\n");`
		1782	`fprintf(as_file, "\t.long\t0\n");`
		1783
		1784	`/* tbtable_sht as bytes */`
		1785	`fprintf(as_file, "\t.byte\t");`
7	7u83	1786	`for (i = 0; i < sizeof(tbtable_sht) - 1; i++)`
		1787	`fprintf(as_file, "%#x,",((unsigned char *)(&tbtable_sht))[i]);`
		1788	`fprintf(as_file, "%#x\n",((unsigned char *)(&tbtable_sht))[i]);`
2	7u83	1789
		1790	`/* optional portions of traceback table */`
		1791
		1792	`/* parminfo */`
		1793	`if (tbtable_sht.fixedparms \|\| tbtable_sht.floatparms)`
		1794	`fprintf(as_file, "\t.long\t0\n"); /* +++ */`
		1795
		1796	`/* tb_offset */`
		1797	`fprintf(as_file, "\t.long\tE.%s-.%s\n", id, id);`
		1798
		1799	`/* we never use hand_mask, ctl_info and ctl_info_disp optional components */`
		1800	`ASSERT(!tbtable_sht.int_hndl);`
		1801	`ASSERT(!tbtable_sht.has_ctl);`
		1802
		1803	`/* proc name */`
7	7u83	1804	`fprintf(as_file, "\t.short\t%d\n",(int)strlen(nm));`
2	7u83	1805	`fprintf(as_file, "\t.byte\t\"%s\"\n", nm);`
		1806
		1807	`/* alloca_reg */`
		1808	`if (tbtable_sht.uses_alloca)`
		1809	`fprintf(as_file, "\t.byte\t0\n"); /* +++ */`
		1810
		1811	`/* keep program area [PR] word aligned */`
		1812	`fprintf(as_file, "\t.align\t2\n");`
		1813	`}`
		1814	`}`
		1815
		1816
		1817	`/*`
		1818	`* Output appropriate info to symbol table to indicate the declaration of`
		1819	`* a local identifier, nm, defined by id, displaced by disp; findex is the`
		1820	`* index of the file containing the declaration. The code below gives does`
		1821	`* not allow for identifiers allocated in registers; in fact, with`
		1822	`* current translator, none are used by stab_local. I don't even know`
		1823	`* whether dbx can actually use them.`
		1824	`*/`
7	7u83	1825	`void stab_local(char *nm, diag_type dt, exp id, int disp, int findex)`
2	7u83	1826	`{`
7	7u83	1827	`FULLCOMMENT3("stab_local: %s disp=%d boff(id).offset=%d",(long)nm, disp, boff(id).offset);`
2	7u83	1828	`disp += boff(id).offset;`
		1829	`again:`
		1830	`if (name(id) == ident_tag)`
		1831	`{`
7	7u83	1832	`FULLCOMMENT2("stab_local ident_tag: %s disp=%d",(long)nm, disp);`
2	7u83	1833	`if ((props(id) & defer_bit) == 0)`
		1834	`{`
		1835	`if (isparam(id))`
		1836	`{`
		1837	`fprintf(as_file, "\t.stabx\t\"%s:p", nm);`
		1838	`out_dt_TypeId(dt);`
		1839	`fprintf(as_file, "\",%d,%d,%d\n", disp, C_PSYM, 0);`
		1840	`return;`
		1841	`}`
		1842	`else`
		1843	`{`
		1844	`fprintf(as_file, "\t.stabx\t\"%s:", nm);`
		1845	`out_dt_TypeId(dt);`
		1846	`fprintf(as_file, "\",%d,%d,%d\n", disp, C_LSYM, 0);`
		1847	`return;`
		1848	`}`
		1849	`}`
		1850	`else`
		1851	`{`
		1852	`exp sn = son(id);`
		1853	`int d = disp;`
		1854
		1855	`while (sn != nilexp)`
		1856	`{`
		1857	`switch (name(sn))`
		1858	`{`
		1859	`case name_tag:`
		1860	`{`
		1861	`disp = d + no(sn);`
		1862	`id = son(sn);`
		1863	`if (isvar(id))`
		1864	`dt = dt->data.ptr.object;`
		1865	`goto again;`
		1866	`}`
		1867	`case reff_tag:`
		1868	`{`
		1869	`d += no(sn);`
		1870	`sn = son(sn);`
		1871	`break;`
		1872	`}`
		1873	`case cont_tag:`
		1874	`{`
		1875	`sn = son(sn);`
		1876	`break;`
		1877	`}`
		1878	`default:`
		1879	`return;`
		1880	`}`
		1881	`}`
		1882	`}`
		1883	`}`
		1884	`}`
		1885
		1886
		1887	`/*`
		1888	`* Output a .stabx for all internal struct/unions not already processed.`
		1889	`* This avoids extremely long stabstrings from internal struct/unions being`
		1890	`* output on the fly for the top level struct/union.`
		1891	`* It also avoids dbx going recursive printing some types.`
		1892	`*/`
7	7u83	1893	`static void stab_internal_types(diag_type dt, bool stabthislevel)`
2	7u83	1894	`{`
		1895	`if (IS_OUTED(dt))`
		1896	`return; /* already been here */`
		1897
		1898	`switch (dt->key)`
		1899	`{`
		1900	`case DIAG_TYPE_STRUCT:`
		1901	`case DIAG_TYPE_UNION:`
		1902	`{`
		1903	`int i;`
		1904	`diag_field_list fields;`
		1905	`int non;`
		1906
		1907	`if (stabthislevel && !IS_OUTED(dt))`
		1908	`{`
		1909	`non = next_typen();`
		1910	`SET_OUTED_NO(dt, non); /* record typeno for future use,`
		1911	`* use before definition allowed */`
		1912	`}`
		1913	`else`
		1914	`{`
		1915	`non = 0;`
		1916	`}`
		1917
		1918	`if (dt->key == DIAG_TYPE_STRUCT)`
		1919	`fields = dt->data.t_struct.fields;`
		1920	`else`
7	7u83	1921	`fields = (diag_field_list)dt->data.t_union.fields;`
2	7u83	1922
		1923	`for (i = fields->lastused - 1; i >= 0; i--)`
		1924	`{`
		1925	`diag_field sf = (fields->array)[i];`
		1926
		1927	`stab_internal_types(sf->field_type, 1);`
		1928	`}`
		1929
		1930	`if (non != 0)`
		1931	`{`
		1932	`/*`
		1933	`* Generate NamedType stabstring:`
		1934	`* NamedType: T TypeId "Struct, union, or enumeration tag"`
		1935	`* TypeId: INTEGER = TypeDef "New type number described by TypeDef"`
		1936	`*/`
		1937	`fprintf(as_file, "\t.stabx\t\":"); /* Unnamed object`
		1938	`* classification */`
		1939	`fprintf(as_file, "T%d=", non);`
		1940	`out_dt_TypeDef_no_recurse(dt);`
		1941
		1942	`fprintf(as_file, "\",%d,%d,%d\n", 0, C_DECL, 0);`
		1943	`}`
		1944
		1945	`break;`
		1946	`}`
		1947
		1948	`case DIAG_TYPE_PTR:`
		1949	`{`
		1950	`stab_internal_types(dt->data.ptr.object, 1);`
		1951	`break;`
		1952	`}`
		1953
		1954	`case DIAG_TYPE_ARRAY:`
		1955	`{`
		1956	`stab_internal_types(dt->data.array.index_type, 1);`
		1957	`stab_internal_types(dt->data.array.element_type, 1);`
		1958	`break;`
		1959	`}`
		1960
		1961	`case DIAG_TYPE_PROC:`
		1962	`{`
		1963	`stab_internal_types(dt->data.proc.result_type, 1);`
		1964	`break;`
		1965	`}`
		1966
		1967	`default:`
		1968	`{`
		1969	`/* simple types without internal types */`
		1970	`break;`
		1971	`}`
		1972	`}`
		1973	`}`
		1974
		1975
		1976	`/*`
		1977	`* Generate stab for a basic type, for which there is a standard IBM AIX StabNo.`
		1978	`*/`
		1979	`static void stab_basicshape`
7	7u83	1980	`(shape sha, char *typename, int tdf_typeidnum, int ibm_typeidnum)`
2	7u83	1981	`{`
		1982	`int n = next_typen();`
		1983
		1984	`ASSERT(tdf_typeidnum == n);`
		1985
		1986	`fprintf(as_file, "\t.stabx\t\"%s:t%d=%d", typename, tdf_typeidnum, ibm_typeidnum);`
		1987	`fprintf(as_file, "\",%d,%d,%d\n", 0, C_DECL, 0);`
		1988	`}`
		1989
		1990
		1991	`/*`
		1992	`* Output diagnostic stabs for built in types, and for structs and unions.`
		1993	`* Information about procedures is ignored for present;`
		1994	`* it is output by stab_procN().`
		1995	`*`
		1996	`* Must be called before any ".stabx" directive attempted.`
		1997	`*/`
7	7u83	1998	`static void stab_types(void)`
2	7u83	1999	`{`
		2000	`/* Numbering and outputing of basicshapes,structs,unions and typedefs */`
7	7u83	2001	`(void)number_and_stab_basicshapes();`
		2002	`(void)number_structs_and_unions();`
		2003	`(void)number_typedefs();`
		2004	`(void)stab_structs_and_unions();`
		2005	`(void)stab_typedefs();`
2	7u83	2006	`}`
		2007
7	7u83	2008

Subversion Repositories tendra.SVN

(root)/trunk/src/installers/power/common/diagout.c – Rev 7