[deliverable/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')
c5aa993b JM	63	/* Need a space if going to print stars or brackets;
c5aa993b JM	64	but not if we will print just a type name. */
905e0470 PM	65	\|\| ((show > 0 \|\| TYPE_NAME (type) == 0)
	66	&& (code == TYPE_CODE_PTR \|\| code == TYPE_CODE_FUNC
	67	\|\| code == TYPE_CODE_METHOD
	68	\|\| code == TYPE_CODE_ARRAY
	69	\|\| code == TYPE_CODE_REF)))
c906108c SS	70	fputs_filtered (" ", stream);
	71	f_type_print_varspec_prefix (type, stream, show, 0);
	72
a7dfd010 MD	73	if (varstring != NULL)
	74	{
	75	fputs_filtered (varstring, stream);
c906108c	76
a7dfd010 MD	77	/* For demangled function names, we have the arglist as part of the name,
a7dfd010 MD	78	so don't print an additional pair of ()'s */
c906108c	79
a7dfd010	80	demangled_args = varstring[strlen (varstring) - 1] == ')';
0311118f	81	f_type_print_varspec_suffix (type, stream, show, 0, demangled_args, 0);
a7dfd010	82	}
c906108c SS	83	}
	84
	85	/* Print any asterisks or open-parentheses needed before the
	86	variable name (to describe its type).
	87
	88	On outermost call, pass 0 for PASSED_A_PTR.
	89	On outermost call, SHOW > 0 means should ignore
	90	any typename for TYPE and show its details.
	91	SHOW is always zero on recursive calls. */
	92
	93	void
fba45db2 KB	94	f_type_print_varspec_prefix (struct type type, struct ui_file stream,
fba45db2 KB	95	int show, int passed_a_ptr)
c906108c SS	96	{
	97	if (type == 0)
	98	return;
	99
	100	if (TYPE_NAME (type) && show <= 0)
	101	return;
	102
	103	QUIT;
	104
	105	switch (TYPE_CODE (type))
	106	{
	107	case TYPE_CODE_PTR:
	108	f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1);
	109	break;
	110
	111	case TYPE_CODE_FUNC:
	112	f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
	113	if (passed_a_ptr)
	114	fprintf_filtered (stream, "(");
	115	break;
	116
	117	case TYPE_CODE_ARRAY:
	118	f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
	119	break;
	120
	121	case TYPE_CODE_UNDEF:
	122	case TYPE_CODE_STRUCT:
	123	case TYPE_CODE_UNION:
	124	case TYPE_CODE_ENUM:
	125	case TYPE_CODE_INT:
	126	case TYPE_CODE_FLT:
	127	case TYPE_CODE_VOID:
	128	case TYPE_CODE_ERROR:
	129	case TYPE_CODE_CHAR:
	130	case TYPE_CODE_BOOL:
	131	case TYPE_CODE_SET:
	132	case TYPE_CODE_RANGE:
	133	case TYPE_CODE_STRING:
	134	case TYPE_CODE_BITSTRING:
	135	case TYPE_CODE_METHOD:
c906108c SS	136	case TYPE_CODE_REF:
	137	case TYPE_CODE_COMPLEX:
	138	case TYPE_CODE_TYPEDEF:
	139	/* These types need no prefix. They are listed here so that
c5aa993b	140	gcc -Wall will reveal any types that haven't been handled. */
c906108c SS	141	break;
	142	}
	143	}
	144
c906108c SS	145	/* Print any array sizes, function arguments or close parentheses
	146	needed after the variable name (to describe its type).
	147	Args work like c_type_print_varspec_prefix. */
	148
	149	static void
