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

/* Support for printing Modula 2 types for GDB, the GNU debugger.
   Copyright (C) 1986-2015 Free Software Foundation, Inc.

   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"		/* Binary File Description */
#include "symtab.h"
#include "gdbtypes.h"
#include "expression.h"
#include "value.h"
#include "gdbcore.h"
#include "m2-lang.h"
#include "target.h"
#include "language.h"
#include "demangle.h"
#include "c-lang.h"
#include "typeprint.h"
#include "cp-abi.h"

static void m2_print_bounds (struct type *type,
			     struct ui_file *stream, int show, int level,
			     int print_high);

static void m2_typedef (struct type *, struct ui_file *, int, int,
			const struct type_print_options *);
static void m2_array (struct type *, struct ui_file *, int, int,
		      const struct type_print_options *);
static void m2_pointer (struct type *, struct ui_file *, int, int,
			const struct type_print_options *);
static void m2_ref (struct type *, struct ui_file *, int, int,
		    const struct type_print_options *);
static void m2_procedure (struct type *, struct ui_file *, int, int,
			  const struct type_print_options *);
static void m2_union (struct type *, struct ui_file *);
static void m2_enum (struct type *, struct ui_file *, int, int);
static void m2_range (struct type *, struct ui_file *, int, int,
		      const struct type_print_options *);
static void m2_type_name (struct type *type, struct ui_file *stream);
static void m2_short_set (struct type *type, struct ui_file *stream,
			  int show, int level);
static int m2_long_set (struct type *type, struct ui_file *stream,
			int show, int level, const struct type_print_options *flags);
static int m2_unbounded_array (struct type *type, struct ui_file *stream,
			       int show, int level,
			       const struct type_print_options *flags);
static void m2_record_fields (struct type *type, struct ui_file *stream,
			      int show, int level, const struct type_print_options *flags);
static void m2_unknown (const char *s, struct type *type,
			struct ui_file *stream, int show, int level);

int m2_is_long_set (struct type *type);
int m2_is_long_set_of_type (struct type *type, struct type **of_type);
int m2_is_unbounded_array (struct type *type);


void
m2_print_type (struct type *type, const char *varstring,
	       struct ui_file *stream,
	       int show, int level,
	       const struct type_print_options *flags)
{
  type = check_typedef (type);

  QUIT;

  wrap_here ("    ");
  if (type == NULL)
    {
      fputs_filtered (_("<type unknown>"), stream);
      return;
    }

  switch (TYPE_CODE (type))
    {
    case TYPE_CODE_SET:
      m2_short_set(type, stream, show, level);
      break;

    case TYPE_CODE_STRUCT:
      if (m2_long_set (type, stream, show, level, flags)
	  || m2_unbounded_array (type, stream, show, level, flags))
	break;
      m2_record_fields (type, stream, show, level, flags);
      break;

    case TYPE_CODE_TYPEDEF:
      m2_typedef (type, stream, show, level, flags);
      break;

    case TYPE_CODE_ARRAY:
      m2_array (type, stream, show, level, flags);
      break;

    case TYPE_CODE_PTR:
      m2_pointer (type, stream, show, level, flags);
      break;

    case TYPE_CODE_REF:
      m2_ref (type, stream, show, level, flags);
      break;

    case TYPE_CODE_METHOD:
      m2_unknown (_("method"), type, stream, show, level);
      break;

    case TYPE_CODE_FUNC:
      m2_procedure (type, stream, show, level, flags);
      break;

    case TYPE_CODE_UNION:
      m2_union (type, stream);
      break;

    case TYPE_CODE_ENUM:
      m2_enum (type, stream, show, level);
      break;

    case TYPE_CODE_VOID:
      break;

    case TYPE_CODE_UNDEF:
      /* i18n: Do not translate the "struct" part!  */
      m2_unknown (_("undef"), type, stream, show, level);
      break;

    case TYPE_CODE_ERROR:
      m2_unknown (_("error"), type, stream, show, level);
      break;

    case TYPE_CODE_RANGE:
      m2_range (type, stream, show, level, flags);
      break;

    default:
      m2_type_name (type, stream);
      break;
    }
}

/* Print a typedef using M2 syntax.  TYPE is the underlying type.
   NEW_SYMBOL is the symbol naming the type.  STREAM is the stream on
   which to print.  */

void
m2_print_typedef (struct type *type, struct symbol *new_symbol,
		  struct ui_file *stream)
{
  type = check_typedef (type);
  fprintf_filtered (stream, "TYPE ");
  if (!TYPE_NAME (SYMBOL_TYPE (new_symbol))
      || strcmp (TYPE_NAME ((SYMBOL_TYPE (new_symbol))),
		 SYMBOL_LINKAGE_NAME (new_symbol)) != 0)
    fprintf_filtered (stream, "%s = ", SYMBOL_PRINT_NAME (new_symbol));
  else
    fprintf_filtered (stream, "<builtin> = ");
  type_print (type, "", stream, 0);
  fprintf_filtered (stream, ";\n");
}

/* m2_type_name - if a, type, has a name then print it.  */

void
m2_type_name (struct type *type, struct ui_file *stream)
{
  if (TYPE_NAME (type) != NULL)
    fputs_filtered (TYPE_NAME (type), stream);
}

/* m2_range - displays a Modula-2 subrange type.  */

