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

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

   Copyright (C) 1986-2020 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"
#include "cli/cli-style.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 value *val,
			 struct ui_file *stream, int recurse,
			 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_styled (stream, metadata_style.style (),
		      " %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 value *value,
			  struct ui_file *stream, int recurse,
			  const struct value_print_options *options)
{
  CORE_ADDR addr;
  LONGEST len;
  struct value *val;

  struct type *type = check_typedef (value_type (value));
  const gdb_byte *valaddr = value_contents_for_printing (value);

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

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

  fprintf_filtered (stream, "{");  
  m2_print_array_contents (val, stream, recurse, 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 value *val,
			 struct ui_file *stream, int recurse,
			 const struct value_print_options *options,
			 int len)
{
  struct type *type = check_typedef (value_type (val));

  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, value_address (val), len+1, stream,
			  options);
      else
	{
	  fprintf_filtered (stream, "{");
	  value_print_array_elements (val, stream, recurse, options, 0);
	  fprintf_filtered (stream, "}");
	}
    }
}

/* Decorations for Modula 2.  */

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

/* See m2-lang.h.  */

void
m2_value_print_inner (struct value *val, struct ui_file *stream, int recurse,
		      const struct value_print_options *options)
{
  unsigned len;
  struct type *elttype;
  CORE_ADDR addr;
  const gdb_byte *valaddr = value_contents_for_printing (val);
  const CORE_ADDR address = value_address (val);

  struct type *type = check_typedef (value_type (val));
  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[temp_len]
			&& temp_len < len && temp_len < options->print_max);
		       temp_len++);
		  len = temp_len;
		}

	      LA_PRINT_STRING (stream, TYPE_TARGET_TYPE (type),
			       valaddr, len, NULL, 0, options);
	    }
	  else
	    {
	      fprintf_filtered (stream, "{");
	      value_print_array_elements (val, stream, recurse,
					  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, stream, recurse, options);
      else if (options->format && options->format != 's')
	value_print_scalar_formatted (val, options, 0, stream);
      else
	{
	  addr = unpack_pointer (type, valaddr);
	  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, 0, address, stream);
      else if (m2_is_unbounded_array (type))
	m2_print_unbounded_array (val, stream, recurse, options);
      else
	cp_print_value_fields (val, stream, recurse, options, NULL, 0);
      break;

    case TYPE_CODE_SET:
      elttype = TYPE_INDEX_TYPE (type);
      elttype = check_typedef (elttype);
      if (TYPE_STUB (elttype))
	{
	  fprintf_styled (stream, metadata_style.style (),
			  _("<incomplete type>"));
	  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_styled (_("<error value>"), metadata_style.style (),
			    stream);
	      goto done;
	    }

	  for (i = low_bound; i <= high_bound; i++)
	    {
	      int element = value_bit_index (type, valaddr, 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, ++i))
		    {
		      int j = i;

		      fputs_filtered ("..", stream);
		      while (i + 1 <= high_bound
			     && value_bit_index (type, valaddr, ++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)))
	{
	  struct value *v = value_cast (TYPE_TARGET_TYPE (type), val);
	  m2_value_print_inner (v, stream, recurse, 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_value_print (val, stream, recurse, options, &m2_decorations);
      break;
    }
}
Commit	Line	Data
c906108c	1	/* Support for printing Modula 2 values for GDB, the GNU debugger.
a8d6eb4a	2
b811d2c2	3	Copyright (C) 1986-2020 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"
72019c9c GM	30	#include "target.h"
7f6aba03	31	#include "cli/cli-style.h"
72019c9c	32
79a45b7d TT	33	static int print_unpacked_pointer (struct type *type,
	34	CORE_ADDR address, CORE_ADDR addr,
	35	const struct value_print_options *options,
	36	struct ui_file *stream);
844781a1	37	static void
59fcdac6	38	m2_print_array_contents (struct value *val,
79a45b7d TT	39	struct ui_file *stream, int recurse,
	40	const struct value_print_options *options,
	41	int len);
72019c9c GM	42
72019c9c GM	43
844781a1 GM	44	/* get_long_set_bounds - assigns the bounds of the long set to low and
844781a1 GM	45	high. */
72019c9c GM	46
	47	int
	48	get_long_set_bounds (struct type type, LONGEST low, LONGEST *high)
	49	{
	50	int len, i;
	51
	52	if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
	53	{
	54	len = TYPE_NFIELDS (type);
	55	i = TYPE_N_BASECLASSES (type);
	56	if (len == 0)
	57	return 0;
	58	*low = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, i)));
	59	*high = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type,
	60	len-1)));
	61	return 1;
	62	}
	63	error (_("expecting long_set"));
	64	return 0;
	65	}
	66
	67	static void
	68	m2_print_long_set (struct type type, const gdb_byte valaddr,
	69	int embedded_offset, CORE_ADDR address,
79a45b7d	70	struct ui_file *stream)
72019c9c GM	71	{
	72	int empty_set = 1;
	73	int element_seen = 0;
	74	LONGEST previous_low = 0;
	75	LONGEST previous_high= 0;
	76	LONGEST i, low_bound, high_bound;
	77	LONGEST field_low, field_high;
	78	struct type *range;
	79	int len, field;
	80	struct type *target;
	81	int bitval;
	82
f168693b	83	type = check_typedef (type);
72019c9c GM	84
	85	fprintf_filtered (stream, "{");
	86	len = TYPE_NFIELDS (type);
	87	if (get_long_set_bounds (type, &low_bound, &high_bound))
	88	{
	89	field = TYPE_N_BASECLASSES (type);
	90	range = TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, field));
	91	}
	92	else
	93	{
7f6aba03 TT	94	fprintf_styled (stream, metadata_style.style (),
7f6aba03 TT	95	" %s }", _("<unknown bounds of set>"));
72019c9c GM	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
59fcdac6 TT	159	static void
	160	m2_print_unbounded_array (struct value *value,
	161	struct ui_file *stream, int recurse,
	162	const struct value_print_options *options)
	163	{
	164	CORE_ADDR addr;
	165	LONGEST len;
	166	struct value *val;
	167
	168	struct type *type = check_typedef (value_type (value));
	169	const gdb_byte *valaddr = value_contents_for_printing (value);
	170
	171	addr = unpack_pointer (TYPE_FIELD_TYPE (type, 0),
	172	(TYPE_FIELD_BITPOS (type, 0) / 8) +
	173	valaddr);
	174
	175	val = value_at_lazy (TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 0)),
	176	addr);
	177	len = unpack_field_as_long (type, valaddr, 1);
	178
	179	fprintf_filtered (stream, "{");
	180	m2_print_array_contents (val, stream, recurse, options, len);
	181	fprintf_filtered (stream, ", HIGH = %d}", (int) len);
	182	}
	183
