[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-2012 Free
   Software Foundation, Inc.

   This file is part of GDB.

   This program is free software; you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 3 of the License, or
   (at your option) any later version.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */

#include "defs.h"
#include "gdb_obstack.h"
#include "bfd.h"		/* Binary File Description */
#include "symtab.h"
#include "gdbtypes.h"
#include "expression.h"
#include "value.h"
#include "gdbcore.h"
#include "m2-lang.h"
#include "target.h"
#include "language.h"
#include "demangle.h"
#include "c-lang.h"
#include "typeprint.h"
#include "cp-abi.h"

#include "gdb_string.h"
#include <errno.h>

static void m2_print_bounds (struct type *type,
			     struct ui_file *stream, int show, int level,
			     int print_high);

static void m2_typedef (struct type *, struct ui_file *, int, int,
			const struct type_print_options *);
static void m2_array (struct type *, struct ui_file *, int, int,
		      const struct type_print_options *);
static void m2_pointer (struct type *, struct ui_file *, int, int,
			const struct type_print_options *);
static void m2_ref (struct type *, struct ui_file *, int, int,
		    const struct type_print_options *);
static void m2_procedure (struct type *, struct ui_file *, int, int,
			  const struct type_print_options *);
static void m2_union (struct type *, struct ui_file *);
static void m2_enum (struct type *, struct ui_file *, int, int);
static void m2_range (struct type *, struct ui_file *, int, int,
		      const struct type_print_options *);
static void m2_type_name (struct type *type, struct ui_file *stream);
static void m2_short_set (struct type *type, struct ui_file *stream,
			  int show, int level);
static int m2_long_set (struct type *type, struct ui_file *stream,
			int show, int level, const struct type_print_options *flags);
static int m2_unbounded_array (struct type *type, struct ui_file *stream,
			       int show, int level,
			       const struct type_print_options *flags);
static void m2_record_fields (struct type *type, struct ui_file *stream,
			      int show, int level, const struct type_print_options *flags);
static void m2_unknown (const char *s, struct type *type,
			struct ui_file *stream, int show, int level);

int m2_is_long_set (struct type *type);
int m2_is_long_set_of_type (struct type *type, struct type **of_type);
int m2_is_unbounded_array (struct type *type);


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

  CHECK_TYPEDEF (type);

  QUIT;

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

  code = TYPE_CODE (type);
  switch (TYPE_CODE (type))
    {
    case TYPE_CODE_SET:
      m2_short_set(type, stream, show, level);
      break;

    case TYPE_CODE_STRUCT:
      if (m2_long_set (type, stream, show, level, flags)
	  || m2_unbounded_array (type, stream, show, level, flags))
	break;
      m2_record_fields (type, stream, show, level, flags);
      break;

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

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

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

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

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

    case TYPE_CODE_FUNC:
      m2_procedure (type, stream, show, level, flags);
      break;

    case TYPE_CODE_UNION:
      m2_union (type, stream);
      break;

    case TYPE_CODE_ENUM:
      m2_enum (type, stream, show, level);
      break;

    case TYPE_CODE_VOID:
      break;

    case TYPE_CODE_UNDEF:
      /* i18n: Do not translate the "struct" part!  */
      m2_unknown (_("undef"), type, stream, show, level);
      break;

    case TYPE_CODE_ERROR:
      m2_unknown (_("error"), type, stream, show, level);
      break;

    case TYPE_CODE_RANGE:
      m2_range (type, stream, show, level, flags);
      break;

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

/* Print a typedef using M2 syntax.  TYPE is the underlying type.
   NEW_SYMBOL is the symbol naming the type.  STREAM is the stream on
   which to print.  */

void
m2_print_typedef (struct type *type, struct symbol *new_symbol,
		  struct ui_file *stream)
{
  CHECK_TYPEDEF (type);
  fprintf_filtered (stream, "TYPE ");
  if (!TYPE_NAME (SYMBOL_TYPE (new_symbol))
      || strcmp (TYPE_NAME ((SYMBOL_TYPE (new_symbol))),
		 SYMBOL_LINKAGE_NAME (new_symbol)) != 0)
    fprintf_filtered (stream, "%s = ", SYMBOL_PRINT_NAME (new_symbol));
  else
    fprintf_filtered (stream, "<builtin> = ");
  type_print (type, "", stream, 0);
  fprintf_filtered (stream, ";\n");
}

/* m2_type_name - if a, type, has a name then print it.  */

void
m2_type_name (struct type *type, struct ui_file *stream)
{
  if (TYPE_NAME (type) != NULL)
    fputs_filtered (TYPE_NAME (type), stream);
}

/* m2_range - displays a Modula-2 subrange type.  */

void
m2_range (struct type *type, struct ui_file *stream, int show,
	  int level, const struct type_print_options *flags)
{
  if (TYPE_HIGH_BOUND (type) == TYPE_LOW_BOUND (type))
    m2_print_type (TYPE_DOMAIN_TYPE (type), "", stream, show, level,
		   flags);
  else
    {
      struct type *target = TYPE_TARGET_TYPE (type);

      fprintf_filtered (stream, "[");
      print_type_scalar (target, TYPE_LOW_BOUND (type), stream);
      fprintf_filtered (stream, "..");
      print_type_scalar (target, TYPE_HIGH_BOUND (type), stream);
      fprintf_filtered (stream, "]");
    }
}

static void
m2_typedef (struct type *type, struct ui_file *stream, int show,
	    int level, const struct type_print_options *flags)
{
  if (TYPE_NAME (type) != NULL)
    {
      fputs_filtered (TYPE_NAME (type), stream);
      fputs_filtered (" = ", stream);
    }
  m2_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level, flags);
}

/* m2_array - prints out a Modula-2 ARRAY ... OF type.  */

static void m2_array (struct type *type, struct ui_file *stream,
		      int show, int level, const struct type_print_options *flags)
{
  fprintf_filtered (stream, "ARRAY [");
  if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0
      && !TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
    {
      if (TYPE_INDEX_TYPE (type) != 0)
	{
	  m2_print_bounds (TYPE_INDEX_TYPE (type), stream, show, -1, 0);
	  fprintf_filtered (stream, "..");
	  m2_print_bounds (TYPE_INDEX_TYPE (type), stream, show, -1, 1);
	}
      else
	fprintf_filtered (stream, "%d",
			  (TYPE_LENGTH (type)
			   / TYPE_LENGTH (TYPE_TARGET_TYPE (type))));
    }
  fprintf_filtered (stream, "] OF ");
  m2_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level, flags);
}

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

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

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

