pkgsrc-wip/tendra/patches/patch-ag
Thomas Klausner 12732c7ca0 Initial import of (incomplete) tendra package, provided by
Alistair Crooks (agc@netbsd) -- help welcome.

tendra is a multi-targetted BSD-licensed C and C++ compiler.

Alistair says:
At the moment, it can't handle the RENAME()s in NetBSD's header files,
and I build things in a ${WRKSRC}/build directory, and these files need
to be moved to ${PREFIX} in the install stage. The files should also be
checked to see if there are any embedded hardcoded paths, which would
make this approach infeasible.
2003-04-29 09:22:27 +00:00

1011 lines
24 KiB
Text

$NetBSD: patch-ag,v 1.1.1.1 2003/04/29 09:22:28 thomasklausner Exp $
--- /dev/null 2003-04-28 11:19:52.000000000 +0100
+++ src/installers/80x86/netbsd/diag_out.c 2003-04-28 11:13:11.000000000 +0100
@@ -0,0 +1,1006 @@
+/*
+ Crown Copyright (c) 1997
+
+ This TenDRA(r) Computer Program is subject to Copyright
+ owned by the United Kingdom Secretary of State for Defence
+ acting through the Defence Evaluation and Research Agency
+ (DERA). It is made available to Recipients with a
+ royalty-free licence for its use, reproduction, transfer
+ to other parties and amendment for any purpose not excluding
+ product development provided that any such use et cetera
+ shall be deemed to be acceptance of the following conditions:-
+
+ (1) Its Recipients shall ensure that this Notice is
+ reproduced upon any copies or amended versions of it;
+
+ (2) Any amended version of it shall be clearly marked to
+ show both the nature of and the organisation responsible
+ for the relevant amendment or amendments;
+
+ (3) Its onward transfer from a recipient to another
+ party shall be deemed to be that party's acceptance of
+ these conditions;
+
+ (4) DERA gives no warranty or assurance as to its
+ quality or suitability for any purpose and DERA accepts
+ no liability whatsoever in relation to any use to which
+ it may be put.
+*/
+
+
+/* netbsd/diag_out.c */
+
+#include "config.h"
+#include "common_types.h"
+#include "basicread.h"
+#include "out.h"
+#include "machine.h"
+#include "shapemacs.h"
+#include "expmacs.h"
+#include "tags.h"
+#include "szs_als.h"
+#include "diagglob.h"
+#include "xalloc.h"
+#include "exp.h"
+#include "mark_scope.h"
+#include "externs.h"
+#ifdef NEWDIAGS
+#include "codermacs.h"
+#include "instr.h"
+#endif
+
+
+
+/*
+ FORWARD DECLARATIONS
+*/
+
+static void stab_scope_open PROTO_S ( ( long ) ) ;
+static void stab_scope_close PROTO_S ( ( long ) ) ;
+static void stab_file PROTO_S ( ( long, bool ) ) ;
+static void stab_local PROTO_S ( ( diag_info *, int, exp ) ) ;
+static void stab_types PROTO_S ( ( void ) ) ;
+
+
+
+
+/*
+ DIAGNOSTICS FILE
+*/
+
+static FILE *dg_file ;
+static char *dg_file_name ;
+
+
+/*
+ BASIC TYPE NUMBERS
+*/
+
+#define STAB_SCHAR 4
+#define STAB_UCHAR 6
+#define STAB_SSHRT 2
+#define STAB_USHRT 3
+#define STAB_SLONG 1
+#define STAB_ULONG 8
+#define STAB_FLOAT 10
+#define STAB_DBL 11
+#define STAB_LDBL 12
+#define STAB_VOID 13
+#define STAB_S64 14
+#define STAB_U64 15
+#define NO_STABS 16
+
+
+/*
+ 80x86 register numbers
+*/
+
+#ifdef NEWDIAGS
+static long reg_stabno [8] = {0, 2, 1, 3, 7, 6, 5, 4};
+#endif
+
+/*
+ BASIC POINTERS
+*/
+
+static long stab_ptrs [ NO_STABS ] = {
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
+} ;
+
+
+/*
+ CURRENT TYPE NUMBER
+*/
+
+static long typeno ;
+
+
+/*
+ SIZE OF LAST STAB TYPE OUTPUT
+*/
+
+static long last_type_sz = 0 ;
+
+
+/*
+ CURRENT LINE NUMBER AND FILE NUMBER
+*/
+
+long currentlno = -1 ;
+long currentfile = -1 ;
+
+
+/*
+ ARRAY OF TYPE SIZES
+*/
+
+static long *type_sizes ;
+static int total_type_sizes = 0 ;
+
+
+/*
+ SETTING AND GETTING TYPE SIZES
+*/
+
+#define set_stab_size( i ) type_sizes [ ( i ) ] = last_type_sz
+#define get_stab_size( i ) ( type_sizes [ ( i ) ] )
+
+
+/*
+ GET THE NEXT TYPE NUMBER
+*/
+
+static long next_typen
+ PROTO_Z ()
+{
+ if ( typeno >= total_type_sizes ) {
+ int i, n = total_type_sizes, m = n + 100 ;
+ type_sizes = ( long * ) xrealloc ( (void*)(CH type_sizes),
+ m * sizeof ( long ) ) ;
+ for ( i = n ; i < m ; i++ ) type_sizes [i] = 0 ;
+ total_type_sizes = m ;
+ }
+ return ( typeno++ ) ;
+}
+
+
+/*
+ ARRAY OF FILE DESCRIPTORS
+*/
+
+static filename *fds = NULL ;
+static int szfds = 0 ;
+static int nofds = 0 ;
+
+
+/*
+ ADD A NEW FILE TO THE ARRAY OF FILE DESCRIPTORS
+*/
+
+void stab_collect_files
+ PROTO_N ( (f) )
+ PROTO_T ( filename f )
+{
+ if ( fds == NULL ) {
+ szfds += 10 ;
+ fds = ( filename * ) xmalloc ( szfds * sizeof ( filename ) ) ;
+ } else if ( nofds >= szfds ) {
+ szfds += 10 ;
+ fds = ( filename * ) xrealloc ( (void*)(CH fds),
+ szfds * sizeof ( filename ) ) ;
+ }
+ fds [ nofds++ ] = f ;
+ return ;
+}
+
+
+/*
+ FIND THE FILE DESCRIPTOR CORRESPONDING TO A FILE NAME
+*/
+
+static long find_file
+ PROTO_N ( (f) )
+ PROTO_T ( char * f )
+{
+ long i ;
+ for ( i = 0 ; i < nofds ; i++ ) {
+ if ( strcmp ( f, fds [i]->file.ints.chars ) == 0 ) return ( i ) ;
+ }
+ return ( 0 ) ;
+}
+
+
+static int last_proc_cname;
+static char * last_proc_pname;
+static int in_proc = 0;
+
+static void out_procname
+ PROTO_Z ()
+{
+ if (last_proc_cname == -1) {
+ outs (last_proc_pname);
+ }
+ else {
+ outs(local_prefix);
+ outn ((long)last_proc_cname);
+ };
+}
+
+
+/*
+ OUTPUT A FILE POSITION CONSTRUCT
+*/
+
+#define N_SLINE 0x44
+#define N_DSLINE 0x46
+#define N_BSLINE 0x48
+#define N_LBRAC 0xc0
+#define N_RBRAC 0xe0
+
+static void stabd
+ PROTO_N ( (findex, lno, seg) )
+ PROTO_T ( long findex X long lno X int seg )
+{
+ long i ;
+
+ if ( findex == currentfile && lno == currentlno ) return ;
+ stab_file ( findex, 1 ) ;
+
+ if (seg != 0) /* 0 suppresses always */
+ {
+ if (seg < 0)
+ seg = - seg;
+ if (seg > 0) /* -ve line nos are put out in the stabs */
+ {
+ i = next_lab () ;
+ fprintf ( dg_file, "%sL.%ld:\n", local_prefix, i ) ;
+ fprintf ( dg_file, "\t.stabn\t0x%x,0,%ld,%sL.%ld",seg, lno, local_prefix, i ) ;
+ outnl ();
+ }
+ }
+ currentlno = lno ;
+ return ;
+}
+
+
+#ifdef NEWDIAGS
+/*
+ OUTPUT DIAGNOSTICS SURROUNDING CODE
+*/
+
+void code_diag_info
+ PROTO_N ( (d, proc_no, mcode, args) )
+ PROTO_T ( diag_info * d X int proc_no X void (*mcode) PROTO_S ((void *)) X void * args )
+{
+ if (d == nildiag) {
+ (*mcode)(args);
+ return;
+ }
+ switch (d->key) {
+ case DIAG_INFO_SCOPE: {
+ stab_scope_open ( currentfile ) ;
+ stabd ( currentfile, ( long ) ( currentlno + 1 ), N_SLINE ) ;
+ code_diag_info (d->more, proc_no, mcode, args);
+ stab_scope_close ( currentfile ) ;
+ return;
+ }
+ case DIAG_INFO_SOURCE: {
+ sourcemark *s = &d->data.source.beg ;
+ long f = find_file ( s->file->file.ints.chars ) ;
+ stabd ( f, ( long ) s->line_no.nat_val.small_nat ,N_SLINE) ;
+ code_diag_info (d->more, proc_no, mcode, args);
+ s = &d->data.source.end ;
+ f = find_file ( s->file->file.ints.chars ) ;
+ stabd ( f, ( long ) s->line_no.nat_val.small_nat ,N_SLINE) ;
+ return;
+ }
+ case DIAG_INFO_ID: {
+ exp acc = d -> data.id_scope.access;
+ if (name(acc) != hold_tag)
+ failer("not hold_tag");
+ acc = son(acc);
+ if (name(acc) == cont_tag && name(son(acc)) == name_tag && isvar(son(son(acc))))
+ acc = son(acc);
+ if ( ( name(acc) == name_tag && !isdiscarded(acc) && !isglob(son(acc)) ) ||
+ name(acc) == val_tag )
+ stab_local ( d, proc_no, acc );
+ code_diag_info (d->more, proc_no, mcode, args);
+ }
+ };
+ return;
+}
+
+
+#else
+
+/*
+ OUTPUT INITIAL DIAGNOSTICS FOR A DIAGNOSE_TAG
+*/
+
+void output_diag
+ PROTO_N ( (d, proc_no, e) )
+ PROTO_T ( diag_info * d X int proc_no X exp e )
+{
+ if ( d->key == DIAG_INFO_SOURCE ) {
+ sourcemark *s = &d->data.source.beg ;
+ long f = find_file ( s->file->file.ints.chars ) ;
+ stabd ( f, ( long ) s->line_no.nat_val.small_nat ,N_SLINE) ;
+ return ;
+ }
+
+ if (d -> key == DIAG_INFO_ID) {
+ exp acc = d -> data.id_scope.access;
+
+ if ( isglob ( son ( acc ) ) || no ( son ( acc ) ) == 1 ) return;
+ mark_scope(e);
+
+ if ( props ( e ) & 0x80 ) {
+ stab_scope_open ( currentfile ) ;
+ stabd ( currentfile, ( long ) ( currentlno + 1 ), N_SLINE ) ;
+ }
+
+ stab_local ( d, proc_no, acc );
+ return ;
+ }
+}
+
+
+/*
+ OUTPUT FINAL DIAGNOSTICS FOR A DIAGNOSE_TAG
+*/
+
+void output_end_scope
+ PROTO_N ( (d, e) )
+ PROTO_T ( diag_info * d X exp e )
+{
+ if ( d->key == DIAG_INFO_SOURCE ) {
+ sourcemark *s = &d->data.source.end ;
+ long f = find_file ( s->file->file.ints.chars ) ;
+ long lno = s->line_no.nat_val.small_nat ;
+ stabd ( f, lno, N_SLINE) ;
+ return ;
+ }
+ if ( d->key == DIAG_INFO_ID && props ( e ) & 0x80 ) {
+ stab_scope_close ( currentfile ) ;
+ return ;
+ }
+ return ;
+}
+
+
+#endif
+/*
+ INITIALISE DIAGNOSTICS
+*/
+
+void out_diagnose_prelude
+ PROTO_Z ()
+{
+ dg_file_name = tmpnam ( NULL ) ;
+ dg_file = fopen ( dg_file_name, "w" ) ;
+ if ( dg_file == NULL ) {
+ failer ( "Can't open temporary diagnostics file" ) ;
+ exit (EXIT_FAILURE) ;
+ }
+ stab_types () ;
+ return ;
+}
+
+
+/*
+ INITIALIZE DIAGNOSTICS
+*/
+
+void init_stab_aux
+ PROTO_Z ()
+{
+ int c ;
+ FILE *f ;
+ int i, j = -1 ;
+ for ( i = 0 ; i < nofds ; i++ ) {
+ char *s = fds [i]->file.ints.chars ;
+ int n = ( int ) strlen ( s ) ;
+ if ( n && s [ n - 1 ] != 'h' ) j = i ;
+ }
+ fclose ( dg_file ) ;
+ dg_file = fpout ;
+ if (j >= 0)
+ fprintf (dg_file, "\t.file\t\"%s\"\n", fds[j]->file.ints.chars) ;
+ else
+ fprintf (dg_file, "\t.file\t\"no_source_file\"\n") ;
+ stab_file ( ( long ) j, 0 ) ;
+ f = fopen ( dg_file_name, "r" ) ;
+ if ( f == NULL ) {
+ failer ( "Can't open temporary diagnostics file" ) ;
+ exit (EXIT_FAILURE) ;
+ }
+ while ( c = fgetc ( f ), c != EOF ) outc ( c ) ;
+ fclose ( f ) ;
+ remove ( dg_file_name ) ;
+ return ;
+}
+
+void out_diagnose_postlude
+ PROTO_Z ()
+{
+ long i = next_lab () ;
+ fprintf ( dg_file, ".text\n" ) ;
+ fprintf ( dg_file, "%sL.%ld:\n", local_prefix, i ) ;
+ fprintf ( dg_file, "\t.stabs\t\"\",0x64,0,0,%sL.%ld\n", local_prefix, i ) ;
+ return ;
+}
+
+
+/*
+ FIND THE STAB OF A SIMPLE SHAPE
+*/
+
+static long out_sh_type
+ PROTO_N ( (s) )
+ PROTO_T ( shape s )
+{
+ last_type_sz = shape_size ( s ) ;
+ switch ( name ( s ) ) {
+ case scharhd : return ( STAB_SCHAR ) ;
+ case ucharhd : return ( STAB_UCHAR ) ;
+ case swordhd : return ( STAB_SSHRT ) ;
+ case uwordhd : return ( STAB_USHRT ) ;
+ case slonghd : return ( STAB_SLONG ) ;
+ case ulonghd : return ( STAB_ULONG ) ;
+ case s64hd : return ( STAB_S64 ) ;
+ case u64hd : return ( STAB_U64 ) ;
+ case shrealhd : return ( STAB_FLOAT ) ;
+ case realhd : return ( STAB_DBL ) ;
+ case doublehd : return ( STAB_LDBL ) ;
+ }
+ return ( STAB_VOID ) ;
+}
+
+
+/*
+ OUTPUT DIAGNOSTICS DIRECTIVE FOR A FILE
+*/
+
+static void stab_file
+ PROTO_N ( (findex, internal) )
+ PROTO_T ( long findex X bool internal )
+{
+ static long i = 0 ;
+
+ if ( findex == currentfile || findex < 0 || findex >= szfds ) {
+ return ;
+ }
+
+ if ( !internal ) {
+ /* source file */
+ i = next_lab () ;
+ fprintf ( dg_file, "%sL.%ld:\n", local_prefix, i ) ;
+ fprintf ( dg_file, "\t.stabs\t\"%s\",0x64,0,0,%sL.%ld\n",
+ fds [ findex ]->file.ints.chars, local_prefix, i ) ;
+ } else {
+ /* included file */
+ fprintf ( dg_file, "\t.stabs\t\"%s\",0x84,0,0,%sL.%ld\n",
+ fds [ findex ]->file.ints.chars, local_prefix, i ) ;
+ }
+ currentfile = findex ;
+ return ;
+}
+
+
+/*
+ ARRAY OF DIAGNOSTIC SCOPES
+*/
+
+static long open_label = 0 ;
+static long bracket_level = 0 ;
+
+
+/*
+ START OF A DIAGNOSTICS SCOPE
+*/
+
+static void stab_scope_open
+ PROTO_N ( (findex) )
+ PROTO_T ( long findex )
+{
+ long i ;
+ stab_file ( findex, 1 ) ;
+ if ( open_label != 0 )
+ {
+ fprintf ( dg_file, "\t.stabn\t0x%x,0,%ld,%sL.%ld\n", N_LBRAC,
+ bracket_level, local_prefix, open_label ) ;
+ }
+ i = next_lab () ;
+ fprintf ( dg_file, "%sL.%ld:\n", local_prefix, i ) ;
+ bracket_level++ ;
+ open_label = i ;
+ return ;
+}
+
+
+/*
+ END OF A DIAGNOSTICS SCOPE
+*/
+
+static void stab_scope_close
+ PROTO_N ( (findex) )
+ PROTO_T ( long findex )
+{
+ long i ;
+ if ( open_label != 0 )
+ {
+ fprintf ( dg_file, "\t.stabn\t0x%x,0,%ld,%sL.%ld\n", N_LBRAC,
+ bracket_level, local_prefix, open_label ) ;
+ open_label = 0 ;
+ }
+ i = next_lab () ;
+ fprintf ( dg_file, "%sL.%ld:\n", local_prefix, i ) ;
+ fprintf ( dg_file, "\t.stabn\t0x%x,0,%ld,%sL.%ld\n", N_RBRAC,
+ bracket_level, local_prefix, i ) ;
+ bracket_level-- ;
+ return ;
+}
+
+
+/*
+ DEPTH COUNT FOR STAB TYPES
+*/
+
+static int max_depth = 64 ;
+static int depth_now = 0 ;
+
+
+/*
+ OUTPUT A DIAGNOSTICS TYPE
+*/
+
+#define OUT_DT_SHAPE( dt ) out_dt_shape ( ( depth_now = 0, dt ) )
+
+static void out_dt_shape
+ PROTO_N ( (dt) )
+ PROTO_T ( diag_type dt )
+{
+ if ( dt->been_outed ) {
+ fprintf ( dg_file, "%d",(int) dt->been_outed ) ;
+ last_type_sz = get_stab_size ( dt->been_outed ) ;
+ return ;
+ }
+
+ /* SunOS as(1) rejects stab lines >2k so reduce size arbitrarily */
+ if ( depth_now >= max_depth ) {
+ fprintf ( dg_file, "%d", STAB_SLONG ) ;
+ return ;
+ }
+ depth_now++ ;
+
+ switch ( dt->key ) {
+
+ case DIAG_TYPE_PTR : {
+ long non ;
+ diag_type pdt = dt->data.ptr.object ;
+ if ( pdt->key == DIAG_TYPE_VARIETY ) {
+ long pn = out_sh_type ( f_integer ( pdt->data.var ) ) ;
+ non = stab_ptrs [ pn ] ;
+ if ( non == 0 ) {
+ non = next_typen () ;
+ stab_ptrs [ pn ] = non ;
+ fprintf ( dg_file, "%ld=*%ld", non, pn ) ;
+ } else {
+ fprintf ( dg_file, "%ld", non ) ;
+ }
+ } else {
+ non = next_typen () ;
+ fprintf ( dg_file, "%ld=*", non ) ;
+ out_dt_shape ( dt->data.ptr.object ) ;
+ }
+ dt->been_outed = non ;
+ last_type_sz = 32 ;
+ set_stab_size ( non ) ;
+ break ;
+ }
+
+ case DIAG_TYPE_ARRAY : {
+#if 0
+ long str = no ( dt->data.array.stride ) ;
+#endif
+ long lwb = no ( dt->data.array.lower_b ) ;
+ long upb = no ( dt->data.array.upper_b ) ;
+ diag_type index_type = dt->data.array.index_type ;
+ diag_type element_type = dt->data.array.element_type ;
+ long non = next_typen () ;
+ dt->been_outed = non ;
+ fprintf ( dg_file, "%ld=ar", non ) ;
+ out_dt_shape ( index_type ) ;
+ fprintf ( dg_file, ";%ld;%ld;", lwb, upb ) ;
+ out_dt_shape ( element_type ) ;
+ last_type_sz *= ( upb - lwb + 1 ) ;
+ set_stab_size ( non ) ;
+ break ;
+ }
+
+ case DIAG_TYPE_STRUCT :
+ case DIAG_TYPE_UNION : {
+ int i ;
+ char su ;
+ shape s ;
+ diag_field_list fields ;
+ long non = next_typen () ;
+ dt->been_outed = non ;
+
+ if ( dt->key == DIAG_TYPE_STRUCT ) {
+ fields = dt->data.t_struct.fields ;
+ s = dt->data.t_struct.tdf_shape ;
+ su = 's';
+ } else {
+ fields = dt->data.t_union.fields ;
+ s = dt->data.t_union.tdf_shape;
+ su = 'u' ;
+ }
+ fprintf ( dg_file, "%ld=%c%d", non, su, shape_size ( s ) / 8 ) ;
+
+ for ( i = fields->lastused - 1 ; i >= 0 ; i-- ) {
+ diag_field sf = ( fields->array ) [i] ;
+ long offset = no ( sf->where );
+
+ if ( depth_now >= max_depth ) return ;
+ depth_now++ ;
+ fprintf ( dg_file, "%s:", sf->field_name.ints.chars ) ;
+ out_dt_shape ( sf->field_type ) ;
+ fprintf ( dg_file, ",%ld,%ld;", offset, last_type_sz ) ;
+ }
+ fprintf ( dg_file, ";" ) ;
+ last_type_sz = shape_size ( s ) ;
+ set_stab_size ( non ) ;
+ break ;
+ }
+
+ case DIAG_TYPE_VARIETY : {
+ dt->been_outed = out_sh_type ( f_integer ( dt->data.var ) ) ;
+ fprintf ( dg_file, "%ld", dt->been_outed ) ;
+ break ;
+ }
+
+ case DIAG_TYPE_PROC: {
+ diag_type result_type = dt->data.proc.result_type ;
+ long non1 = next_typen () ;
+ long non2 = next_typen () ;
+ dt->been_outed = non1 ;
+ fprintf ( dg_file, "%ld=*%ld=f", non1, non2 ) ;
+ out_dt_shape ( result_type ) ;
+ last_type_sz = 32 ;
+ set_stab_size ( non1 ) ;
+ set_stab_size ( non2 ) ;
+ break ;
+ }
+
+ case DIAG_TYPE_LOC: {
+ /* +++ use qualifier which gives "const"/"volatile" */
+ out_dt_shape ( dt->data.loc.object ) ;
+ break ;
+ }
+
+ case DIAG_TYPE_FLOAT : {
+ dt->been_outed = out_sh_type ( f_floating ( dt->data.f_var ) ) ;
+ fprintf ( dg_file, "%ld", dt->been_outed ) ;
+ break ;
+ }
+
+ case DIAG_TYPE_NULL : {
+ fprintf ( dg_file, "%d", STAB_VOID ) ;
+ last_type_sz = 0 ;
+ break ;
+ }
+
+ case DIAG_TYPE_BITFIELD : {
+ long sz = dt->data.bitfield.no_of_bits.nat_val.small_nat ;
+ fprintf ( dg_file, "%d", STAB_SLONG ) ;
+ last_type_sz = sz ;
+ break ;
+ }
+
+ case DIAG_TYPE_ENUM : {
+ int i ;
+ enum_values_list enumvals = dt->data.t_enum.values;
+ long non = next_typen () ;
+ dt->been_outed = non ;
+ fprintf ( dg_file, "%ld=e", non ) ;
+ for ( i = enumvals->lastused - 1 ; i >= 0 ; i-- ) {
+ enum_values ef = ( enumvals->array ) [i] ;
+ fprintf ( dg_file, "%s:%d,", ef->nme.ints.chars, no ( ef->val ) );
+ }
+ fprintf ( dg_file, ";" ) ;
+ last_type_sz = 32 ;
+ set_stab_size ( non ) ;
+ break ;
+ }
+
+ default : {
+ fprintf ( dg_file, "%d", STAB_VOID ) ;
+ last_type_sz = 0 ;
+ break ;
+ }
+ }
+ return ;
+}
+
+
+/*
+ OUTPUT DIAGNOSTICS FOR A GLOBAL VARIABLE
+*/
+
+void diag_val_begin
+ PROTO_N ( (d, global, cname, pname) )
+ PROTO_T ( diag_global * d X int global X int cname X char * pname )
+{
+ stabd ( find_file ( d->data.id.whence.file->file.ints.chars ),
+ ( long ) d->data.id.whence.line_no.nat_val.small_nat
+ , -N_DSLINE ) ;
+
+ fprintf ( dg_file, "\t.stabs\t\"%s:%c",
+ d->data.id.nme.ints.chars, (global ? 'G' : 'S'));
+ OUT_DT_SHAPE ( d->data.id.new_type ) ;
+ if (global)
+ fprintf ( dg_file, "\",0x20,0,%d,0\n",
+ d->data.id.whence.line_no.nat_val.small_nat);
+ else {
+ fprintf ( dg_file, "\",0x28,0,%d,",
+ d->data.id.whence.line_no.nat_val.small_nat);
+ if (cname == -1) {
+ outs (pname);
+ }
+ else {
+ outs(local_prefix);
+ outn ((long)cname);
+ };
+ outnl ();
+ };
+ return ;
+}
+
+void diag_val_end
+ PROTO_N ( (d) )
+ PROTO_T ( diag_global * d )
+{
+ UNUSED(d);
+ return;
+}
+
+
+/*
+ OUTPUT DIAGNOSTICS FOR A PROCEDURE
+*/
+
+void diag_proc_begin
+ PROTO_N ( (d, global, cname, pname) )
+ PROTO_T ( diag_global * d X int global X int cname X char * pname )
+{
+ last_proc_pname = pname;
+ last_proc_cname = cname;
+ in_proc = 1;
+ if (!d)
+ return;
+
+ stabd ( find_file ( d->data.id.whence.file->file.ints.chars ),
+ ( long ) d->data.id.whence.line_no.nat_val.small_nat
+ ,0) ;
+
+ outs ("\t.stabs\t\"");
+ outs (d->data.id.nme.ints.chars);
+ if (global)
+ outs (":F");
+ else
+ outs (":f");
+ OUT_DT_SHAPE ( d->data.id.new_type->data.proc.result_type ) ;
+ outs ("\",0x24,0,0,");
+ out_procname ();
+ outnl ();
+ return ;
+}
+
+void diag_proc_end
+ PROTO_N ( (d) )
+ PROTO_T ( diag_global * d )
+{
+ UNUSED(d);
+ in_proc = 0;
+ return;
+}
+
+
+
+/*
+ OUTPUT DIAGNOSTICS FOR A LOCAL VARIABLE
+*/
+
+static void stab_local
+ PROTO_N ( (d, proc_no, acc) )
+ PROTO_T ( diag_info * d X int proc_no X exp acc )
+{
+ int p, param_dec;
+#ifdef NEWDIAGS
+ long acc_type;
+ if (name(acc) == name_tag) {
+ acc_type = ptno(son(acc));
+ if (no_frame && acc_type != reg_pl)
+ return;
+ }
+ if (name(acc) != name_tag) {
+ fprintf ( dg_file, "\t.stabs\t\"%s=i\",0x80,0,0,%d\n",
+ d -> data.id_scope.nme.ints.chars, no(acc) );
+ }
+ else
+ if (acc_type == reg_pl) {
+ fprintf ( dg_file, "\t.stabs\t\"%s:r",
+ d -> data.id_scope.nme.ints.chars );
+ OUT_DT_SHAPE ( d -> data.id_scope.typ ) ;
+ fprintf ( dg_file, "\",0x40,0,0,%d\n",
+ reg_stabno [get_reg_no (no(son(acc)))]);
+ }
+ else
+#endif
+ {
+ p = (no(acc) + no(son(acc))) / 8;
+ param_dec = isparam(son(acc));
+
+ fprintf ( dg_file, "\t.stabs\t\"%s:",
+ d -> data.id_scope.nme.ints.chars );
+ OUT_DT_SHAPE ( d -> data.id_scope.typ ) ;
+ fprintf ( dg_file, "\",0x80,0,%d,",
+ 0 /* or line number? */ );
+ if (param_dec)
+ fprintf ( dg_file, "%d\n", p+8);
+ else
+ fprintf ( dg_file, "%d-%sdisp%d\n", p, local_prefix, proc_no);
+ }
+ return ;
+}
+
+
+
+/*
+ DEAL WITH BASIC TYPES
+*/
+
+static void stab_types
+ PROTO_Z ()
+{
+ total_type_sizes = NO_STABS ;
+ typeno = NO_STABS ;
+ type_sizes = ( long * ) xmalloc ( NO_STABS * sizeof ( long ) ) ;
+ fputs ( "\t.stabs\t\"int:t1=r1;-2147483648;2147483647;\",0x80,0,0,0\n",
+ dg_file ) ;
+ fputs ( "\t.stabs\t\"short int:t2=r1;-32768;32767;\",0x80,0,0,0\n",
+ dg_file ) ;
+ fputs ( "\t.stabs\t\"short unsigned int:t3=r1;0;65535;\",0x80,0,0,0\n",
+ dg_file ) ;
+ fputs ( "\t.stabs\t\"char:t4=r4;0;127;\",0x80,0,0,0\n",
+ dg_file ) ;
+ fputs ( "\t.stabs\t\"signed char:t5=r1;-128;127;\",0x80,0,0,0\n",
+ dg_file ) ;
+ fputs ( "\t.stabs\t\"unsigned char:t6=r1;0;255;\",0x80,0,0,0\n",
+ dg_file ) ;
+ fputs ( "\t.stabs\t\"long int:t7=r1;-2147483648;2147483647;\",0x80,0,0,0\n",
+ dg_file ) ;
+ fputs ( "\t.stabs\t\"unsigned int:t8=r1;0;-1;\",0x80,0,0,0\n",
+ dg_file ) ;
+ fputs ( "\t.stabs\t\"long unsigned int:t9=r1;0;-1;\",0x80,0,0,0\n",
+ dg_file ) ;
+ fputs ( "\t.stabs\t\"float:t10=r1;4;0;\",0x80,0,0,0\n",
+ dg_file ) ;
+ fputs ( "\t.stabs\t\"double:t11=r1;8;0;\",0x80,0,0,0\n",
+ dg_file ) ;
+ fprintf ( dg_file, "\t.stabs\t\"long double:t12=r1;%d;0;\",0x80,0,0,0\n",
+ DOUBLE_SZ / 8 ) ;
+ fputs ( "\t.stabs\t\"void:t13=13\",0x80,0,0,0\n",
+ dg_file ) ;
+ fputs ( "\t.stabs\t\"long long int:t14=r1;", dg_file ) ;
+ fputs ( "01000000000000000000000;0777777777777777777777;\",0x80,0,0,0\n",
+ dg_file ) ;
+ fputs ( "\t.stabs\t\"unsigned long long int:t15=r1;", dg_file ) ;
+ fputs ( "0000000000000;01777777777777777777777;\",0x80,0,0,0\n",
+ dg_file ) ;
+ type_sizes [0] = 0 ;
+ type_sizes [1] = 32 ;
+ type_sizes [2] = 16 ;
+ type_sizes [3] = 16 ;
+ type_sizes [4] = 8 ;
+ type_sizes [5] = 8 ;
+ type_sizes [6] = 8 ;
+ type_sizes [7] = 32 ;
+ type_sizes [8] = 32 ;
+ type_sizes [9] = 32 ;
+ type_sizes [10] = 32 ;
+ type_sizes [11] = 64 ;
+ type_sizes [12] = DOUBLE_SZ ;
+ type_sizes [13] = 0 ;
+ type_sizes [14] = 64 ;
+ type_sizes [15] = 64 ;
+ return ;
+}
+
+
+/*
+ DEAL WITH STRUCTURE, UNION AND ENUM TAGS
+*/
+
+void stab_tagdefs
+ PROTO_Z ()
+{
+ diag_tagdef **di = unit_ind_diagtags ;
+ int i, n = unit_no_of_diagtags, istag ;
+
+ for ( i = 0 ; i < n ; i++ ) {
+ diag_type d = di [i]->d_type ;
+ istag = 1;
+
+ switch ( d->key ) {
+
+ case DIAG_TYPE_STRUCT : {
+ char *nme = d->data.t_struct.nme.ints.chars ;
+ if ( nme && *nme ) {
+ fprintf ( dg_file, "\t.stabs\t\"%s:", nme ) ;
+ } else {
+ static int s_count = 0 ;
+ fprintf ( dg_file, "\t.stabs\t\"_struct%d:", s_count++ ) ;
+ }
+ break ;
+ }
+ case DIAG_TYPE_UNION : {
+ char *nme = d->data.t_union.nme.ints.chars ;
+ if ( nme && *nme ) {
+ fprintf ( dg_file, "\t.stabs\t\"%s:", nme ) ;
+ } else {
+ static int u_count = 0 ;
+ fprintf ( dg_file, "\t.stabs\t\"_union%d:", u_count++ ) ;
+ }
+ break ;
+ }
+ case DIAG_TYPE_ENUM : {
+ char *nme = d->data.t_enum.nme.ints.chars ;
+ if ( nme && *nme ) {
+ fprintf ( dg_file, "\t.stabs\t\"%s:", nme ) ;
+ } else {
+ static int e_count = 0 ;
+ fprintf ( dg_file, "\t.stabs\t\"_enum%d:", e_count++ ) ;
+ }
+ break ;
+ }
+ default: {
+ istag = 0 ;
+ break ;
+ }
+ }
+ if (istag) {
+ if ( d->been_outed && 0) {
+ fprintf ( dg_file, "%d", (int)d->been_outed ) ;
+ } else {
+ fprintf ( dg_file, "T" ) ;
+ OUT_DT_SHAPE ( d ) ;
+ }
+ fprintf ( dg_file, "\",0x80,0,0,0\n" ) ;
+ }
+ }
+ return ;
+}
+
+
+/*
+ DEAL WITH TYPEDEFS
+*/
+
+void stab_typedefs
+ PROTO_Z ()
+{
+ diag_descriptor *di = unit_diagvar_tab.array ;
+ int i, n = unit_diagvar_tab.lastused ;
+ for ( i = 0 ; i < n ; i++ ) {
+ if ( di [i].key == DIAG_TYPEDEF_KEY ) {
+ long non = next_typen () ;
+ fprintf ( dg_file, "\t.stabs\t\"%s:t%ld=",
+ di [i].data.typ.nme.ints.chars, non ) ;
+ OUT_DT_SHAPE ( di [i].data.typ.new_type ) ;
+ fprintf ( dg_file, "\",0x80,0,0,0\n" ) ;
+ }
+ }
+ return ;
+}