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

/* Support for printing Modula 2 types for GDB, the GNU debugger.
   Copyright (C) 1986, 1988, 1989, 1991, 1992, 1995, 2000, 2001, 2002, 2003,
                 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
                 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);
static void m2_array (struct type *, struct ui_file *, int, int);
static void m2_pointer (struct type *, struct ui_file *, int, int);
static void m2_ref (struct type *, struct ui_file *, int, int);
static void m2_procedure (struct type *, struct ui_file *, int, int);
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);
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);
static int m2_unbounded_array (struct type *type, struct ui_file *stream,
			       int show, int level);
static void m2_record_fields (struct type *type, struct ui_file *stream,
			      int show, int level);
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)
{
  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)
	  || m2_unbounded_array (type, stream, show, level))
	break;
      m2_record_fields (type, stream, show, level);
      break;

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

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

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

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

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

    case TYPE_CODE_FUNC:
      m2_procedure (type, stream, show, level);
      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);
      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)
{
  if (TYPE_HIGH_BOUND (type) == TYPE_LOW_BOUND (type))
    m2_print_type (TYPE_DOMAIN_TYPE (type), "", stream, show, level);
  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)
{
  if (TYPE_NAME (type) != NULL)
    {
      fputs_filtered (TYPE_NAME (type), stream);
      fputs_filtered (" = ", stream);
    }
  m2_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level);
}

/* 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)
{
  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);
}

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

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

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

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)
{
  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);
	}
      if (TYPE_TARGET_TYPE (type) != NULL)
	{
	  fprintf_filtered (stream, " : ");
	  m2_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, 0);
	}
    }
}

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)
{
  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);
	  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)
{
  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);
	}
      return 1;
    }
  return 0;
}

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