void
m2_range (struct type *type, struct ui_file *stream, int show,
	  int level, const struct type_print_options *flags)
{
  if (TYPE_HIGH_BOUND (type) == TYPE_LOW_BOUND (type))
    {
      /* FIXME: TYPE_TARGET_TYPE used to be TYPE_DOMAIN_TYPE but that was
	 wrong.  Not sure if TYPE_TARGET_TYPE is correct though.  */
      m2_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level,
		     flags);
    }
  else
    {
      struct type *target = TYPE_TARGET_TYPE (type);

      fprintf_filtered (stream, "[");
      print_type_scalar (target, TYPE_LOW_BOUND (type), stream);
      fprintf_filtered (stream, "..");
      print_type_scalar (target, TYPE_HIGH_BOUND (type), stream);
      fprintf_filtered (stream, "]");
    }
}

static void
m2_typedef (struct type *type, struct ui_file *stream, int show,
	    int level, const struct type_print_options *flags)
{
  if (TYPE_NAME (type) != NULL)
    {
      fputs_filtered (TYPE_NAME (type), stream);
      fputs_filtered (" = ", stream);
    }
  m2_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level, flags);
}

/* m2_array - prints out a Modula-2 ARRAY ... OF type.  */

static void m2_array (struct type *type, struct ui_file *stream,
		      int show, int level, const struct type_print_options *flags)
{
  fprintf_filtered (stream, "ARRAY [");
  if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0
      && !TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
    {
      if (TYPE_INDEX_TYPE (type) != 0)
	{
	  m2_print_bounds (TYPE_INDEX_TYPE (type), stream, show, -1, 0);
	  fprintf_filtered (stream, "..");
	  m2_print_bounds (TYPE_INDEX_TYPE (type), stream, show, -1, 1);
	}
      else
	fprintf_filtered (stream, "%d",
			  (TYPE_LENGTH (type)
			   / TYPE_LENGTH (TYPE_TARGET_TYPE (type))));
    }
  fprintf_filtered (stream, "] OF ");
  m2_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level, flags);
}

static void
m2_pointer (struct type *type, struct ui_file *stream, int show,
	    int level, const struct type_print_options *flags)
{
  if (TYPE_CONST (type))
    fprintf_filtered (stream, "[...] : ");
  else
    fprintf_filtered (stream, "POINTER TO ");

  m2_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level, flags);
}

static void
m2_ref (struct type *type, struct ui_file *stream, int show,
	int level, const struct type_print_options *flags)
{
  fprintf_filtered (stream, "VAR");
  m2_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level, flags);
}

static void
m2_unknown (const char *s, struct type *type, struct ui_file *stream,
	    int show, int level)
{
  fprintf_filtered (stream, "%s %s", s, _("is unknown"));
}

static void m2_union (struct type *type, struct ui_file *stream)
{
  fprintf_filtered (stream, "union");
}

static void
m2_procedure (struct type *type, struct ui_file *stream,
	      int show, int level, const struct type_print_options *flags)
{
  fprintf_filtered (stream, "PROCEDURE ");
  m2_type_name (type, stream);
  if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
    {
      int i, len = TYPE_NFIELDS (type);

      fprintf_filtered (stream, " (");
      for (i = 0; i < len; i++)
	{
	  if (i > 0)
	    {
	      fputs_filtered (", ", stream);
	      wrap_here ("    ");
	    }
	  m2_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0, flags);
	}
      if (TYPE_TARGET_TYPE (type) != NULL)
	{
	  fprintf_filtered (stream, " : ");
	  m2_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, 0, flags);
	}
    }
}

static void
m2_print_bounds (struct type *type,
		 struct ui_file *stream, int show, int level,
		 int print_high)
{
  struct type *target = TYPE_TARGET_TYPE (type);

  if (TYPE_NFIELDS(type) == 0)
    return;

  if (print_high)
    print_type_scalar (target, TYPE_HIGH_BOUND (type), stream);
  else
    print_type_scalar (target, TYPE_LOW_BOUND (type), stream);
}

static void
m2_short_set (struct type *type, struct ui_file *stream, int show, int level)
{
  fprintf_filtered(stream, "SET [");
  m2_print_bounds (TYPE_INDEX_TYPE (type), stream,
		   show - 1, level, 0);

  fprintf_filtered(stream, "..");
  m2_print_bounds (TYPE_INDEX_TYPE (type), stream,
		   show - 1, level, 1);
  fprintf_filtered(stream, "]");
}

int
m2_is_long_set (struct type *type)
{
  LONGEST previous_high = 0;  /* Unnecessary initialization
				 keeps gcc -Wall happy.  */
  int len, i;
  struct type *range;

  if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
    {

      /* check if all fields of the RECORD are consecutive sets.  */

      len = TYPE_NFIELDS (type);
      for (i = TYPE_N_BASECLASSES (type); i < len; i++)
	{
	  if (TYPE_FIELD_TYPE (type, i) == NULL)
	    return 0;
	  if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) != TYPE_CODE_SET)
	    return 0;
	  if (TYPE_FIELD_NAME (type, i) != NULL
	      && (strcmp (TYPE_FIELD_NAME (type, i), "") != 0))
	    return 0;
	  range = TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, i));
	  if ((i > TYPE_N_BASECLASSES (type))
	      && previous_high + 1 != TYPE_LOW_BOUND (range))
	    return 0;
	  previous_high = TYPE_HIGH_BOUND (range);
	}
      return len>0;
    }
  return 0;
}

/* m2_get_discrete_bounds - a wrapper for get_discrete_bounds which
                            understands that CHARs might be signed.
                            This should be integrated into gdbtypes.c
                            inside get_discrete_bounds.  */

