[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_CODE_STRUCT)
    {
      len = type->num_fields ();
      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->num_fields ();
  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 (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 (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;
	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
72019c9c GM	85	fprintf_filtered (stream, "{");
1f704f76	86	len = type->num_fields ();
72019c9c GM	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	193
78134374	194	if (elttype->code () == TYPE_CODE_FUNC)
72019c9c GM	195	{
72019c9c GM	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
78134374	212	&& elttype->code () == 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, "] : ");
72019c9c GM	239
78134374	240	if (elttype->code () != TYPE_CODE_UNDEF)
72019c9c GM	241	{
72019c9c GM	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	{
844781a1	268	/* For an array of chars, print with string syntax. */
354ecfd5	269	if (TYPE_LENGTH (type) == 1 &&
78134374	270	((type->code () == TYPE_CODE_INT)
844781a1	271	\|\| ((current_language->la_language == language_m2)
78134374	272	&& (type->code () == TYPE_CODE_CHAR)))
79a45b7d	273	&& (options->format == 0 \|\| options->format == 's'))
59fcdac6 TT	274	val_print_string (type, NULL, value_address (val), len+1, stream,
59fcdac6 TT	275	options);
844781a1 GM	276	else
	277	{
	278	fprintf_filtered (stream, "{");
59fcdac6	279	value_print_array_elements (val, stream, recurse, options, 0);
844781a1 GM	280	fprintf_filtered (stream, "}");
	281	}
	282	}
	283	}
	284
e88acd96 TT	285	/* Decorations for Modula 2. */
	286
	287	static const struct generic_val_print_decorations m2_decorations =
	288	{
	289	"",
	290	" + ",
	291	" * I",
	292	"TRUE",
	293	"FALSE",
00272ec4 TT	294	"void",
	295	"{",
	296	"}"
e88acd96	297	};
844781a1	298
62c4663d TT	299	/* See m2-lang.h. */
	300
	301	void
	302	m2_value_print_inner (struct value val, struct ui_file stream, int recurse,
	303	const struct value_print_options *options)
	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
	327	elements up to it. */
	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
	340	LA_PRINT_STRING (stream, TYPE_TARGET_TYPE (type),
	341	valaddr, len, NULL, 0, options);
	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:
	385	elttype = TYPE_INDEX_TYPE (type);
	386	elttype = check_typedef (elttype);
	387	if (TYPE_STUB (elttype))
	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
	402	i = get_discrete_bounds (range, &low_bound, &high_bound);
	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);
449	m2_value_print_inner (v, stream, recurse, options);
450	break;
451	}
452	/* FIXME: create_static_range_type does not set the unsigned bit in a
453	range type (I think it probably should copy it from the target
454	type), so we won't print values which are too large to
455	fit in a signed integer correctly. */
456	/* FIXME: Doesn't handle ranges of enums correctly. (Can't just
457	print with the target type, though, because the size of our type
458	and the target type might differ). */
459	/* FALLTHROUGH */
460
461	case TYPE_CODE_REF:
462	case TYPE_CODE_ENUM:
463	case TYPE_CODE_FUNC:
464	case TYPE_CODE_INT:
465	case TYPE_CODE_FLT:
466	case TYPE_CODE_METHOD:
467	case TYPE_CODE_VOID:
468	case TYPE_CODE_ERROR:
469	case TYPE_CODE_UNDEF:
470	case TYPE_CODE_BOOL:
471	case TYPE_CODE_CHAR:
472	default:
473	generic_value_print (val, stream, recurse, options, &m2_decorations);
474	break;
475	}
62c4663d	476	}