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

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

   Copyright (C) 1986-2019 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;

  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)
    {
      int demangled_args;

      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 != '\0'
			&& 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)
{
  /* 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);

          LONGEST lower_bound = f77_get_lowerbound (type);

          if (lower_bound != 1)	/* Not the default.  */
            fprintf_filtered (stream, "%s:", plongest (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
            {
              LONGEST upper_bound = f77_get_upperbound (type);

              fputs_filtered (plongest (upper_bound), stream);
            }

          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 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))
    {
      const char *prefix = "";
      if (TYPE_CODE (type) == TYPE_CODE_UNION)
	prefix = "Type, C_Union :: ";
      else if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
	prefix = "Type ";
      fprintfi_filtered (level, stream, "%s%s", prefix, 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:
      f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
      break;
    case TYPE_CODE_FUNC:
      if (TYPE_TARGET_TYPE (type) == NULL)
	type_print_unknown_return_type (stream);
      else
	f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
      break;

    case TYPE_CODE_PTR:
      fprintfi_filtered (level, stream, "PTR TO -> ( ");
      f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0);
      break;

    case TYPE_CODE_REF:
      fprintfi_filtered (level, stream, "REF TO -> ( ");
      f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0);
      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
	{
	  LONGEST upper_bound = f77_get_upperbound (type);

	  fprintf_filtered (stream, "character*%s", pulongest (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_NAME (type), stream);
      /* According to the definition,
         we only print structure elements in case show > 0.  */
      if (show > 0)
	{
	  fputs_filtered ("\n", stream);
	  for (index = 0; index < TYPE_NFIELDS (type); index++)
	    {
	      f_type_print_base (TYPE_FIELD_TYPE (type, index), stream,
				 show - 1, level + 4);
	      fputs_filtered (" :: ", stream);
	      fputs_filtered (TYPE_FIELD_NAME (type, index), stream);
	      f_type_print_varspec_suffix (TYPE_FIELD_TYPE (type, index),
					   stream, show - 1, 0, 0, 0);
	      fputs_filtered ("\n", stream);
	    }
	  fprintfi_filtered (level, stream, "End Type ");
	  fputs_filtered (TYPE_NAME (type), stream);
	}
      break;

    case TYPE_CODE_MODULE:
      fprintfi_filtered (level, stream, "module %s", TYPE_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
42a4f53d	3	Copyright (C) 1986-2019 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"
4de283e4	24	#include "gdb_obstack.h"
c906108c	25	#include "bfd.h"
4de283e4 TT	26	#include "symtab.h"
4de283e4 TT	27	#include "gdbtypes.h"
c906108c	28	#include "expression.h"
4de283e4	29	#include "value.h"
c906108c SS	30	#include "gdbcore.h"
c906108c SS	31	#include "target.h"
4de283e4	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	55
3f2f83dd KB	56	if (type_not_associated (type))
	57	{
	58	val_print_not_associated (stream);
	59	return;
	60	}
	61
	62	if (type_not_allocated (type))
	63	{
	64	val_print_not_allocated (stream);
	65	return;
	66	}
	67
c906108c SS	68	f_type_print_base (type, stream, show, level);
	69	code = TYPE_CODE (type);
	70	if ((varstring != NULL && *varstring != '\0')
c5aa993b JM	71	/* Need a space if going to print stars or brackets;
c5aa993b JM	72	but not if we will print just a type name. */
905e0470 PM	73	\|\| ((show > 0 \|\| TYPE_NAME (type) == 0)
	74	&& (code == TYPE_CODE_PTR \|\| code == TYPE_CODE_FUNC
	75	\|\| code == TYPE_CODE_METHOD
	76	\|\| code == TYPE_CODE_ARRAY
	77	\|\| code == TYPE_CODE_REF)))
c906108c SS	78	fputs_filtered (" ", stream);
	79	f_type_print_varspec_prefix (type, stream, show, 0);
	80
a7dfd010 MD	81	if (varstring != NULL)
a7dfd010 MD	82	{
2123df0e YQ	83	int demangled_args;
2123df0e YQ	84
a7dfd010	85	fputs_filtered (varstring, stream);
c906108c	86
a7dfd010	87	/* For demangled function names, we have the arglist as part of the name,
0963b4bd	88	so don't print an additional pair of ()'s. */
c906108c	89
2123df0e YQ	90	demangled_args = (*varstring != '\0'
2123df0e YQ	91	&& varstring[strlen (varstring) - 1] == ')');
0311118f	92	f_type_print_varspec_suffix (type, stream, show, 0, demangled_args, 0);
a7dfd010	93	}
c906108c SS	94	}
	95
	96	/* Print any asterisks or open-parentheses needed before the
	97	variable name (to describe its type).
	98
	99	On outermost call, pass 0 for PASSED_A_PTR.
	100	On outermost call, SHOW > 0 means should ignore
	101	any typename for TYPE and show its details.
	102	SHOW is always zero on recursive calls. */
	103
	104	void
fba45db2 KB	105	f_type_print_varspec_prefix (struct type type, struct ui_file stream,
fba45db2 KB	106	int show, int passed_a_ptr)
c906108c SS	107	{
	108	if (type == 0)
	109	return;
	110
	111	if (TYPE_NAME (type) && show <= 0)
	112	return;
	113
	114	QUIT;
	115
	116	switch (TYPE_CODE (type))
	117	{
	118	case TYPE_CODE_PTR:
	119	f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1);
	120	break;
	121
	122	case TYPE_CODE_FUNC:
	123	f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
	124	if (passed_a_ptr)
	125	fprintf_filtered (stream, "(");
	126	break;
	127
	128	case TYPE_CODE_ARRAY:
	129	f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
	130	break;
	131
	132	case TYPE_CODE_UNDEF:
	133	case TYPE_CODE_STRUCT:
	134	case TYPE_CODE_UNION:
	135	case TYPE_CODE_ENUM:
	136	case TYPE_CODE_INT:
	137	case TYPE_CODE_FLT:
	138	case TYPE_CODE_VOID:
	139	case TYPE_CODE_ERROR:
	140	case TYPE_CODE_CHAR:
	141	case TYPE_CODE_BOOL:
	142	case TYPE_CODE_SET:
	143	case TYPE_CODE_RANGE:
	144	case TYPE_CODE_STRING:
c906108c	145	case TYPE_CODE_METHOD:
c906108c SS	146	case TYPE_CODE_REF:
	147	case TYPE_CODE_COMPLEX:
	148	case TYPE_CODE_TYPEDEF:
	149	/* These types need no prefix. They are listed here so that
c5aa993b	150	gcc -Wall will reveal any types that haven't been handled. */
c906108c SS	151	break;
	152	}
	153	}
	154
c906108c SS	155	/* Print any array sizes, function arguments or close parentheses
	156	needed after the variable name (to describe its type).
	157	Args work like c_type_print_varspec_prefix. */
	158
	159	static void
fba45db2	160	f_type_print_varspec_suffix (struct type type, struct ui_file stream,
0311118f JK	161	int show, int passed_a_ptr, int demangled_args,
0311118f JK	162	int arrayprint_recurse_level)
c906108c	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
2880242d KS	193	LONGEST lower_bound = f77_get_lowerbound (type);
2880242d KS	194
3f2f83dd	195	if (lower_bound != 1) /* Not the default. */
2880242d	196	fprintf_filtered (stream, "%s:", plongest (lower_bound));
3f2f83dd KB	197
	198	/* Make sure that, if we have an assumed size array, we
	199	print out a warning and print the upperbound as ''. /
	200
	201	if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
	202	fprintf_filtered (stream, "*");
	203	else
	204	{
2880242d KS	205	LONGEST upper_bound = f77_get_upperbound (type);
	206
	207	fputs_filtered (plongest (upper_bound), stream);
3f2f83dd KB	208	}
	209
	210	if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
	211	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
	212	0, 0, arrayprint_recurse_level);
	213	}
c906108c SS	214	if (arrayprint_recurse_level == 1)
	215	fprintf_filtered (stream, ")");
	216	else
c5aa993b	217	fprintf_filtered (stream, ",");
c906108c SS	218	arrayprint_recurse_level--;
	219	break;
	220
	221	case TYPE_CODE_PTR:
	222	case TYPE_CODE_REF:
0311118f JK	223	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0,
0311118f JK	224	arrayprint_recurse_level);
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,
0311118f	230	passed_a_ptr, 0, arrayprint_recurse_level);
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:
c906108c	250	case TYPE_CODE_METHOD:
c906108c SS	251	case TYPE_CODE_COMPLEX:
	252	case TYPE_CODE_TYPEDEF:
	253	/* These types do not need a suffix. They are listed so that
c5aa993b	254	gcc -Wall will report types that may not have been considered. */
c906108c SS	255	break;
	256	}
	257	}
	258
