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

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

   Copyright (C) 1986, 1988-1989, 1991-1992, 1996, 1998, 2000, 2005-2012
   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"

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,
			 const 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;

  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_filtered (stream, " %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)
{
  struct type *content_type;
  CORE_ADDR addr;
  LONGEST len;
  struct value *val;

  CHECK_TYPEDEF (type);
  content_type = TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 0));

  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,
			 const struct value *val,
			 const struct value_print_options *options,
			 int len)
{
  int eltlen;
  CHECK_TYPEDEF (type);

  if (TYPE_LENGTH (type) > 0)
    {
      eltlen = TYPE_LENGTH (type);
      if (options->prettyprint_arrays)
	print_spaces_filtered (2 + 2 * recurse, stream);
      /* For an array of chars, print with string syntax.  */
      if (eltlen == 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, valaddr, 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, const gdb_byte *valaddr, int embedded_offset,
	      CORE_ADDR address, struct ui_file *stream, int recurse,
	      const struct value *original_value,
	      const struct value_print_options *options)
{
  struct gdbarch *gdbarch = get_type_arch (type);
  unsigned int i = 0;	/* Number of characters printed.  */
  unsigned len;
  struct type *elttype;
  unsigned eltlen;
  CORE_ADDR addr;

  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));
	  eltlen = TYPE_LENGTH (elttype);
	  len = TYPE_LENGTH (type) / eltlen;
	  if (options->prettyprint_arrays)
	    print_spaces_filtered (2 + 2 * recurse, stream);
	  /* For an array of chars, print with string syntax.  */
	  if (eltlen == 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);
	      i = len;
	    }
	  else
	    {
	      fprintf_filtered (stream, "{");
	      val_print_array_elements (type, valaddr, 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, valaddr, 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, valaddr, embedded_offset,
			       address, stream, recurse, original_value,
			       options, NULL, 0);
      break;

    case TYPE_CODE_BITSTRING:
    case TYPE_CODE_SET:
      elttype = TYPE_INDEX_TYPE (type);
      CHECK_TYPEDEF (elttype);
      if (TYPE_STUB (elttype))
	{
	  fprintf_filtered (stream, _("<incomplete type>"));
	  gdb_flush (stream);
	  break;
	}
      else
	{
	  struct type *range = elttype;
	  LONGEST low_bound, high_bound;
	  int i;
	  int is_bitstring = TYPE_CODE (type) == TYPE_CODE_BITSTRING;
	  int need_comma = 0;

	  if (is_bitstring)
	    fputs_filtered ("B'", stream);
	  else
	    fputs_filtered ("{", stream);

	  i = get_discrete_bounds (range, &low_bound, &high_bound);
	maybe_bad_bstring:
	  if (i < 0)
	    {
	      fputs_filtered (_("<error value>"), 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 (is_bitstring)
		fprintf_filtered (stream, "%d", element);
	      else 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:
	  if (is_bitstring)
	    fputs_filtered ("'", stream);
	  else
	    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), valaddr, embedded_offset,
			address, stream, recurse, original_value, options);
	  break;
	}
      /* FIXME: create_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, valaddr, embedded_offset, address,
			 stream, recurse, original_value, options,
			 &m2_decorations);
      break;
    }
  gdb_flush (stream);
}
Commit	Line	Data
c906108c	1	/* Support for printing Modula 2 values for GDB, the GNU debugger.
a8d6eb4a	2
0b302171 JB	3	Copyright (C) 1986, 1988-1989, 1991-1992, 1996, 1998, 2000, 2005-2012
0b302171 JB	4	Free Software Foundation, Inc.
c906108c	5
c5aa993b	6	This file is part of GDB.
c906108c	7
c5aa993b JM	8	This program is free software; you can redistribute it and/or modify
c5aa993b JM	9	it under the terms of the GNU General Public License as published by
a9762ec7	10	the Free Software Foundation; either version 3 of the License, or
c5aa993b	11	(at your option) any later version.
c906108c	12
c5aa993b JM	13	This program is distributed in the hope that it will be useful,
	14	but WITHOUT ANY WARRANTY; without even the implied warranty of
	15	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	16	GNU General Public License for more details.
c906108c	17
c5aa993b	18	You should have received a copy of the GNU General Public License
a9762ec7	19	along with this program. If not, see <http://www.gnu.org/licenses/>. */
c906108c SS	20
c906108c SS	21	#include "defs.h"
c906108c SS	22	#include "symtab.h"
c906108c SS	23	#include "gdbtypes.h"
72019c9c GM	24	#include "expression.h"
	25	#include "value.h"
	26	#include "valprint.h"
	27	#include "language.h"
	28	#include "typeprint.h"
a8d6eb4a	29	#include "c-lang.h"
72019c9c GM	30	#include "m2-lang.h"
	31	#include "target.h"
	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,
0e03807e	41	const 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
	85	CHECK_TYPEDEF (type);
	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	{
	96	fprintf_filtered (stream, " %s }", _("<unknown bounds of set>"));
	97	return;
	98	}
	99
	100	target = TYPE_TARGET_TYPE (range);
72019c9c GM	101
	102	if (get_discrete_bounds (range, &field_low, &field_high) >= 0)
	103	{
	104	for (i = low_bound; i <= high_bound; i++)
	105	{
	106	bitval = value_bit_index (TYPE_FIELD_TYPE (type, field),
	107	(TYPE_FIELD_BITPOS (type, field) / 8) +
	108	valaddr + embedded_offset, i);
	109	if (bitval < 0)
	110	error (_("bit test is out of range"));
	111	else if (bitval > 0)
	112	{
	113	previous_high = i;
	114	if (! element_seen)
	115	{
	116	if (! empty_set)
	117	fprintf_filtered (stream, ", ");
	118	print_type_scalar (target, i, stream);
	119	empty_set = 0;
	120	element_seen = 1;
	121	previous_low = i;
	122	}
	123	}
	124	else
	125	{
	126	/* bit is not set */
	127	if (element_seen)
	128	{
	129	if (previous_low+1 < previous_high)
	130	fprintf_filtered (stream, "..");
	131	if (previous_low+1 < previous_high)
	132	print_type_scalar (target, previous_high, stream);
	133	element_seen = 0;
	134	}
	135	}
	136	if (i == field_high)
	137	{
	138	field++;
	139	if (field == len)
	140	break;
	141	range = TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, field));
	142	if (get_discrete_bounds (range, &field_low, &field_high) < 0)
	143	break;
	144	target = TYPE_TARGET_TYPE (range);
72019c9c GM	145	}
	146	}
	147	if (element_seen)
	148	{
	149	if (previous_low+1 < previous_high)
	150	{
	151	fprintf_filtered (stream, "..");
	152	print_type_scalar (target, previous_high, stream);
	153	}
	154	element_seen = 0;
	155	}
	156	fprintf_filtered (stream, "}");
	157	}
	158	}
	159