79a45b7d	184	static int
72019c9c GM	185	print_unpacked_pointer (struct type *type,
72019c9c GM	186	CORE_ADDR address, CORE_ADDR addr,
79a45b7d TT	187	const struct value_print_options *options,
79a45b7d TT	188	struct ui_file *stream)
72019c9c	189	{
50810684	190	struct gdbarch *gdbarch = get_type_arch (type);
72019c9c	191	struct type *elttype = check_typedef (TYPE_TARGET_TYPE (type));
b012acdd	192	int want_space = 0;
72019c9c GM	193
	194	if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
	195	{
	196	/* Try to print what function it points to. */
edf0c1b7	197	print_function_pointer_address (options, gdbarch, addr, stream);
72019c9c GM	198	/* Return value is irrelevant except for string pointers. */
	199	return 0;
	200	}
	201
79a45b7d	202	if (options->addressprint && options->format != 's')
b012acdd TT	203	{
	204	fputs_filtered (paddress (gdbarch, address), stream);
	205	want_space = 1;
	206	}
72019c9c GM	207
	208	/* For a pointer to char or unsigned char, also print the string
	209	pointed to, unless pointer is null. */
	210
	211	if (TYPE_LENGTH (elttype) == 1
	212	&& TYPE_CODE (elttype) == TYPE_CODE_INT
79a45b7d	213	&& (options->format == 0 \|\| options->format == 's')
72019c9c	214	&& addr != 0)
b012acdd TT	215	{
	216	if (want_space)
	217	fputs_filtered (" ", stream);
	218	return val_print_string (TYPE_TARGET_TYPE (type), NULL, addr, -1,
	219	stream, options);
	220	}
72019c9c GM	221
	222	return 0;
	223	}
	224
	225	static void
844781a1 GM	226	print_variable_at_address (struct type *type,
844781a1 GM	227	const gdb_byte *valaddr,
79a45b7d TT	228	struct ui_file *stream,
	229	int recurse,
	230	const struct value_print_options *options)