static int
m2_get_discrete_bounds (struct type *type, LONGEST *lowp, LONGEST *highp)
{
  type = check_typedef (type);
  switch (TYPE_CODE (type))
    {
    case TYPE_CODE_CHAR:
      if (TYPE_LENGTH (type) < sizeof (LONGEST))
	{
	  if (!TYPE_UNSIGNED (type))
	    {
	      *lowp = -(1 << (TYPE_LENGTH (type) * TARGET_CHAR_BIT - 1));
	      *highp = -*lowp - 1;
	      return 0;
	    }
	}
      /* fall through */
    default:
      return get_discrete_bounds (type, lowp, highp);
    }
}

/* m2_is_long_set_of_type - returns TRUE if the long set was declared as
                            SET OF <oftype> of_type is assigned to the
                            subtype.  */

int
m2_is_long_set_of_type (struct type *type, struct type **of_type)
{
  int len, i;
  struct type *range;
  struct type *target;
  LONGEST l1, l2;
  LONGEST h1, h2;

  if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
    {
      len = TYPE_NFIELDS (type);
      i = TYPE_N_BASECLASSES (type);
      if (len == 0)
	return 0;
      range = TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, i));
      target = TYPE_TARGET_TYPE (range);

      l1 = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, i)));
      h1 = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, len-1)));
      *of_type = target;
      if (m2_get_discrete_bounds (target, &l2, &h2) >= 0)
	return (l1 == l2 && h1 == h2);
      error (_("long_set failed to find discrete bounds for its subtype"));
      return 0;
    }
  error (_("expecting long_set"));
  return 0;
}

static int
m2_long_set (struct type *type, struct ui_file *stream, int show, int level,
	     const struct type_print_options *flags)
{
  struct type *of_type;
  int i;
  int len = TYPE_NFIELDS (type);
  LONGEST low;
  LONGEST high;

  if (m2_is_long_set (type))
    {
      if (TYPE_TAG_NAME (type) != NULL)
	{
	  fputs_filtered (TYPE_TAG_NAME (type), stream);
	  if (show == 0)
	    return 1;
	}
      else if (TYPE_NAME (type) != NULL)
	{
	  fputs_filtered (TYPE_NAME (type), stream);
	  if (show == 0)
	    return 1;
	}

      if (TYPE_TAG_NAME (type) != NULL || TYPE_NAME (type) != NULL)
	fputs_filtered (" = ", stream);

      if (get_long_set_bounds (type, &low, &high))
	{
	  fprintf_filtered(stream, "SET OF ");
	  i = TYPE_N_BASECLASSES (type);
	  if (m2_is_long_set_of_type (type, &of_type))
	    m2_print_type (of_type, "", stream, show - 1, level, flags);
	  else
	    {
	      fprintf_filtered(stream, "[");
	      m2_print_bounds (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, i)),
			       stream, show - 1, level, 0);

	      fprintf_filtered(stream, "..");

	      m2_print_bounds (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, len-1)),
			       stream, show - 1, level, 1);
	      fprintf_filtered(stream, "]");
	    }
	}
      else
	/* i18n: Do not translate the "SET OF" part!  */
	fprintf_filtered(stream, _("SET OF <unknown>"));

      return 1;
    }
  return 0;
}

/* m2_is_unbounded_array - returns TRUE if, type, should be regarded
                           as a Modula-2 unbounded ARRAY type.  */

int
m2_is_unbounded_array (struct type *type)
{
  if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
    {
      /*
       *  check if we have a structure with exactly two fields named
       *  _m2_contents and _m2_high.  It also checks to see if the
       *  type of _m2_contents is a pointer.  The TYPE_TARGET_TYPE
       *  of the pointer determines the unbounded ARRAY OF type.
       */
      if (TYPE_NFIELDS (type) != 2)
	return 0;
      if (strcmp (TYPE_FIELD_NAME (type, 0), "_m2_contents") != 0)
	return 0;
      if (strcmp (TYPE_FIELD_NAME (type, 1), "_m2_high") != 0)
	return 0;
      if (TYPE_CODE (TYPE_FIELD_TYPE (type, 0)) != TYPE_CODE_PTR)
	return 0;
      return 1;
    }
  return 0;
}

/* m2_unbounded_array - if the struct type matches a Modula-2 unbounded
                        parameter type then display the type as an
                        ARRAY OF type.  Returns TRUE if an unbounded
                        array type was detected.  */

static int
m2_unbounded_array (struct type *type, struct ui_file *stream, int show,
		    int level, const struct type_print_options *flags)
{
  if (m2_is_unbounded_array (type))
    {
      if (show > 0)
	{
	  fputs_filtered ("ARRAY OF ", stream);
	  m2_print_type (TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 0)),
			 "", stream, 0, level, flags);
	}
      return 1;
    }
  return 0;
}