844781a1 GM	160	static void
	161	m2_print_unbounded_array (struct type type, const gdb_byte valaddr,
	162	int embedded_offset, CORE_ADDR address,
79a45b7d TT	163	struct ui_file *stream, int recurse,
79a45b7d TT	164	const struct value_print_options *options)
844781a1 GM	165	{
	166	struct type *content_type;
	167	CORE_ADDR addr;
	168	LONGEST len;
	169	struct value *val;
	170
	171	CHECK_TYPEDEF (type);
	172	content_type = TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 0));
	173
	174	addr = unpack_pointer (TYPE_FIELD_TYPE (type, 0),
	175	(TYPE_FIELD_BITPOS (type, 0) / 8) +
	176	valaddr + embedded_offset);
	177
	178	val = value_at_lazy (TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 0)),
	179	addr);
	180	len = unpack_field_as_long (type, valaddr + embedded_offset, 1);
	181
	182	fprintf_filtered (stream, "{");
66d61a4c PA	183	m2_print_array_contents (value_type (val),
66d61a4c PA	184	value_contents_for_printing (val),
844781a1	185	value_embedded_offset (val), addr, stream,
66d61a4c	186	recurse, val, options, len);
844781a1 GM	187	fprintf_filtered (stream, ", HIGH = %d}", (int) len);
	188	}
	189