72019c9c	231	{
5af949e3	232	struct gdbarch *gdbarch = get_type_arch (type);
72019c9c GM	233	CORE_ADDR addr = unpack_pointer (type, valaddr);
	234	struct type *elttype = check_typedef (TYPE_TARGET_TYPE (type));
	235
	236	fprintf_filtered (stream, "[");
5af949e3	237	fputs_filtered (paddress (gdbarch, addr), stream);
72019c9c GM	238	fprintf_filtered (stream, "] : ");
	239
	240	if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
	241	{
	242	struct value *deref_val =
d8631d21	243	value_at (TYPE_TARGET_TYPE (type), unpack_pointer (type, valaddr));
b8d56208	244
79a45b7d	245	common_val_print (deref_val, stream, recurse, options, current_language);
72019c9c GM	246	}
	247	else
	248	fputs_filtered ("???", stream);
	249	}
	250
844781a1 GM	251
	252	/* m2_print_array_contents - prints out the contents of an
	253	array up to a max_print values.
	254	It prints arrays of char as a string
	255	and all other data types as comma
	256	separated values. */
	257
	258	static void
59fcdac6	259	m2_print_array_contents (struct value *val,
79a45b7d TT	260	struct ui_file *stream, int recurse,
	261	const struct value_print_options *options,
	262	int len)
844781a1	263	{
59fcdac6	264	struct type *type = check_typedef (value_type (val));
844781a1 GM	265
	266	if (TYPE_LENGTH (type) > 0)
	267	{
2a998fc0	268	if (options->prettyformat_arrays)
844781a1 GM	269	print_spaces_filtered (2 + 2 * recurse, stream);
844781a1 GM	270	/* For an array of chars, print with string syntax. */
354ecfd5	271	if (TYPE_LENGTH (type) == 1 &&
844781a1 GM	272	((TYPE_CODE (type) == TYPE_CODE_INT)
	273	\|\| ((current_language->la_language == language_m2)
	274	&& (TYPE_CODE (type) == TYPE_CODE_CHAR)))
79a45b7d	275	&& (options->format == 0 \|\| options->format == 's'))
59fcdac6 TT	276	val_print_string (type, NULL, value_address (val), len+1, stream,
59fcdac6 TT	277	options);
844781a1 GM	278	else
	279	{
	280	fprintf_filtered (stream, "{");
59fcdac6	281	value_print_array_elements (val, stream, recurse, options, 0);
844781a1 GM	282	fprintf_filtered (stream, "}");
	283	}
	284	}
	285	}
	286
