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

/* Support for printing Modula 2 values for GDB, the GNU debugger.

   Copyright (C) 1986-2017 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 "symtab.h"
#include "gdbtypes.h"
#include "expression.h"
#include "value.h"
#include "valprint.h"
#include "language.h"
#include "typeprint.h"
#include "c-lang.h"
#include "m2-lang.h"
#include "target.h"

static int print_unpacked_pointer (struct type *type,
				   CORE_ADDR address, CORE_ADDR addr,
				   const struct value_print_options *options,
				   struct ui_file *stream);
static void
m2_print_array_contents (struct type *type, const gdb_byte *valaddr,
			 int embedded_offset, CORE_ADDR address,
			 struct ui_file *stream, int recurse,
			 struct value *val,
			 const struct value_print_options *options,
			 int len);


/* get_long_set_bounds - assigns the bounds of the long set to low and
                         high.  */

int
get_long_set_bounds (struct type *type, LONGEST *low, LONGEST *high)
{
  int len, i;

  if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
    {
      len = TYPE_NFIELDS (type);
      i = TYPE_N_BASECLASSES (type);
      if (len == 0)
	return 0;
      *low = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, i)));
      *high = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type,
								 len-1)));
      return 1;
    }
  error (_("expecting long_set"));
  return 0;
}

static void
m2_print_long_set (struct type *type, const gdb_byte *valaddr,
		   int embedded_offset, CORE_ADDR address,
		   struct ui_file *stream)
{
  int empty_set        = 1;
  int element_seen     = 0;
  LONGEST previous_low = 0;
  LONGEST previous_high= 0;
  LONGEST i, low_bound, high_bound;
  LONGEST field_low, field_high;
  struct type *range;
  int len, field;
  struct type *target;
  int bitval;

  type = check_typedef (type);

  fprintf_filtered (stream, "{");
  len = TYPE_NFIELDS (type);
  if (get_long_set_bounds (type, &low_bound, &high_bound))
    {
      field = TYPE_N_BASECLASSES (type);
      range = TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, field));
    }
  else
    {
      fprintf_filtered (stream, " %s }", _("<unknown bounds of set>"));
      return;
    }

  target = TYPE_TARGET_TYPE (range);

  if (get_discrete_bounds (range, &field_low, &field_high) >= 0)
    {
      for (i = low_bound; i <= high_bound; i++)
	{
	  bitval = value_bit_index (TYPE_FIELD_TYPE (type, field),
				    (TYPE_FIELD_BITPOS (type, field) / 8) +
				    valaddr + embedded_offset, i);
	  if (bitval < 0)
	    error (_("bit test is out of range"));
	  else if (bitval > 0)
	    {
	      previous_high = i;
	      if (! element_seen)
		{
		  if (! empty_set)
		    fprintf_filtered (stream, ", ");
		  print_type_scalar (target, i, stream);
		  empty_set    = 0;
		  element_seen = 1;
		  previous_low = i;
		}
	    }
	  else
	    {
	      /* bit is not set */
	      if (element_seen)
		{
		  if (previous_low+1 < previous_high)
		    fprintf_filtered (stream, "..");
		  if (previous_low+1 < previous_high)
		    print_type_scalar (target, previous_high, stream);
		  element_seen = 0;
		}
	    }
	  if (i == field_high)
	    {
	      field++;
	      if (field == len)
		break;
	      range = TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, field));
	      if (get_discrete_bounds (range, &field_low, &field_high) < 0)
		break;
	      target = TYPE_TARGET_TYPE (range);
	    }
	}
      if (element_seen)
	{
	  if (previous_low+1 < previous_high)
	    {
	      fprintf_filtered (stream, "..");
	      print_type_scalar (target, previous_high, stream);
	    }
	  element_seen = 0;
	}
      fprintf_filtered (stream, "}");
    }
}

static void
m2_print_unbounded_array (struct type *type, const gdb_byte *valaddr,
			  int embedded_offset, CORE_ADDR address,
			  struct ui_file *stream, int recurse,
			  const struct value_print_options *options)
{
  CORE_ADDR addr;
  LONGEST len;
  struct value *val;

  type = check_typedef (type);

  addr = unpack_pointer (TYPE_FIELD_TYPE (type, 0),
			 (TYPE_FIELD_BITPOS (type, 0) / 8) +
			 valaddr + embedded_offset);

  val = value_at_lazy (TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 0)),
		       addr);
  len = unpack_field_as_long (type, valaddr + embedded_offset, 1);

  fprintf_filtered (stream, "{");  
  m2_print_array_contents (value_type (val),
			   value_contents_for_printing (val),
			   value_embedded_offset (val), addr, stream,
			   recurse, val, options, len);
  fprintf_filtered (stream, ", HIGH = %d}", (int) len);
}

