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

/* Support for printing Modula 2 types for GDB, the GNU debugger.
   Copyright (C) 1986-2013 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"

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