static void
m2_unknown (const char *s, struct type *type, struct ui_file *stream,
	    int show, int level)
{
  fprintf_filtered (stream, "%s %s", s, _("is unknown"));
}

static void m2_union (struct type *type, struct ui_file *stream)
{
  fprintf_filtered (stream, "union");
}

static void
m2_procedure (struct type *type, struct ui_file *stream,
	      int show, int level, const struct type_print_options *flags)
{
  fprintf_filtered (stream, "PROCEDURE ");
  m2_type_name (type, stream);
  if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
    {
      int i, len = TYPE_NFIELDS (type);

      fprintf_filtered (stream, " (");
      for (i = 0; i < len; i++)
	{
	  if (i > 0)
	    {
	      fputs_filtered (", ", stream);
	      wrap_here ("    ");
	    }
	  m2_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0, flags);
	}
      if (TYPE_TARGET_TYPE (type) != NULL)
	{
	  fprintf_filtered (stream, " : ");
	  m2_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, 0, flags);
	}
    }
}

static void
m2_print_bounds (struct type *type,
		 struct ui_file *stream, int show, int level,
		 int print_high)
{
  struct type *target = TYPE_TARGET_TYPE (type);

  if (TYPE_NFIELDS(type) == 0)
    return;

  if (print_high)
    print_type_scalar (target, TYPE_HIGH_BOUND (type), stream);
  else
    print_type_scalar (target, TYPE_LOW_BOUND (type), stream);
}

static void
m2_short_set (struct type *type, struct ui_file *stream, int show, int level)
{
  fprintf_filtered(stream, "SET [");
  m2_print_bounds (TYPE_INDEX_TYPE (type), stream,
		   show - 1, level, 0);

  fprintf_filtered(stream, "..");
  m2_print_bounds (TYPE_INDEX_TYPE (type), stream,
		   show - 1, level, 1);
  fprintf_filtered(stream, "]");
}

