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