c906108c SS	259	/* Print the name of the type (or the ultimate pointer target,
	260	function value or array element), or the description of a
	261	structure or union.
	262
	263	SHOW nonzero means don't print this type as just its name;
	264	show its real definition even if it has a name.
	265	SHOW zero means print just typename or struct tag if there is one
	266	SHOW negative means abbreviate structure elements.
	267	SHOW is decremented for printing of structure elements.
	268
	269	LEVEL is the depth to indent by.
	270	We increase it for some recursive calls. */
	271
	272	void
fba45db2 KB	273	f_type_print_base (struct type type, struct ui_file stream, int show,
fba45db2 KB	274	int level)
c906108c	275	{
2a5e440c WZ	276	int index;
2a5e440c WZ	277
c906108c SS	278	QUIT;
	279
	280	wrap_here (" ");
	281	if (type == NULL)
	282	{
	283	fputs_filtered ("<type unknown>", stream);
	284	return;
	285	}
	286
	287	/* When SHOW is zero or less, and there is a valid type name, then always
0963b4bd	288	just print the type name directly from the type. */
c906108c SS	289
	290	if ((show <= 0) && (TYPE_NAME (type) != NULL))
	291	{
e86ca25f TT	292	const char *prefix = "";
	293	if (TYPE_CODE (type) == TYPE_CODE_UNION)
	294	prefix = "Type, C_Union :: ";
	295	else if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
	296	prefix = "Type ";
	297	fprintfi_filtered (level, stream, "%s%s", prefix, TYPE_NAME (type));
c906108c SS	298	return;
	299	}
	300
	301	if (TYPE_CODE (type) != TYPE_CODE_TYPEDEF)
f168693b	302	type = check_typedef (type);
c906108c SS	303
	304	switch (TYPE_CODE (type))
	305	{
	306	case TYPE_CODE_TYPEDEF:
	307	f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
	308	break;
	309
	310	case TYPE_CODE_ARRAY:
c906108c	311	f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
7022349d PA	312	break;
	313	case TYPE_CODE_FUNC:
	314	if (TYPE_TARGET_TYPE (type) == NULL)
	315	type_print_unknown_return_type (stream);
	316	else
	317	f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
c906108c SS	318	break;
c906108c SS	319
c5aa993b	320	case TYPE_CODE_PTR:
a5ad232b FP	321	fprintfi_filtered (level, stream, "PTR TO -> ( ");
a5ad232b FP	322	f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0);
7e86466e RH	323	break;
	324
	325	case TYPE_CODE_REF:
a5ad232b FP	326	fprintfi_filtered (level, stream, "REF TO -> ( ");
a5ad232b FP	327	f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0);
c906108c SS	328	break;
	329
	330	case TYPE_CODE_VOID:
