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

/* Support for printing Fortran types for GDB, the GNU debugger.

   Copyright (C) 1986-2016 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 "typeprint.h"

#if 0				/* Currently unused.  */
static void f_type_print_args (struct type *, struct ui_file *);
#endif

static void f_type_print_varspec_suffix (struct type *, struct ui_file *, int,
					 int, int, 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, const char *varstring, struct ui_file *stream,
	      int show, int level, const struct type_print_options *flags)
{
  enum type_code code;
  int demangled_args;

  if (type_not_associated (type))
    {
      val_print_not_associated (stream);
      return;
    }

  if (type_not_allocated (type))
    {
      val_print_not_allocated (stream);
      return;
    }

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

  if (varstring != NULL)
    {
      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, 0);
   }
}

/* 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_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 arrayprint_recurse_level)
{
  int upper_bound, lower_bound;

  /* No static variables are permitted as an error call may occur during
     execution of this function.  */

  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_not_associated (type))
        val_print_not_associated (stream);
      else if (type_not_allocated (type))
        val_print_not_allocated (stream);
      else
        {
          if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
            f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
                                        0, 0, arrayprint_recurse_level);

          lower_bound = f77_get_lowerbound (type);
          if (lower_bound != 1)	/* Not the default.  */
            fprintf_filtered (stream, "%d:", lower_bound);

          /* 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_IS_UNDEFINED (type))
            fprintf_filtered (stream, "*");
          else
            {
              upper_bound = f77_get_upperbound (type);
              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, arrayprint_recurse_level);
        }
      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,
				   arrayprint_recurse_level);
      fprintf_filtered (stream, ")");
      break;

    case TYPE_CODE_FUNC:
      f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
				   passed_a_ptr, 0, arrayprint_recurse_level);
      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_METHOD:
    case TYPE_CODE_COMPLEX:
    case TYPE_CODE_TYPEDEF:
      /* These types do not need a suffix.  They are listed so that
         gcc -Wall will report types that may not have been considered.  */
      break;
    }
}

/* Print the name of the type (or the ultimate pointer target,
   function value or array element), or the description of a
   structure or union.

   SHOW nonzero means don't print this type as just its name;
   show its real definition even if it has a name.
   SHOW zero means print just typename or struct tag if there is one
   SHOW negative means abbreviate structure elements.
   SHOW is decremented for printing of structure elements.

   LEVEL is the depth to indent by.
   We increase it for some recursive calls.  */

void
f_type_print_base (struct type *type, struct ui_file *stream, int show,
		   int level)
{
  int 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))
    {
      fprintfi_filtered (level, stream, "%s", TYPE_NAME (type));
      return;
    }

  if (TYPE_CODE (type) != TYPE_CODE_TYPEDEF)
    type = 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, "%s", TYPE_ERROR_NAME (type));
      break;

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

    case TYPE_CODE_CHAR:
    case TYPE_CODE_INT:
      /* There may be some character types that attempt to come
         through as TYPE_CODE_INT since dbxstclass.h is so
         C-oriented, we must change these to "character" from "char".  */

      if (strcmp (TYPE_NAME (type), "char") == 0)
	fprintfi_filtered (level, stream, "character");
      else
	goto default_case;
      break;

    case TYPE_CODE_STRING:
      /* Strings may have dynamic upperbounds (lengths) like arrays.  */

      if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
	fprintfi_filtered (level, stream, "character*(*)");
      else
	{
	  upper_bound = f77_get_upperbound (type);
	  fprintf_filtered (stream, "character*%d", upper_bound);
	}
      break;

    case TYPE_CODE_STRUCT:
    case TYPE_CODE_UNION:
      if (TYPE_CODE (type) == TYPE_CODE_UNION)
	fprintfi_filtered (level, stream, "Type, C_Union :: ");
      else
	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_type_print_base (TYPE_FIELD_TYPE (type, index), stream, show,
			     level + 4);
	  fputs_filtered (" :: ", stream);
	  fputs_filtered (TYPE_FIELD_NAME (type, index), stream);
	  f_type_print_varspec_suffix (TYPE_FIELD_TYPE (type, index),
				       stream, 0, 0, 0, 0);
	  fputs_filtered ("\n", stream);
	} 
      fprintfi_filtered (level, stream, "End Type ");
      fputs_filtered (TYPE_TAG_NAME (type), stream);
      break;

    case TYPE_CODE_MODULE:
      fprintfi_filtered (level, stream, "module %s", TYPE_TAG_NAME (type));
      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