static int
print_unpacked_pointer (struct type *type,
			CORE_ADDR address, CORE_ADDR addr,
			const struct value_print_options *options,
			struct ui_file *stream)
{
  struct gdbarch *gdbarch = get_type_arch (type);
  struct type *elttype = check_typedef (TYPE_TARGET_TYPE (type));
  int want_space = 0;

  if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
    {
      /* Try to print what function it points to.  */
      print_function_pointer_address (options, gdbarch, addr, stream);
      /* Return value is irrelevant except for string pointers.  */
      return 0;
    }

  if (options->addressprint && options->format != 's')
    {
      fputs_filtered (paddress (gdbarch, address), stream);
      want_space = 1;
    }

  /* For a pointer to char or unsigned char, also print the string
     pointed to, unless pointer is null.  */

  if (TYPE_LENGTH (elttype) == 1
      && TYPE_CODE (elttype) == TYPE_CODE_INT
      && (options->format == 0 || options->format == 's')
      && addr != 0)
    {
      if (want_space)
	fputs_filtered (" ", stream);
      return val_print_string (TYPE_TARGET_TYPE (type), NULL, addr, -1,
			       stream, options);
    }
  
  return 0;
}

static void
print_variable_at_address (struct type *type,
			   const gdb_byte *valaddr,
			   struct ui_file *stream,
			   int recurse,
			   const struct value_print_options *options)
{
  struct gdbarch *gdbarch = get_type_arch (type);
  CORE_ADDR addr = unpack_pointer (type, valaddr);
  struct type *elttype = check_typedef (TYPE_TARGET_TYPE (type));

  fprintf_filtered (stream, "[");
  fputs_filtered (paddress (gdbarch, addr), stream);
  fprintf_filtered (stream, "] : ");
  
  if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
    {
      struct value *deref_val =
	value_at (TYPE_TARGET_TYPE (type), unpack_pointer (type, valaddr));

      common_val_print (deref_val, stream, recurse, options, current_language);
    }
  else
    fputs_filtered ("???", stream);
}


/* m2_print_array_contents - prints out the contents of an
                             array up to a max_print values.
                             It prints arrays of char as a string
                             and all other data types as comma
                             separated values.  */

static void
m2_print_array_contents (struct type *type, const gdb_byte *valaddr,
			 int embedded_offset, CORE_ADDR address,
			 struct ui_file *stream, int recurse,
			 struct value *val,
			 const struct value_print_options *options,
			 int len)
{
  type = check_typedef (type);

  if (TYPE_LENGTH (type) > 0)
    {
      if (options->prettyformat_arrays)
	print_spaces_filtered (2 + 2 * recurse, stream);
      /* For an array of chars, print with string syntax.  */
      if (TYPE_LENGTH (type) == 1 &&
	  ((TYPE_CODE (type) == TYPE_CODE_INT)
	   || ((current_language->la_language == language_m2)
	       && (TYPE_CODE (type) == TYPE_CODE_CHAR)))
	  && (options->format == 0 || options->format == 's'))
	val_print_string (type, NULL, address, len+1, stream, options);
      else
	{
	  fprintf_filtered (stream, "{");
	  val_print_array_elements (type, embedded_offset,
				    address, stream, recurse, val,
				    options, 0);
	  fprintf_filtered (stream, "}");
	}
    }
}

/* Decorations for Modula 2.  */

static const struct generic_val_print_decorations m2_decorations =
{
  "",
  " + ",
  " * I",
  "TRUE",
  "FALSE",
  "void",
  "{",
  "}"
};

/* See val_print for a description of the various parameters of this
   function; they are identical.  */