2a5e440c	331	fprintfi_filtered (level, stream, "VOID");
c906108c SS	332	break;
	333
	334	case TYPE_CODE_UNDEF:
2a5e440c	335	fprintfi_filtered (level, stream, "struct <unknown>");
c906108c SS	336	break;
	337
	338	case TYPE_CODE_ERROR:
b00fdb78	339	fprintfi_filtered (level, stream, "%s", TYPE_ERROR_NAME (type));
c906108c SS	340	break;
	341
	342	case TYPE_CODE_RANGE:
0963b4bd	343	/* This should not occur. */
2a5e440c	344	fprintfi_filtered (level, stream, "<range type>");
c906108c SS	345	break;
	346
	347	case TYPE_CODE_CHAR:
c906108c SS	348	case TYPE_CODE_INT:
	349	/* There may be some character types that attempt to come
	350	through as TYPE_CODE_INT since dbxstclass.h is so
	351	C-oriented, we must change these to "character" from "char". */
	352
bde58177	353	if (strcmp (TYPE_NAME (type), "char") == 0)
2a5e440c	354	fprintfi_filtered (level, stream, "character");
c906108c SS	355	else
	356	goto default_case;
	357	break;
	358
c906108c	359	case TYPE_CODE_STRING:
0963b4bd	360	/* Strings may have dynamic upperbounds (lengths) like arrays. */
c906108c	361
d78df370	362	if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
2a5e440c	363	fprintfi_filtered (level, stream, "character()");
c906108c SS	364	else
c906108c SS	365	{
2880242d KS	366	LONGEST upper_bound = f77_get_upperbound (type);
	367
	368	fprintf_filtered (stream, "character*%s", pulongest (upper_bound));
c906108c SS	369	}
	370	break;
	371
