[binutils.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,
   2001, 2002
   Free Software Foundation, Inc.
   Contributed by Motorola.  Adapted from the C version by Farooq Butt
   ([email protected]).

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

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