[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 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);

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);

  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);
}

/* 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 upper_bound, lower_bound;
  int lower_bound_was_default = 0;
  static int arrayprint_recurse_level = 0;
  int retcode;

  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);

      retcode = f77_get_dynamic_lowerbound (type, &lower_bound);

      lower_bound_was_default = 0;

      if (retcode == BOUND_FETCH_ERROR)
	fprintf_filtered (stream, "???");
      else if (lower_bound == 1)	/* The default */
	lower_bound_was_default = 1;
      else
	fprintf_filtered (stream, "%d", lower_bound);

      if (lower_bound_was_default)
	lower_bound_was_default = 0;
      else
	fprintf_filtered (stream, ":");

      /* 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_TYPE (type) == BOUND_CANNOT_BE_DETERMINED)
	fprintf_filtered (stream, "*");
      else
	{
	  retcode = f77_get_dynamic_upperbound (type, &upper_bound);

	  if (retcode == BOUND_FETCH_ERROR)
	    fprintf_filtered (stream, "???");
	  else
	    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);
      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);
      fprintf_filtered (stream, ")");
      break;

    case TYPE_CODE_FUNC:
      f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
				   passed_a_ptr, 0);
      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_TYPE (type) == BOUND_CANNOT_BE_DETERMINED)
	fprintfi_filtered (level, stream, "character*(*)");
      else
	{
	  retcode = f77_get_dynamic_upperbound (type, &upper_bound);

	  if (retcode == BOUND_FETCH_ERROR)
	    fprintf_filtered (stream, "character*???");
	  else
	    fprintf_filtered (stream, "character*%d", upper_bound);
	}
      break;

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