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