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

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

   Copyright (C) 1986-2021 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_CODE_STRUCT)
    {
      len = type->num_fields ();
      i = TYPE_N_BASECLASSES (type);
      if (len == 0)
	return 0;
      *low = type->field (i).type ()->bounds ()->low.const_val ();
      *high = type->field (len - 1).type ()->bounds ()->high.const_val ();
      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->num_fields ();
  if (get_long_set_bounds (type, &low_bound, &high_bound))
    {
      field = TYPE_N_BASECLASSES (type);
      range = type->field (field).type ()->index_type ();
    }
  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))
    {
      for (i = low_bound; i <= high_bound; i++)
	{
	  bitval = value_bit_index (type->field (field).type (),
				    (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->field (field).type ()->index_type ();
	      if (!get_discrete_bounds (range, &field_low, &field_high))
		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 (0).type (),
			 (TYPE_FIELD_BITPOS (type, 0) / 8) +
			 valaddr);

  val = value_at_lazy (TYPE_TARGET_TYPE (type->field (0).type ()),
		       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 = type->arch ();
  struct type *elttype = check_typedef (TYPE_TARGET_TYPE (type));
  int want_space = 0;

  if (elttype->code () == 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
      && elttype->code () == 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 = type->arch ();
  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 (elttype->code () != 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)
    {
      /* For an array of chars, print with string syntax.  */
      if (TYPE_LENGTH (type) == 1 &&
	  ((type->code () == TYPE_CODE_INT)
	   || ((current_language->la_language == language_m2)
	       && (type->code () == 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_language::value_print_inner (struct value *val, struct ui_file *stream,
				int recurse,
				const struct value_print_options *options) const
{
  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 ())
    {
    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);
	  /* For an array of chars, print with string syntax.  */
	  if (TYPE_LENGTH (elttype) == 1 &&
	      ((elttype->code () == TYPE_CODE_INT)
	       || ((current_language->la_language == language_m2)
		   && (elttype->code () == 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;
		}

	      printstr (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 ();
      elttype = check_typedef (elttype);
      if (elttype->is_stub ())
	{
	  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) ? 0 : -1;
	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);
	  value_print_inner (v, stream, recurse, options);
	  break;
	}
      /* 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
3666a048	3	Copyright (C) 1986-2021 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	44	/* get_long_set_bounds - assigns the bounds of the long set to low and
dda83cd7	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
78134374	52	if (type->code () == TYPE_CODE_STRUCT)
72019c9c	53	{
1f704f76	54	len = type->num_fields ();
72019c9c GM	55	i = TYPE_N_BASECLASSES (type);
	56	if (len == 0)
	57	return 0;
cf88be68 SM	58	*low = type->field (i).type ()->bounds ()->low.const_val ();
cf88be68 SM	59	*high = type->field (len - 1).type ()->bounds ()->high.const_val ();
72019c9c GM	60	return 1;
	61	}
	62	error (_("expecting long_set"));
	63	return 0;
	64	}
	65
	66	static void
	67	m2_print_long_set (struct type type, const gdb_byte valaddr,
	68	int embedded_offset, CORE_ADDR address,
79a45b7d	69	struct ui_file *stream)
72019c9c GM	70	{
	71	int empty_set = 1;
	72	int element_seen = 0;
	73	LONGEST previous_low = 0;
	74	LONGEST previous_high= 0;
	75	LONGEST i, low_bound, high_bound;
	76	LONGEST field_low, field_high;
	77	struct type *range;
	78	int len, field;
	79	struct type *target;
	80	int bitval;
	81
f168693b	82	type = check_typedef (type);
72019c9c GM	83
72019c9c GM	84	fprintf_filtered (stream, "{");
1f704f76	85	len = type->num_fields ();
72019c9c GM	86	if (get_long_set_bounds (type, &low_bound, &high_bound))
	87	{
	88	field = TYPE_N_BASECLASSES (type);
940da03e	89	range = type->field (field).type ()->index_type ();
72019c9c GM	90	}
	91	else
	92	{
7f6aba03 TT	93	fprintf_styled (stream, metadata_style.style (),
7f6aba03 TT	94	" %s }", _("<unknown bounds of set>"));
72019c9c GM	95	return;
	96	}
	97
	98	target = TYPE_TARGET_TYPE (range);
72019c9c	99
1f8d2881	100	if (get_discrete_bounds (range, &field_low, &field_high))
72019c9c GM	101	{
	102	for (i = low_bound; i <= high_bound; i++)
	103	{
940da03e	104	bitval = value_bit_index (type->field (field).type (),
72019c9c GM	105	(TYPE_FIELD_BITPOS (type, field) / 8) +
	106	valaddr + embedded_offset, i);
	107	if (bitval < 0)
	108	error (_("bit test is out of range"));
	109	else if (bitval > 0)
	110	{
	111	previous_high = i;
	112	if (! element_seen)
	113	{
	114	if (! empty_set)
	115	fprintf_filtered (stream, ", ");
	116	print_type_scalar (target, i, stream);
	117	empty_set = 0;
	118	element_seen = 1;
	119	previous_low = i;
	120	}
	121	}
	122	else
	123	{
	124	/* bit is not set */
	125	if (element_seen)
	126	{
	127	if (previous_low+1 < previous_high)
	128	fprintf_filtered (stream, "..");
	129	if (previous_low+1 < previous_high)
	130	print_type_scalar (target, previous_high, stream);
	131	element_seen = 0;
	132	}
	133	}
	134	if (i == field_high)
	135	{
	136	field++;
	137	if (field == len)
	138	break;
940da03e	139	range = type->field (field).type ()->index_type ();
1f8d2881	140	if (!get_discrete_bounds (range, &field_low, &field_high))
72019c9c GM	141	break;
72019c9c GM	142	target = TYPE_TARGET_TYPE (range);
72019c9c GM	143	}
	144	}
	145	if (element_seen)
	146	{
	147	if (previous_low+1 < previous_high)
	148	{
	149	fprintf_filtered (stream, "..");
	150	print_type_scalar (target, previous_high, stream);
	151	}
	152	element_seen = 0;
	153	}
	154	fprintf_filtered (stream, "}");
	155	}
	156	}
	157
59fcdac6 TT	158	static void
	159	m2_print_unbounded_array (struct value *value,
	160	struct ui_file *stream, int recurse,
	161	const struct value_print_options *options)
	162	{
	163	CORE_ADDR addr;
	164	LONGEST len;
	165	struct value *val;
	166
	167	struct type *type = check_typedef (value_type (value));
	168	const gdb_byte *valaddr = value_contents_for_printing (value);
	169
940da03e	170	addr = unpack_pointer (type->field (0).type (),
59fcdac6 TT	171	(TYPE_FIELD_BITPOS (type, 0) / 8) +
	172	valaddr);
	173
940da03e	174	val = value_at_lazy (TYPE_TARGET_TYPE (type->field (0).type ()),
59fcdac6 TT	175	addr);
	176	len = unpack_field_as_long (type, valaddr, 1);
	177
	178	fprintf_filtered (stream, "{");
	179	m2_print_array_contents (val, stream, recurse, options, len);
	180	fprintf_filtered (stream, ", HIGH = %d}", (int) len);
	181	}
	182
79a45b7d	183	static int
72019c9c GM	184	print_unpacked_pointer (struct type *type,
72019c9c GM	185	CORE_ADDR address, CORE_ADDR addr,
79a45b7d TT	186	const struct value_print_options *options,
79a45b7d TT	187	struct ui_file *stream)
72019c9c	188	{
8ee511af	189	struct gdbarch *gdbarch = type->arch ();
72019c9c	190	struct type *elttype = check_typedef (TYPE_TARGET_TYPE (type));
b012acdd	191	int want_space = 0;
72019c9c	192
78134374	193	if (elttype->code () == TYPE_CODE_FUNC)
72019c9c GM	194	{
72019c9c GM	195	/* Try to print what function it points to. */
edf0c1b7	196	print_function_pointer_address (options, gdbarch, addr, stream);
72019c9c GM	197	/* Return value is irrelevant except for string pointers. */
	198	return 0;
	199	}
	200
79a45b7d	201	if (options->addressprint && options->format != 's')
b012acdd TT	202	{
	203	fputs_filtered (paddress (gdbarch, address), stream);
	204	want_space = 1;
	205	}
72019c9c GM	206
	207	/* For a pointer to char or unsigned char, also print the string
	208	pointed to, unless pointer is null. */
	209
	210	if (TYPE_LENGTH (elttype) == 1
78134374	211	&& elttype->code () == TYPE_CODE_INT
79a45b7d	212	&& (options->format == 0 \|\| options->format == 's')
72019c9c	213	&& addr != 0)
b012acdd TT	214	{
	215	if (want_space)
	216	fputs_filtered (" ", stream);
	217	return val_print_string (TYPE_TARGET_TYPE (type), NULL, addr, -1,
	218	stream, options);
	219	}
72019c9c GM	220
	221	return 0;
	222	}
	223
	224	static void
844781a1 GM	225	print_variable_at_address (struct type *type,
844781a1 GM	226	const gdb_byte *valaddr,
79a45b7d TT	227	struct ui_file *stream,
	228	int recurse,
	229	const struct value_print_options *options)
72019c9c	230	{
8ee511af	231	struct gdbarch *gdbarch = type->arch ();
72019c9c GM	232	CORE_ADDR addr = unpack_pointer (type, valaddr);
	233	struct type *elttype = check_typedef (TYPE_TARGET_TYPE (type));
	234
	235	fprintf_filtered (stream, "[");
5af949e3	236	fputs_filtered (paddress (gdbarch, addr), stream);
72019c9c GM	237	fprintf_filtered (stream, "] : ");
72019c9c GM	238
78134374	239	if (elttype->code () != TYPE_CODE_UNDEF)
72019c9c GM	240	{
72019c9c GM	241	struct value *deref_val =
d8631d21	242	value_at (TYPE_TARGET_TYPE (type), unpack_pointer (type, valaddr));
b8d56208	243
79a45b7d	244	common_val_print (deref_val, stream, recurse, options, current_language);
72019c9c GM	245	}
	246	else
	247	fputs_filtered ("???", stream);
	248	}
	249
844781a1 GM	250
844781a1 GM	251	/* m2_print_array_contents - prints out the contents of an
dda83cd7 SM	252	array up to a max_print values.
	253	It prints arrays of char as a string
	254	and all other data types as comma
	255	separated values. */
844781a1 GM	256
844781a1 GM	257	static void
59fcdac6	258	m2_print_array_contents (struct value *val,
79a45b7d TT	259	struct ui_file *stream, int recurse,
	260	const struct value_print_options *options,
	261	int len)
844781a1	262	{
59fcdac6	263	struct type *type = check_typedef (value_type (val));
844781a1 GM	264
	265	if (TYPE_LENGTH (type) > 0)
	266	{
844781a1	267	/* For an array of chars, print with string syntax. */
354ecfd5	268	if (TYPE_LENGTH (type) == 1 &&
78134374	269	((type->code () == TYPE_CODE_INT)
844781a1	270	\|\| ((current_language->la_language == language_m2)
78134374	271	&& (type->code () == TYPE_CODE_CHAR)))
79a45b7d	272	&& (options->format == 0 \|\| options->format == 's'))
59fcdac6 TT	273	val_print_string (type, NULL, value_address (val), len+1, stream,
59fcdac6 TT	274	options);
844781a1 GM	275	else
	276	{
	277	fprintf_filtered (stream, "{");
59fcdac6	278	value_print_array_elements (val, stream, recurse, options, 0);
844781a1 GM	279	fprintf_filtered (stream, "}");
	280	}
	281	}
	282	}
	283
e88acd96 TT	284	/* Decorations for Modula 2. */
	285
	286	static const struct generic_val_print_decorations m2_decorations =
	287	{
	288	"",
	289	" + ",
	290	" * I",
	291	"TRUE",
	292	"FALSE",
00272ec4 TT	293	"void",
	294	"{",
	295	"}"
e88acd96	296	};
844781a1	297
62c4663d TT	298	/* See m2-lang.h. */
	299
	300	void
790e2a12 AB	301	m2_language::value_print_inner (struct value val, struct ui_file stream,
	302	int recurse,
	303	const struct value_print_options *options) const
62c4663d	304	{
59fcdac6 TT	305	unsigned len;
	306	struct type *elttype;
	307	CORE_ADDR addr;
	308	const gdb_byte *valaddr = value_contents_for_printing (val);
	309	const CORE_ADDR address = value_address (val);
	310
	311	struct type *type = check_typedef (value_type (val));
78134374	312	switch (type->code ())
59fcdac6 TT	313	{
	314	case TYPE_CODE_ARRAY:
	315	if (TYPE_LENGTH (type) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0)
	316	{
	317	elttype = check_typedef (TYPE_TARGET_TYPE (type));
	318	len = TYPE_LENGTH (type) / TYPE_LENGTH (elttype);
59fcdac6 TT	319	/* For an array of chars, print with string syntax. */
59fcdac6 TT	320	if (TYPE_LENGTH (elttype) == 1 &&
78134374	321	((elttype->code () == TYPE_CODE_INT)
59fcdac6	322	\|\| ((current_language->la_language == language_m2)
78134374	323	&& (elttype->code () == TYPE_CODE_CHAR)))
59fcdac6 TT	324	&& (options->format == 0 \|\| options->format == 's'))
	325	{
	326	/* If requested, look for the first null char and only print
dda83cd7	327	elements up to it. */
59fcdac6 TT	328	if (options->stop_print_at_null)
	329	{
	330	unsigned int temp_len;
	331
	332	/* Look for a NULL char. */
	333	for (temp_len = 0;
	334	(valaddr[temp_len]
	335	&& temp_len < len && temp_len < options->print_max);
	336	temp_len++);
	337	len = temp_len;
	338	}
	339
790e2a12 AB	340	printstr (stream, TYPE_TARGET_TYPE (type), valaddr, len,
790e2a12 AB	341	NULL, 0, options);
59fcdac6 TT	342	}
	343	else
	344	{
	345	fprintf_filtered (stream, "{");
	346	value_print_array_elements (val, stream, recurse,
	347	options, 0);
	348	fprintf_filtered (stream, "}");
	349	}
	350	break;
	351	}
	352	/* Array of unspecified length: treat like pointer to first elt. */
	353	print_unpacked_pointer (type, address, address, options, stream);
	354	break;
	355
	356	case TYPE_CODE_PTR:
	357	if (TYPE_CONST (type))
	358	print_variable_at_address (type, valaddr, stream, recurse, options);
	359	else if (options->format && options->format != 's')
	360	value_print_scalar_formatted (val, options, 0, stream);
	361	else
	362	{
	363	addr = unpack_pointer (type, valaddr);
	364	print_unpacked_pointer (type, addr, address, options, stream);
	365	}
	366	break;
	367
	368	case TYPE_CODE_UNION:
	369	if (recurse && !options->unionprint)
	370	{
	371	fprintf_filtered (stream, "{...}");
	372	break;
	373	}
	374	/* Fall through. */
	375	case TYPE_CODE_STRUCT:
	376	if (m2_is_long_set (type))
	377	m2_print_long_set (type, valaddr, 0, address, stream);
	378	else if (m2_is_unbounded_array (type))
	379	m2_print_unbounded_array (val, stream, recurse, options);
	380	else
64b653ca	381	cp_print_value_fields (val, stream, recurse, options, NULL, 0);
59fcdac6 TT	382	break;
	383
	384	case TYPE_CODE_SET:
3d967001	385	elttype = type->index_type ();
59fcdac6	386	elttype = check_typedef (elttype);
e46d3488	387	if (elttype->is_stub ())
59fcdac6 TT	388	{
	389	fprintf_styled (stream, metadata_style.style (),
	390	_("<incomplete type>"));
	391	break;
	392	}
	393	else
	394	{
	395	struct type *range = elttype;
	396	LONGEST low_bound, high_bound;
	397	int i;
	398	int need_comma = 0;
	399
	400	fputs_filtered ("{", stream);
	401
1f8d2881	402	i = get_discrete_bounds (range, &low_bound, &high_bound) ? 0 : -1;
59fcdac6 TT	403	maybe_bad_bstring:
	404	if (i < 0)
	405	{
	406	fputs_styled (_("<error value>"), metadata_style.style (),
	407	stream);
	408	goto done;
	409	}
	410
	411	for (i = low_bound; i <= high_bound; i++)
	412	{
	413	int element = value_bit_index (type, valaddr, i);
	414
	415	if (element < 0)
	416	{
	417	i = element;
	418	goto maybe_bad_bstring;
	419	}
	420	if (element)
	421	{
	422	if (need_comma)
	423	fputs_filtered (", ", stream);
	424	print_type_scalar (range, i, stream);
	425	need_comma = 1;
	426
	427	if (i + 1 <= high_bound
	428	&& value_bit_index (type, valaddr, ++i))
	429	{
	430	int j = i;
	431
	432	fputs_filtered ("..", stream);
	433	while (i + 1 <= high_bound
	434	&& value_bit_index (type, valaddr, ++i))
	435	j = i;
	436	print_type_scalar (range, j, stream);
	437	}
	438	}
	439	}
	440	done:
	441	fputs_filtered ("}", stream);
	442	}
	443	break;
	444
	445	case TYPE_CODE_RANGE:
	446	if (TYPE_LENGTH (type) == TYPE_LENGTH (TYPE_TARGET_TYPE (type)))
	447	{
	448	struct value *v = value_cast (TYPE_TARGET_TYPE (type), val);
790e2a12	449	value_print_inner (v, stream, recurse, options);
59fcdac6 TT	450	break;
59fcdac6 TT	451	}
59fcdac6 TT	452	/* FALLTHROUGH */
	453
	454	case TYPE_CODE_REF:
	455	case TYPE_CODE_ENUM:
	456	case TYPE_CODE_FUNC:
	457	case TYPE_CODE_INT:
	458	case TYPE_CODE_FLT:
	459	case TYPE_CODE_METHOD:
	460	case TYPE_CODE_VOID:
	461	case TYPE_CODE_ERROR:
	462	case TYPE_CODE_UNDEF:
	463	case TYPE_CODE_BOOL:
	464	case TYPE_CODE_CHAR:
	465	default:
	466	generic_value_print (val, stream, recurse, options, &m2_decorations);
	467	break;
	468	}
62c4663d	469	}