Subversion Repositories tendra.SVN

/*

    Copyright (c) 1993 Open Software Foundation, Inc.

    All Rights Reserved

    Permission to use, copy, modify, and distribute this software

    and its documentation for any purpose and without fee is hereby

    granted, provided that the above copyright notice appears in all

    copies and that both the copyright notice and this permission

    notice appear in supporting documentation.

    OSF DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING

    ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A

    PARTICULAR PURPOSE.

    IN NO EVENT SHALL OSF BE LIABLE FOR ANY SPECIAL, INDIRECT, OR

    CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM

    LOSS OF USE, DATA OR PROFITS, WHETHER IN ACTION OF CONTRACT,

    NEGLIGENCE, OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION

    WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

*/

/*

    		 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.

*/

/**********************************************************************

$Author: release $

$Date: 1998/02/04 15:48:42 $

$Revision: 1.3 $

$Log: diagout.c,v $

 * Revision 1.3  1998/02/04  15:48:42  release

 * Added OSF copyright message.

 *

 * Revision 1.2  1998/02/04  10:43:52  release

 * Changes during testing.

 *

 * Revision 1.1.1.1  1998/01/17  15:55:56  release

 * First version to be checked into rolling release.

 *

 * Revision 1.2  1996/10/04  16:00:10  pwe

 * add banners and mod for PWE ownership

 *

**********************************************************************/

#include "config.h"

#include "cross_config.h"

#include <time.h>

#ifdef CROSS_INCLUDE

#include CROSS_INCLUDE/dbxstclass.h>

#include CROSS_INCLUDE/sys/debug.h>

#else

#include <dbxstclass.h>

#include <sys/debug.h>

#endif

#include "common_types.h"

#include "memtdf.h"

#include "installglob.h"

#include "li_types.h"

#include "diagtypes.h"

#include "toktypes.h"

#include "diag_fns.h"

#include "diagglob.h"

#include "mark_scope.h"

#include "externs.h"		/* for f_floating() */

#include "translat.h"

#include "machine.h"

#include "szs_als.h"

#include "install_fns.h"

#include "xalloc.h"

#include "maxminmacs.h"

#include "proc.h"

#include "comment.h"

#include "myassert.h"

#include "stack.h"

#include "diagout.h"

/* configuration options */

/* maximum .bb/.eb nesting depth in output, negative value implies no limit */

#ifndef MAX_BLOCK_DEPTH

#define MAX_BLOCK_DEPTH		1	/* more than one seems to upset dbx */

#endif

/* special line number codes */

#define UNKNOWN			(-9999)

#define NOT_IN_PROC		(-9998)

/* TypeId INTEGER number for standard TDF shapes */

#define TYPEID_SCHAR		1

#define TYPEID_UCHAR		2

#define TYPEID_SWORD		3

#define TYPEID_UWORD		4

#define TYPEID_SLONG		5

#define TYPEID_ULONG		6

#define TYPEID_SHREAL		7

#define TYPEID_REAL		8

#define TYPEID_DOUBLE		9

#define TYPEID_VOID		10

#define TYPEID_TOKEN		11

/* tdfstring -> nul terminated C string (char *) */

#define CSTRING(tdfstring)	((tdfstring).ints.chars)

/* tdf exp -> C int */

#define EXPINT(exp)		(ASSERT(name(exp) == val_tag) , no(exp))

/* tdf nat -> C int */

#define NATINT(n)		((n).nat_val.small_nat)

/*

 * Query and set "been_outed" field, which may hold

 * stabstring TypeNo if type has already been output.

 */

#define	CLR_OUTED_NO(dt)	((dt)->been_outed = (OUTPUT_REC)0)

#define	SET_OUTED_NO(dt,i)	((dt)->been_outed = (OUTPUT_REC)(i))

#define	OUTED_NO(dt)		((int)(dt)->been_outed)

#define	IS_OUTED(dt)		((dt)->been_outed != 0)

/*

 * Params for stab_relativeline().

 */

static CONST char line_stab[] = ".line";	/* line number */

