[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 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 print_equivalent_f77_float_type (int level, struct type *,
					     struct ui_file *);

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

static void
print_equivalent_f77_float_type (int level, struct type *type,
				 struct ui_file *stream)
{
  /* Override type name "float" and make it the
     appropriate real. XLC stupidly outputs -12 as a type
     for real when it really should be outputting -18 */

  fprintfi_filtered (level, stream, "real*%d", TYPE_LENGTH (type));
}

/* 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))
    {
      if (TYPE_CODE (type) == TYPE_CODE_FLT)
	print_equivalent_f77_float_type (level, type, stream);
      else
	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_COMPLEX:
      fprintfi_filtered (level, stream, "complex*%d", TYPE_LENGTH (type));
      break;

    case TYPE_CODE_FLT:
      print_equivalent_f77_float_type (level, type, stream);
      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 DJ	3	Copyright (C) 1986, 1988, 1989, 1991, 1993, 1994, 1995, 1996, 1998, 2000,
6aba47ca DJ	4	2001, 2002, 2003, 2006, 2007 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
2a5e440c	42	static void print_equivalent_f77_float_type (int level, struct type *,
d9fcf2fb	43	struct ui_file *);
c906108c	44
d9fcf2fb JM	45	static void f_type_print_varspec_suffix (struct type , struct ui_file ,
d9fcf2fb JM	46	int, int, int);
c906108c	47
d9fcf2fb JM	48	void f_type_print_varspec_prefix (struct type , struct ui_file ,
d9fcf2fb JM	49	int, int);
c906108c	50
d9fcf2fb	51	void f_type_print_base (struct type , struct ui_file , int, int);
c906108c	52	\f
c5aa993b	53
c906108c SS	54	/* LEVEL is the depth to indent lines by. */
	55
	56	void
fba45db2 KB	57	f_print_type (struct type type, char varstring, struct ui_file *stream,
fba45db2 KB	58	int show, int level)
c906108c	59	{
52f0bd74	60	enum type_code code;
c906108c SS	61	int demangled_args;
	62
	63	f_type_print_base (type, stream, show, level);
	64	code = TYPE_CODE (type);
	65	if ((varstring != NULL && *varstring != '\0')
	66	\|\|
c5aa993b JM	67	/* Need a space if going to print stars or brackets;
c5aa993b JM	68	but not if we will print just a type name. */
c906108c SS	69	((show > 0 \|\| TYPE_NAME (type) == 0)
	70	&&
	71	(code == TYPE_CODE_PTR \|\| code == TYPE_CODE_FUNC
	72	\|\| code == TYPE_CODE_METHOD
	73	\|\| code == TYPE_CODE_ARRAY
c906108c SS	74	\|\| code == TYPE_CODE_REF)))
	75	fputs_filtered (" ", stream);
	76	f_type_print_varspec_prefix (type, stream, show, 0);
	77
	78	fputs_filtered (varstring, stream);
	79
	80	/* For demangled function names, we have the arglist as part of the name,
	81	so don't print an additional pair of ()'s */
	82
c5aa993b	83	demangled_args = varstring[strlen (varstring) - 1] == ')';
c906108c SS	84	f_type_print_varspec_suffix (type, stream, show, 0, demangled_args);
	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 KB	152	f_type_print_varspec_suffix (struct type type, struct ui_file stream,
fba45db2 KB	153	int show, int passed_a_ptr, int demangled_args)
c906108c SS	154	{
	155	int upper_bound, lower_bound;
	156	int lower_bound_was_default = 0;
	157	static int arrayprint_recurse_level = 0;
	158	int retcode;
	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
	176	if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
	177	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0);
	178
c5aa993b	179	retcode = f77_get_dynamic_lowerbound (type, &lower_bound);
c906108c SS	180
	181	lower_bound_was_default = 0;
	182
	183	if (retcode == BOUND_FETCH_ERROR)
c5aa993b JM	184	fprintf_filtered (stream, "???");
	185	else if (lower_bound == 1) /* The default */
	186	lower_bound_was_default = 1;
c906108c	187	else
c5aa993b	188	fprintf_filtered (stream, "%d", lower_bound);
c906108c SS	189
	190	if (lower_bound_was_default)
	191	lower_bound_was_default = 0;
	192	else
c5aa993b	193	fprintf_filtered (stream, ":");
c906108c SS	194
c906108c SS	195	/* Make sure that, if we have an assumed size array, we
c5aa993b	196	print out a warning and print the upperbound as '' /
c906108c	197
c5aa993b	198	if (TYPE_ARRAY_UPPER_BOUND_TYPE (type) == BOUND_CANNOT_BE_DETERMINED)
c906108c	199	fprintf_filtered (stream, "*");
c5aa993b JM	200	else
	201	{
	202	retcode = f77_get_dynamic_upperbound (type, &upper_bound);
c906108c	203
c5aa993b JM	204	if (retcode == BOUND_FETCH_ERROR)
	205	fprintf_filtered (stream, "???");
	206	else
	207	fprintf_filtered (stream, "%d", upper_bound);
	208	}
c906108c SS	209
	210	if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
	211	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0);
	212	if (arrayprint_recurse_level == 1)
	213	fprintf_filtered (stream, ")");
	214	else
c5aa993b	215	fprintf_filtered (stream, ",");
c906108c SS	216	arrayprint_recurse_level--;
	217	break;
	218
	219	case TYPE_CODE_PTR:
	220	case TYPE_CODE_REF:
	221	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0);
c5aa993b	222	fprintf_filtered (stream, ")");
c906108c SS	223	break;
	224
	225	case TYPE_CODE_FUNC:
	226	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
c5aa993b	227	passed_a_ptr, 0);
c906108c SS	228	if (passed_a_ptr)
	229	fprintf_filtered (stream, ")");
	230
	231	fprintf_filtered (stream, "()");
	232	break;
	233
	234	case TYPE_CODE_UNDEF:
	235	case TYPE_CODE_STRUCT:
	236	case TYPE_CODE_UNION:
	237	case TYPE_CODE_ENUM:
	238	case TYPE_CODE_INT:
	239	case TYPE_CODE_FLT:
	240	case TYPE_CODE_VOID:
	241	case TYPE_CODE_ERROR:
	242	case TYPE_CODE_CHAR:
	243	case TYPE_CODE_BOOL:
	244	case TYPE_CODE_SET:
	245	case TYPE_CODE_RANGE:
	246	case TYPE_CODE_STRING:
	247	case TYPE_CODE_BITSTRING:
	248	case TYPE_CODE_METHOD:
c906108c SS	249	case TYPE_CODE_COMPLEX:
	250	case TYPE_CODE_TYPEDEF:
	251	/* These types do not need a suffix. They are listed so that
c5aa993b	252	gcc -Wall will report types that may not have been considered. */
c906108c SS	253	break;
	254	}
	255	}
	256
	257	static void
