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

/* Support for printing Modula 2 types for GDB, the GNU debugger.
   Copyright (C) 1986-2019 Free Software Foundation, Inc.

   This file is part of GDB.

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

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

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

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

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

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

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


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

  QUIT;

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

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

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

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

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

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

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

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

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

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

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

    case TYPE_CODE_VOID:
      break;

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

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

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

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

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

void
m2_print_typedef (struct type *type, struct symbol *new_symbol,
		  struct ui_file *stream)
{
  type = 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))
    {
      /* FIXME: TYPE_TARGET_TYPE used to be TYPE_DOMAIN_TYPE but that was
	 wrong.  Not sure if TYPE_TARGET_TYPE is correct though.  */
      m2_print_type (TYPE_TARGET_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
	fputs_filtered (pulongest ((TYPE_LENGTH (type)
				    / TYPE_LENGTH (TYPE_TARGET_TYPE (type)))),
			stream);
    }
  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_TARGET_TYPE (type) == NULL
      || 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);
	}
      fprintf_filtered (stream, ") : ");
      if (TYPE_TARGET_TYPE (type) != NULL)
	m2_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, 0, flags);
      else
	type_print_unknown_return_type (stream);
    }
}

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)
{
  type = 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_NAME (type) != NULL)
	{
	  fputs_filtered (TYPE_NAME (type), stream);
	  if (show == 0)
	    return 1;
	  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_NAME (type) != NULL)
    {
      if (!startswith (TYPE_NAME (type), "$$"))
	{
	  fputs_filtered (TYPE_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_NAME (type) == NULL)
	fprintf_filtered (stream, "(...)");
    }
  else if (show > 0 || TYPE_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.
42a4f53d	2	Copyright (C) 1986-2019 Free Software Foundation, Inc.
c906108c	3
c5aa993b JM	4	This file is part of GDB.
	5
	6	This program is free software; you can redistribute it and/or modify
	7	it under the terms of the GNU General Public License as published by
a9762ec7	8	the Free Software Foundation; either version 3 of the License, or
c5aa993b JM	9	(at your option) any later version.
	10
	11	This program is distributed in the hope that it will be useful,
	12	but WITHOUT ANY WARRANTY; without even the implied warranty of
	13	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	14	GNU General Public License for more details.
	15
	16	You should have received a copy of the GNU General Public License
a9762ec7	17	along with this program. If not, see <http://www.gnu.org/licenses/>. */
c906108c SS	18
c906108c SS	19	#include "defs.h"
72019c9c	20	#include "gdb_obstack.h"
c906108c SS	21	#include "bfd.h" /* Binary File Description */
	22	#include "symtab.h"
	23	#include "gdbtypes.h"
	24	#include "expression.h"
	25	#include "value.h"
	26	#include "gdbcore.h"
c906108c	27	#include "m2-lang.h"
72019c9c GM	28	#include "target.h"
	29	#include "language.h"
	30	#include "demangle.h"
	31	#include "c-lang.h"
	32	#include "typeprint.h"
	33	#include "cp-abi.h"
c906108c	34
72019c9c GM	35	static void m2_print_bounds (struct type *type,
	36	struct ui_file *stream, int show, int level,
	37	int print_high);
	38
79d43c61 TT	39	static void m2_typedef (struct type , struct ui_file , int, int,
	40	const struct type_print_options *);
	41	static void m2_array (struct type , struct ui_file , int, int,
	42	const struct type_print_options *);
	43	static void m2_pointer (struct type , struct ui_file , int, int,
	44	const struct type_print_options *);
	45	static void m2_ref (struct type , struct ui_file , int, int,
	46	const struct type_print_options *);
	47	static void m2_procedure (struct type , struct ui_file , int, int,
	48	const struct type_print_options *);
72019c9c GM	49	static void m2_union (struct type , struct ui_file );
72019c9c GM	50	static void m2_enum (struct type , struct ui_file , int, int);
79d43c61 TT	51	static void m2_range (struct type , struct ui_file , int, int,
79d43c61 TT	52	const struct type_print_options *);
72019c9c GM	53	static void m2_type_name (struct type type, struct ui_file stream);
	54	static void m2_short_set (struct type type, struct ui_file stream,
	55	int show, int level);
	56	static int m2_long_set (struct type type, struct ui_file stream,
79d43c61	57	int show, int level, const struct type_print_options *flags);
844781a1	58	static int m2_unbounded_array (struct type type, struct ui_file stream,
79d43c61 TT	59	int show, int level,
79d43c61 TT	60	const struct type_print_options *flags);
72019c9c	61	static void m2_record_fields (struct type type, struct ui_file stream,
79d43c61	62	int show, int level, const struct type_print_options *flags);
72019c9c GM	63	static void m2_unknown (const char s, struct type type,
	64	struct ui_file *stream, int show, int level);
	65
	66	int m2_is_long_set (struct type *type);
	67	int m2_is_long_set_of_type (struct type type, struct type *of_type);
844781a1	68	int m2_is_unbounded_array (struct type *type);
72019c9c GM	69
72019c9c GM	70
c906108c	71	void
025bb325 MS	72	m2_print_type (struct type type, const char varstring,
025bb325 MS	73	struct ui_file *stream,
79d43c61 TT	74	int show, int level,
79d43c61 TT	75	const struct type_print_options *flags)
c906108c	76	{
f168693b	77	type = check_typedef (type);
72019c9c GM	78
	79	QUIT;
	80
	81	wrap_here (" ");
	82	if (type == NULL)
	83	{
	84	fputs_filtered (_("<type unknown>"), stream);
	85	return;
	86	}
	87
	88	switch (TYPE_CODE (type))
	89	{
	90	case TYPE_CODE_SET:
	91	m2_short_set(type, stream, show, level);
	92	break;
	93
	94	case TYPE_CODE_STRUCT:
79d43c61 TT	95	if (m2_long_set (type, stream, show, level, flags)
79d43c61 TT	96	\|\| m2_unbounded_array (type, stream, show, level, flags))
72019c9c	97	break;
79d43c61	98	m2_record_fields (type, stream, show, level, flags);
72019c9c GM	99	break;
	100
	101	case TYPE_CODE_TYPEDEF:
79d43c61	102	m2_typedef (type, stream, show, level, flags);
72019c9c GM	103	break;
	104
	105	case TYPE_CODE_ARRAY:
79d43c61	106	m2_array (type, stream, show, level, flags);
72019c9c GM	107	break;
	108
	109	case TYPE_CODE_PTR:
79d43c61	110	m2_pointer (type, stream, show, level, flags);
72019c9c GM	111	break;
	112
	113	case TYPE_CODE_REF:
79d43c61	114	m2_ref (type, stream, show, level, flags);
72019c9c GM	115	break;
72019c9c GM	116
72019c9c GM	117	case TYPE_CODE_METHOD:
	118	m2_unknown (_("method"), type, stream, show, level);
	119	break;
	120
	121	case TYPE_CODE_FUNC:
79d43c61	122	m2_procedure (type, stream, show, level, flags);
72019c9c GM	123	break;
	124
	125	case TYPE_CODE_UNION:
	126	m2_union (type, stream);
	127	break;
	128
	129	case TYPE_CODE_ENUM:
	130	m2_enum (type, stream, show, level);
	131	break;
	132
	133	case TYPE_CODE_VOID:
	134	break;
	135
	136	case TYPE_CODE_UNDEF:
025bb325	137	/* i18n: Do not translate the "struct" part! */
72019c9c GM	138	m2_unknown (_("undef"), type, stream, show, level);
	139	break;
	140
	141	case TYPE_CODE_ERROR:
	142	m2_unknown (_("error"), type, stream, show, level);
	143	break;
	144
	145	case TYPE_CODE_RANGE:
79d43c61	146	m2_range (type, stream, show, level, flags);
72019c9c GM	147	break;
72019c9c GM	148
72019c9c GM	149	default:
	150	m2_type_name (type, stream);
	151	break;
	152	}
	153	}
	154
5c6ce71d TT	155	/* Print a typedef using M2 syntax. TYPE is the underlying type.
	156	NEW_SYMBOL is the symbol naming the type. STREAM is the stream on
	157	which to print. */
	158
	159	void
	160	m2_print_typedef (struct type type, struct symbol new_symbol,
	161	struct ui_file *stream)
	162	{
f168693b	163	type = check_typedef (type);
5c6ce71d TT	164	fprintf_filtered (stream, "TYPE ");
	165	if (!TYPE_NAME (SYMBOL_TYPE (new_symbol))
	166	\|\| strcmp (TYPE_NAME ((SYMBOL_TYPE (new_symbol))),
	167	SYMBOL_LINKAGE_NAME (new_symbol)) != 0)
	168	fprintf_filtered (stream, "%s = ", SYMBOL_PRINT_NAME (new_symbol));
	169	else
	170	fprintf_filtered (stream, "<builtin> = ");
	171	type_print (type, "", stream, 0);
	172	fprintf_filtered (stream, ";\n");
	173	}
	174
844781a1	175	/* m2_type_name - if a, type, has a name then print it. */
72019c9c GM	176
	177	void
	178	m2_type_name (struct type type, struct ui_file stream)
	179	{
	180	if (TYPE_NAME (type) != NULL)
	181	fputs_filtered (TYPE_NAME (type), stream);
	182	}
	183
844781a1	184	/* m2_range - displays a Modula-2 subrange type. */
72019c9c GM	185
	186	void
	187	m2_range (struct type type, struct ui_file stream, int show,
79d43c61	188	int level, const struct type_print_options *flags)
72019c9c GM	189	{
72019c9c GM	190	if (TYPE_HIGH_BOUND (type) == TYPE_LOW_BOUND (type))
09e2d7c7 DE	191	{
	192	/* FIXME: TYPE_TARGET_TYPE used to be TYPE_DOMAIN_TYPE but that was
	193	wrong. Not sure if TYPE_TARGET_TYPE is correct though. */
	194	m2_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level,
	195	flags);
	196	}
72019c9c GM	197	else
	198	{
	199	struct type *target = TYPE_TARGET_TYPE (type);
	200
	201	fprintf_filtered (stream, "[");
	202	print_type_scalar (target, TYPE_LOW_BOUND (type), stream);
	203	fprintf_filtered (stream, "..");
	204	print_type_scalar (target, TYPE_HIGH_BOUND (type), stream);
	205	fprintf_filtered (stream, "]");
	206	}
	207	}
	208
	209	static void
	210	m2_typedef (struct type type, struct ui_file stream, int show,
79d43c61	211	int level, const struct type_print_options *flags)
72019c9c GM	212	{
	213	if (TYPE_NAME (type) != NULL)
	214	{
	215	fputs_filtered (TYPE_NAME (type), stream);
	216	fputs_filtered (" = ", stream);
	217	}
79d43c61	218	m2_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level, flags);
72019c9c GM	219	}
72019c9c GM	220
844781a1	221	/* m2_array - prints out a Modula-2 ARRAY ... OF type. */
72019c9c GM	222
72019c9c GM	223	static void m2_array (struct type type, struct ui_file stream,
79d43c61	224	int show, int level, const struct type_print_options *flags)
72019c9c GM	225	{
72019c9c GM	226	fprintf_filtered (stream, "ARRAY [");
d5d6fca5	227	if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0
d78df370	228	&& !TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
72019c9c GM	229	{
	230	if (TYPE_INDEX_TYPE (type) != 0)
	231	{
	232	m2_print_bounds (TYPE_INDEX_TYPE (type), stream, show, -1, 0);
	233	fprintf_filtered (stream, "..");
	234	m2_print_bounds (TYPE_INDEX_TYPE (type), stream, show, -1, 1);
	235	}
	236	else
cc1defb1 KS	237	fputs_filtered (pulongest ((TYPE_LENGTH (type)
	238	/ TYPE_LENGTH (TYPE_TARGET_TYPE (type)))),
	239	stream);
72019c9c GM	240	}
72019c9c GM	241	fprintf_filtered (stream, "] OF ");
79d43c61	242	m2_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level, flags);
72019c9c GM	243	}
	244
	245	static void
	246	m2_pointer (struct type type, struct ui_file stream, int show,
79d43c61	247	int level, const struct type_print_options *flags)
72019c9c GM	248	{
	249	if (TYPE_CONST (type))
	250	fprintf_filtered (stream, "[...] : ");
	251	else
	252	fprintf_filtered (stream, "POINTER TO ");
	253
79d43c61	254	m2_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level, flags);
72019c9c GM	255	}
	256
	257	static void
	258	m2_ref (struct type type, struct ui_file stream, int show,
79d43c61	259	int level, const struct type_print_options *flags)
72019c9c GM	260	{
72019c9c GM	261	fprintf_filtered (stream, "VAR");
79d43c61	262	m2_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level, flags);
72019c9c GM	263	}
	264
	265	static void
	266	m2_unknown (const char s, struct type type, struct ui_file *stream,
	267	int show, int level)
	268	{
	269	fprintf_filtered (stream, "%s %s", s, _("is unknown"));
	270	}
	271
	272	static void m2_union (struct type type, struct ui_file stream)
	273	{
	274	fprintf_filtered (stream, "union");
	275	}
	276
	277	static void
	278	m2_procedure (struct type type, struct ui_file stream,
79d43c61	279	int show, int level, const struct type_print_options *flags)
72019c9c GM	280	{
	281	fprintf_filtered (stream, "PROCEDURE ");
	282	m2_type_name (type, stream);
7022349d PA	283	if (TYPE_TARGET_TYPE (type) == NULL
7022349d PA	284	\|\| TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
72019c9c GM	285	{
	286	int i, len = TYPE_NFIELDS (type);
	287
	288	fprintf_filtered (stream, " (");
	289	for (i = 0; i < len; i++)
	290	{
	291	if (i > 0)
	292	{
	293	fputs_filtered (", ", stream);
	294	wrap_here (" ");
	295	}
79d43c61	296	m2_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0, flags);
72019c9c	297	}
7022349d	298	fprintf_filtered (stream, ") : ");
72019c9c	299	if (TYPE_TARGET_TYPE (type) != NULL)
7022349d PA	300	m2_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, 0, flags);
	301	else
	302	type_print_unknown_return_type (stream);
72019c9c GM	303	}
	304	}
	305
	306	static void
	307	m2_print_bounds (struct type *type,
	308	struct ui_file *stream, int show, int level,
	309	int print_high)
	310	{
	311	struct type *target = TYPE_TARGET_TYPE (type);
	312
72019c9c GM	313	if (TYPE_NFIELDS(type) == 0)
	314	return;
	315
	316	if (print_high)
	317	print_type_scalar (target, TYPE_HIGH_BOUND (type), stream);
	318	else
	319	print_type_scalar (target, TYPE_LOW_BOUND (type), stream);
	320	}
	321
	322	static void
	323	m2_short_set (struct type type, struct ui_file stream, int show, int level)
	324	{
	325	fprintf_filtered(stream, "SET [");
	326	m2_print_bounds (TYPE_INDEX_TYPE (type), stream,
	327	show - 1, level, 0);
	328
	329	fprintf_filtered(stream, "..");
	330	m2_print_bounds (TYPE_INDEX_TYPE (type), stream,
	331	show - 1, level, 1);
	332	fprintf_filtered(stream, "]");
	333	}
	334
	335	int
	336	m2_is_long_set (struct type *type)
	337	{
025bb325 MS	338	LONGEST previous_high = 0; /* Unnecessary initialization
025bb325 MS	339	keeps gcc -Wall happy. */
72019c9c GM	340	int len, i;
	341	struct type *range;
	342
	343	if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
	344	{
	345
844781a1 GM	346	/* check if all fields of the RECORD are consecutive sets. */
844781a1 GM	347
72019c9c GM	348	len = TYPE_NFIELDS (type);
	349	for (i = TYPE_N_BASECLASSES (type); i < len; i++)
	350	{
	351	if (TYPE_FIELD_TYPE (type, i) == NULL)
	352	return 0;
	353	if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) != TYPE_CODE_SET)
	354	return 0;
	355	if (TYPE_FIELD_NAME (type, i) != NULL
	356	&& (strcmp (TYPE_FIELD_NAME (type, i), "") != 0))
	357	return 0;
	358	range = TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, i));
	359	if ((i > TYPE_N_BASECLASSES (type))
	360	&& previous_high + 1 != TYPE_LOW_BOUND (range))
	361	return 0;
	362	previous_high = TYPE_HIGH_BOUND (range);
	363	}
	364	return len>0;
	365	}
	366	return 0;
	367	}
	368