void
m2_val_print (struct type *type, int embedded_offset,
	      CORE_ADDR address, struct ui_file *stream, int recurse,
	      struct value *original_value,
	      const struct value_print_options *options)
{
  struct gdbarch *gdbarch = get_type_arch (type);
  unsigned len;
  struct type *elttype;
  CORE_ADDR addr;
  const gdb_byte *valaddr = value_contents_for_printing (original_value);

  type = check_typedef (type);
  switch (TYPE_CODE (type))
    {
    case TYPE_CODE_ARRAY:
      if (TYPE_LENGTH (type) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0)
	{
	  elttype = check_typedef (TYPE_TARGET_TYPE (type));
	  len = TYPE_LENGTH (type) / TYPE_LENGTH (elttype);
	  if (options->prettyformat_arrays)
	    print_spaces_filtered (2 + 2 * recurse, stream);
	  /* For an array of chars, print with string syntax.  */
	  if (TYPE_LENGTH (elttype) == 1 &&
	      ((TYPE_CODE (elttype) == TYPE_CODE_INT)
	       || ((current_language->la_language == language_m2)
		   && (TYPE_CODE (elttype) == TYPE_CODE_CHAR)))
	      && (options->format == 0 || options->format == 's'))
	    {
	      /* If requested, look for the first null char and only print
	         elements up to it.  */
	      if (options->stop_print_at_null)
		{
		  unsigned int temp_len;

		  /* Look for a NULL char.  */
		  for (temp_len = 0;
		       (valaddr + embedded_offset)[temp_len]
			 && temp_len < len && temp_len < options->print_max;
		       temp_len++);
		  len = temp_len;
		}

	      LA_PRINT_STRING (stream, TYPE_TARGET_TYPE (type),
			       valaddr + embedded_offset, len, NULL,
			       0, options);
	    }
	  else
	    {
	      fprintf_filtered (stream, "{");
	      val_print_array_elements (type, embedded_offset,
					address, stream,
					recurse, original_value,
					options, 0);
	      fprintf_filtered (stream, "}");
	    }
	  break;
	}
      /* Array of unspecified length: treat like pointer to first elt.  */
      print_unpacked_pointer (type, address, address, options, stream);
      break;

    case TYPE_CODE_PTR:
      if (TYPE_CONST (type))
	print_variable_at_address (type, valaddr + embedded_offset,
				   stream, recurse, options);
      else if (options->format && options->format != 's')
	val_print_scalar_formatted (type, embedded_offset,
				    original_value, options, 0, stream);
      else
	{
	  addr = unpack_pointer (type, valaddr + embedded_offset);
	  print_unpacked_pointer (type, addr, address, options, stream);
	}
      break;

    case TYPE_CODE_UNION:
      if (recurse && !options->unionprint)
	{
	  fprintf_filtered (stream, "{...}");
	  break;
	}
      /* Fall through.  */
    case TYPE_CODE_STRUCT:
      if (m2_is_long_set (type))
	m2_print_long_set (type, valaddr, embedded_offset, address,
			   stream);
      else if (m2_is_unbounded_array (type))
	m2_print_unbounded_array (type, valaddr, embedded_offset,
				  address, stream, recurse, options);
      else
	cp_print_value_fields (type, type, embedded_offset,
			       address, stream, recurse, original_value,
			       options, NULL, 0);
      break;

    case TYPE_CODE_SET:
      elttype = TYPE_INDEX_TYPE (type);
      elttype = check_typedef (elttype);
      if (TYPE_STUB (elttype))
	{
	  fprintf_filtered (stream, _("<incomplete type>"));
	  gdb_flush (stream);
	  break;
	}
      else
	{
	  struct type *range = elttype;
	  LONGEST low_bound, high_bound;
	  int i;
	  int need_comma = 0;

	  fputs_filtered ("{", stream);

	  i = get_discrete_bounds (range, &low_bound, &high_bound);
	maybe_bad_bstring:
	  if (i < 0)
	    {
	      fputs_filtered (_("<error value>"), stream);
	      goto done;
	    }

	  for (i = low_bound; i <= high_bound; i++)
	    {
	      int element = value_bit_index (type, valaddr + embedded_offset,
					     i);

	      if (element < 0)
		{
		  i = element;
		  goto maybe_bad_bstring;
		}
	      if (element)
		{
		  if (need_comma)
		    fputs_filtered (", ", stream);
		  print_type_scalar (range, i, stream);
		  need_comma = 1;

		  if (i + 1 <= high_bound
		      && value_bit_index (type, valaddr + embedded_offset,
					  ++i))
		    {
		      int j = i;

		      fputs_filtered ("..", stream);
		      while (i + 1 <= high_bound
			     && value_bit_index (type,
						 valaddr + embedded_offset,
						 ++i))
			j = i;
		      print_type_scalar (range, j, stream);
		    }
		}
	    }
	done:
	  fputs_filtered ("}", stream);
	}
      break;

    case TYPE_CODE_RANGE:
      if (TYPE_LENGTH (type) == TYPE_LENGTH (TYPE_TARGET_TYPE (type)))
	{
	  m2_val_print (TYPE_TARGET_TYPE (type), embedded_offset,
			address, stream, recurse, original_value, options);
	  break;
	}
      /* FIXME: create_static_range_type does not set the unsigned bit in a
         range type (I think it probably should copy it from the target
         type), so we won't print values which are too large to
         fit in a signed integer correctly.  */
      /* FIXME: Doesn't handle ranges of enums correctly.  (Can't just
         print with the target type, though, because the size of our type
         and the target type might differ).  */
      /* FALLTHROUGH */

    case TYPE_CODE_REF:
    case TYPE_CODE_ENUM:
    case TYPE_CODE_FUNC:
    case TYPE_CODE_INT:
    case TYPE_CODE_FLT:
    case TYPE_CODE_METHOD:
    case TYPE_CODE_VOID:
    case TYPE_CODE_ERROR:
    case TYPE_CODE_UNDEF:
    case TYPE_CODE_BOOL:
    case TYPE_CODE_CHAR:
    default:
      generic_val_print (type, embedded_offset, address,
			 stream, recurse, original_value, options,
			 &m2_decorations);
      break;
    }
  gdb_flush (stream);
}
Commit	Line	Data
c906108c	1	/* Support for printing Modula 2 values for GDB, the GNU debugger.
a8d6eb4a	2
61baf725	3	Copyright (C) 1986-2017 Free Software Foundation, Inc.
c906108c	4
c5aa993b	5	This file is part of GDB.
c906108c	6
c5aa993b JM	7	This program is free software; you can redistribute it and/or modify
c5aa993b JM	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	10	(at your option) any later version.
c906108c	11
c5aa993b JM	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.
c906108c	16
c5aa993b	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"
c906108c SS	21	#include "symtab.h"
c906108c SS	22	#include "gdbtypes.h"
72019c9c GM	23	#include "expression.h"
	24	#include "value.h"
	25	#include "valprint.h"
	26	#include "language.h"
	27	#include "typeprint.h"
a8d6eb4a	28	#include "c-lang.h"
72019c9c GM	29	#include "m2-lang.h"
	30	#include "target.h"
	31
79a45b7d TT	32	static int print_unpacked_pointer (struct type *type,
	33	CORE_ADDR address, CORE_ADDR addr,
	34	const struct value_print_options *options,
	35	struct ui_file *stream);
844781a1 GM	36	static void
	37	m2_print_array_contents (struct type type, const gdb_byte valaddr,
	38	int embedded_offset, CORE_ADDR address,
79a45b7d	39	struct ui_file *stream, int recurse,
e8b24d9f	40	struct value *val,
79a45b7d TT	41	const struct value_print_options *options,
79a45b7d TT	42	int len);
72019c9c GM	43
72019c9c GM	44
844781a1 GM	45	/* get_long_set_bounds - assigns the bounds of the long set to low and
844781a1 GM	46	high. */
72019c9c GM	47
	48	int
	49	get_long_set_bounds (struct type type, LONGEST low, LONGEST *high)
	50	{
	51	int len, i;
	52
	53	if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
	54	{
	55	len = TYPE_NFIELDS (type);
	56	i = TYPE_N_BASECLASSES (type);
	57	if (len == 0)
	58	return 0;
	59	*low = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, i)));
	60	*high = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type,
	61	len-1)));
	62	return 1;
	63	}
	64	error (_("expecting long_set"));
	65	return 0;
	66	}
	67
	68	static void
	69	m2_print_long_set (struct type type, const gdb_byte valaddr,
	70	int embedded_offset, CORE_ADDR address,
79a45b7d	71	struct ui_file *stream)
72019c9c GM	72	{
	73	int empty_set = 1;
	74	int element_seen = 0;
	75	LONGEST previous_low = 0;
	76	LONGEST previous_high= 0;
	77	LONGEST i, low_bound, high_bound;
	78	LONGEST field_low, field_high;
	79	struct type *range;
	80	int len, field;
	81	struct type *target;
	82	int bitval;
	83
f168693b	84	type = check_typedef (type);
72019c9c GM	85
	86	fprintf_filtered (stream, "{");
	87	len = TYPE_NFIELDS (type);
	88	if (get_long_set_bounds (type, &low_bound, &high_bound))
	89	{
	90	field = TYPE_N_BASECLASSES (type);
	91	range = TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, field));
	92	}
	93	else
	94	{
	95	fprintf_filtered (stream, " %s }", _("<unknown bounds of set>"));
	96	return;
	97	}
	98
	99	target = TYPE_TARGET_TYPE (range);