fba45db2	150	f_type_print_varspec_suffix (struct type type, struct ui_file stream,
0311118f JK	151	int show, int passed_a_ptr, int demangled_args,
0311118f JK	152	int arrayprint_recurse_level)
c906108c SS	153	{
c906108c SS	154	int upper_bound, lower_bound;
c906108c	155	int retcode;
0311118f JK	156	/* No static variables are permitted as an error call may occur during
0311118f JK	157	execution of this function. */
c906108c SS	158
	159	if (type == 0)
	160	return;
	161
	162	if (TYPE_NAME (type) && show <= 0)
	163	return;
	164
	165	QUIT;
	166
	167	switch (TYPE_CODE (type))
	168	{
	169	case TYPE_CODE_ARRAY:
	170	arrayprint_recurse_level++;
	171
	172	if (arrayprint_recurse_level == 1)
c5aa993b	173	fprintf_filtered (stream, "(");
c906108c SS	174
c906108c SS	175	if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
0311118f JK	176	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
0311118f JK	177	arrayprint_recurse_level);
c906108c	178
d78df370 JK	179	lower_bound = f77_get_lowerbound (type);
	180	if (lower_bound != 1) /* Not the default. */
	181	fprintf_filtered (stream, "%d:", lower_bound);
c906108c SS	182
c906108c SS	183	/* Make sure that, if we have an assumed size array, we
c5aa993b	184	print out a warning and print the upperbound as '' /
c906108c	185
d78df370	186	if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
c906108c	187	fprintf_filtered (stream, "*");
c5aa993b JM	188	else
c5aa993b JM	189	{
d78df370 JK	190	upper_bound = f77_get_upperbound (type);
d78df370 JK	191	fprintf_filtered (stream, "%d", upper_bound);
c5aa993b	192	}
c906108c SS	193
c906108c SS	194	if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
0311118f JK	195	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
0311118f JK	196	arrayprint_recurse_level);
c906108c SS	197	if (arrayprint_recurse_level == 1)
	198	fprintf_filtered (stream, ")");
	199	else
c5aa993b	200	fprintf_filtered (stream, ",");
c906108c SS	201	arrayprint_recurse_level--;
	202	break;
	203
	204	case TYPE_CODE_PTR:
	205	case TYPE_CODE_REF:
0311118f JK	206	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0,
0311118f JK	207	arrayprint_recurse_level);
c5aa993b	208	fprintf_filtered (stream, ")");
c906108c SS	209	break;
	210
	211	case TYPE_CODE_FUNC:
	212	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
0311118f	213	passed_a_ptr, 0, arrayprint_recurse_level);
c906108c SS	214	if (passed_a_ptr)
	215	fprintf_filtered (stream, ")");
	216
	217	fprintf_filtered (stream, "()");
	218	break;
	219
	220	case TYPE_CODE_UNDEF:
	221	case TYPE_CODE_STRUCT:
	222	case TYPE_CODE_UNION:
	223	case TYPE_CODE_ENUM:
	224	case TYPE_CODE_INT:
	225	case TYPE_CODE_FLT:
	226	case TYPE_CODE_VOID:
	227	case TYPE_CODE_ERROR:
	228	case TYPE_CODE_CHAR:
	229	case TYPE_CODE_BOOL:
	230	case TYPE_CODE_SET:
	231	case TYPE_CODE_RANGE:
	232	case TYPE_CODE_STRING:
	233	case TYPE_CODE_BITSTRING:
	234	case TYPE_CODE_METHOD:
c906108c SS	235	case TYPE_CODE_COMPLEX:
	236	case TYPE_CODE_TYPEDEF:
	237	/* These types do not need a suffix. They are listed so that
c5aa993b	238	gcc -Wall will report types that may not have been considered. */
c906108c SS	239	break;
	240	}
	241	}
	242
c906108c SS	243	/* Print the name of the type (or the ultimate pointer target,
	244	function value or array element), or the description of a
	245	structure or union.
	246
	247	SHOW nonzero means don't print this type as just its name;
	248	show its real definition even if it has a name.
	249	SHOW zero means print just typename or struct tag if there is one
	250	SHOW negative means abbreviate structure elements.
	251	SHOW is decremented for printing of structure elements.
	252
	253	LEVEL is the depth to indent by.
	254	We increase it for some recursive calls. */
	255
	256	void