static CONST char bf_stab[] = ".bf";	/* begin function */

static CONST char ef_stab[] = ".ef";	/* end function */

static CONST char bb_stab[] = ".bb";	/* begin block */

static CONST char eb_stab[] = ".eb";	/* end block */

/*

 * Location in the source program

 */

static int current_fileno;	/* file number of last file output */

static int current_lineno;	/* the last line number output */

static int files_stabbed;	/* number of .file or .bi output */

static int first_fileno;

static int current_procstart_lineno;	/* line proc started on */

static int block_depth;		/* .bb/.eb nesting depth */

static filename *fds;		/* known files numbered from 0 */

static int mainfile_fd = -1;	/* index into fds of 'main source file' */

static int szfds = 0;		/* space malloc'd for fds */

static int nofds = 0;		/* how many are known */

/*

 * Struct/union type information.

 * (See function OUTPUT_DIAG_TAGS)

 */

static diag_tagdef **su_diags = (diag_tagdef **) 0;

static int no_of_sus = 0;

static int leng_sus = 0;

/*

 * Typedef information

 * (See function OUTPUT_GLOBALS_TAB)

 */

static diag_descriptor **typedef_diags = (diag_descriptor ** ) 0;

static int no_of_typedefs = 0;

static int leng_typedefs = 0;

/*

 * Shapes we need, set in init_diag.

 */

static shape voidsh;		/* shape for void */

static shape tokensh;		/* shape for TDF tokenised type */

/*

 * Static procs.

 */

static diag_descriptor *find_dd PROTO_S ((exp));

static int find_file PROTO_S ((char *));

static void stab_relativeline PROTO_S ((CONST char *));

static void stab_begin_block PROTO_S ((void));

static void stab_end_block PROTO_S ((void));

static void stabn PROTO_S ((int, int));

static void stab_file PROTO_S ((int));

static void diagbr_open PROTO_S ((int));

static void diagbr_close PROTO_S ((int));

static int next_typen PROTO_S ((void));

static int TypeNo_of_shape PROTO_S ((shape));

static bool eq_sutype PROTO_S ((diag_type, diag_type));

static bool eq_typedef_type PROTO_S ((diag_descriptor *,diag_descriptor *));

static int size_dt PROTO_S ((diag_type));

static void out_dt_TypeDef_no_recurse PROTO_S ((diag_type));

static void out_dt_TypeDef PROTO_S ((diag_type));

static void out_dt_NewTypeId PROTO_S ((diag_type, int));

static void out_dt_TypeId PROTO_S ((diag_type));

static void stab_internal_types PROTO_S ((diag_type, bool));

static void stab_types PROTO_S ((void));

static void number_and_stab_basicshapes PROTO_S ((void));

static void number_structs_and_unions PROTO_S ((void));

static void stab_structs_and_unions PROTO_S ((void));

static void number_typedefs PROTO_S ((void));

static void stab_typedefs PROTO_S ((void));

static void stab_basicshape PROTO_S ((shape,char * ,int,int));

/*(See diag_config.h)

 * remember a filename so that find_file() can map onto filename number

 */

void INSPECT_FILENAME PROTO_N ((f)) PROTO_T (filename f)

{

  FULLCOMMENT2("INSPECT_FILENAME %d: '%s'", nofds, (int) CSTRING(f->file));

  if (fds == (filename *) 0)

  {

    fds = (filename *) xmalloc((szfds += 5) * sizeof (filename));

  }

  else if (nofds >= szfds)

  {

    fds = (filename *) xrealloc(fds, (szfds += 5) * sizeof (filename));

  }

  fds[nofds] = f;

  /*

   * The following is taken from trans386/dwarf/dwarf_out.c.

   * It works out the main source filename. There must be a better way. +++

   */

  if (mainfile_fd < 0)

  {

    /* use heuristic to see if this is 'main source file' */

    char *lastdot = strrchr(CSTRING(f->file), '.');

    /* XXX.h not considered 'main source file' */

    if (lastdot != 0 && lastdot[1] != 'h')

      mainfile_fd = nofds;

  }

  nofds++;

  return;

}