e88acd96 TT	287	/* Decorations for Modula 2. */
	288
	289	static const struct generic_val_print_decorations m2_decorations =
	290	{
	291	"",
	292	" + ",
	293	" * I",
	294	"TRUE",
	295	"FALSE",
00272ec4 TT	296	"void",
	297	"{",
	298	"}"
e88acd96	299	};
844781a1	300
62c4663d TT	301	/* See m2-lang.h. */
	302
	303	void
	304	m2_value_print_inner (struct value val, struct ui_file stream, int recurse,
	305	const struct value_print_options *options)
	306	{
59fcdac6 TT	307	unsigned len;
	308	struct type *elttype;
	309	CORE_ADDR addr;
	310	const gdb_byte *valaddr = value_contents_for_printing (val);
	311	const CORE_ADDR address = value_address (val);
	312
	313	struct type *type = check_typedef (value_type (val));
	314	switch (TYPE_CODE (type))
	315	{
	316	case TYPE_CODE_ARRAY:
	317	if (TYPE_LENGTH (type) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0)
	318	{
	319	elttype = check_typedef (TYPE_TARGET_TYPE (type));
	320	len = TYPE_LENGTH (type) / TYPE_LENGTH (elttype);
	321	if (options->prettyformat_arrays)
	322	print_spaces_filtered (2 + 2 * recurse, stream);
	323	/* For an array of chars, print with string syntax. */
	324	if (TYPE_LENGTH (elttype) == 1 &&
	325	((TYPE_CODE (elttype) == TYPE_CODE_INT)
	326	\|\| ((current_language->la_language == language_m2)
	327	&& (TYPE_CODE (elttype) == TYPE_CODE_CHAR)))
	328	&& (options->format == 0 \|\| options->format == 's'))
	329	{
	330	/* If requested, look for the first null char and only print
	331	elements up to it. */
	332	if (options->stop_print_at_null)
	333	{
	334	unsigned int temp_len;
	335
	336	/* Look for a NULL char. */
	337	for (temp_len = 0;
	338	(valaddr[temp_len]
	339	&& temp_len < len && temp_len < options->print_max);
	340	temp_len++);
	341	len = temp_len;
	342	}
	343
	344	LA_PRINT_STRING (stream, TYPE_TARGET_TYPE (type),
	345	valaddr, len, NULL, 0, options);
	346	}
	347	else
	348	{
	349	fprintf_filtered (stream, "{");
	350	value_print_array_elements (val, stream, recurse,
	351	options, 0);
	352	fprintf_filtered (stream, "}");
	353	}
	354	break;
	355	}
	356	/* Array of unspecified length: treat like pointer to first elt. */
	357	print_unpacked_pointer (type, address, address, options, stream);
	358	break;
	359
	360	case TYPE_CODE_PTR:
	361	if (TYPE_CONST (type))
	362	print_variable_at_address (type, valaddr, stream, recurse, options);
	363	else if (options->format && options->format != 's')
	364	value_print_scalar_formatted (val, options, 0, stream);
	365	else
	366	{
	367	addr = unpack_pointer (type, valaddr);
	368	print_unpacked_pointer (type, addr, address, options, stream);
	369	}
	370	break;
371
372	case TYPE_CODE_UNION:
373	if (recurse && !options->unionprint)
374	{
375	fprintf_filtered (stream, "{...}");
376	break;
377	}
378	/* Fall through. */
379	case TYPE_CODE_STRUCT:
380	if (m2_is_long_set (type))
381	m2_print_long_set (type, valaddr, 0, address, stream);
382	else if (m2_is_unbounded_array (type))
383	m2_print_unbounded_array (val, stream, recurse, options);
384	else
64b653ca	385	cp_print_value_fields (val, stream, recurse, options, NULL, 0);
59fcdac6 TT	386	break;
	387
	388	case TYPE_CODE_SET:
	389	elttype = TYPE_INDEX_TYPE (type);
	390	elttype = check_typedef (elttype);
	391	if (TYPE_STUB (elttype))
	392	{
	393	fprintf_styled (stream, metadata_style.style (),
	394	_("<incomplete type>"));
	395	break;
	396	}
	397	else
	398	{
	399	struct type *range = elttype;
	400	LONGEST low_bound, high_bound;
	401	int i;
	402	int need_comma = 0;
	403
	404	fputs_filtered ("{", stream);
	405
	406	i = get_discrete_bounds (range, &low_bound, &high_bound);
	407	maybe_bad_bstring:
	408	if (i < 0)
	409	{
	410	fputs_styled (_("<error value>"), metadata_style.style (),
	411	stream);
	412	goto done;
	413	}
	414
	415	for (i = low_bound; i <= high_bound; i++)
	416	{
	417	int element = value_bit_index (type, valaddr, i);
	418
	419	if (element < 0)
	420	{
	421	i = element;
	422	goto maybe_bad_bstring;
	423	}
	424	if (element)
	425	{
	426	if (need_comma)
	427	fputs_filtered (", ", stream);
	428	print_type_scalar (range, i, stream);
	429	need_comma = 1;
	430
	431	if (i + 1 <= high_bound
	432	&& value_bit_index (type, valaddr, ++i))
	433	{
	434	int j = i;
	435
	436	fputs_filtered ("..", stream);
	437	while (i + 1 <= high_bound
	438	&& value_bit_index (type, valaddr, ++i))
	439	j = i;
	440	print_type_scalar (range, j, stream);
	441	}
	442	}
	443	}
	444	done:
	445	fputs_filtered ("}", stream);
	446	}
	447	break;
	448
	449	case TYPE_CODE_RANGE:
450	if (TYPE_LENGTH (type) == TYPE_LENGTH (TYPE_TARGET_TYPE (type)))
451	{
452	struct value *v = value_cast (TYPE_TARGET_TYPE (type), val);
453	m2_value_print_inner (v, stream, recurse, options);
454	break;
455	}
456	/* FIXME: create_static_range_type does not set the unsigned bit in a
457	range type (I think it probably should copy it from the target
458	type), so we won't print values which are too large to
459	fit in a signed integer correctly. */
460	/* FIXME: Doesn't handle ranges of enums correctly. (Can't just
461	print with the target type, though, because the size of our type
462	and the target type might differ). */
463	/* FALLTHROUGH */
464
465	case TYPE_CODE_REF:
466	case TYPE_CODE_ENUM:
467	case TYPE_CODE_FUNC:
468	case TYPE_CODE_INT:
469	case TYPE_CODE_FLT:
470	case TYPE_CODE_METHOD:
471	case TYPE_CODE_VOID:
472	case TYPE_CODE_ERROR:
473	case TYPE_CODE_UNDEF:
474	case TYPE_CODE_BOOL:
475	case TYPE_CODE_CHAR:
476	default:
477	generic_value_print (val, stream, recurse, options, &m2_decorations);
478	break;
479	}
62c4663d	480	}