618f726f	3	Copyright (C) 1986-2016 Free Software Foundation, Inc.
1bac305b	4
c906108c SS	5	Contributed by Motorola. Adapted from the C version by Farooq Butt
	6	(fmbutt@engage.sps.mot.com).
	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
c5aa993b JM	11	it under the terms of the GNU General Public License as published by
a9762ec7	12	the Free Software Foundation; either version 3 of the License, or
c5aa993b	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	20	You should have received a copy of the GNU General Public License
a9762ec7	21	along with this program. If not, see <http://www.gnu.org/licenses/>. */
c906108c SS	22
c906108c SS	23	#include "defs.h"
04ea0df1	24	#include "gdb_obstack.h"
c906108c SS	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"
c906108c	32	#include "f-lang.h"
3f2f83dd	33	#include "typeprint.h"
c906108c	34
0963b4bd	35	#if 0 /* Currently unused. */
d9fcf2fb	36	static void f_type_print_args (struct type , struct ui_file );
c906108c SS	37	#endif
c906108c SS	38
0311118f	39	static void f_type_print_varspec_suffix (struct type , struct ui_file , int,
d9fcf2fb	40	int, int, int);
c906108c	41
d9fcf2fb JM	42	void f_type_print_varspec_prefix (struct type , struct ui_file ,
d9fcf2fb JM	43	int, int);
c906108c	44
d9fcf2fb	45	void f_type_print_base (struct type , struct ui_file , int, int);
c906108c	46	\f
c5aa993b	47
c906108c SS	48	/* LEVEL is the depth to indent lines by. */
	49
	50	void
25b524e8	51	f_print_type (struct type type, const char varstring, struct ui_file *stream,
79d43c61	52	int show, int level, const struct type_print_options *flags)
c906108c	53	{
52f0bd74	54	enum type_code code;
c906108c SS	55	int demangled_args;
c906108c SS	56
3f2f83dd KB	57	if (type_not_associated (type))
	58	{
	59	val_print_not_associated (stream);
	60	return;
	61	}
	62
	63	if (type_not_allocated (type))
	64	{
	65	val_print_not_allocated (stream);
	66	return;
	67	}
	68
c906108c SS	69	f_type_print_base (type, stream, show, level);
	70	code = TYPE_CODE (type);
	71	if ((varstring != NULL && *varstring != '\0')
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. */
905e0470 PM	74	\|\| ((show > 0 \|\| TYPE_NAME (type) == 0)
	75	&& (code == TYPE_CODE_PTR \|\| code == TYPE_CODE_FUNC
	76	\|\| code == TYPE_CODE_METHOD
	77	\|\| code == TYPE_CODE_ARRAY
	78	\|\| code == TYPE_CODE_REF)))
c906108c SS	79	fputs_filtered (" ", stream);
	80	f_type_print_varspec_prefix (type, stream, show, 0);
	81
a7dfd010 MD	82	if (varstring != NULL)
	83	{
	84	fputs_filtered (varstring, stream);
c906108c	85
a7dfd010	86	/* For demangled function names, we have the arglist as part of the name,
0963b4bd	87	so don't print an additional pair of ()'s. */
c906108c	88
a7dfd010	89	demangled_args = varstring[strlen (varstring) - 1] == ')';
0311118f	90	f_type_print_varspec_suffix (type, stream, show, 0, demangled_args, 0);
a7dfd010	91	}
c906108c SS	92	}
	93
	94	/* Print any asterisks or open-parentheses needed before the
	95	variable name (to describe its type).
	96
	97	On outermost call, pass 0 for PASSED_A_PTR.
	98	On outermost call, SHOW > 0 means should ignore
	99	any typename for TYPE and show its details.
	100	SHOW is always zero on recursive calls. */
	101
	102	void