/*(See diag_config.h)

 * outputs structs & unions from global level types

 */

void OUTPUT_DIAG_TAGS PROTO_Z ()

{

  diag_tagdef **di = unit_ind_diagtags;

  unsigned int n = unit_no_of_diagtags;

  int i;

  int il = no_of_sus; /* There should be no clashes within a single unit so we save a bit of time here */

  for (i = 0; i < n; ++i)

  {

    diag_type d = di[i]->d_type;

    switch (d->key)

    {

     case DIAG_TYPE_STRUCT:

     case DIAG_TYPE_UNION:

      {

	int j;

	for (j = 0; j < il; j++)

	{

	  /* Check we have not done already */

	  if (eq_sutype(d, su_diags[j]->d_type))

	  {

	    break;

	  }

	}

	if (j != il)

	{

	  break;

	}

	if (no_of_sus >= leng_sus)

	{

	  if (su_diags == (diag_tagdef **) 0)

	  {

	    su_diags=(diag_tagdef**)xmalloc((leng_sus+=20)*sizeof(diag_tagdef*));

	  }

	  else

	  {

	    su_diags=(diag_tagdef**)xrealloc(su_diags,(leng_sus+=20)*sizeof(diag_tagdef*));

	  }

	}

	/* Set up the appropriate member of the su_diags array */

	su_diags[no_of_sus++] = di[i];

	break;

      }

    default:

      break;

    }

  }

  return;

}

/*

 * Collects information

 */

void OUTPUT_GLOBALS_TAB PROTO_Z ()

{

  diag_descriptor * unit_typedef_array = unit_diagvar_tab.array;

  unsigned int no_of_typedefs_in_unit =unit_diagvar_tab.lastused;

  int i;

  int il = no_of_typedefs;

  for(i=0 ; i<=no_of_typedefs_in_unit ; i++)

  {

    diag_descriptor * dd = unit_typedef_array + i;

    switch (dd->key)

    {

     case DIAG_TYPEDEF_KEY:

      {

	int j;

	/* Check that we have not done already */

	for(j=0; j < il ; j++)

	{

	  if(eq_typedef_type(dd,typedef_diags[j]))

	  {

	    break;

	  }

	}

	if( j != il )

	{

	  break;

	}

	/* We have a new one */

	if (no_of_typedefs >= leng_typedefs)

	{ 

	  if(typedef_diags == (diag_descriptor **) 0)

	  {

	    typedef_diags = (diag_descriptor **)xmalloc ((leng_typedefs+=20)*sizeof(diag_descriptor *));

	  }

	  else

	  {

	    typedef_diags = (diag_descriptor **)xrealloc(typedef_diags,(leng_typedefs+=20)*sizeof(diag_descriptor *));

	  }

	}

	typedef_diags[no_of_typedefs++]=dd;

      }

      break;

     default:

      break;

    }

  }

}

static void number_and_stab_basicshapes PROTO_Z ()