79a45b7d	190	static int
72019c9c GM	191	print_unpacked_pointer (struct type *type,
72019c9c GM	192	CORE_ADDR address, CORE_ADDR addr,
79a45b7d TT	193	const struct value_print_options *options,
79a45b7d TT	194	struct ui_file *stream)
72019c9c	195	{
50810684	196	struct gdbarch *gdbarch = get_type_arch (type);
72019c9c	197	struct type *elttype = check_typedef (TYPE_TARGET_TYPE (type));
b012acdd	198	int want_space = 0;
72019c9c GM	199
	200	if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
	201	{
	202	/* Try to print what function it points to. */
edf0c1b7	203	print_function_pointer_address (options, gdbarch, addr, stream);
72019c9c GM	204	/* Return value is irrelevant except for string pointers. */
	205	return 0;
	206	}
	207
79a45b7d	208	if (options->addressprint && options->format != 's')
b012acdd TT	209	{
	210	fputs_filtered (paddress (gdbarch, address), stream);
	211	want_space = 1;
	212	}
72019c9c GM	213
	214	/* For a pointer to char or unsigned char, also print the string
	215	pointed to, unless pointer is null. */
	216
	217	if (TYPE_LENGTH (elttype) == 1
	218	&& TYPE_CODE (elttype) == TYPE_CODE_INT
79a45b7d	219	&& (options->format == 0 \|\| options->format == 's')
72019c9c	220	&& addr != 0)
b012acdd TT	221	{
	222	if (want_space)
	223	fputs_filtered (" ", stream);
	224	return val_print_string (TYPE_TARGET_TYPE (type), NULL, addr, -1,
	225	stream, options);
	226	}
72019c9c GM	227
	228	return 0;
	229	}
	230
	231	static void
844781a1 GM	232	print_variable_at_address (struct type *type,
844781a1 GM	233	const gdb_byte *valaddr,
79a45b7d TT	234	struct ui_file *stream,
	235	int recurse,
	236	const struct value_print_options *options)
72019c9c	237	{
5af949e3	238	struct gdbarch *gdbarch = get_type_arch (type);
72019c9c GM	239	CORE_ADDR addr = unpack_pointer (type, valaddr);
	240	struct type *elttype = check_typedef (TYPE_TARGET_TYPE (type));
	241
	242	fprintf_filtered (stream, "[");
5af949e3	243	fputs_filtered (paddress (gdbarch, addr), stream);
72019c9c GM	244	fprintf_filtered (stream, "] : ");
	245
	246	if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
	247	{
	248	struct value *deref_val =
d8631d21	249	value_at (TYPE_TARGET_TYPE (type), unpack_pointer (type, valaddr));
b8d56208	250
79a45b7d	251	common_val_print (deref_val, stream, recurse, options, current_language);
72019c9c GM	252	}
	253	else
	254	fputs_filtered ("???", stream);
	255	}
	256
844781a1 GM	257
	258	/* m2_print_array_contents - prints out the contents of an
	259	array up to a max_print values.
	260	It prints arrays of char as a string
	261	and all other data types as comma
	262	separated values. */
	263
	264	static void
	265	m2_print_array_contents (struct type type, const gdb_byte valaddr,
	266	int embedded_offset, CORE_ADDR address,
79a45b7d	267	struct ui_file *stream, int recurse,
0e03807e	268	const struct value *val,
79a45b7d TT	269	const struct value_print_options *options,
79a45b7d TT	270	int len)
844781a1 GM	271	{
	272	int eltlen;
	273	CHECK_TYPEDEF (type);
	274
	275	if (TYPE_LENGTH (type) > 0)
	276	{
	277	eltlen = TYPE_LENGTH (type);
79a45b7d	278	if (options->prettyprint_arrays)
844781a1 GM	279	print_spaces_filtered (2 + 2 * recurse, stream);
	280	/* For an array of chars, print with string syntax. */
	281	if (eltlen == 1 &&
	282	((TYPE_CODE (type) == TYPE_CODE_INT)
	283	\|\| ((current_language->la_language == language_m2)
	284	&& (TYPE_CODE (type) == TYPE_CODE_CHAR)))
79a45b7d	285	&& (options->format == 0 \|\| options->format == 's'))
09ca9e2e	286	val_print_string (type, NULL, address, len+1, stream, options);
844781a1 GM	287	else
	288	{
	289	fprintf_filtered (stream, "{");
490f124f	290	val_print_array_elements (type, valaddr, embedded_offset,
0e03807e TT	291	address, stream, recurse, val,
0e03807e TT	292	options, 0);
844781a1 GM	293	fprintf_filtered (stream, "}");
	294	}
	295	}
	296	}
	297
e88acd96 TT	298	/* Decorations for Modula 2. */
	299
	300	static const struct generic_val_print_decorations m2_decorations =
	301	{
	302	"",
	303	" + ",
	304	" * I",
	305	"TRUE",
	306	"FALSE",
	307	"void"
	308	};