void
m2_record_fields (struct type *type, struct ui_file *stream, int show,
		  int level, const struct type_print_options *flags)
{
  /* Print the tag if it exists.  */
  if (TYPE_TAG_NAME (type) != NULL)
    {
      if (!startswith (TYPE_TAG_NAME (type), "$$"))
	{
	  fputs_filtered (TYPE_TAG_NAME (type), stream);
	  if (show > 0)
	    fprintf_filtered (stream, " = ");
	}
    }
  wrap_here ("    ");
  if (show < 0)
    {
      if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
	fprintf_filtered (stream, "RECORD ... END ");
      else if (TYPE_CODE (type) == TYPE_CODE_UNION)
	fprintf_filtered (stream, "CASE ... END ");
    }
  else if (show > 0)
    {
      int i;
      int len = TYPE_NFIELDS (type);

      if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
	fprintf_filtered (stream, "RECORD\n");
      else if (TYPE_CODE (type) == TYPE_CODE_UNION)
	/* i18n: Do not translate "CASE" and "OF".  */
	fprintf_filtered (stream, _("CASE <variant> OF\n"));

      for (i = TYPE_N_BASECLASSES (type); i < len; i++)
	{
	  QUIT;

	  print_spaces_filtered (level + 4, stream);
	  fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
	  fputs_filtered (" : ", stream);
	  m2_print_type (TYPE_FIELD_TYPE (type, i),
			 "",
			 stream, 0, level + 4, flags);
	  if (TYPE_FIELD_PACKED (type, i))
	    {
	      /* It is a bitfield.  This code does not attempt
		 to look at the bitpos and reconstruct filler,
		 unnamed fields.  This would lead to misleading
		 results if the compiler does not put out fields
		 for such things (I don't know what it does).  */
	      fprintf_filtered (stream, " : %d",
				TYPE_FIELD_BITSIZE (type, i));
	    }
	  fprintf_filtered (stream, ";\n");
	}
      
      fprintfi_filtered (level, stream, "END ");
    }
}

void
m2_enum (struct type *type, struct ui_file *stream, int show, int level)
{
  LONGEST lastval;
  int i, len;

  if (show < 0)
    {
      /* If we just printed a tag name, no need to print anything else.  */
      if (TYPE_TAG_NAME (type) == NULL)
	fprintf_filtered (stream, "(...)");
    }
  else if (show > 0 || TYPE_TAG_NAME (type) == NULL)
    {
      fprintf_filtered (stream, "(");
      len = TYPE_NFIELDS (type);
      lastval = 0;
      for (i = 0; i < len; i++)
	{
	  QUIT;
	  if (i > 0)
	    fprintf_filtered (stream, ", ");
	  wrap_here ("    ");
	  fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
	  if (lastval != TYPE_FIELD_ENUMVAL (type, i))
	    {
	      fprintf_filtered (stream, " = %s",
				plongest (TYPE_FIELD_ENUMVAL (type, i)));
	      lastval = TYPE_FIELD_ENUMVAL (type, i);
	    }
	  lastval++;
	}
      fprintf_filtered (stream, ")");
    }
}
Commit	Line	Data
c906108c	1	/* Support for printing Modula 2 types for GDB, the GNU debugger.
32d0add0	2	Copyright (C) 1986-2015 Free Software Foundation, Inc.
c906108c	3
c5aa993b JM	4	This file is part of GDB.
	5
	6	This program is free software; you can redistribute it and/or modify
	7	it under the terms of the GNU General Public License as published by
a9762ec7	8	the Free Software Foundation; either version 3 of the License, or
c5aa993b JM	9	(at your option) any later version.
	10
	11	This program is distributed in the hope that it will be useful,
	12	but WITHOUT ANY WARRANTY; without even the implied warranty of
	13	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	14	GNU General Public License for more details.
	15
	16	You should have received a copy of the GNU General Public License
a9762ec7	17	along with this program. If not, see <http://www.gnu.org/licenses/>. */
c906108c SS	18
c906108c SS	19	#include "defs.h"
72019c9c	20	#include "gdb_obstack.h"
c906108c SS	21	#include "bfd.h" /* Binary File Description */
	22	#include "symtab.h"
	23	#include "gdbtypes.h"
	24	#include "expression.h"
	25	#include "value.h"
	26	#include "gdbcore.h"
c906108c	27	#include "m2-lang.h"
72019c9c GM	28	#include "target.h"
	29	#include "language.h"
	30	#include "demangle.h"
	31	#include "c-lang.h"
	32	#include "typeprint.h"
	33	#include "cp-abi.h"
c906108c	34
72019c9c GM	35	static void m2_print_bounds (struct type *type,
	36	struct ui_file *stream, int show, int level,
	37	int print_high);
	38
79d43c61 TT	39	static void m2_typedef (struct type , struct ui_file , int, int,
	40	const struct type_print_options *);
	41	static void m2_array (struct type , struct ui_file , int, int,
	42	const struct type_print_options *);
	43	static void m2_pointer (struct type , struct ui_file , int, int,
	44	const struct type_print_options *);
	45	static void m2_ref (struct type , struct ui_file , int, int,
	46	const struct type_print_options *);
	47	static void m2_procedure (struct type , struct ui_file , int, int,
	48	const struct type_print_options *);
72019c9c GM	49	static void m2_union (struct type , struct ui_file );
72019c9c GM	50	static void m2_enum (struct type , struct ui_file , int, int);
79d43c61 TT	51	static void m2_range (struct type , struct ui_file , int, int,
79d43c61 TT	52	const struct type_print_options *);
72019c9c GM	53	static void m2_type_name (struct type type, struct ui_file stream);
	54	static void m2_short_set (struct type type, struct ui_file stream,
	55	int show, int level);
	56	static int m2_long_set (struct type type, struct ui_file stream,
79d43c61	57	int show, int level, const struct type_print_options *flags);
844781a1	58	static int m2_unbounded_array (struct type type, struct ui_file stream,
79d43c61 TT	59	int show, int level,
79d43c61 TT	60	const struct type_print_options *flags);
72019c9c	61	static void m2_record_fields (struct type type, struct ui_file stream,
79d43c61	62	int show, int level, const struct type_print_options *flags);
72019c9c GM	63	static void m2_unknown (const char s, struct type type,
	64	struct ui_file *stream, int show, int level);
	65
	66	int m2_is_long_set (struct type *type);
	67	int m2_is_long_set_of_type (struct type type, struct type *of_type);
