[thirdparty/binutils-gdb.git] / gdb / f-typeprint.c

/* Support for printing Fortran types for GDB, the GNU debugger.

   Copyright (C) 1986, 1988, 1989, 1991, 1993, 1994, 1995, 1996, 1998, 2000,
   2001, 2002, 2003, 2006, 2007, 2008, 2009, 2010, 2011
   Free Software Foundation, Inc.

   Contributed by Motorola.  Adapted from the C version by Farooq Butt
   (fmbutt@engage.sps.mot.com).

   This file is part of GDB.

   This program is free software; you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 3 of the License, or
   (at your option) any later version.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */

#include "defs.h"
#include "gdb_obstack.h"
#include "bfd.h"
#include "symtab.h"
#include "gdbtypes.h"
#include "expression.h"
#include "value.h"
#include "gdbcore.h"
#include "target.h"
#include "f-lang.h"

#include "gdb_string.h"
#include <errno.h>

#if 0				/* Currently unused.  */
static void f_type_print_args (struct type *, struct ui_file *);
#endif

static void f_type_print_varspec_suffix (struct type *, struct ui_file *, int,
					 int, int, int);

void f_type_print_varspec_prefix (struct type *, struct ui_file *,
				  int, int);

void f_type_print_base (struct type *, struct ui_file *, int, int);
\f

/* LEVEL is the depth to indent lines by.  */

void
f_print_type (struct type *type, const char *varstring, struct ui_file *stream,
	      int show, int level)
{
  enum type_code code;
  int demangled_args;

  f_type_print_base (type, stream, show, level);
  code = TYPE_CODE (type);
  if ((varstring != NULL && *varstring != '\0')
  /* Need a space if going to print stars or brackets;
     but not if we will print just a type name.  */
      || ((show > 0 || TYPE_NAME (type) == 0)
          && (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC
	      || code == TYPE_CODE_METHOD
	      || code == TYPE_CODE_ARRAY
	      || code == TYPE_CODE_REF)))
    fputs_filtered (" ", stream);
  f_type_print_varspec_prefix (type, stream, show, 0);

  if (varstring != NULL)
    {
      fputs_filtered (varstring, stream);

      /* For demangled function names, we have the arglist as part of the name,
         so don't print an additional pair of ()'s.  */

      demangled_args = varstring[strlen (varstring) - 1] == ')'; 
      f_type_print_varspec_suffix (type, stream, show, 0, demangled_args, 0);
   }
}

/* Print any asterisks or open-parentheses needed before the
   variable name (to describe its type).

   On outermost call, pass 0 for PASSED_A_PTR.
   On outermost call, SHOW > 0 means should ignore
   any typename for TYPE and show its details.
   SHOW is always zero on recursive calls.  */

void
f_type_print_varspec_prefix (struct type *type, struct ui_file *stream,
			     int show, int passed_a_ptr)
{
  if (type == 0)
    return;

  if (TYPE_NAME (type) && show <= 0)
    return;

  QUIT;

  switch (TYPE_CODE (type))
    {
    case TYPE_CODE_PTR:
      f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1);
      break;

    case TYPE_CODE_FUNC:
      f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
      if (passed_a_ptr)
	fprintf_filtered (stream, "(");
      break;

    case TYPE_CODE_ARRAY:
      f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
      break;

    case TYPE_CODE_UNDEF:
    case TYPE_CODE_STRUCT:
    case TYPE_CODE_UNION:
    case TYPE_CODE_ENUM:
    case TYPE_CODE_INT:
    case TYPE_CODE_FLT:
    case TYPE_CODE_VOID:
    case TYPE_CODE_ERROR:
    case TYPE_CODE_CHAR:
    case TYPE_CODE_BOOL:
    case TYPE_CODE_SET:
    case TYPE_CODE_RANGE:
    case TYPE_CODE_STRING:
    case TYPE_CODE_BITSTRING:
    case TYPE_CODE_METHOD:
    case TYPE_CODE_REF:
    case TYPE_CODE_COMPLEX:
    case TYPE_CODE_TYPEDEF:
      /* These types need no prefix.  They are listed here so that
         gcc -Wall will reveal any types that haven't been handled.  */
      break;
    }
}