{

  /* NOTE: char is unsigned char */

  stab_basicshape(scharsh ,"signed char"   , TYPEID_SCHAR , TP_SCHAR);

  stab_basicshape(ucharsh ,"char"          , TYPEID_UCHAR , TP_CHAR);

  stab_basicshape(swordsh ,"short"         , TYPEID_SWORD , TP_SHORT);

  stab_basicshape(uwordsh ,"unsigned short", TYPEID_UWORD , TP_USHORT);

  stab_basicshape(slongsh ,"int"           , TYPEID_SLONG , TP_LONG);

  stab_basicshape(ulongsh ,"unsigned int"  , TYPEID_ULONG , TP_ULONG);

  stab_basicshape(shrealsh,"float"         , TYPEID_SHREAL, TP_FLOAT);

  stab_basicshape(realsh  ,"double"        , TYPEID_REAL  , TP_DOUBLE);

  stab_basicshape(doublesh,"long double"   , TYPEID_DOUBLE, TP_LDOUBLE);

  stab_basicshape(voidsh  ,"void"          , TYPEID_VOID  , TP_VOID);

#if 0

  /* this work fine with dbx and gdb, the type is given as "TOKENISED_TYPE" */

  stab_basicshape(tokensh, "TOKENISED_TYPE", TYPEID_TOKEN, TP_VOID);

#else

  /*

   * ... but this is better

   * dbx gives type as "@TOKENISED_TYPE", gdb "struct <unknown>",

   * when value is printed, dbx says "[typeref]", gdb "<incomplete type>"

   */

  {

    int n = next_typen();	/* use up the typen TYPEID_TOKEN */

    ASSERT(TYPEID_TOKEN == n);

    /*

     * TypeId:	    INTEGER = TypeDef	"New type number described by TypeDef"

     * TypeDef:	    o NAME ;		"Opaque type"

     */

    fprintf(as_file, "\t.stabx\t\":t%d=oTOKENISED_TYPE;", TYPEID_TOKEN);

    fprintf(as_file, "\",%d,%d,%d\n", 0, C_DECL, 0);

  }

#endif

}

static void number_structs_and_unions PROTO_Z ()

{

  int i;

  for (i = 0; i < no_of_sus; ++i)

  {

    SET_OUTED_NO(su_diags[i]->d_type, next_typen());

  }

}

static void number_typedefs PROTO_Z ()

{

  int i;

  for (i=0;i<no_of_typedefs; i++)

  {

    if (!IS_OUTED(typedef_diags[i]->data.typ.new_type))

    {

      SET_OUTED_NO(typedef_diags[i]->data.typ.new_type,next_typen());

    }

  }

}

static void stab_structs_and_unions PROTO_Z ()

{

  int i;

  for (i = 0; i < no_of_sus; ++i)

  {

    int non;

    diag_type dt = su_diags[i]->d_type;

    char *nme = (dt->key == DIAG_TYPE_STRUCT)

			? CSTRING(dt->data.t_struct.nme)

			: CSTRING(dt->data.t_union.nme);

    COMMENT2("su_diags: is_struct=%d nme='%s'", dt->key == DIAG_TYPE_STRUCT, (int) nme);

    stab_internal_types(dt, 0);

    if (nme == (char *) 0 || *nme == (char) 0)

    {

      /*

       * Output unnamed object here for 2 reasons:

       *	1) gdb (but not dbx) is confused by Typeid which includes a

       *	   full TypeDef and treats it as an anonymous struct.

       *	   It prefers TypeDef to refer to a previous TypeId INTEGER.

       *	2) It avoids very long stabstrings from unnamed object

       *	   being expanded on the fly.

       */

      fprintf(as_file, "\t.stabx\t\":T");	/* Unnamed object */

    }

    else

    {

      fprintf(as_file, "\t.stabx\t\"%s:T", nme);

    }

    non = OUTED_NO(dt);

    CLR_OUTED_NO(dt);			/* avoid identity */

    out_dt_NewTypeId(dt, non);

    fprintf(as_file, "\",%d,%d,%d\n", 0, C_DECL, 0);

  }

}  

static void stab_typedefs PROTO_Z ()

{

  int i;

  for(i=0;i<no_of_typedefs;i++)

  {

    diag_descriptor * dd = typedef_diags[i];

    int non;

    diag_type dt = dd->data.typ.new_type;

    stab_internal_types(dt,0);

    ASSERT(CSTRING(dd->data.typ.nme)[0]!=0);/* Not an empty string */

    fprintf(as_file, "\t.stabx\t\"%s:t", CSTRING(dd->data.typ.nme));

    non = OUTED_NO(dt);

    CLR_OUTED_NO(dt);			/* avoid identity */

    out_dt_NewTypeId(dt, non);

    fprintf(as_file, "\",%d,%d,%d\n", 0, C_DECL, 0);

  }

}

/*

 * init_diag - used by translate_capsule() to initialise diagnostics.

 */

void init_diag PROTO_Z ()