72019c9c GM	100
	101	if (get_discrete_bounds (range, &field_low, &field_high) >= 0)
	102	{
	103	for (i = low_bound; i <= high_bound; i++)
	104	{
	105	bitval = value_bit_index (TYPE_FIELD_TYPE (type, field),
	106	(TYPE_FIELD_BITPOS (type, field) / 8) +
	107	valaddr + embedded_offset, i);
	108	if (bitval < 0)
	109	error (_("bit test is out of range"));
	110	else if (bitval > 0)
	111	{
	112	previous_high = i;
	113	if (! element_seen)
	114	{
	115	if (! empty_set)
	116	fprintf_filtered (stream, ", ");
	117	print_type_scalar (target, i, stream);
	118	empty_set = 0;
	119	element_seen = 1;
	120	previous_low = i;
	121	}
	122	}
	123	else
	124	{
	125	/* bit is not set */
	126	if (element_seen)
	127	{
	128	if (previous_low+1 < previous_high)
	129	fprintf_filtered (stream, "..");
	130	if (previous_low+1 < previous_high)
	131	print_type_scalar (target, previous_high, stream);
	132	element_seen = 0;
	133	}
	134	}
	135	if (i == field_high)
	136	{
	137	field++;
	138	if (field == len)
	139	break;
	140	range = TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, field));
	141	if (get_discrete_bounds (range, &field_low, &field_high) < 0)
	142	break;
	143	target = TYPE_TARGET_TYPE (range);
72019c9c GM	144	}
	145	}
	146	if (element_seen)
	147	{
	148	if (previous_low+1 < previous_high)
	149	{
	150	fprintf_filtered (stream, "..");
	151	print_type_scalar (target, previous_high, stream);
	152	}
	153	element_seen = 0;
	154	}
	155	fprintf_filtered (stream, "}");
	156	}
	157	}
	158