/* Print any array sizes, function arguments or close parentheses
   needed after the variable name (to describe its type).
   Args work like c_type_print_varspec_prefix.  */

static void
f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
			     int show, int passed_a_ptr, int demangled_args,
			     int arrayprint_recurse_level)
{
  int upper_bound, lower_bound;

  /* No static variables are permitted as an error call may occur during
     execution of this function.  */

  if (type == 0)
    return;

  if (TYPE_NAME (type) && show <= 0)
    return;

  QUIT;

  switch (TYPE_CODE (type))
    {
    case TYPE_CODE_ARRAY:
      arrayprint_recurse_level++;

      if (arrayprint_recurse_level == 1)
	fprintf_filtered (stream, "(");

      if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
				     arrayprint_recurse_level);

      lower_bound = f77_get_lowerbound (type);
      if (lower_bound != 1)	/* Not the default.  */
	fprintf_filtered (stream, "%d:", lower_bound);

      /* Make sure that, if we have an assumed size array, we
         print out a warning and print the upperbound as '*'.  */

      if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
	fprintf_filtered (stream, "*");
      else
	{
	  upper_bound = f77_get_upperbound (type);
	  fprintf_filtered (stream, "%d", upper_bound);
	}

      if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
				     arrayprint_recurse_level);
      if (arrayprint_recurse_level == 1)
	fprintf_filtered (stream, ")");
      else
	fprintf_filtered (stream, ",");
      arrayprint_recurse_level--;
      break;

    case TYPE_CODE_PTR:
    case TYPE_CODE_REF:
      f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0,
				   arrayprint_recurse_level);
      fprintf_filtered (stream, ")");
      break;

    case TYPE_CODE_FUNC:
      f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
				   passed_a_ptr, 0, arrayprint_recurse_level);
      if (passed_a_ptr)
	fprintf_filtered (stream, ")");

      fprintf_filtered (stream, "()");
      break;

    case TYPE_CODE_UNDEF:
    case TYPE_CODE_STRUCT:
    case TYPE_CODE_UNION:
    case TYPE_CODE_ENUM:
    case TYPE_CODE_INT:
    case TYPE_CODE_FLT:
    case TYPE_CODE_VOID:
    case TYPE_CODE_ERROR:
    case TYPE_CODE_CHAR:
    case TYPE_CODE_BOOL:
    case TYPE_CODE_SET:
    case TYPE_CODE_RANGE:
    case TYPE_CODE_STRING:
    case TYPE_CODE_BITSTRING:
    case TYPE_CODE_METHOD:
    case TYPE_CODE_COMPLEX:
    case TYPE_CODE_TYPEDEF:
      /* These types do not need a suffix.  They are listed so that
         gcc -Wall will report types that may not have been considered.  */
      break;
    }
}

/* Print the name of the type (or the ultimate pointer target,
   function value or array element), or the description of a
   structure or union.

   SHOW nonzero means don't print this type as just its name;
   show its real definition even if it has a name.
   SHOW zero means print just typename or struct tag if there is one
   SHOW negative means abbreviate structure elements.
   SHOW is decremented for printing of structure elements.

   LEVEL is the depth to indent by.
   We increase it for some recursive calls.  */