{

  /* 

   * Initialisation of diagnostics 

   */

  current_fileno = UNKNOWN;

  current_procstart_lineno = NOT_IN_PROC;

  current_lineno = NOT_IN_PROC;

  files_stabbed = 0;

  first_fileno = -100;

  stab_file(mainfile_fd);

  voidsh = getshape(0, 0, 0, TOP_ALIGN, TOP_SZ, tophd);/* very dubious */

  tokensh = getshape(0, 0, 0, TOP_ALIGN, TOP_SZ, bothd);/* very dubious */

  stab_types();

  return;

}

/*

 * Correct the name for non externs (eg C static) to keep dbx happy.

 * gdb happily uses the stab info to override the assembler label,

 * but dbx does not.  local_prefix names (eg S.999) upset dbx,

 * partcularly on stack tracebacks from 'where'.  If we find that

 * the name is already in use, eg possibly from nested C static

 * we change the name to "S.NNN.name" to add meaning, but stay unique.

 */

void fixup_name PROTO_N ((global,top_def,crt_def)) PROTO_T (exp global X dec * top_def X dec * crt_def)

{

  diag_descriptor *dd;

  dec *d;

  char *id = crt_def->dec_u.dec_val.dec_id;	/* assembler label */

  char *nm;			/* real name, or uniqued real name */

  /*

   * Externs have correct name currently.

   * Any name not starting with local_prefix is special, leave it.

   */

  if (crt_def->dec_u.dec_val.extnamed ||

      id[0] != local_prefix[0] || id[1] != local_prefix[1])

  {

    return;			/* externs have correct name currently */

  }

  dd = find_dd(global);

  if (dd == (diag_descriptor *) 0)

  {

    /* eg string constant or currently static within proc */

    FULLCOMMENT("correct_name: no descriptor");

    return;

  }

  nm = CSTRING(dd->data.id.nme);

  /* search def chain to see if name is already used as assembler label */

  for (d = top_def; d != crt_def && d != (dec *) 0; d = d->def_next)

  {

    if (strcmp(nm, d->dec_u.dec_val.dec_id) == 0)

    {

      /*

       * Name already used, create new name to add meaning but stay unique:

       * "S.NNNN.name".

       */

      int len1 = strlen(id);

      int len2 = strlen(nm);

      char *newid;

      newid = (char *)xmalloc(len1 + 1 + len2 + 1);

      strcpy(newid, id);

      newid[len1] = '.';

      strcpy(&newid[len1 + 1], nm);

      nm = newid;

      break;

    }

  }

  crt_def->dec_u.dec_val.dec_id = nm;	/* change label to real identifier

					 * name */

}

/*

 * output_diag - used by make_code() to implement "diagnose_tag".

 */

void output_diag PROTO_N ((d,proc_no,e)) PROTO_T (diag_info * d X int proc_no X exp e)

{

  exp id;

  FULLCOMMENT1("output_diag: key=%d", d->key);

  if (d->key == DIAG_INFO_SOURCE)

  {

    sourcemark *s = &d->data.source.beg;

    int f = find_file(CSTRING(s->file->file));

    stabn(f, NATINT(s->line_no));

    return;

  }

  if (d->key != DIAG_INFO_ID)

  {

    FULLCOMMENT1("output_diag: unsupported key=%d", d->key);

    return;

  }

  id = son(d->data.id_scope.access);

  FULLCOMMENT3("output_diag: DIAG_INFO_ID %s isglob(id)=%d no(id)=%d",

	       (int) CSTRING(d->data.id_scope.nme), isglob(id), no(id));

  /* can't output global values as local names */

  if (isglob(id))

  {

    return;

  }

  ASSERT(name(id) == ident_tag);

  mark_scope(e);

  FULLCOMMENT1("output_diag: DIAG_INFO_ID mark_scope props(e)=%#x", props(e));

  if (props(e) & 0x80)

  {

    diagbr_open(current_fileno);

    stabn(current_fileno, current_lineno + 1);	/* don't have proper lineno */

  }

  /* dbx is upset if a function does not have a begin block, make sure it does */

  if (!isparam(id) && block_depth == 0)

  {

    stab_begin_block();

  }

  stab_local(CSTRING(d->data.id_scope.nme), d->data.id_scope.typ,

	     id, 0, current_fileno);

  if (isparam(id) && last_caller_param(id))

  {

    if (block_depth == 0)

    {

      stab_begin_block();

    }

#if 0

    stabn(current_fileno, current_lineno + 1);	/* don't have proper lineno */

#endif

  }

  return;

}