844781a1	309
32b72a42	310	/* See val_print for a description of the various parameters of this
d3eab38a	311	function; they are identical. */
c906108c	312
d3eab38a	313	void
fc1a4b47	314	m2_val_print (struct type type, const gdb_byte valaddr, int embedded_offset,
79a45b7d	315	CORE_ADDR address, struct ui_file *stream, int recurse,
0e03807e	316	const struct value *original_value,
79a45b7d	317	const struct value_print_options *options)
c906108c	318	{
5af949e3	319	struct gdbarch *gdbarch = get_type_arch (type);
025bb325	320	unsigned int i = 0; /* Number of characters printed. */
72019c9c GM	321	unsigned len;
	322	struct type *elttype;
	323	unsigned eltlen;
72019c9c GM	324	CORE_ADDR addr;
	325
	326	CHECK_TYPEDEF (type);
	327	switch (TYPE_CODE (type))
	328	{
	329	case TYPE_CODE_ARRAY:
	330	if (TYPE_LENGTH (type) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0)
	331	{
	332	elttype = check_typedef (TYPE_TARGET_TYPE (type));
	333	eltlen = TYPE_LENGTH (elttype);
	334	len = TYPE_LENGTH (type) / eltlen;
79a45b7d	335	if (options->prettyprint_arrays)
72019c9c GM	336	print_spaces_filtered (2 + 2 * recurse, stream);
	337	/* For an array of chars, print with string syntax. */
	338	if (eltlen == 1 &&
	339	((TYPE_CODE (elttype) == TYPE_CODE_INT)
	340	\|\| ((current_language->la_language == language_m2)
	341	&& (TYPE_CODE (elttype) == TYPE_CODE_CHAR)))
79a45b7d	342	&& (options->format == 0 \|\| options->format == 's'))
72019c9c GM	343	{
	344	/* If requested, look for the first null char and only print
	345	elements up to it. */
79a45b7d	346	if (options->stop_print_at_null)
72019c9c GM	347	{
	348	unsigned int temp_len;
	349
025bb325	350	/* Look for a NULL char. */
72019c9c GM	351	for (temp_len = 0;
72019c9c GM	352	(valaddr + embedded_offset)[temp_len]
79a45b7d	353	&& temp_len < len && temp_len < options->print_max;
72019c9c GM	354	temp_len++);
	355	len = temp_len;
	356	}
	357
6c7a06a3	358	LA_PRINT_STRING (stream, TYPE_TARGET_TYPE (type),
be759fcf PM	359	valaddr + embedded_offset, len, NULL,
be759fcf PM	360	0, options);
72019c9c GM	361	i = len;
	362	}
	363	else
	364	{
	365	fprintf_filtered (stream, "{");
490f124f	366	val_print_array_elements (type, valaddr, embedded_offset,
025bb325 MS	367	address, stream,
025bb325 MS	368	recurse, original_value,
0e03807e	369	options, 0);
72019c9c GM	370	fprintf_filtered (stream, "}");
	371	}
	372	break;
	373	}
	374	/* Array of unspecified length: treat like pointer to first elt. */
79a45b7d	375	print_unpacked_pointer (type, address, address, options, stream);
72019c9c GM	376	break;
	377
	378	case TYPE_CODE_PTR:
	379	if (TYPE_CONST (type))
	380	print_variable_at_address (type, valaddr + embedded_offset,
79a45b7d TT	381	stream, recurse, options);
79a45b7d TT	382	else if (options->format && options->format != 's')
ab2188aa PA	383	val_print_scalar_formatted (type, valaddr, embedded_offset,
ab2188aa PA	384	original_value, options, 0, stream);
72019c9c GM	385	else
	386	{
	387	addr = unpack_pointer (type, valaddr + embedded_offset);
79a45b7d	388	print_unpacked_pointer (type, addr, address, options, stream);
72019c9c GM	389	}
	390	break;
	391
72019c9c	392	case TYPE_CODE_UNION:
79a45b7d	393	if (recurse && !options->unionprint)
72019c9c GM	394	{
	395	fprintf_filtered (stream, "{...}");
	396	break;
	397	}
	398	/* Fall through. */
	399	case TYPE_CODE_STRUCT:
	400	if (m2_is_long_set (type))
	401	m2_print_long_set (type, valaddr, embedded_offset, address,
79a45b7d	402	stream);
844781a1 GM	403	else if (m2_is_unbounded_array (type))
844781a1 GM	404	m2_print_unbounded_array (type, valaddr, embedded_offset,
79a45b7d	405	address, stream, recurse, options);
72019c9c GM	406	else
72019c9c GM	407	cp_print_value_fields (type, type, valaddr, embedded_offset,
0e03807e TT	408	address, stream, recurse, original_value,
0e03807e TT	409	options, NULL, 0);
72019c9c GM	410	break;
72019c9c GM	411
72019c9c GM	412	case TYPE_CODE_BITSTRING:
	413	case TYPE_CODE_SET:
	414	elttype = TYPE_INDEX_TYPE (type);
	415	CHECK_TYPEDEF (elttype);
	416	if (TYPE_STUB (elttype))
	417	{
	418	fprintf_filtered (stream, _("<incomplete type>"));
	419	gdb_flush (stream);
	420	break;
	421	}
	422	else
	423	{
	424	struct type *range = elttype;
	425	LONGEST low_bound, high_bound;
	426	int i;
	427	int is_bitstring = TYPE_CODE (type) == TYPE_CODE_BITSTRING;
	428	int need_comma = 0;
	429
	430	if (is_bitstring)
	431	fputs_filtered ("B'", stream);
	432	else
	433	fputs_filtered ("{", stream);
	434
	435	i = get_discrete_bounds (range, &low_bound, &high_bound);
	436	maybe_bad_bstring:
	437	if (i < 0)
	438	{
	439	fputs_filtered (_("<error value>"), stream);
	440	goto done;
	441	}
	442
	443	for (i = low_bound; i <= high_bound; i++)
	444	{
	445	int element = value_bit_index (type, valaddr + embedded_offset,
	446	i);
b8d56208	447
72019c9c GM	448	if (element < 0)
	449	{
	450	i = element;
	451	goto maybe_bad_bstring;
	452	}
	453	if (is_bitstring)
	454	fprintf_filtered (stream, "%d", element);
	455	else if (element)
	456	{
	457	if (need_comma)
	458	fputs_filtered (", ", stream);
	459	print_type_scalar (range, i, stream);
	460	need_comma = 1;
	461
	462	if (i + 1 <= high_bound
	463	&& value_bit_index (type, valaddr + embedded_offset,
	464	++i))
	465	{
	466	int j = i;
b8d56208	467
72019c9c GM	468	fputs_filtered ("..", stream);
	469	while (i + 1 <= high_bound
	470	&& value_bit_index (type,
	471	valaddr + embedded_offset,
	472	++i))
	473	j = i;
	474	print_type_scalar (range, j, stream);
	475	}
	476	}
	477	}
	478	done:
	479	if (is_bitstring)
	480	fputs_filtered ("'", stream);
	481	else
	482	fputs_filtered ("}", stream);
	483	}
	484	break;
	485
e88acd96 TT	486	case TYPE_CODE_RANGE:
	487	if (TYPE_LENGTH (type) == TYPE_LENGTH (TYPE_TARGET_TYPE (type)))
	488	{
	489	m2_val_print (TYPE_TARGET_TYPE (type), valaddr, embedded_offset,
	490	address, stream, recurse, original_value, options);
	491	break;
	492	}
	493	/* FIXME: create_range_type does not set the unsigned bit in a
	494	range type (I think it probably should copy it from the target
	495	type), so we won't print values which are too large to
	496	fit in a signed integer correctly. */
	497	/* FIXME: Doesn't handle ranges of enums correctly. (Can't just
	498	print with the target type, though, because the size of our type
	499	and the target type might differ). */
	500	/* FALLTHROUGH */
72019c9c	501
e88acd96 TT	502	case TYPE_CODE_REF:
	503	case TYPE_CODE_ENUM:
	504	case TYPE_CODE_FUNC:
	505	case TYPE_CODE_INT:
	506	case TYPE_CODE_FLT:
	507	case TYPE_CODE_METHOD:
	508	case TYPE_CODE_VOID:
72019c9c	509	case TYPE_CODE_ERROR:
72019c9c	510	case TYPE_CODE_UNDEF:
e88acd96 TT	511	case TYPE_CODE_BOOL:
e88acd96 TT	512	case TYPE_CODE_CHAR:
72019c9c	513	default:
e88acd96 TT	514	generic_val_print (type, valaddr, embedded_offset, address,
	515	stream, recurse, original_value, options,
	516	&m2_decorations);
	517	break;
72019c9c GM	518	}
72019c9c GM	519	gdb_flush (stream);
c906108c	520	}