[thirdparty/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_CODE_STRUCT)
    {
      len = type->num_fields ();
      i = TYPE_N_BASECLASSES (type);
      if (len == 0)
	return 0;
      *low = TYPE_LOW_BOUND (type->field (i).type ()->index_type ());
      *high = TYPE_HIGH_BOUND (type->field (len - 1).type ()->index_type ());
      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) >= 0)
    {
      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) < 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 (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 = get_type_arch (type);
  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 = 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 (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_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 ())
    {
    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;
		}

	      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 ();
      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
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;
940da03e SM	58	*low = TYPE_LOW_BOUND (type->field (i).type ()->index_type ());
940da03e SM	59	*high = TYPE_HIGH_BOUND (type->field (len - 1).type ()->index_type ());
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 GM	99
	100	if (get_discrete_bounds (range, &field_low, &field_high) >= 0)
	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 ();
72019c9c GM	140	if (get_discrete_bounds (range, &field_low, &field_high) < 0)
	141	break;
	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	{
50810684	189	struct gdbarch *gdbarch = get_type_arch (type);
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	{
5af949e3	231	struct gdbarch *gdbarch = get_type_arch (type);
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
	251	/* m2_print_array_contents - prints out the contents of an
	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. */
	256
	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
	301	m2_value_print_inner (struct value val, struct ui_file stream, int recurse,
	302	const struct value_print_options *options)
	303	{
59fcdac6 TT	304	unsigned len;
	305	struct type *elttype;
	306	CORE_ADDR addr;
	307	const gdb_byte *valaddr = value_contents_for_printing (val);
	308	const CORE_ADDR address = value_address (val);
	309
	310	struct type *type = check_typedef (value_type (val));
78134374	311	switch (type->code ())
59fcdac6 TT	312	{
	313	case TYPE_CODE_ARRAY:
	314	if (TYPE_LENGTH (type) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0)
	315	{
	316	elttype = check_typedef (TYPE_TARGET_TYPE (type));
	317	len = TYPE_LENGTH (type) / TYPE_LENGTH (elttype);
59fcdac6 TT	318	/* For an array of chars, print with string syntax. */
59fcdac6 TT	319	if (TYPE_LENGTH (elttype) == 1 &&
78134374	320	((elttype->code () == TYPE_CODE_INT)
59fcdac6	321	\|\| ((current_language->la_language == language_m2)
78134374	322	&& (elttype->code () == TYPE_CODE_CHAR)))
59fcdac6 TT	323	&& (options->format == 0 \|\| options->format == 's'))
	324	{
	325	/* If requested, look for the first null char and only print
	326	elements up to it. */
	327	if (options->stop_print_at_null)
	328	{
	329	unsigned int temp_len;
	330
	331	/* Look for a NULL char. */
	332	for (temp_len = 0;
	333	(valaddr[temp_len]
	334	&& temp_len < len && temp_len < options->print_max);
	335	temp_len++);
	336	len = temp_len;
	337	}
	338
	339	LA_PRINT_STRING (stream, TYPE_TARGET_TYPE (type),
	340	valaddr, len, NULL, 0, options);
	341	}
	342	else
	343	{
	344	fprintf_filtered (stream, "{");
	345	value_print_array_elements (val, stream, recurse,
	346	options, 0);
	347	fprintf_filtered (stream, "}");
	348	}
	349	break;
	350	}
	351	/* Array of unspecified length: treat like pointer to first elt. */
	352	print_unpacked_pointer (type, address, address, options, stream);
	353	break;
	354
	355	case TYPE_CODE_PTR:
	356	if (TYPE_CONST (type))
	357	print_variable_at_address (type, valaddr, stream, recurse, options);
	358	else if (options->format && options->format != 's')
	359	value_print_scalar_formatted (val, options, 0, stream);
	360	else
	361	{
	362	addr = unpack_pointer (type, valaddr);
	363	print_unpacked_pointer (type, addr, address, options, stream);
	364	}
	365	break;
	366
	367	case TYPE_CODE_UNION:
	368	if (recurse && !options->unionprint)
	369	{
	370	fprintf_filtered (stream, "{...}");
	371	break;
	372	}
	373	/* Fall through. */
	374	case TYPE_CODE_STRUCT:
	375	if (m2_is_long_set (type))
	376	m2_print_long_set (type, valaddr, 0, address, stream);
	377	else if (m2_is_unbounded_array (type))
	378	m2_print_unbounded_array (val, stream, recurse, options);
	379	else
64b653ca	380	cp_print_value_fields (val, stream, recurse, options, NULL, 0);
59fcdac6 TT	381	break;
	382
	383	case TYPE_CODE_SET:
3d967001	384	elttype = type->index_type ();
59fcdac6 TT	385	elttype = check_typedef (elttype);
	386	if (TYPE_STUB (elttype))
	387	{
	388	fprintf_styled (stream, metadata_style.style (),
	389	_("<incomplete type>"));
	390	break;
	391	}
	392	else
	393	{
	394	struct type *range = elttype;
	395	LONGEST low_bound, high_bound;
	396	int i;
	397	int need_comma = 0;
	398
	399	fputs_filtered ("{", stream);
	400
	401	i = get_discrete_bounds (range, &low_bound, &high_bound);
	402	maybe_bad_bstring:
	403	if (i < 0)
	404	{
	405	fputs_styled (_("<error value>"), metadata_style.style (),
	406	stream);
	407	goto done;
	408	}
	409
	410	for (i = low_bound; i <= high_bound; i++)
	411	{
	412	int element = value_bit_index (type, valaddr, i);
	413
	414	if (element < 0)
	415	{
	416	i = element;
	417	goto maybe_bad_bstring;
	418	}
	419	if (element)
	420	{
	421	if (need_comma)
	422	fputs_filtered (", ", stream);
	423	print_type_scalar (range, i, stream);
	424	need_comma = 1;
	425
	426	if (i + 1 <= high_bound
	427	&& value_bit_index (type, valaddr, ++i))
	428	{
	429	int j = i;
	430
	431	fputs_filtered ("..", stream);
	432	while (i + 1 <= high_bound
	433	&& value_bit_index (type, valaddr, ++i))
	434	j = i;
	435	print_type_scalar (range, j, stream);
	436	}
	437	}
	438	}
	439	done:
	440	fputs_filtered ("}", stream);
	441	}
	442	break;
	443
	444	case TYPE_CODE_RANGE:
	445	if (TYPE_LENGTH (type) == TYPE_LENGTH (TYPE_TARGET_TYPE (type)))
	446	{
	447	struct value *v = value_cast (TYPE_TARGET_TYPE (type), val);
	448	m2_value_print_inner (v, stream, recurse, options);
449	break;
450	}
451	/* FIXME: create_static_range_type does not set the unsigned bit in a
452	range type (I think it probably should copy it from the target
453	type), so we won't print values which are too large to
454	fit in a signed integer correctly. */
455	/* FIXME: Doesn't handle ranges of enums correctly. (Can't just
456	print with the target type, though, because the size of our type
457	and the target type might differ). */
458	/* FALLTHROUGH */
459
460	case TYPE_CODE_REF:
461	case TYPE_CODE_ENUM:
462	case TYPE_CODE_FUNC:
463	case TYPE_CODE_INT:
464	case TYPE_CODE_FLT:
465	case TYPE_CODE_METHOD:
466	case TYPE_CODE_VOID:
467	case TYPE_CODE_ERROR:
468	case TYPE_CODE_UNDEF:
469	case TYPE_CODE_BOOL:
470	case TYPE_CODE_CHAR:
471	default:
472	generic_value_print (val, stream, recurse, options, &m2_decorations);
473	break;
474	}
62c4663d	475	}