[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 type *type, const gdb_byte *valaddr,
			 int embedded_offset, CORE_ADDR address,
			 struct ui_file *stream, int recurse,
			 struct value *val,
			 const struct value_print_options *options,
			 int len);


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

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

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

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

  type = check_typedef (type);

  fprintf_filtered (stream, "{");
  len = TYPE_NFIELDS (type);
  if (get_long_set_bounds (type, &low_bound, &high_bound))
    {
      field = TYPE_N_BASECLASSES (type);
      range = TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, field));
    }
  else
    {
      fprintf_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 type *type, const gdb_byte *valaddr,
			  int embedded_offset, CORE_ADDR address,
			  struct ui_file *stream, int recurse,
			  const struct value_print_options *options)
{
  CORE_ADDR addr;
  LONGEST len;
  struct value *val;

  type = check_typedef (type);

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

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

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

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

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

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

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

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

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

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

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


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

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

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

/* Decorations for Modula 2.  */

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

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

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

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

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

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

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

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

    case TYPE_CODE_SET:
      elttype = TYPE_INDEX_TYPE (type);
      elttype = check_typedef (elttype);
      if (TYPE_STUB (elttype))
	{
	  fprintf_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 + embedded_offset,
					     i);

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

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

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

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

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