int
m2_is_long_set (struct type *type)
{
  LONGEST previous_high = 0;  /* Unnecessary initialization
				 keeps gcc -Wall happy.  */
  int len, i;
  struct type *range;

  if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
    {

      /* check if all fields of the RECORD are consecutive sets.  */

      len = TYPE_NFIELDS (type);
      for (i = TYPE_N_BASECLASSES (type); i < len; i++)
	{
	  if (TYPE_FIELD_TYPE (type, i) == NULL)
	    return 0;
	  if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) != TYPE_CODE_SET)
	    return 0;
	  if (TYPE_FIELD_NAME (type, i) != NULL
	      && (strcmp (TYPE_FIELD_NAME (type, i), "") != 0))
	    return 0;
	  range = TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, i));
	  if ((i > TYPE_N_BASECLASSES (type))
	      && previous_high + 1 != TYPE_LOW_BOUND (range))
	    return 0;
	  previous_high = TYPE_HIGH_BOUND (range);
	}
      return len>0;
    }
  return 0;
}

/* m2_get_discrete_bounds - a wrapper for get_discrete_bounds which
                            understands that CHARs might be signed.
                            This should be integrated into gdbtypes.c
                            inside get_discrete_bounds.  */

static int
m2_get_discrete_bounds (struct type *type, LONGEST *lowp, LONGEST *highp)
{
  CHECK_TYPEDEF (type);
  switch (TYPE_CODE (type))
    {
    case TYPE_CODE_CHAR:
      if (TYPE_LENGTH (type) < sizeof (LONGEST))
	{
	  if (!TYPE_UNSIGNED (type))
	    {
	      *lowp = -(1 << (TYPE_LENGTH (type) * TARGET_CHAR_BIT - 1));
	      *highp = -*lowp - 1;
	      return 0;
	    }
	}
      /* fall through */
    default:
      return get_discrete_bounds (type, lowp, highp);
    }
}

/* m2_is_long_set_of_type - returns TRUE if the long set was declared as
                            SET OF <oftype> of_type is assigned to the
                            subtype.  */

int
m2_is_long_set_of_type (struct type *type, struct type **of_type)
{
  int len, i;
  struct type *range;
  struct type *target;
  LONGEST l1, l2;
  LONGEST h1, h2;

  if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
    {
      len = TYPE_NFIELDS (type);
      i = TYPE_N_BASECLASSES (type);
      if (len == 0)
	return 0;
      range = TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, i));
      target = TYPE_TARGET_TYPE (range);

      l1 = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, i)));
      h1 = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, len-1)));
      *of_type = target;
      if (m2_get_discrete_bounds (target, &l2, &h2) >= 0)
	return (l1 == l2 && h1 == h2);
      error (_("long_set failed to find discrete bounds for its subtype"));
      return 0;
    }
  error (_("expecting long_set"));
  return 0;
}

static int
m2_long_set (struct type *type, struct ui_file *stream, int show, int level,
	     const struct type_print_options *flags)
{
  struct type *of_type;
  int i;
  int len = TYPE_NFIELDS (type);
  LONGEST low;
  LONGEST high;

  if (m2_is_long_set (type))
    {
      if (TYPE_TAG_NAME (type) != NULL)
	{
	  fputs_filtered (TYPE_TAG_NAME (type), stream);
	  if (show == 0)
	    return 1;
	}
      else if (TYPE_NAME (type) != NULL)
	{
	  fputs_filtered (TYPE_NAME (type), stream);
	  if (show == 0)
	    return 1;
	}

      if (TYPE_TAG_NAME (type) != NULL || TYPE_NAME (type) != NULL)
	fputs_filtered (" = ", stream);

      if (get_long_set_bounds (type, &low, &high))
	{
	  fprintf_filtered(stream, "SET OF ");
	  i = TYPE_N_BASECLASSES (type);
	  if (m2_is_long_set_of_type (type, &of_type))
	    m2_print_type (of_type, "", stream, show - 1, level, flags);
	  else
	    {
	      fprintf_filtered(stream, "[");
	      m2_print_bounds (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, i)),
			       stream, show - 1, level, 0);

	      fprintf_filtered(stream, "..");

	      m2_print_bounds (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, len-1)),
			       stream, show - 1, level, 1);
	      fprintf_filtered(stream, "]");
	    }
	}
      else
	/* i18n: Do not translate the "SET OF" part!  */
	fprintf_filtered(stream, _("SET OF <unknown>"));

      return 1;
    }
  return 0;
}