/*

 * output_end_scope - used by make_code() to make end of diagnose_tag scope.

 */

void output_end_scope PROTO_N ((d,e)) PROTO_T (diag_info * d X exp e)

{

  FULLCOMMENT1("output_end_scope key=%d", d->key);

  if (d->key == DIAG_INFO_SOURCE)

  {

    sourcemark *s = &d->data.source.end;

    int f = find_file(CSTRING(s->file->file));

    int lno = NATINT(s->line_no);

    stabn(f, lno);

    return;

  }

  if (d->key == DIAG_INFO_ID && props(e) & 0x80)

  {

    diagbr_close(current_fileno);

    return;

  }

}

/*

 * find_dd

 */

static diag_descriptor *find_dd PROTO_N ((e)) PROTO_T (exp e)

{

  if (diag_def==NULL) 

  {

    return NULL;

  }

  return diag_def->dec_u.dec_val.diag_info;

}

/*

 * get filename number

 */

static int find_file PROTO_N ((f)) PROTO_T (char *f)

{

  int i;

  for (i = 0; i < nofds; i++)

  {

    if (strcmp(f, CSTRING(fds[i]->file)) == 0)

    {

      return i;

    }

  }

  return 0;

}

/*

 * ============================================================================

 *		Procs to generate line number related stabs

 */

/*

 * output directive using proc start relative linenos

 */

static void stab_relativeline PROTO_N ((directive)) PROTO_T (CONST char *directive)

{

  int lineinproc = current_lineno - current_procstart_lineno;

  /* avoid nonsense line nos from unusual header or #line usage */

  if (lineinproc >= 0)

  {

    fprintf(as_file, "\t%s\t%d\n", directive, lineinproc + 1);

  }

  else if (directive != line_stab)

  {

    fprintf(as_file, "\t%s\t%d\n", directive, 1);	/* must put out

							 * something to match

							 * begin/end */

  }

  return;

}

/*

 * output begin block directive

 */

static void stab_begin_block PROTO_Z ()

{

#if 0

  if (MAX_BLOCK_DEPTH < 0 || block_depth < MAX_BLOCK_DEPTH)

#endif

  {

    stab_relativeline(bb_stab);

  }

  block_depth++;

  return;

}

/*

 * output end block directive

 */

static void stab_end_block PROTO_Z ()

{

  if (block_depth >= 0)

  {

#if 0

    if (MAX_BLOCK_DEPTH < 0 || block_depth <= MAX_BLOCK_DEPTH)

#endif

    {

      stab_relativeline(eb_stab);

    }

    block_depth--;

  }

  return;

}

/*

 * Generate stabs for current file and line number.

 * Note that line number stabs are relative to start of current proc.

 */

static void stabn PROTO_N ((findex,lno)) PROTO_T (int findex X int lno)

{

  if (findex == current_fileno && lno == current_lineno)

  {

    return;

  }

  if (findex != current_fileno)

  {

    stab_file(findex);

  }

  if (current_procstart_lineno == NOT_IN_PROC)

  {

    return;

  }

  current_lineno = lno;

  stab_relativeline(line_stab);

  return;

}

/*

 * stab_end_file ties up lose ends 

 */

void stab_end_file PROTO_Z ()

{

  if (current_fileno != first_fileno)

  {

    COMMENT("stab_end_file: close the last include file with  a .ei");

    /* close the last include file */

    fprintf(as_file, "\t.ei\t\"%s\"\n", CSTRING(fds[current_fileno]->file));

  }

  return;

}

/*

 * output file name if changed

 */