844781a1	68	int m2_is_unbounded_array (struct type *type);
72019c9c GM	69
72019c9c GM	70
c906108c	71	void
025bb325 MS	72	m2_print_type (struct type type, const char varstring,
025bb325 MS	73	struct ui_file *stream,
79d43c61 TT	74	int show, int level,
79d43c61 TT	75	const struct type_print_options *flags)
c906108c	76	{
f168693b	77	type = check_typedef (type);
72019c9c GM	78
	79	QUIT;
	80
	81	wrap_here (" ");
	82	if (type == NULL)
	83	{
	84	fputs_filtered (_("<type unknown>"), stream);
	85	return;
	86	}
	87
	88	switch (TYPE_CODE (type))
	89	{
	90	case TYPE_CODE_SET:
	91	m2_short_set(type, stream, show, level);
	92	break;
	93
	94	case TYPE_CODE_STRUCT:
79d43c61 TT	95	if (m2_long_set (type, stream, show, level, flags)
79d43c61 TT	96	\|\| m2_unbounded_array (type, stream, show, level, flags))
72019c9c	97	break;
79d43c61	98	m2_record_fields (type, stream, show, level, flags);
72019c9c GM	99	break;
	100
	101	case TYPE_CODE_TYPEDEF:
79d43c61	102	m2_typedef (type, stream, show, level, flags);
72019c9c GM	103	break;
	104
	105	case TYPE_CODE_ARRAY:
79d43c61	106	m2_array (type, stream, show, level, flags);
72019c9c GM	107	break;
	108
	109	case TYPE_CODE_PTR:
79d43c61	110	m2_pointer (type, stream, show, level, flags);
72019c9c GM	111	break;
	112
	113	case TYPE_CODE_REF:
79d43c61	114	m2_ref (type, stream, show, level, flags);
72019c9c GM	115	break;
72019c9c GM	116
72019c9c GM	117	case TYPE_CODE_METHOD:
	118	m2_unknown (_("method"), type, stream, show, level);
	119	break;
	120
	121	case TYPE_CODE_FUNC:
79d43c61	122	m2_procedure (type, stream, show, level, flags);
72019c9c GM	123	break;
	124
	125	case TYPE_CODE_UNION:
	126	m2_union (type, stream);
	127	break;
	128
	129	case TYPE_CODE_ENUM:
	130	m2_enum (type, stream, show, level);
	131	break;
	132
	133	case TYPE_CODE_VOID:
	134	break;
	135
	136	case TYPE_CODE_UNDEF:
025bb325	137	/* i18n: Do not translate the "struct" part! */
72019c9c GM	138	m2_unknown (_("undef"), type, stream, show, level);
	139	break;
	140
	141	case TYPE_CODE_ERROR:
	142	m2_unknown (_("error"), type, stream, show, level);
	143	break;
	144
	145	case TYPE_CODE_RANGE:
79d43c61	146	m2_range (type, stream, show, level, flags);
72019c9c GM	147	break;
72019c9c GM	148
72019c9c GM	149	default:
	150	m2_type_name (type, stream);
	151	break;
	152	}
	153	}
	154
5c6ce71d TT	155	/* Print a typedef using M2 syntax. TYPE is the underlying type.
	156	NEW_SYMBOL is the symbol naming the type. STREAM is the stream on
	157	which to print. */
	158
	159	void
	160	m2_print_typedef (struct type type, struct symbol new_symbol,
	161	struct ui_file *stream)
	162	{
f168693b	163	type = check_typedef (type);
5c6ce71d TT	164	fprintf_filtered (stream, "TYPE ");
	165	if (!TYPE_NAME (SYMBOL_TYPE (new_symbol))
	166	\|\| strcmp (TYPE_NAME ((SYMBOL_TYPE (new_symbol))),
	167	SYMBOL_LINKAGE_NAME (new_symbol)) != 0)
	168	fprintf_filtered (stream, "%s = ", SYMBOL_PRINT_NAME (new_symbol));
	169	else
	170	fprintf_filtered (stream, "<builtin> = ");
	171	type_print (type, "", stream, 0);
	172	fprintf_filtered (stream, ";\n");
	173	}
	174
844781a1	175	/* m2_type_name - if a, type, has a name then print it. */
72019c9c GM	176
	177	void
	178	m2_type_name (struct type type, struct ui_file stream)
	179	{
	180	if (TYPE_NAME (type) != NULL)
	181	fputs_filtered (TYPE_NAME (type), stream);
	182	}
	183
844781a1	184	/* m2_range - displays a Modula-2 subrange type. */
72019c9c GM	185
	186	void
	187	m2_range (struct type type, struct ui_file stream, int show,
79d43c61	188	int level, const struct type_print_options *flags)
72019c9c GM	189	{
72019c9c GM	190	if (TYPE_HIGH_BOUND (type) == TYPE_LOW_BOUND (type))
09e2d7c7 DE	191	{
	192	/* FIXME: TYPE_TARGET_TYPE used to be TYPE_DOMAIN_TYPE but that was
	193	wrong. Not sure if TYPE_TARGET_TYPE is correct though. */
	194	m2_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level,
	195	flags);
	196	}