fba45db2 KB	103	f_type_print_varspec_prefix (struct type type, struct ui_file stream,
fba45db2 KB	104	int show, int passed_a_ptr)
c906108c SS	105	{
	106	if (type == 0)
	107	return;
	108
	109	if (TYPE_NAME (type) && show <= 0)
	110	return;
	111
	112	QUIT;
	113
	114	switch (TYPE_CODE (type))
	115	{
	116	case TYPE_CODE_PTR:
	117	f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1);
	118	break;
	119
	120	case TYPE_CODE_FUNC:
	121	f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
	122	if (passed_a_ptr)
	123	fprintf_filtered (stream, "(");
	124	break;
	125
	126	case TYPE_CODE_ARRAY:
	127	f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
	128	break;
	129
	130	case TYPE_CODE_UNDEF:
	131	case TYPE_CODE_STRUCT:
	132	case TYPE_CODE_UNION:
	133	case TYPE_CODE_ENUM:
	134	case TYPE_CODE_INT:
	135	case TYPE_CODE_FLT:
	136	case TYPE_CODE_VOID:
	137	case TYPE_CODE_ERROR:
	138	case TYPE_CODE_CHAR:
	139	case TYPE_CODE_BOOL:
	140	case TYPE_CODE_SET:
	141	case TYPE_CODE_RANGE:
	142	case TYPE_CODE_STRING:
c906108c	143	case TYPE_CODE_METHOD:
c906108c SS	144	case TYPE_CODE_REF:
	145	case TYPE_CODE_COMPLEX:
	146	case TYPE_CODE_TYPEDEF:
	147	/* These types need no prefix. They are listed here so that
c5aa993b	148	gcc -Wall will reveal any types that haven't been handled. */
c906108c SS	149	break;
	150	}
	151	}
	152
c906108c SS	153	/* Print any array sizes, function arguments or close parentheses
	154	needed after the variable name (to describe its type).
	155	Args work like c_type_print_varspec_prefix. */
	156
	157	static void