844781a1 GM	369	/* m2_get_discrete_bounds - a wrapper for get_discrete_bounds which
	370	understands that CHARs might be signed.
	371	This should be integrated into gdbtypes.c
	372	inside get_discrete_bounds. */
72019c9c	373
2c0b251b	374	static int
72019c9c GM	375	m2_get_discrete_bounds (struct type type, LONGEST lowp, LONGEST *highp)
72019c9c GM	376	{
f168693b	377	type = check_typedef (type);
72019c9c GM	378	switch (TYPE_CODE (type))
	379	{
	380	case TYPE_CODE_CHAR:
	381	if (TYPE_LENGTH (type) < sizeof (LONGEST))
	382	{
	383	if (!TYPE_UNSIGNED (type))
	384	{
	385	lowp = -(1 << (TYPE_LENGTH (type) TARGET_CHAR_BIT - 1));
	386	highp = -lowp - 1;
	387	return 0;
	388	}
	389	}
	390	/* fall through */
	391	default:
	392	return get_discrete_bounds (type, lowp, highp);
	393	}
	394	}
	395
844781a1 GM	396	/* m2_is_long_set_of_type - returns TRUE if the long set was declared as
	397	SET OF <oftype> of_type is assigned to the
	398	subtype. */
72019c9c GM	399
	400	int
	401	m2_is_long_set_of_type (struct type type, struct type *of_type)
	402	{
	403	int len, i;
	404	struct type *range;
	405	struct type *target;
	406	LONGEST l1, l2;
	407	LONGEST h1, h2;
	408
	409	if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
	410	{
	411	len = TYPE_NFIELDS (type);
	412	i = TYPE_N_BASECLASSES (type);
	413	if (len == 0)
	414	return 0;
	415	range = TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, i));
	416	target = TYPE_TARGET_TYPE (range);