void
f_type_print_base (struct type *type, struct ui_file *stream, int show,
		   int level)
{
  int upper_bound;
  int index;

  QUIT;

  wrap_here ("    ");
  if (type == NULL)
    {
      fputs_filtered ("<type unknown>", stream);
      return;
    }

  /* When SHOW is zero or less, and there is a valid type name, then always
     just print the type name directly from the type.  */

  if ((show <= 0) && (TYPE_NAME (type) != NULL))
    {
      fputs_filtered (TYPE_NAME (type), stream);
      return;
    }

  if (TYPE_CODE (type) != TYPE_CODE_TYPEDEF)
    CHECK_TYPEDEF (type);

  switch (TYPE_CODE (type))
    {
    case TYPE_CODE_TYPEDEF:
      f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
      break;

    case TYPE_CODE_ARRAY:
    case TYPE_CODE_FUNC:
      f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
      break;

    case TYPE_CODE_PTR:
      fprintf_filtered (stream, "PTR TO -> ( ");
      f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
      break;

    case TYPE_CODE_REF:
      fprintf_filtered (stream, "REF TO -> ( ");
      f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
      break;

    case TYPE_CODE_VOID:
      fprintfi_filtered (level, stream, "VOID");
      break;

    case TYPE_CODE_UNDEF:
      fprintfi_filtered (level, stream, "struct <unknown>");
      break;

    case TYPE_CODE_ERROR:
      fprintfi_filtered (level, stream, "%s", TYPE_ERROR_NAME (type));
      break;

    case TYPE_CODE_RANGE:
      /* This should not occur.  */
      fprintfi_filtered (level, stream, "<range type>");
      break;

    case TYPE_CODE_CHAR:
      /* Override name "char" and make it "character".  */
      fprintfi_filtered (level, stream, "character");
      break;

    case TYPE_CODE_INT:
      /* There may be some character types that attempt to come
         through as TYPE_CODE_INT since dbxstclass.h is so
         C-oriented, we must change these to "character" from "char".  */

      if (strcmp (TYPE_NAME (type), "char") == 0)
	fprintfi_filtered (level, stream, "character");
      else
	goto default_case;
      break;

    case TYPE_CODE_STRING:
      /* Strings may have dynamic upperbounds (lengths) like arrays.  */

      if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
	fprintfi_filtered (level, stream, "character*(*)");
      else
	{
	  upper_bound = f77_get_upperbound (type);
	  fprintf_filtered (stream, "character*%d", upper_bound);
	}
      break;

    case TYPE_CODE_STRUCT:
    case TYPE_CODE_UNION:
      if (TYPE_CODE (type) == TYPE_CODE_UNION)
	fprintfi_filtered (level, stream, "Type, C_Union :: ");
      else
	fprintfi_filtered (level, stream, "Type ");
      fputs_filtered (TYPE_TAG_NAME (type), stream);
      fputs_filtered ("\n", stream);
      for (index = 0; index < TYPE_NFIELDS (type); index++)
	{
	  f_type_print_base (TYPE_FIELD_TYPE (type, index), stream, show,
			     level + 4);
	  fputs_filtered (" :: ", stream);
	  fputs_filtered (TYPE_FIELD_NAME (type, index), stream);
	  f_type_print_varspec_suffix (TYPE_FIELD_TYPE (type, index),
				       stream, 0, 0, 0, 0);
	  fputs_filtered ("\n", stream);
	} 
      fprintfi_filtered (level, stream, "End Type ");
      fputs_filtered (TYPE_TAG_NAME (type), stream);
      break;

    case TYPE_CODE_MODULE:
      fprintfi_filtered (level, stream, "module %s", TYPE_TAG_NAME (type));
      break;

    default_case:
    default:
      /* Handle types not explicitly handled by the other cases,
         such as fundamental types.  For these, just print whatever
         the type name is, as recorded in the type itself.  If there
         is no type name, then complain.  */
      if (TYPE_NAME (type) != NULL)
	fprintfi_filtered (level, stream, "%s", TYPE_NAME (type));
      else
	error (_("Invalid type code (%d) in symbol table."), TYPE_CODE (type));
      break;
    }
}
Commit	Line	Data
c906108c	1	/* Support for printing Fortran types for GDB, the GNU debugger.
1bac305b	2
6aba47ca	3	Copyright (C) 1986, 1988, 1989, 1991, 1993, 1994, 1995, 1996, 1998, 2000,
7b6bb8da	4	2001, 2002, 2003, 2006, 2007, 2008, 2009, 2010, 2011
4c38e0a4	5	Free Software Foundation, Inc.
1bac305b	6
c906108c SS	7	Contributed by Motorola. Adapted from the C version by Farooq Butt
	8	(fmbutt@engage.sps.mot.com).
	9
c5aa993b	10	This file is part of GDB.
c906108c	11
c5aa993b JM	12	This program is free software; you can redistribute it and/or modify
c5aa993b JM	13	it under the terms of the GNU General Public License as published by
a9762ec7	14	the Free Software Foundation; either version 3 of the License, or
c5aa993b	15	(at your option) any later version.
c906108c	16
c5aa993b JM	17	This program is distributed in the hope that it will be useful,
	18	but WITHOUT ANY WARRANTY; without even the implied warranty of
	19	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	20	GNU General Public License for more details.
c906108c	21
c5aa993b	22	You should have received a copy of the GNU General Public License
a9762ec7	23	along with this program. If not, see <http://www.gnu.org/licenses/>. */
c906108c SS	24
c906108c SS	25	#include "defs.h"
04ea0df1	26	#include "gdb_obstack.h"
c906108c SS	27	#include "bfd.h"
	28	#include "symtab.h"
	29	#include "gdbtypes.h"
	30	#include "expression.h"
	31	#include "value.h"
	32	#include "gdbcore.h"
	33	#include "target.h"