72019c9c GM	197	else
	198	{
	199	struct type *target = TYPE_TARGET_TYPE (type);
	200
	201	fprintf_filtered (stream, "[");
	202	print_type_scalar (target, TYPE_LOW_BOUND (type), stream);
	203	fprintf_filtered (stream, "..");
	204	print_type_scalar (target, TYPE_HIGH_BOUND (type), stream);
	205	fprintf_filtered (stream, "]");
	206	}
	207	}
	208
	209	static void
	210	m2_typedef (struct type type, struct ui_file stream, int show,
79d43c61	211	int level, const struct type_print_options *flags)
72019c9c GM	212	{
	213	if (TYPE_NAME (type) != NULL)
	214	{
	215	fputs_filtered (TYPE_NAME (type), stream);
	216	fputs_filtered (" = ", stream);
	217	}
79d43c61	218	m2_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level, flags);
72019c9c GM	219	}
72019c9c GM	220
844781a1	221	/* m2_array - prints out a Modula-2 ARRAY ... OF type. */
72019c9c GM	222
72019c9c GM	223	static void m2_array (struct type type, struct ui_file stream,
79d43c61	224	int show, int level, const struct type_print_options *flags)
72019c9c GM	225	{
72019c9c GM	226	fprintf_filtered (stream, "ARRAY [");
d5d6fca5	227	if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0
d78df370	228	&& !TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
72019c9c GM	229	{
	230	if (TYPE_INDEX_TYPE (type) != 0)
	231	{
	232	m2_print_bounds (TYPE_INDEX_TYPE (type), stream, show, -1, 0);
	233	fprintf_filtered (stream, "..");
	234	m2_print_bounds (TYPE_INDEX_TYPE (type), stream, show, -1, 1);
	235	}
	236	else
	237	fprintf_filtered (stream, "%d",
	238	(TYPE_LENGTH (type)
	239	/ TYPE_LENGTH (TYPE_TARGET_TYPE (type))));
	240	}
	241	fprintf_filtered (stream, "] OF ");
79d43c61	242	m2_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level, flags);
72019c9c GM	243	}
	244
	245	static void
	246	m2_pointer (struct type type, struct ui_file stream, int show,
79d43c61	247	int level, const struct type_print_options *flags)
72019c9c GM	248	{
	249	if (TYPE_CONST (type))
	250	fprintf_filtered (stream, "[...] : ");
	251	else
	252	fprintf_filtered (stream, "POINTER TO ");
	253
79d43c61	254	m2_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level, flags);
72019c9c GM	255	}
	256
	257	static void
	258	m2_ref (struct type type, struct ui_file stream, int show,
79d43c61	259	int level, const struct type_print_options *flags)
72019c9c GM	260	{
72019c9c GM	261	fprintf_filtered (stream, "VAR");
79d43c61	262	m2_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level, flags);
72019c9c GM	263	}
	264
	265	static void
	266	m2_unknown (const char s, struct type type, struct ui_file *stream,
	267	int show, int level)
	268	{
	269	fprintf_filtered (stream, "%s %s", s, _("is unknown"));
	270	}
	271
	272	static void m2_union (struct type type, struct ui_file stream)
	273	{
	274	fprintf_filtered (stream, "union");
	275	}
	276
	277	static void
	278	m2_procedure (struct type type, struct ui_file stream,
79d43c61	279	int show, int level, const struct type_print_options *flags)
72019c9c GM	280	{
	281	fprintf_filtered (stream, "PROCEDURE ");
	282	m2_type_name (type, stream);
	283	if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
	284	{
	285	int i, len = TYPE_NFIELDS (type);
	286
	287	fprintf_filtered (stream, " (");
	288	for (i = 0; i < len; i++)
	289	{
	290	if (i > 0)
	291	{
	292	fputs_filtered (", ", stream);
	293	wrap_here (" ");
	294	}
79d43c61	295	m2_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0, flags);
72019c9c GM	296	}
	297	if (TYPE_TARGET_TYPE (type) != NULL)
	298	{
	299	fprintf_filtered (stream, " : ");
79d43c61	300	m2_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, 0, flags);
72019c9c GM	301	}
	302	}
	303	}
	304
	305	static void
	306	m2_print_bounds (struct type *type,
	307	struct ui_file *stream, int show, int level,
	308	int print_high)
	309	{
	310	struct type *target = TYPE_TARGET_TYPE (type);
	311
72019c9c GM	312	if (TYPE_NFIELDS(type) == 0)
	313	return;
	314
	315	if (print_high)
	316	print_type_scalar (target, TYPE_HIGH_BOUND (type), stream);
	317	else
	318	print_type_scalar (target, TYPE_LOW_BOUND (type), stream);
	319	}
	320
	321	static void
	322	m2_short_set (struct type type, struct ui_file stream, int show, int level)
	323	{
	324	fprintf_filtered(stream, "SET [");
	325	m2_print_bounds (TYPE_INDEX_TYPE (type), stream,
	326	show - 1, level, 0);
	327
	328	fprintf_filtered(stream, "..");
	329	m2_print_bounds (TYPE_INDEX_TYPE (type), stream,
	330	show - 1, level, 1);
	331	fprintf_filtered(stream, "]");
	332	}
	333
	334	int
	335	m2_is_long_set (struct type *type)
	336	{
025bb325 MS	337	LONGEST previous_high = 0; /* Unnecessary initialization
025bb325 MS	338	keeps gcc -Wall happy. */
72019c9c GM	339	int len, i;
	340	struct type *range;
	341
	342	if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
	343	{
	344
844781a1 GM	345	/* check if all fields of the RECORD are consecutive sets. */
844781a1 GM	346
72019c9c GM	347	len = TYPE_NFIELDS (type);
	348	for (i = TYPE_N_BASECLASSES (type); i < len; i++)
	349	{
	350	if (TYPE_FIELD_TYPE (type, i) == NULL)
	351	return 0;
	352	if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) != TYPE_CODE_SET)
	353	return 0;
	354	if (TYPE_FIELD_NAME (type, i) != NULL
	355	&& (strcmp (TYPE_FIELD_NAME (type, i), "") != 0))
	356	return 0;
	357	range = TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, i));
	358	if ((i > TYPE_N_BASECLASSES (type))
	359	&& previous_high + 1 != TYPE_LOW_BOUND (range))
	360	return 0;
	361	previous_high = TYPE_HIGH_BOUND (range);
	362	}
	363	return len>0;
	364	}
	365	return 0;
	366	}
	367
