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

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