72019c9c GM	417
	418	l1 = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, i)));
	419	h1 = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, len-1)));
	420	*of_type = target;
	421	if (m2_get_discrete_bounds (target, &l2, &h2) >= 0)
	422	return (l1 == l2 && h1 == h2);
	423	error (_("long_set failed to find discrete bounds for its subtype"));
	424	return 0;
	425	}
	426	error (_("expecting long_set"));
	427	return 0;
	428	}
	429
	430	static int
79d43c61 TT	431	m2_long_set (struct type type, struct ui_file stream, int show, int level,
79d43c61 TT	432	const struct type_print_options *flags)
72019c9c	433	{
72019c9c GM	434	struct type *of_type;
	435	int i;
	436	int len = TYPE_NFIELDS (type);
	437	LONGEST low;
	438	LONGEST high;
	439
	440	if (m2_is_long_set (type))
	441	{
e86ca25f	442	if (TYPE_NAME (type) != NULL)
72019c9c GM	443	{
	444	fputs_filtered (TYPE_NAME (type), stream);
	445	if (show == 0)
	446	return 1;
e86ca25f	447	fputs_filtered (" = ", stream);
72019c9c GM	448	}
72019c9c GM	449
72019c9c GM	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))
79d43c61	455	m2_print_type (of_type, "", stream, show - 1, level, flags);
72019c9c GM	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
025bb325	470	/* i18n: Do not translate the "SET OF" part! */
72019c9c GM	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,
79d43c61	512	int level, const struct type_print_options *flags)
844781a1 GM	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)),
79d43c61	520	"", stream, 0, level, flags);
844781a1 GM	521	}
	522	return 1;
	523	}
	524	return 0;
	525	}
	526