2a5e440c WZ	258	print_equivalent_f77_float_type (int level, struct type *type,
2a5e440c WZ	259	struct ui_file *stream)
c906108c SS	260	{
	261	/* Override type name "float" and make it the
	262	appropriate real. XLC stupidly outputs -12 as a type
	263	for real when it really should be outputting -18 */
	264
2a5e440c	265	fprintfi_filtered (level, stream, "real*%d", TYPE_LENGTH (type));
c906108c SS	266	}
	267
	268	/* Print the name of the type (or the ultimate pointer target,
	269	function value or array element), or the description of a
	270	structure or union.
	271
	272	SHOW nonzero means don't print this type as just its name;
	273	show its real definition even if it has a name.
	274	SHOW zero means print just typename or struct tag if there is one
	275	SHOW negative means abbreviate structure elements.
	276	SHOW is decremented for printing of structure elements.
	277
	278	LEVEL is the depth to indent by.
	279	We increase it for some recursive calls. */
	280
	281	void
fba45db2 KB	282	f_type_print_base (struct type type, struct ui_file stream, int show,
fba45db2 KB	283	int level)
c906108c SS	284	{
	285	int retcode;
	286	int upper_bound;
	287
2a5e440c WZ	288	int index;
2a5e440c WZ	289
c906108c SS	290	QUIT;
	291
	292	wrap_here (" ");
	293	if (type == NULL)
	294	{
	295	fputs_filtered ("<type unknown>", stream);
	296	return;
	297	}
	298
	299	/* When SHOW is zero or less, and there is a valid type name, then always
	300	just print the type name directly from the type. */
	301
	302	if ((show <= 0) && (TYPE_NAME (type) != NULL))
	303	{
	304	if (TYPE_CODE (type) == TYPE_CODE_FLT)
2a5e440c	305	print_equivalent_f77_float_type (level, type, stream);
c906108c SS	306	else
	307	fputs_filtered (TYPE_NAME (type), stream);
	308	return;
	309	}
	310
	311	if (TYPE_CODE (type) != TYPE_CODE_TYPEDEF)
	312	CHECK_TYPEDEF (type);
	313
	314	switch (TYPE_CODE (type))
	315	{
	316	case TYPE_CODE_TYPEDEF:
	317	f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
	318	break;
	319
	320	case TYPE_CODE_ARRAY:
	321	case TYPE_CODE_FUNC:
	322	f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
	323	break;
	324
c5aa993b	325	case TYPE_CODE_PTR:
c906108c SS	326	fprintf_filtered (stream, "PTR TO -> ( ");
c906108c SS	327	f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
7e86466e RH	328	break;
	329
	330	case TYPE_CODE_REF:
	331	fprintf_filtered (stream, "REF TO -> ( ");
	332	f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
c906108c SS	333	break;
	334
	335	case TYPE_CODE_VOID:
2a5e440c	336	fprintfi_filtered (level, stream, "VOID");
c906108c SS	337	break;
	338
	339	case TYPE_CODE_UNDEF:
2a5e440c	340	fprintfi_filtered (level, stream, "struct <unknown>");
c906108c SS	341	break;
	342
	343	case TYPE_CODE_ERROR:
2a5e440c	344	fprintfi_filtered (level, stream, "<unknown type>");
c906108c SS	345	break;
	346
	347	case TYPE_CODE_RANGE:
	348	/* This should not occur */
2a5e440c	349	fprintfi_filtered (level, stream, "<range type>");
c906108c SS	350	break;
	351
	352	case TYPE_CODE_CHAR:
	353	/* Override name "char" and make it "character" */
2a5e440c	354	fprintfi_filtered (level, stream, "character");
c906108c SS	355	break;
	356
	357	case TYPE_CODE_INT:
	358	/* There may be some character types that attempt to come
	359	through as TYPE_CODE_INT since dbxstclass.h is so
	360	C-oriented, we must change these to "character" from "char". */
	361
bde58177	362	if (strcmp (TYPE_NAME (type), "char") == 0)
2a5e440c	363	fprintfi_filtered (level, stream, "character");
c906108c SS	364	else
	365	goto default_case;
	366	break;
	367
	368	case TYPE_CODE_COMPLEX:
2a5e440c	369	fprintfi_filtered (level, stream, "complex*%d", TYPE_LENGTH (type));
c906108c SS	370	break;
	371
	372	case TYPE_CODE_FLT:
2a5e440c	373	print_equivalent_f77_float_type (level, type, stream);
c906108c SS	374	break;
	375
	376	case TYPE_CODE_STRING:
	377	/* Strings may have dynamic upperbounds (lengths) like arrays. */
	378
	379	if (TYPE_ARRAY_UPPER_BOUND_TYPE (type) == BOUND_CANNOT_BE_DETERMINED)
2a5e440c	380	fprintfi_filtered (level, stream, "character()");
c906108c SS	381	else
	382	{
	383	retcode = f77_get_dynamic_upperbound (type, &upper_bound);
	384
	385	if (retcode == BOUND_FETCH_ERROR)
	386	fprintf_filtered (stream, "character*???");
	387	else
	388	fprintf_filtered (stream, "character*%d", upper_bound);
	389	}
	390	break;
	391
2a5e440c WZ	392	case TYPE_CODE_STRUCT:
	393	fprintfi_filtered (level, stream, "Type ");
	394	fputs_filtered (TYPE_TAG_NAME (type), stream);
	395	fputs_filtered ("\n", stream);
	396	for (index = 0; index < TYPE_NFIELDS (type); index++)
	397	{
	398	f_print_type (TYPE_FIELD_TYPE (type, index), "", stream, show, level + 4);
	399	fputs_filtered (" :: ", stream);
	400	fputs_filtered (TYPE_FIELD_NAME (type, index), stream);
	401	fputs_filtered ("\n", stream);
	402	}
	403	fprintfi_filtered (level, stream, "End Type ");
	404	fputs_filtered (TYPE_TAG_NAME (type), stream);
	405	break;
	406
c906108c SS	407	default_case:
	408	default:
	409	/* Handle types not explicitly handled by the other cases,
c5aa993b JM	410	such as fundamental types. For these, just print whatever
	411	the type name is, as recorded in the type itself. If there
	412	is no type name, then complain. */
c906108c	413	if (TYPE_NAME (type) != NULL)
848359ac	414	fprintfi_filtered (level, stream, "%s", TYPE_NAME (type));
c906108c	415	else
8a3fe4f8	416	error (_("Invalid type code (%d) in symbol table."), TYPE_CODE (type));
c906108c SS	417	break;
	418	}
	419	}