844781a1 GM	368	/* m2_get_discrete_bounds - a wrapper for get_discrete_bounds which
	369	understands that CHARs might be signed.
	370	This should be integrated into gdbtypes.c
	371	inside get_discrete_bounds. */
72019c9c	372
2c0b251b	373	static int
72019c9c GM	374	m2_get_discrete_bounds (struct type type, LONGEST lowp, LONGEST *highp)
72019c9c GM	375	{
f168693b	376	type = check_typedef (type);
72019c9c GM	377	switch (TYPE_CODE (type))
	378	{
	379	case TYPE_CODE_CHAR:
	380	if (TYPE_LENGTH (type) < sizeof (LONGEST))
	381	{
	382	if (!TYPE_UNSIGNED (type))
	383	{
	384	lowp = -(1 << (TYPE_LENGTH (type) TARGET_CHAR_BIT - 1));
	385	highp = -lowp - 1;
	386	return 0;
	387	}
	388	}
	389	/* fall through */
	390	default:
	391	return get_discrete_bounds (type, lowp, highp);
	392	}
	393	}
	394
844781a1 GM	395	/* m2_is_long_set_of_type - returns TRUE if the long set was declared as
	396	SET OF <oftype> of_type is assigned to the
	397	subtype. */
72019c9c GM	398
	399	int
	400	m2_is_long_set_of_type (struct type type, struct type *of_type)
	401	{
	402	int len, i;
	403	struct type *range;
	404	struct type *target;
	405	LONGEST l1, l2;
	406	LONGEST h1, h2;
	407
	408	if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
	409	{
	410	len = TYPE_NFIELDS (type);
	411	i = TYPE_N_BASECLASSES (type);
	412	if (len == 0)
	413	return 0;
	414	range = TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, i));
	415	target = TYPE_TARGET_TYPE (range);
72019c9c GM	416
	417	l1 = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, i)));
	418	h1 = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, len-1)));
	419	*of_type = target;
	420	if (m2_get_discrete_bounds (target, &l2, &h2) >= 0)
	421	return (l1 == l2 && h1 == h2);
	422	error (_("long_set failed to find discrete bounds for its subtype"));
	423	return 0;
	424	}
	425	error (_("expecting long_set"));
	426	return 0;
	427	}
	428
	429	static int
79d43c61 TT	430	m2_long_set (struct type type, struct ui_file stream, int show, int level,
79d43c61 TT	431	const struct type_print_options *flags)
72019c9c	432	{
72019c9c GM	433	struct type *of_type;
	434	int i;
	435	int len = TYPE_NFIELDS (type);
	436	LONGEST low;
	437	LONGEST high;
	438
	439	if (m2_is_long_set (type))
	440	{
	441	if (TYPE_TAG_NAME (type) != NULL)
	442	{
	443	fputs_filtered (TYPE_TAG_NAME (type), stream);
	444	if (show == 0)
	445	return 1;
	446	}
	447	else if (TYPE_NAME (type) != NULL)
	448	{
	449	fputs_filtered (TYPE_NAME (type), stream);
	450	if (show == 0)
	451	return 1;
	452	}
	453
	454	if (TYPE_TAG_NAME (type) != NULL \|\| TYPE_NAME (type) != NULL)
	455	fputs_filtered (" = ", stream);
	456
	457	if (get_long_set_bounds (type, &low, &high))
	458	{
	459	fprintf_filtered(stream, "SET OF ");
	460	i = TYPE_N_BASECLASSES (type);
	461	if (m2_is_long_set_of_type (type, &of_type))
79d43c61	462	m2_print_type (of_type, "", stream, show - 1, level, flags);
72019c9c GM	463	else
	464	{
	465	fprintf_filtered(stream, "[");
	466	m2_print_bounds (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, i)),
	467	stream, show - 1, level, 0);
	468
	469	fprintf_filtered(stream, "..");
	470
	471	m2_print_bounds (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, len-1)),
	472	stream, show - 1, level, 1);
	473	fprintf_filtered(stream, "]");
	474	}
	475	}
	476	else
025bb325	477	/* i18n: Do not translate the "SET OF" part! */
72019c9c GM	478	fprintf_filtered(stream, _("SET OF <unknown>"));
	479
	480	return 1;
	481	}
	482	return 0;
	483	}
	484
