[deliverable/binutils-gdb.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 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 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);


void
m2_print_type (struct type *type, char *varstring, struct ui_file *stream,
	       int show, int level)
{
  enum type_code code;
  int demangled_args;

  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))
	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;

    case TYPE_CODE_TEMPLATE:
      break;

    default:
      m2_type_name (type, stream);
      break;
    }
}

/*
 *  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_TYPE (type) != BOUND_CANNOT_BE_DETERMINED)
    {
      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 (target == NULL)
    target = builtin_type_int;

  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.
 */

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);
      if (target == NULL)
	target = builtin_type_int;

      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 *index_type;
  struct type *range_type;
  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;
}

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