[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)
{
  enum type_code code;

  CHECK_TYPEDEF (type);

  QUIT;

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

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