844781a1 GM	159	static void
	160	m2_print_unbounded_array (struct type type, const gdb_byte valaddr,
	161	int embedded_offset, CORE_ADDR address,
79a45b7d TT	162	struct ui_file *stream, int recurse,
79a45b7d TT	163	const struct value_print_options *options)
844781a1	164	{
844781a1 GM	165	CORE_ADDR addr;
	166	LONGEST len;
	167	struct value *val;
	168
f168693b	169	type = check_typedef (type);
844781a1 GM	170
	171	addr = unpack_pointer (TYPE_FIELD_TYPE (type, 0),
	172	(TYPE_FIELD_BITPOS (type, 0) / 8) +
	173	valaddr + embedded_offset);
	174
	175	val = value_at_lazy (TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 0)),
	176	addr);
	177	len = unpack_field_as_long (type, valaddr + embedded_offset, 1);
	178
	179	fprintf_filtered (stream, "{");
66d61a4c PA	180	m2_print_array_contents (value_type (val),
66d61a4c PA	181	value_contents_for_printing (val),
844781a1	182	value_embedded_offset (val), addr, stream,
66d61a4c	183	recurse, val, options, len);
844781a1 GM	184	fprintf_filtered (stream, ", HIGH = %d}", (int) len);
	185	}
	186