c906108c	34	#include "f-lang.h"
c906108c SS	35
	36	#include "gdb_string.h"
	37	#include <errno.h>
	38
0963b4bd	39	#if 0 /* Currently unused. */
d9fcf2fb	40	static void f_type_print_args (struct type , struct ui_file );
c906108c SS	41	#endif
c906108c SS	42
0311118f	43	static void f_type_print_varspec_suffix (struct type , struct ui_file , int,
d9fcf2fb	44	int, int, int);
c906108c	45
d9fcf2fb JM	46	void f_type_print_varspec_prefix (struct type , struct ui_file ,
d9fcf2fb JM	47	int, int);
c906108c	48
d9fcf2fb	49	void f_type_print_base (struct type , struct ui_file , int, int);
c906108c	50	\f
c5aa993b	51
c906108c SS	52	/* LEVEL is the depth to indent lines by. */
	53
	54	void
25b524e8	55	f_print_type (struct type type, const char varstring, struct ui_file *stream,
fba45db2	56	int show, int level)
c906108c	57	{
52f0bd74	58	enum type_code code;
c906108c SS	59	int demangled_args;
	60
	61	f_type_print_base (type, stream, show, level);
	62	code = TYPE_CODE (type);
	63	if ((varstring != NULL && *varstring != '\0')
c5aa993b JM	64	/* Need a space if going to print stars or brackets;
c5aa993b JM	65	but not if we will print just a type name. */
905e0470 PM	66	\|\| ((show > 0 \|\| TYPE_NAME (type) == 0)
	67	&& (code == TYPE_CODE_PTR \|\| code == TYPE_CODE_FUNC
	68	\|\| code == TYPE_CODE_METHOD
	69	\|\| code == TYPE_CODE_ARRAY
	70	\|\| code == TYPE_CODE_REF)))
c906108c SS	71	fputs_filtered (" ", stream);
	72	f_type_print_varspec_prefix (type, stream, show, 0);
	73
a7dfd010 MD	74	if (varstring != NULL)
	75	{
	76	fputs_filtered (varstring, stream);
c906108c	77
a7dfd010	78	/* For demangled function names, we have the arglist as part of the name,
0963b4bd	79	so don't print an additional pair of ()'s. */
c906108c	80
a7dfd010	81	demangled_args = varstring[strlen (varstring) - 1] == ')';
0311118f	82	f_type_print_varspec_suffix (type, stream, show, 0, demangled_args, 0);
a7dfd010	83	}
c906108c SS	84	}
	85
	86	/* Print any asterisks or open-parentheses needed before the
	87	variable name (to describe its type).
	88
	89	On outermost call, pass 0 for PASSED_A_PTR.
	90	On outermost call, SHOW > 0 means should ignore
	91	any typename for TYPE and show its details.
	92	SHOW is always zero on recursive calls. */
	93
	94	void