844781a1 GM	485	/* m2_is_unbounded_array - returns TRUE if, type, should be regarded
	486	as a Modula-2 unbounded ARRAY type. */
	487
	488	int
	489	m2_is_unbounded_array (struct type *type)
	490	{
	491	if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
	492	{
	493	/*
	494	* check if we have a structure with exactly two fields named
	495	* _m2_contents and _m2_high. It also checks to see if the
	496	* type of _m2_contents is a pointer. The TYPE_TARGET_TYPE
	497	* of the pointer determines the unbounded ARRAY OF type.
	498	*/
	499	if (TYPE_NFIELDS (type) != 2)
	500	return 0;
	501	if (strcmp (TYPE_FIELD_NAME (type, 0), "_m2_contents") != 0)
	502	return 0;
	503	if (strcmp (TYPE_FIELD_NAME (type, 1), "_m2_high") != 0)
	504	return 0;
	505	if (TYPE_CODE (TYPE_FIELD_TYPE (type, 0)) != TYPE_CODE_PTR)
	506	return 0;
	507	return 1;
	508	}
	509	return 0;
	510	}
	511
	512	/* m2_unbounded_array - if the struct type matches a Modula-2 unbounded
	513	parameter type then display the type as an
	514	ARRAY OF type. Returns TRUE if an unbounded
	515	array type was detected. */
	516
	517	static int
	518	m2_unbounded_array (struct type type, struct ui_file stream, int show,
79d43c61	519	int level, const struct type_print_options *flags)
844781a1 GM	520	{
	521	if (m2_is_unbounded_array (type))
	522	{
	523	if (show > 0)
	524	{
	525	fputs_filtered ("ARRAY OF ", stream);
	526	m2_print_type (TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 0)),
79d43c61	527	"", stream, 0, level, flags);
844781a1 GM	528	}
	529	return 1;
	530	}
	531	return 0;
	532	}
	533
72019c9c GM	534	void
72019c9c GM	535	m2_record_fields (struct type type, struct ui_file stream, int show,
79d43c61	536	int level, const struct type_print_options *flags)
72019c9c	537	{
844781a1	538	/* Print the tag if it exists. */
72019c9c GM	539	if (TYPE_TAG_NAME (type) != NULL)
72019c9c GM	540	{
61012eef	541	if (!startswith (TYPE_TAG_NAME (type), "$$"))
72019c9c GM	542	{
	543	fputs_filtered (TYPE_TAG_NAME (type), stream);
	544	if (show > 0)
	545	fprintf_filtered (stream, " = ");
	546	}
	547	}
	548	wrap_here (" ");
	549	if (show < 0)
	550	{
0cc2414c	551	if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
72019c9c	552	fprintf_filtered (stream, "RECORD ... END ");
0cc2414c	553	else if (TYPE_CODE (type) == TYPE_CODE_UNION)
72019c9c GM	554	fprintf_filtered (stream, "CASE ... END ");
	555	}
	556	else if (show > 0)
	557	{
5648af48 JB	558	int i;
	559	int len = TYPE_NFIELDS (type);
	560
72019c9c GM	561	if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
	562	fprintf_filtered (stream, "RECORD\n");
	563	else if (TYPE_CODE (type) == TYPE_CODE_UNION)
025bb325	564	/* i18n: Do not translate "CASE" and "OF". */
72019c9c	565	fprintf_filtered (stream, _("CASE <variant> OF\n"));
72019c9c GM	566
	567	for (i = TYPE_N_BASECLASSES (type); i < len; i++)
	568	{
	569	QUIT;
	570
	571	print_spaces_filtered (level + 4, stream);
	572	fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
	573	fputs_filtered (" : ", stream);
	574	m2_print_type (TYPE_FIELD_TYPE (type, i),
	575	"",
79d43c61	576	stream, 0, level + 4, flags);
72019c9c GM	577	if (TYPE_FIELD_PACKED (type, i))
	578	{
	579	/* It is a bitfield. This code does not attempt
	580	to look at the bitpos and reconstruct filler,
	581	unnamed fields. This would lead to misleading
	582	results if the compiler does not put out fields
	583	for such things (I don't know what it does). */
	584	fprintf_filtered (stream, " : %d",
	585	TYPE_FIELD_BITSIZE (type, i));
	586	}
	587	fprintf_filtered (stream, ";\n");
	588	}
	589
	590	fprintfi_filtered (level, stream, "END ");
	591	}
	592	}
	593
	594	void
	595	m2_enum (struct type type, struct ui_file stream, int show, int level)
	596	{
b4aa388a SP	597	LONGEST lastval;
b4aa388a SP	598	int i, len;
c906108c	599
72019c9c GM	600	if (show < 0)
	601	{
	602	/* If we just printed a tag name, no need to print anything else. */
	603	if (TYPE_TAG_NAME (type) == NULL)
	604	fprintf_filtered (stream, "(...)");
	605	}
	606	else if (show > 0 \|\| TYPE_TAG_NAME (type) == NULL)
	607	{
	608	fprintf_filtered (stream, "(");
	609	len = TYPE_NFIELDS (type);
	610	lastval = 0;
	611	for (i = 0; i < len; i++)
	612	{
	613	QUIT;
	614	if (i > 0)
	615	fprintf_filtered (stream, ", ");
	616	wrap_here (" ");
	617	fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
14e75d8e	618	if (lastval != TYPE_FIELD_ENUMVAL (type, i))
72019c9c	619	{
14e75d8e JK	620	fprintf_filtered (stream, " = %s",
	621	plongest (TYPE_FIELD_ENUMVAL (type, i)));
	622	lastval = TYPE_FIELD_ENUMVAL (type, i);
72019c9c GM	623	}
	624	lastval++;
	625	}
	626	fprintf_filtered (stream, ")");
	627	}
c906108c	628	}