fba45db2	158	f_type_print_varspec_suffix (struct type type, struct ui_file stream,
0311118f JK	159	int show, int passed_a_ptr, int demangled_args,
0311118f JK	160	int arrayprint_recurse_level)
c906108c SS	161	{
c906108c SS	162	int upper_bound, lower_bound;
9216103f	163
0311118f JK	164	/* No static variables are permitted as an error call may occur during
0311118f JK	165	execution of this function. */
c906108c SS	166
	167	if (type == 0)
	168	return;
	169
	170	if (TYPE_NAME (type) && show <= 0)
	171	return;
	172
	173	QUIT;
	174
	175	switch (TYPE_CODE (type))
	176	{
	177	case TYPE_CODE_ARRAY:
	178	arrayprint_recurse_level++;
	179
	180	if (arrayprint_recurse_level == 1)
c5aa993b	181	fprintf_filtered (stream, "(");
c906108c	182
3f2f83dd KB	183	if (type_not_associated (type))
	184	val_print_not_associated (stream);
	185	else if (type_not_allocated (type))
	186	val_print_not_allocated (stream);
c5aa993b	187	else
3f2f83dd KB	188	{
	189	if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
	190	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
	191	0, 0, arrayprint_recurse_level);
	192
	193	lower_bound = f77_get_lowerbound (type);
	194	if (lower_bound != 1) /* Not the default. */
	195	fprintf_filtered (stream, "%d:", lower_bound);
	196
	197	/* Make sure that, if we have an assumed size array, we
	198	print out a warning and print the upperbound as ''. /
	199
	200	if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
	201	fprintf_filtered (stream, "*");
	202	else
	203	{
	204	upper_bound = f77_get_upperbound (type);
	205	fprintf_filtered (stream, "%d", upper_bound);
	206	}
	207
	208	if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
	209	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
	210	0, 0, arrayprint_recurse_level);
	211	}
c906108c SS	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:
0311118f JK	221	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0,
0311118f JK	222	arrayprint_recurse_level);
c5aa993b	223	fprintf_filtered (stream, ")");
c906108c SS	224	break;
	225
	226	case TYPE_CODE_FUNC:
	227	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
0311118f	228	passed_a_ptr, 0, arrayprint_recurse_level);
c906108c SS	229	if (passed_a_ptr)
	230	fprintf_filtered (stream, ")");
	231
	232	fprintf_filtered (stream, "()");
	233	break;
	234
	235	case TYPE_CODE_UNDEF:
	236	case TYPE_CODE_STRUCT:
	237	case TYPE_CODE_UNION:
	238	case TYPE_CODE_ENUM:
	239	case TYPE_CODE_INT:
	240	case TYPE_CODE_FLT:
	241	case TYPE_CODE_VOID:
	242	case TYPE_CODE_ERROR:
	243	case TYPE_CODE_CHAR:
	244	case TYPE_CODE_BOOL:
	245	case TYPE_CODE_SET:
	246	case TYPE_CODE_RANGE:
	247	case TYPE_CODE_STRING:
c906108c	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
c906108c SS	257	/* Print the name of the type (or the ultimate pointer target,
	258	function value or array element), or the description of a
	259	structure or union.
	260
	261	SHOW nonzero means don't print this type as just its name;
	262	show its real definition even if it has a name.
	263	SHOW zero means print just typename or struct tag if there is one
	264	SHOW negative means abbreviate structure elements.
	265	SHOW is decremented for printing of structure elements.
	266
	267	LEVEL is the depth to indent by.
	268	We increase it for some recursive calls. */
	269
	270	void
fba45db2 KB	271	f_type_print_base (struct type type, struct ui_file stream, int show,
fba45db2 KB	272	int level)
c906108c	273	{
c906108c	274	int upper_bound;
2a5e440c WZ	275	int index;
2a5e440c WZ	276
c906108c SS	277	QUIT;
	278
	279	wrap_here (" ");
	280	if (type == NULL)
	281	{
	282	fputs_filtered ("<type unknown>", stream);
	283	return;
	284	}
	285
	286	/* When SHOW is zero or less, and there is a valid type name, then always
0963b4bd	287	just print the type name directly from the type. */
c906108c SS	288
	289	if ((show <= 0) && (TYPE_NAME (type) != NULL))
	290	{
72b17055	291	fprintfi_filtered (level, stream, "%s", TYPE_NAME (type));
c906108c SS	292	return;
	293	}
	294
	295	if (TYPE_CODE (type) != TYPE_CODE_TYPEDEF)
f168693b	296	type = check_typedef (type);
c906108c SS	297
	298	switch (TYPE_CODE (type))
	299	{
	300	case TYPE_CODE_TYPEDEF:
	301	f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
	302	break;
	303
	304	case TYPE_CODE_ARRAY:
	305	case TYPE_CODE_FUNC:
	306	f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
	307	break;
	308
c5aa993b	309	case TYPE_CODE_PTR:
c906108c SS	310	fprintf_filtered (stream, "PTR TO -> ( ");
c906108c SS	311	f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
7e86466e RH	312	break;
	313
	314	case TYPE_CODE_REF:
	315	fprintf_filtered (stream, "REF TO -> ( ");
	316	f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
c906108c SS	317	break;
	318
	319	case TYPE_CODE_VOID:
2a5e440c	320	fprintfi_filtered (level, stream, "VOID");
c906108c SS	321	break;
	322
	323	case TYPE_CODE_UNDEF:
2a5e440c	324	fprintfi_filtered (level, stream, "struct <unknown>");
c906108c SS	325	break;
	326
	327	case TYPE_CODE_ERROR:
b00fdb78	328	fprintfi_filtered (level, stream, "%s", TYPE_ERROR_NAME (type));
c906108c SS	329	break;
	330
	331	case TYPE_CODE_RANGE:
0963b4bd	332	/* This should not occur. */
2a5e440c	333	fprintfi_filtered (level, stream, "<range type>");
c906108c SS	334	break;
	335
	336	case TYPE_CODE_CHAR:
c906108c SS	337	case TYPE_CODE_INT:
	338	/* There may be some character types that attempt to come
	339	through as TYPE_CODE_INT since dbxstclass.h is so
	340	C-oriented, we must change these to "character" from "char". */
	341
bde58177	342	if (strcmp (TYPE_NAME (type), "char") == 0)
2a5e440c	343	fprintfi_filtered (level, stream, "character");
c906108c SS	344	else
	345	goto default_case;
	346	break;
	347
c906108c	348	case TYPE_CODE_STRING:
0963b4bd	349	/* Strings may have dynamic upperbounds (lengths) like arrays. */
c906108c	350
d78df370	351	if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
2a5e440c	352	fprintfi_filtered (level, stream, "character()");
c906108c SS	353	else
c906108c SS	354	{
d78df370 JK	355	upper_bound = f77_get_upperbound (type);
d78df370 JK	356	fprintf_filtered (stream, "character*%d", upper_bound);
c906108c SS	357	}
	358	break;
	359
2a5e440c	360	case TYPE_CODE_STRUCT:
9eec4d1e MD	361	case TYPE_CODE_UNION:
	362	if (TYPE_CODE (type) == TYPE_CODE_UNION)
	363	fprintfi_filtered (level, stream, "Type, C_Union :: ");
	364	else
	365	fprintfi_filtered (level, stream, "Type ");
2a5e440c WZ	366	fputs_filtered (TYPE_TAG_NAME (type), stream);
	367	fputs_filtered ("\n", stream);
	368	for (index = 0; index < TYPE_NFIELDS (type); index++)
	369	{
9eec4d1e MD	370	f_type_print_base (TYPE_FIELD_TYPE (type, index), stream, show,
9eec4d1e MD	371	level + 4);
2a5e440c	372	fputs_filtered (" :: ", stream);
60023297	373	fputs_filtered (TYPE_FIELD_NAME (type, index), stream);
9eec4d1e	374	f_type_print_varspec_suffix (TYPE_FIELD_TYPE (type, index),
0311118f	375	stream, 0, 0, 0, 0);
2a5e440c WZ	376	fputs_filtered ("\n", stream);
	377	}
	378	fprintfi_filtered (level, stream, "End Type ");
	379	fputs_filtered (TYPE_TAG_NAME (type), stream);
	380	break;
	381
f55ee35c JK	382	case TYPE_CODE_MODULE:
	383	fprintfi_filtered (level, stream, "module %s", TYPE_TAG_NAME (type));
	384	break;
	385
c906108c SS	386	default_case:
	387	default:
	388	/* Handle types not explicitly handled by the other cases,
c5aa993b JM	389	such as fundamental types. For these, just print whatever
c5aa993b JM	390	the type name is, as recorded in the type itself. If there
0963b4bd	391	is no type name, then complain. */
c906108c	392	if (TYPE_NAME (type) != NULL)
848359ac	393	fprintfi_filtered (level, stream, "%s", TYPE_NAME (type));
c906108c	394	else
8a3fe4f8	395	error (_("Invalid type code (%d) in symbol table."), TYPE_CODE (type));
c906108c SS	396	break;
	397	}
	398	}