79a45b7d	187	static int
72019c9c GM	188	print_unpacked_pointer (struct type *type,
72019c9c GM	189	CORE_ADDR address, CORE_ADDR addr,
79a45b7d TT	190	const struct value_print_options *options,
79a45b7d TT	191	struct ui_file *stream)
72019c9c	192	{
50810684	193	struct gdbarch *gdbarch = get_type_arch (type);
72019c9c	194	struct type *elttype = check_typedef (TYPE_TARGET_TYPE (type));
b012acdd	195	int want_space = 0;
72019c9c GM	196
	197	if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
	198	{
	199	/* Try to print what function it points to. */
edf0c1b7	200	print_function_pointer_address (options, gdbarch, addr, stream);
72019c9c GM	201	/* Return value is irrelevant except for string pointers. */
	202	return 0;
	203	}
	204
79a45b7d	205	if (options->addressprint && options->format != 's')
b012acdd TT	206	{
	207	fputs_filtered (paddress (gdbarch, address), stream);
	208	want_space = 1;
	209	}
72019c9c GM	210
	211	/* For a pointer to char or unsigned char, also print the string
	212	pointed to, unless pointer is null. */
	213
	214	if (TYPE_LENGTH (elttype) == 1
	215	&& TYPE_CODE (elttype) == TYPE_CODE_INT
79a45b7d	216	&& (options->format == 0 \|\| options->format == 's')
72019c9c	217	&& addr != 0)
b012acdd TT	218	{
	219	if (want_space)
	220	fputs_filtered (" ", stream);
	221	return val_print_string (TYPE_TARGET_TYPE (type), NULL, addr, -1,
	222	stream, options);
	223	}
72019c9c GM	224
	225	return 0;
	226	}
	227
	228	static void
844781a1 GM	229	print_variable_at_address (struct type *type,
844781a1 GM	230	const gdb_byte *valaddr,
79a45b7d TT	231	struct ui_file *stream,
	232	int recurse,
	233	const struct value_print_options *options)
72019c9c	234	{
5af949e3	235	struct gdbarch *gdbarch = get_type_arch (type);
72019c9c GM	236	CORE_ADDR addr = unpack_pointer (type, valaddr);
	237	struct type *elttype = check_typedef (TYPE_TARGET_TYPE (type));
	238
	239	fprintf_filtered (stream, "[");
5af949e3	240	fputs_filtered (paddress (gdbarch, addr), stream);
72019c9c GM	241	fprintf_filtered (stream, "] : ");
	242
	243	if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
	244	{
	245	struct value *deref_val =
d8631d21	246	value_at (TYPE_TARGET_TYPE (type), unpack_pointer (type, valaddr));
b8d56208	247
79a45b7d	248	common_val_print (deref_val, stream, recurse, options, current_language);
72019c9c GM	249	}
	250	else
	251	fputs_filtered ("???", stream);
	252	}
	253
844781a1 GM	254
	255	/* m2_print_array_contents - prints out the contents of an
	256	array up to a max_print values.
	257	It prints arrays of char as a string
	258	and all other data types as comma
	259	separated values. */
	260
	261	static void
	262	m2_print_array_contents (struct type type, const gdb_byte valaddr,
	263	int embedded_offset, CORE_ADDR address,
79a45b7d	264	struct ui_file *stream, int recurse,
e8b24d9f	265	struct value *val,
79a45b7d TT	266	const struct value_print_options *options,
79a45b7d TT	267	int len)
844781a1	268	{
f168693b	269	type = check_typedef (type);
844781a1 GM	270
	271	if (TYPE_LENGTH (type) > 0)
	272	{
2a998fc0	273	if (options->prettyformat_arrays)
844781a1 GM	274	print_spaces_filtered (2 + 2 * recurse, stream);
844781a1 GM	275	/* For an array of chars, print with string syntax. */
354ecfd5	276	if (TYPE_LENGTH (type) == 1 &&
844781a1 GM	277	((TYPE_CODE (type) == TYPE_CODE_INT)
	278	\|\| ((current_language->la_language == language_m2)
	279	&& (TYPE_CODE (type) == TYPE_CODE_CHAR)))
79a45b7d	280	&& (options->format == 0 \|\| options->format == 's'))
09ca9e2e	281	val_print_string (type, NULL, address, len+1, stream, options);
844781a1 GM	282	else
	283	{
	284	fprintf_filtered (stream, "{");
e8b24d9f	285	val_print_array_elements (type, embedded_offset,
0e03807e TT	286	address, stream, recurse, val,
0e03807e TT	287	options, 0);
844781a1 GM	288	fprintf_filtered (stream, "}");
	289	}
	290	}
	291	}
	292