fba45db2 KB	95	f_type_print_varspec_prefix (struct type type, struct ui_file stream,
fba45db2 KB	96	int show, int passed_a_ptr)
c906108c SS	97	{
	98	if (type == 0)
	99	return;
	100
	101	if (TYPE_NAME (type) && show <= 0)
	102	return;
	103
	104	QUIT;
	105
	106	switch (TYPE_CODE (type))
	107	{
	108	case TYPE_CODE_PTR:
	109	f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1);
	110	break;
	111
	112	case TYPE_CODE_FUNC:
	113	f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
	114	if (passed_a_ptr)
	115	fprintf_filtered (stream, "(");
	116	break;
	117
	118	case TYPE_CODE_ARRAY:
	119	f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
	120	break;
	121
	122	case TYPE_CODE_UNDEF:
	123	case TYPE_CODE_STRUCT:
	124	case TYPE_CODE_UNION:
	125	case TYPE_CODE_ENUM:
	126	case TYPE_CODE_INT:
	127	case TYPE_CODE_FLT:
	128	case TYPE_CODE_VOID:
	129	case TYPE_CODE_ERROR:
	130	case TYPE_CODE_CHAR:
	131	case TYPE_CODE_BOOL:
	132	case TYPE_CODE_SET:
	133	case TYPE_CODE_RANGE:
	134	case TYPE_CODE_STRING:
	135	case TYPE_CODE_BITSTRING:
	136	case TYPE_CODE_METHOD:
c906108c SS	137	case TYPE_CODE_REF:
	138	case TYPE_CODE_COMPLEX:
	139	case TYPE_CODE_TYPEDEF:
	140	/* These types need no prefix. They are listed here so that
c5aa993b	141	gcc -Wall will reveal any types that haven't been handled. */
c906108c SS	142	break;
	143	}
	144	}
	145
c906108c SS	146	/* Print any array sizes, function arguments or close parentheses
	147	needed after the variable name (to describe its type).
	148	Args work like c_type_print_varspec_prefix. */
	149
	150	static void
fba45db2	151	f_type_print_varspec_suffix (struct type type, struct ui_file stream,
0311118f JK	152	int show, int passed_a_ptr, int demangled_args,
0311118f JK	153	int arrayprint_recurse_level)
c906108c SS	154	{
c906108c SS	155	int upper_bound, lower_bound;
9216103f	156
0311118f JK	157	/* No static variables are permitted as an error call may occur during
0311118f JK	158	execution of this function. */
c906108c SS	159
	160	if (type == 0)
	161	return;
	162
	163	if (TYPE_NAME (type) && show <= 0)
	164	return;
	165
	166	QUIT;
	167
	168	switch (TYPE_CODE (type))
	169	{
	170	case TYPE_CODE_ARRAY:
	171	arrayprint_recurse_level++;
	172
	173	if (arrayprint_recurse_level == 1)
c5aa993b	174	fprintf_filtered (stream, "(");
c906108c SS	175
c906108c SS	176	if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
0311118f JK	177	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
0311118f JK	178	arrayprint_recurse_level);
c906108c	179
d78df370 JK	180	lower_bound = f77_get_lowerbound (type);
	181	if (lower_bound != 1) /* Not the default. */
	182	fprintf_filtered (stream, "%d:", lower_bound);
c906108c SS	183
c906108c SS	184	/* Make sure that, if we have an assumed size array, we
0963b4bd	185	print out a warning and print the upperbound as ''. /
c906108c	186
d78df370	187	if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
c906108c	188	fprintf_filtered (stream, "*");
c5aa993b JM	189	else
c5aa993b JM	190	{
d78df370 JK	191	upper_bound = f77_get_upperbound (type);
d78df370 JK	192	fprintf_filtered (stream, "%d", upper_bound);
c5aa993b	193	}
c906108c SS	194
c906108c SS	195	if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
0311118f JK	196	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
0311118f JK	197	arrayprint_recurse_level);
c906108c SS	198	if (arrayprint_recurse_level == 1)
	199	fprintf_filtered (stream, ")");
	200	else
c5aa993b	201	fprintf_filtered (stream, ",");
c906108c SS	202	arrayprint_recurse_level--;
	203	break;
	204
	205	case TYPE_CODE_PTR:
	206	case TYPE_CODE_REF:
0311118f JK	207	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0,
0311118f JK	208	arrayprint_recurse_level);
c5aa993b	209	fprintf_filtered (stream, ")");
c906108c SS	210	break;
	211
	212	case TYPE_CODE_FUNC:
	213	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
0311118f	214	passed_a_ptr, 0, arrayprint_recurse_level);
c906108c SS	215	if (passed_a_ptr)
	216	fprintf_filtered (stream, ")");
	217
	218	fprintf_filtered (stream, "()");
	219	break;
	220
	221	case TYPE_CODE_UNDEF:
	222	case TYPE_CODE_STRUCT:
	223	case TYPE_CODE_UNION:
	224	case TYPE_CODE_ENUM:
	225	case TYPE_CODE_INT:
	226	case TYPE_CODE_FLT:
	227	case TYPE_CODE_VOID:
	228	case TYPE_CODE_ERROR:
	229	case TYPE_CODE_CHAR:
	230	case TYPE_CODE_BOOL:
	231	case TYPE_CODE_SET:
	232	case TYPE_CODE_RANGE:
	233	case TYPE_CODE_STRING:
	234	case TYPE_CODE_BITSTRING:
	235	case TYPE_CODE_METHOD:
c906108c SS	236	case TYPE_CODE_COMPLEX:
	237	case TYPE_CODE_TYPEDEF:
	238	/* These types do not need a suffix. They are listed so that
c5aa993b	239	gcc -Wall will report types that may not have been considered. */
c906108c SS	240	break;
	241	}
	242	}
	243