/* m2_is_unbounded_array - returns TRUE if, type, should be regarded
                           as a Modula-2 unbounded ARRAY type.  */

int
m2_is_unbounded_array (struct type *type)
{
  if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
    {
      /*
       *  check if we have a structure with exactly two fields named
       *  _m2_contents and _m2_high.  It also checks to see if the
       *  type of _m2_contents is a pointer.  The TYPE_TARGET_TYPE
       *  of the pointer determines the unbounded ARRAY OF type.
       */
      if (TYPE_NFIELDS (type) != 2)
	return 0;
      if (strcmp (TYPE_FIELD_NAME (type, 0), "_m2_contents") != 0)
	return 0;
      if (strcmp (TYPE_FIELD_NAME (type, 1), "_m2_high") != 0)
	return 0;
      if (TYPE_CODE (TYPE_FIELD_TYPE (type, 0)) != TYPE_CODE_PTR)
	return 0;
      return 1;
    }
  return 0;
}

/* m2_unbounded_array - if the struct type matches a Modula-2 unbounded
                        parameter type then display the type as an
                        ARRAY OF type.  Returns TRUE if an unbounded
                        array type was detected.  */

static int
m2_unbounded_array (struct type *type, struct ui_file *stream, int show,
		    int level, const struct type_print_options *flags)
{
  if (m2_is_unbounded_array (type))
    {
      if (show > 0)
	{
	  fputs_filtered ("ARRAY OF ", stream);
	  m2_print_type (TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 0)),
			 "", stream, 0, level, flags);
	}
      return 1;
    }
  return 0;
}

void
m2_record_fields (struct type *type, struct ui_file *stream, int show,
		  int level, const struct type_print_options *flags)
{
  /* Print the tag if it exists.  */
  if (TYPE_TAG_NAME (type) != NULL)
    {
      if (strncmp (TYPE_TAG_NAME (type), "$$", 2) != 0)
	{
	  fputs_filtered (TYPE_TAG_NAME (type), stream);
	  if (show > 0)
	    fprintf_filtered (stream, " = ");
	}
    }
  wrap_here ("    ");
  if (show < 0)
    {
      if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
	fprintf_filtered (stream, "RECORD ... END ");
      else if (TYPE_CODE (type) == TYPE_CODE_UNION)
	fprintf_filtered (stream, "CASE ... END ");
    }
  else if (show > 0)
    {
      int i;
      int len = TYPE_NFIELDS (type);

      if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
	fprintf_filtered (stream, "RECORD\n");
      else if (TYPE_CODE (type) == TYPE_CODE_UNION)
	/* i18n: Do not translate "CASE" and "OF".  */
	fprintf_filtered (stream, _("CASE <variant> OF\n"));

      for (i = TYPE_N_BASECLASSES (type); i < len; i++)
	{
	  QUIT;

	  print_spaces_filtered (level + 4, stream);
	  fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
	  fputs_filtered (" : ", stream);
	  m2_print_type (TYPE_FIELD_TYPE (type, i),
			 "",
			 stream, 0, level + 4, flags);
	  if (TYPE_FIELD_PACKED (type, i))
	    {
	      /* It is a bitfield.  This code does not attempt
		 to look at the bitpos and reconstruct filler,
		 unnamed fields.  This would lead to misleading
		 results if the compiler does not put out fields
		 for such things (I don't know what it does).  */
	      fprintf_filtered (stream, " : %d",
				TYPE_FIELD_BITSIZE (type, i));
	    }
	  fprintf_filtered (stream, ";\n");
	}
      
      fprintfi_filtered (level, stream, "END ");
    }
}

void
m2_enum (struct type *type, struct ui_file *stream, int show, int level)
{
  LONGEST lastval;
  int i, len;

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