72019c9c GM	527	void
72019c9c GM	528	m2_record_fields (struct type type, struct ui_file stream, int show,
79d43c61	529	int level, const struct type_print_options *flags)
72019c9c	530	{
844781a1	531	/* Print the tag if it exists. */
e86ca25f	532	if (TYPE_NAME (type) != NULL)
72019c9c	533	{
e86ca25f	534	if (!startswith (TYPE_NAME (type), "$$"))
72019c9c	535	{
e86ca25f	536	fputs_filtered (TYPE_NAME (type), stream);
72019c9c GM	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)
025bb325	557	/* i18n: Do not translate "CASE" and "OF". */
72019c9c	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	"",
79d43c61	569	stream, 0, level + 4, flags);
72019c9c GM	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	{
b4aa388a SP	590	LONGEST lastval;
b4aa388a SP	591	int i, len;
c906108c	592
72019c9c GM	593	if (show < 0)
	594	{
	595	/* If we just printed a tag name, no need to print anything else. */
e86ca25f	596	if (TYPE_NAME (type) == NULL)
72019c9c GM	597	fprintf_filtered (stream, "(...)");
72019c9c GM	598	}
e86ca25f	599	else if (show > 0 \|\| TYPE_NAME (type) == NULL)
72019c9c GM	600	{
	601	fprintf_filtered (stream, "(");
	602	len = TYPE_NFIELDS (type);
	603	lastval = 0;
	604	for (i = 0; i < len; i++)
	605	{
	606	QUIT;
	607	if (i > 0)
	608	fprintf_filtered (stream, ", ");
	609	wrap_here (" ");
	610	fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
14e75d8e	611	if (lastval != TYPE_FIELD_ENUMVAL (type, i))
72019c9c	612	{
14e75d8e JK	613	fprintf_filtered (stream, " = %s",
	614	plongest (TYPE_FIELD_ENUMVAL (type, i)));
	615	lastval = TYPE_FIELD_ENUMVAL (type, i);
72019c9c GM	616	}
	617	lastval++;
	618	}
	619	fprintf_filtered (stream, ")");
	620	}
c906108c	621	}