[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"

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