c906108c SS	244	/* Print the name of the type (or the ultimate pointer target,
	245	function value or array element), or the description of a
	246	structure or union.
	247
	248	SHOW nonzero means don't print this type as just its name;
	249	show its real definition even if it has a name.
	250	SHOW zero means print just typename or struct tag if there is one
	251	SHOW negative means abbreviate structure elements.
	252	SHOW is decremented for printing of structure elements.
	253
	254	LEVEL is the depth to indent by.
	255	We increase it for some recursive calls. */
	256
	257	void
fba45db2 KB	258	f_type_print_base (struct type type, struct ui_file stream, int show,
fba45db2 KB	259	int level)
c906108c	260	{
c906108c	261	int upper_bound;
2a5e440c WZ	262	int index;
2a5e440c WZ	263
c906108c SS	264	QUIT;
	265
	266	wrap_here (" ");
	267	if (type == NULL)
	268	{
	269	fputs_filtered ("<type unknown>", stream);
	270	return;
	271	}
	272
	273	/* When SHOW is zero or less, and there is a valid type name, then always
0963b4bd	274	just print the type name directly from the type. */
c906108c SS	275
	276	if ((show <= 0) && (TYPE_NAME (type) != NULL))
	277	{
c244f7a6	278	fputs_filtered (TYPE_NAME (type), stream);
c906108c SS	279	return;
	280	}
	281
	282	if (TYPE_CODE (type) != TYPE_CODE_TYPEDEF)
	283	CHECK_TYPEDEF (type);
	284
	285	switch (TYPE_CODE (type))
	286	{
	287	case TYPE_CODE_TYPEDEF:
	288	f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
	289	break;
	290
	291	case TYPE_CODE_ARRAY:
	292	case TYPE_CODE_FUNC:
	293	f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
	294	break;
	295
c5aa993b	296	case TYPE_CODE_PTR:
c906108c SS	297	fprintf_filtered (stream, "PTR TO -> ( ");
c906108c SS	298	f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
7e86466e RH	299	break;
	300
	301	case TYPE_CODE_REF:
	302	fprintf_filtered (stream, "REF TO -> ( ");
	303	f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
c906108c SS	304	break;
	305
	306	case TYPE_CODE_VOID:
2a5e440c	307	fprintfi_filtered (level, stream, "VOID");
c906108c SS	308	break;
	309
	310	case TYPE_CODE_UNDEF:
2a5e440c	311	fprintfi_filtered (level, stream, "struct <unknown>");
c906108c SS	312	break;
	313
	314	case TYPE_CODE_ERROR:
b00fdb78	315	fprintfi_filtered (level, stream, "%s", TYPE_ERROR_NAME (type));
c906108c SS	316	break;
	317
	318	case TYPE_CODE_RANGE:
0963b4bd	319	/* This should not occur. */
2a5e440c	320	fprintfi_filtered (level, stream, "<range type>");
c906108c SS	321	break;
	322
	323	case TYPE_CODE_CHAR:
0963b4bd	324	/* Override name "char" and make it "character". */
2a5e440c	325	fprintfi_filtered (level, stream, "character");
c906108c SS	326	break;
	327
	328	case TYPE_CODE_INT:
	329	/* There may be some character types that attempt to come
	330	through as TYPE_CODE_INT since dbxstclass.h is so
	331	C-oriented, we must change these to "character" from "char". */
	332
bde58177	333	if (strcmp (TYPE_NAME (type), "char") == 0)
2a5e440c	334	fprintfi_filtered (level, stream, "character");
c906108c SS	335	else
	336	goto default_case;
	337	break;
	338
c906108c	339	case TYPE_CODE_STRING:
0963b4bd	340	/* Strings may have dynamic upperbounds (lengths) like arrays. */
c906108c	341
d78df370	342	if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
2a5e440c	343	fprintfi_filtered (level, stream, "character()");
c906108c SS	344	else
c906108c SS	345	{
d78df370 JK	346	upper_bound = f77_get_upperbound (type);
d78df370 JK	347	fprintf_filtered (stream, "character*%d", upper_bound);
c906108c SS	348	}
	349	break;
	350
2a5e440c	351	case TYPE_CODE_STRUCT:
9eec4d1e MD	352	case TYPE_CODE_UNION:
	353	if (TYPE_CODE (type) == TYPE_CODE_UNION)
	354	fprintfi_filtered (level, stream, "Type, C_Union :: ");
	355	else
	356	fprintfi_filtered (level, stream, "Type ");
2a5e440c WZ	357	fputs_filtered (TYPE_TAG_NAME (type), stream);
	358	fputs_filtered ("\n", stream);
	359	for (index = 0; index < TYPE_NFIELDS (type); index++)
	360	{
9eec4d1e MD	361	f_type_print_base (TYPE_FIELD_TYPE (type, index), stream, show,
9eec4d1e MD	362	level + 4);
2a5e440c	363	fputs_filtered (" :: ", stream);
60023297	364	fputs_filtered (TYPE_FIELD_NAME (type, index), stream);
9eec4d1e	365	f_type_print_varspec_suffix (TYPE_FIELD_TYPE (type, index),
0311118f	366	stream, 0, 0, 0, 0);
2a5e440c WZ	367	fputs_filtered ("\n", stream);
	368	}
	369	fprintfi_filtered (level, stream, "End Type ");
	370	fputs_filtered (TYPE_TAG_NAME (type), stream);
	371	break;
	372
f55ee35c JK	373	case TYPE_CODE_MODULE:
	374	fprintfi_filtered (level, stream, "module %s", TYPE_TAG_NAME (type));
	375	break;
	376
c906108c SS	377	default_case:
	378	default:
	379	/* Handle types not explicitly handled by the other cases,
c5aa993b JM	380	such as fundamental types. For these, just print whatever
c5aa993b JM	381	the type name is, as recorded in the type itself. If there
0963b4bd	382	is no type name, then complain. */
c906108c	383	if (TYPE_NAME (type) != NULL)
848359ac	384	fprintfi_filtered (level, stream, "%s", TYPE_NAME (type));
c906108c	385	else
8a3fe4f8	386	error (_("Invalid type code (%d) in symbol table."), TYPE_CODE (type));
c906108c SS	387	break;
	388	}
	389	}