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

/* Support for printing Fortran types for GDB, the GNU debugger.
   Copyright 1986, 1988, 1989, 1991, 1993, 1994, 2000 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 2 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, write to the Free Software
   Foundation, Inc., 59 Temple Place - Suite 330,
   Boston, MA 02111-1307, USA.  */

#include "defs.h"
#include "obstack.h"
#include "bfd.h"
#include "symtab.h"
#include "gdbtypes.h"
#include "expression.h"
#include "value.h"
#include "gdbcore.h"
#include "target.h"
#include "command.h"
#include "gdbcmd.h"
#include "language.h"
#include "demangle.h"
#include "f-lang.h"
#include "typeprint.h"
#include "frame.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 (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)
{
  register 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_MEMBER
	|| 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_MEMBER:
    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;
    }
}

#if 0				/* Currently unused */

static void
f_type_print_args (struct type *type, struct ui_file *stream)
{
  int i;
  struct type **args;

  fprintf_filtered (stream, "(");
  args = TYPE_ARG_TYPES (type);
  if (args != NULL)
    {
      if (args[1] == NULL)
	{
	  fprintf_filtered (stream, "...");
	}
      else
	{
	  for (i = 1; args[i] != NULL && args[i]->code != TYPE_CODE_VOID; i++)
	    {
	      f_print_type (args[i], "", stream, -1, 0);
	      if (args[i + 1] == NULL)
		fprintf_filtered (stream, "...");
	      else if (args[i + 1]->code != TYPE_CODE_VOID)
		{
		  fprintf_filtered (stream, ",");
		  wrap_here ("    ");
		}
	    }
	}
    }
  fprintf_filtered (stream, ")");
}

#endif /* 0 */

/* 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_MEMBER:
    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 (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 */

  fprintf_filtered (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;

  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 (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_VOID:
      fprintf_filtered (stream, "VOID");
      break;

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

    case TYPE_CODE_ERROR:
      fprintf_filtered (stream, "<unknown type>");
      break;

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

    case TYPE_CODE_CHAR:
      /* Override name "char" and make it "character" */
      fprintf_filtered (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 (STREQ (TYPE_NAME (type), "char"))
	fprintf_filtered (stream, "character");
      else
	goto default_case;
      break;

    case TYPE_CODE_COMPLEX:
      fprintf_filtered (stream, "complex*%d", TYPE_LENGTH (type));
      break;

    case TYPE_CODE_FLT:
      print_equivalent_f77_float_type (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)
	fprintf_filtered (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;

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