2a5e440c	372	case TYPE_CODE_STRUCT:
9eec4d1e MD	373	case TYPE_CODE_UNION:
	374	if (TYPE_CODE (type) == TYPE_CODE_UNION)
	375	fprintfi_filtered (level, stream, "Type, C_Union :: ");
	376	else
	377	fprintfi_filtered (level, stream, "Type ");
e86ca25f	378	fputs_filtered (TYPE_NAME (type), stream);
9b2db1fd BH	379	/* According to the definition,
	380	we only print structure elements in case show > 0. */
	381	if (show > 0)
2a5e440c	382	{
2a5e440c	383	fputs_filtered ("\n", stream);
9b2db1fd BH	384	for (index = 0; index < TYPE_NFIELDS (type); index++)
9b2db1fd BH	385	{
e188eb36 BH	386	f_type_print_base (TYPE_FIELD_TYPE (type, index), stream,
e188eb36 BH	387	show - 1, level + 4);
9b2db1fd BH	388	fputs_filtered (" :: ", stream);
	389	fputs_filtered (TYPE_FIELD_NAME (type, index), stream);
	390	f_type_print_varspec_suffix (TYPE_FIELD_TYPE (type, index),
e188eb36	391	stream, show - 1, 0, 0, 0);
9b2db1fd BH	392	fputs_filtered ("\n", stream);
	393	}
	394	fprintfi_filtered (level, stream, "End Type ");
e86ca25f	395	fputs_filtered (TYPE_NAME (type), stream);
9b2db1fd	396	}
2a5e440c WZ	397	break;
2a5e440c WZ	398
f55ee35c	399	case TYPE_CODE_MODULE:
e86ca25f	400	fprintfi_filtered (level, stream, "module %s", TYPE_NAME (type));
f55ee35c JK	401	break;
f55ee35c JK	402
c906108c SS	403	default_case:
	404	default:
	405	/* Handle types not explicitly handled by the other cases,
c5aa993b JM	406	such as fundamental types. For these, just print whatever
c5aa993b JM	407	the type name is, as recorded in the type itself. If there
0963b4bd	408	is no type name, then complain. */
c906108c	409	if (TYPE_NAME (type) != NULL)
848359ac	410	fprintfi_filtered (level, stream, "%s", TYPE_NAME (type));
c906108c	411	else
8a3fe4f8	412	error (_("Invalid type code (%d) in symbol table."), TYPE_CODE (type));
c906108c SS	413	break;
	414	}
	415	}