[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 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, 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;
  int retcode;
  /* 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 retcode;
  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, "<unknown 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;

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