fba45db2 KB	257	f_type_print_base (struct type type, struct ui_file stream, int show,
fba45db2 KB	258	int level)
c906108c SS	259	{
	260	int retcode;
	261	int upper_bound;
	262
2a5e440c WZ	263	int index;
2a5e440c WZ	264
c906108c SS	265	QUIT;
	266
	267	wrap_here (" ");
	268	if (type == NULL)
	269	{
	270	fputs_filtered ("<type unknown>", stream);
	271	return;
	272	}
	273
	274	/* When SHOW is zero or less, and there is a valid type name, then always
	275	just print the type name directly from the type. */
	276
	277	if ((show <= 0) && (TYPE_NAME (type) != NULL))
	278	{
c244f7a6	279	fputs_filtered (TYPE_NAME (type), stream);
c906108c SS	280	return;
	281	}
	282
	283	if (TYPE_CODE (type) != TYPE_CODE_TYPEDEF)
	284	CHECK_TYPEDEF (type);
	285
	286	switch (TYPE_CODE (type))
	287	{
	288	case TYPE_CODE_TYPEDEF:
	289	f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
	290	break;
	291
	292	case TYPE_CODE_ARRAY:
	293	case TYPE_CODE_FUNC:
	294	f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
	295	break;
	296
c5aa993b	297	case TYPE_CODE_PTR:
c906108c SS	298	fprintf_filtered (stream, "PTR TO -> ( ");
c906108c SS	299	f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
7e86466e RH	300	break;
	301
	302	case TYPE_CODE_REF:
	303	fprintf_filtered (stream, "REF TO -> ( ");
	304	f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
c906108c SS	305	break;
	306
	307	case TYPE_CODE_VOID:
2a5e440c	308	fprintfi_filtered (level, stream, "VOID");
c906108c SS	309	break;
	310
	311	case TYPE_CODE_UNDEF:
2a5e440c	312	fprintfi_filtered (level, stream, "struct <unknown>");
c906108c SS	313	break;
	314
	315	case TYPE_CODE_ERROR:
2a5e440c	316	fprintfi_filtered (level, stream, "<unknown type>");
c906108c SS	317	break;
	318
	319	case TYPE_CODE_RANGE:
	320	/* This should not occur */
2a5e440c	321	fprintfi_filtered (level, stream, "<range type>");
c906108c SS	322	break;
	323
	324	case TYPE_CODE_CHAR:
	325	/* Override name "char" and make it "character" */
2a5e440c	326	fprintfi_filtered (level, stream, "character");
c906108c SS	327	break;
	328
	329	case TYPE_CODE_INT:
	330	/* There may be some character types that attempt to come
	331	through as TYPE_CODE_INT since dbxstclass.h is so
	332	C-oriented, we must change these to "character" from "char". */
	333
bde58177	334	if (strcmp (TYPE_NAME (type), "char") == 0)
2a5e440c	335	fprintfi_filtered (level, stream, "character");
c906108c SS	336	else
	337	goto default_case;
	338	break;
	339
c906108c SS	340	case TYPE_CODE_STRING:
	341	/* Strings may have dynamic upperbounds (lengths) like arrays. */
	342
d78df370	343	if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
2a5e440c	344	fprintfi_filtered (level, stream, "character()");
c906108c SS	345	else
c906108c SS	346	{
d78df370 JK	347	upper_bound = f77_get_upperbound (type);
d78df370 JK	348	fprintf_filtered (stream, "character*%d", upper_bound);
c906108c SS	349	}
	350	break;
	351
2a5e440c	352	case TYPE_CODE_STRUCT:
9eec4d1e MD	353	case TYPE_CODE_UNION:
	354	if (TYPE_CODE (type) == TYPE_CODE_UNION)
	355	fprintfi_filtered (level, stream, "Type, C_Union :: ");
	356	else
	357	fprintfi_filtered (level, stream, "Type ");
2a5e440c WZ	358	fputs_filtered (TYPE_TAG_NAME (type), stream);
	359	fputs_filtered ("\n", stream);
	360	for (index = 0; index < TYPE_NFIELDS (type); index++)
	361	{
9eec4d1e MD	362	f_type_print_base (TYPE_FIELD_TYPE (type, index), stream, show,
9eec4d1e MD	363	level + 4);
2a5e440c	364	fputs_filtered (" :: ", stream);
60023297	365	fputs_filtered (TYPE_FIELD_NAME (type, index), stream);
9eec4d1e	366	f_type_print_varspec_suffix (TYPE_FIELD_TYPE (type, index),
0311118f	367	stream, 0, 0, 0, 0);
2a5e440c WZ	368	fputs_filtered ("\n", stream);
	369	}
	370	fprintfi_filtered (level, stream, "End Type ");
	371	fputs_filtered (TYPE_TAG_NAME (type), stream);
	372	break;
	373
c906108c SS	374	default_case:
	375	default:
	376	/* Handle types not explicitly handled by the other cases,
c5aa993b JM	377	such as fundamental types. For these, just print whatever
	378	the type name is, as recorded in the type itself. If there
	379	is no type name, then complain. */
c906108c	380	if (TYPE_NAME (type) != NULL)
848359ac	381	fprintfi_filtered (level, stream, "%s", TYPE_NAME (type));
c906108c	382	else
8a3fe4f8	383	error (_("Invalid type code (%d) in symbol table."), TYPE_CODE (type));
c906108c SS	384	break;
	385	}
	386	}