e88acd96 TT	293	/* Decorations for Modula 2. */
	294
	295	static const struct generic_val_print_decorations m2_decorations =
	296	{
	297	"",
	298	" + ",
	299	" * I",
	300	"TRUE",
	301	"FALSE",
00272ec4 TT	302	"void",
	303	"{",
	304	"}"
e88acd96	305	};
844781a1	306
32b72a42	307	/* See val_print for a description of the various parameters of this
d3eab38a	308	function; they are identical. */
c906108c	309
d3eab38a	310	void
e8b24d9f	311	m2_val_print (struct type *type, int embedded_offset,
79a45b7d	312	CORE_ADDR address, struct ui_file *stream, int recurse,
e8b24d9f	313	struct value *original_value,
79a45b7d	314	const struct value_print_options *options)
c906108c	315	{
5af949e3	316	struct gdbarch *gdbarch = get_type_arch (type);
72019c9c GM	317	unsigned len;
72019c9c GM	318	struct type *elttype;
72019c9c	319	CORE_ADDR addr;
e8b24d9f	320	const gdb_byte *valaddr = value_contents_for_printing (original_value);
72019c9c	321
f168693b	322	type = check_typedef (type);
72019c9c GM	323	switch (TYPE_CODE (type))
	324	{
	325	case TYPE_CODE_ARRAY:
	326	if (TYPE_LENGTH (type) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0)
	327	{
	328	elttype = check_typedef (TYPE_TARGET_TYPE (type));
354ecfd5	329	len = TYPE_LENGTH (type) / TYPE_LENGTH (elttype);
2a998fc0	330	if (options->prettyformat_arrays)
72019c9c GM	331	print_spaces_filtered (2 + 2 * recurse, stream);
72019c9c GM	332	/* For an array of chars, print with string syntax. */
354ecfd5	333	if (TYPE_LENGTH (elttype) == 1 &&
72019c9c GM	334	((TYPE_CODE (elttype) == TYPE_CODE_INT)
	335	\|\| ((current_language->la_language == language_m2)
	336	&& (TYPE_CODE (elttype) == TYPE_CODE_CHAR)))
79a45b7d	337	&& (options->format == 0 \|\| options->format == 's'))
72019c9c GM	338	{
	339	/* If requested, look for the first null char and only print
	340	elements up to it. */
79a45b7d	341	if (options->stop_print_at_null)
72019c9c GM	342	{
	343	unsigned int temp_len;
	344
025bb325	345	/* Look for a NULL char. */
72019c9c GM	346	for (temp_len = 0;
72019c9c GM	347	(valaddr + embedded_offset)[temp_len]
79a45b7d	348	&& temp_len < len && temp_len < options->print_max;
72019c9c GM	349	temp_len++);
	350	len = temp_len;
	351	}
	352
6c7a06a3	353	LA_PRINT_STRING (stream, TYPE_TARGET_TYPE (type),
be759fcf PM	354	valaddr + embedded_offset, len, NULL,
be759fcf PM	355	0, options);
72019c9c GM	356	}
	357	else
	358	{
	359	fprintf_filtered (stream, "{");
e8b24d9f	360	val_print_array_elements (type, embedded_offset,
025bb325 MS	361	address, stream,
025bb325 MS	362	recurse, original_value,
0e03807e	363	options, 0);
72019c9c GM	364	fprintf_filtered (stream, "}");
	365	}
	366	break;
	367	}
	368	/* Array of unspecified length: treat like pointer to first elt. */
79a45b7d	369	print_unpacked_pointer (type, address, address, options, stream);
72019c9c GM	370	break;
	371
	372	case TYPE_CODE_PTR:
	373	if (TYPE_CONST (type))
	374	print_variable_at_address (type, valaddr + embedded_offset,
79a45b7d TT	375	stream, recurse, options);
79a45b7d TT	376	else if (options->format && options->format != 's')
e8b24d9f	377	val_print_scalar_formatted (type, embedded_offset,
ab2188aa	378	original_value, options, 0, stream);
72019c9c GM	379	else
	380	{
	381	addr = unpack_pointer (type, valaddr + embedded_offset);
79a45b7d	382	print_unpacked_pointer (type, addr, address, options, stream);
72019c9c GM	383	}
	384	break;
	385
72019c9c	386	case TYPE_CODE_UNION:
79a45b7d	387	if (recurse && !options->unionprint)
72019c9c GM	388	{
	389	fprintf_filtered (stream, "{...}");
	390	break;
	391	}
	392	/* Fall through. */
	393	case TYPE_CODE_STRUCT:
	394	if (m2_is_long_set (type))
	395	m2_print_long_set (type, valaddr, embedded_offset, address,
79a45b7d	396	stream);
844781a1 GM	397	else if (m2_is_unbounded_array (type))
844781a1 GM	398	m2_print_unbounded_array (type, valaddr, embedded_offset,
79a45b7d	399	address, stream, recurse, options);
72019c9c	400	else
65408fa6	401	cp_print_value_fields (type, type, embedded_offset,
0e03807e TT	402	address, stream, recurse, original_value,
0e03807e TT	403	options, NULL, 0);
72019c9c GM	404	break;
72019c9c GM	405
72019c9c GM	406	case TYPE_CODE_SET:
72019c9c GM	407	elttype = TYPE_INDEX_TYPE (type);
f168693b	408	elttype = check_typedef (elttype);
72019c9c GM	409	if (TYPE_STUB (elttype))
	410	{
	411	fprintf_filtered (stream, _("<incomplete type>"));
	412	gdb_flush (stream);
	413	break;
	414	}
	415	else
	416	{
	417	struct type *range = elttype;
	418	LONGEST low_bound, high_bound;
	419	int i;
72019c9c GM	420	int need_comma = 0;
72019c9c GM	421
6b1755ce	422	fputs_filtered ("{", stream);
72019c9c GM	423
	424	i = get_discrete_bounds (range, &low_bound, &high_bound);
	425	maybe_bad_bstring:
	426	if (i < 0)
	427	{
	428	fputs_filtered (_("<error value>"), stream);
	429	goto done;
	430	}
	431
	432	for (i = low_bound; i <= high_bound; i++)
	433	{
	434	int element = value_bit_index (type, valaddr + embedded_offset,
	435	i);
b8d56208	436
72019c9c GM	437	if (element < 0)
	438	{
	439	i = element;
	440	goto maybe_bad_bstring;
	441	}
6b1755ce	442	if (element)
72019c9c GM	443	{
	444	if (need_comma)
	445	fputs_filtered (", ", stream);
	446	print_type_scalar (range, i, stream);
	447	need_comma = 1;
	448
	449	if (i + 1 <= high_bound
	450	&& value_bit_index (type, valaddr + embedded_offset,
	451	++i))
	452	{
	453	int j = i;
b8d56208	454
72019c9c GM	455	fputs_filtered ("..", stream);
	456	while (i + 1 <= high_bound
	457	&& value_bit_index (type,
	458	valaddr + embedded_offset,
	459	++i))
	460	j = i;
	461	print_type_scalar (range, j, stream);
	462	}
	463	}
	464	}
	465	done:
6b1755ce	466	fputs_filtered ("}", stream);
72019c9c GM	467	}
	468	break;
	469
e88acd96 TT	470	case TYPE_CODE_RANGE:
	471	if (TYPE_LENGTH (type) == TYPE_LENGTH (TYPE_TARGET_TYPE (type)))
	472	{
e8b24d9f	473	m2_val_print (TYPE_TARGET_TYPE (type), embedded_offset,
e88acd96 TT	474	address, stream, recurse, original_value, options);
	475	break;
	476	}
0c9c3474	477	/* FIXME: create_static_range_type does not set the unsigned bit in a
e88acd96 TT	478	range type (I think it probably should copy it from the target
	479	type), so we won't print values which are too large to
	480	fit in a signed integer correctly. */
	481	/* FIXME: Doesn't handle ranges of enums correctly. (Can't just
	482	print with the target type, though, because the size of our type
	483	and the target type might differ). */
	484	/* FALLTHROUGH */
72019c9c	485
e88acd96 TT	486	case TYPE_CODE_REF:
	487	case TYPE_CODE_ENUM:
	488	case TYPE_CODE_FUNC:
	489	case TYPE_CODE_INT:
	490	case TYPE_CODE_FLT:
	491	case TYPE_CODE_METHOD:
	492	case TYPE_CODE_VOID:
72019c9c	493	case TYPE_CODE_ERROR:
72019c9c	494	case TYPE_CODE_UNDEF:
e88acd96 TT	495	case TYPE_CODE_BOOL:
e88acd96 TT	496	case TYPE_CODE_CHAR:
72019c9c	497	default:
e8b24d9f	498	generic_val_print (type, embedded_offset, address,
e88acd96 TT	499	stream, recurse, original_value, options,
	500	&m2_decorations);
	501	break;
72019c9c GM	502	}
72019c9c GM	503	gdb_flush (stream);
c906108c	504	}