[thirdparty/binutils-gdb.git] / gdb / m2-lang.c

/* Modula 2 language support routines for GDB, the GNU debugger.

   Copyright (C) 1992-2019 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 "parser-defs.h"
#include "language.h"
#include "varobj.h"
#include "m2-lang.h"
#include "c-lang.h"
#include "valprint.h"

static void m2_printchar (int, struct type *, struct ui_file *);
static void m2_emit_char (int, struct type *, struct ui_file *, int);

/* Print the character C on STREAM as part of the contents of a literal
   string whose delimiter is QUOTER.  Note that that format for printing
   characters and strings is language specific.
   FIXME:  This is a copy of the same function from c-exp.y.  It should
   be replaced with a true Modula version.  */

static void
m2_emit_char (int c, struct type *type, struct ui_file *stream, int quoter)
{

  c &= 0xFF;			/* Avoid sign bit follies.  */

  if (PRINT_LITERAL_FORM (c))
    {
      if (c == '\\' || c == quoter)
	{
	  fputs_filtered ("\\", stream);
	}
      fprintf_filtered (stream, "%c", c);
    }
  else
    {
      switch (c)
	{
	case '\n':
	  fputs_filtered ("\\n", stream);
	  break;
	case '\b':
	  fputs_filtered ("\\b", stream);
	  break;
	case '\t':
	  fputs_filtered ("\\t", stream);
	  break;
	case '\f':
	  fputs_filtered ("\\f", stream);
	  break;
	case '\r':
	  fputs_filtered ("\\r", stream);
	  break;
	case '\033':
	  fputs_filtered ("\\e", stream);
	  break;
	case '\007':
	  fputs_filtered ("\\a", stream);
	  break;
	default:
	  fprintf_filtered (stream, "\\%.3o", (unsigned int) c);
	  break;
	}
    }
}

/* FIXME:  This is a copy of the same function from c-exp.y.  It should
   be replaced with a true Modula version.  */

static void
m2_printchar (int c, struct type *type, struct ui_file *stream)
{
  fputs_filtered ("'", stream);
  LA_EMIT_CHAR (c, type, stream, '\'');
  fputs_filtered ("'", stream);
}

/* Print the character string STRING, printing at most LENGTH characters.
   Printing stops early if the number hits print_max; repeat counts
   are printed as appropriate.  Print ellipses at the end if we
   had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
   FIXME:  This is a copy of the same function from c-exp.y.  It should
   be replaced with a true Modula version.  */

static void
m2_printstr (struct ui_file *stream, struct type *type, const gdb_byte *string,
	     unsigned int length, const char *encoding, int force_ellipses,
	     const struct value_print_options *options)
{
  unsigned int i;
  unsigned int things_printed = 0;
  int in_quotes = 0;
  int need_comma = 0;

  if (length == 0)
    {
      fputs_filtered ("\"\"", gdb_stdout);
      return;
    }

  for (i = 0; i < length && things_printed < options->print_max; ++i)
    {
      /* Position of the character we are examining
         to see whether it is repeated.  */
      unsigned int rep1;
      /* Number of repetitions we have detected so far.  */
      unsigned int reps;

      QUIT;

      if (need_comma)
	{
	  fputs_filtered (", ", stream);
	  need_comma = 0;
	}

      rep1 = i + 1;
      reps = 1;
      while (rep1 < length && string[rep1] == string[i])
	{
	  ++rep1;
	  ++reps;
	}

      if (reps > options->repeat_count_threshold)
	{
	  if (in_quotes)
	    {
	      fputs_filtered ("\", ", stream);
	      in_quotes = 0;
	    }
	  m2_printchar (string[i], type, stream);
	  fprintf_filtered (stream, " <repeats %u times>", reps);
	  i = rep1 - 1;
	  things_printed += options->repeat_count_threshold;
	  need_comma = 1;
	}
      else
	{
	  if (!in_quotes)
	    {
	      fputs_filtered ("\"", stream);
	      in_quotes = 1;
	    }
	  LA_EMIT_CHAR (string[i], type, stream, '"');
	  ++things_printed;
	}
    }

  /* Terminate the quotes if necessary.  */
  if (in_quotes)
    fputs_filtered ("\"", stream);

  if (force_ellipses || i < length)
    fputs_filtered ("...", stream);
}

/* Return true if TYPE is a string.  */

static bool
m2_is_string_type_p (struct type *type)
{
  type = check_typedef (type);
  if (TYPE_CODE (type) == TYPE_CODE_ARRAY
      && TYPE_LENGTH (type) > 0
      && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0)
    {
      struct type *elttype = check_typedef (TYPE_TARGET_TYPE (type));

      if (TYPE_LENGTH (elttype) == 1
	  && (TYPE_CODE (elttype) == TYPE_CODE_INT
	      || TYPE_CODE (elttype) == TYPE_CODE_CHAR))
	return true;
    }

  return false;
}

static struct value *
evaluate_subexp_modula2 (struct type *expect_type, struct expression *exp,
			 int *pos, enum noside noside)
{
  enum exp_opcode op = exp->elts[*pos].opcode;
  struct value *arg1;
  struct value *arg2;
  struct type *type;

  switch (op)
    {
    case UNOP_HIGH:
      (*pos)++;
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);

      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
	return arg1;
      else
	{
	  arg1 = coerce_ref (arg1);
	  type = check_typedef (value_type (arg1));

	  if (m2_is_unbounded_array (type))
	    {
	      struct value *temp = arg1;

	      type = TYPE_FIELD_TYPE (type, 1);
	      /* i18n: Do not translate the "_m2_high" part!  */
	      arg1 = value_struct_elt (&temp, NULL, "_m2_high", NULL,
				       _("unbounded structure "
					 "missing _m2_high field"));
	  
	      if (value_type (arg1) != type)
		arg1 = value_cast (type, arg1);
	    }
	}
      return arg1;

    case BINOP_SUBSCRIPT:
      (*pos)++;
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
      if (noside == EVAL_SKIP)
	goto nosideret;
      /* If the user attempts to subscript something that is not an
         array or pointer type (like a plain int variable for example),
         then report this as an error.  */

      arg1 = coerce_ref (arg1);
      type = check_typedef (value_type (arg1));

      if (m2_is_unbounded_array (type))
	{
	  struct value *temp = arg1;
	  type = TYPE_FIELD_TYPE (type, 0);
	  if (type == NULL || (TYPE_CODE (type) != TYPE_CODE_PTR))
	    {
	      warning (_("internal error: unbounded "
			 "array structure is unknown"));
	      return evaluate_subexp_standard (expect_type, exp, pos, noside);
	    }
	  /* i18n: Do not translate the "_m2_contents" part!  */
	  arg1 = value_struct_elt (&temp, NULL, "_m2_contents", NULL,
				   _("unbounded structure "
				     "missing _m2_contents field"));
	  
	  if (value_type (arg1) != type)
	    arg1 = value_cast (type, arg1);

	  check_typedef (value_type (arg1));
	  return value_ind (value_ptradd (arg1, value_as_long (arg2)));
	}
      else
	if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
	  {
	    if (TYPE_NAME (type))
	      error (_("cannot subscript something of type `%s'"),
		     TYPE_NAME (type));
	    else
	      error (_("cannot subscript requested type"));
	  }

      if (noside == EVAL_AVOID_SIDE_EFFECTS)
	return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
      else
	return value_subscript (arg1, value_as_long (arg2));

    default:
      return evaluate_subexp_standard (expect_type, exp, pos, noside);
    }

 nosideret:
  return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
}
\f

/* Table of operators and their precedences for printing expressions.  */

static const struct op_print m2_op_print_tab[] =
{
  {"+", BINOP_ADD, PREC_ADD, 0},
  {"+", UNOP_PLUS, PREC_PREFIX, 0},
  {"-", BINOP_SUB, PREC_ADD, 0},
  {"-", UNOP_NEG, PREC_PREFIX, 0},
  {"*", BINOP_MUL, PREC_MUL, 0},
  {"/", BINOP_DIV, PREC_MUL, 0},
  {"DIV", BINOP_INTDIV, PREC_MUL, 0},
  {"MOD", BINOP_REM, PREC_MUL, 0},
  {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
  {"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
  {"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
  {"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
  {"=", BINOP_EQUAL, PREC_EQUAL, 0},
  {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
  {"<=", BINOP_LEQ, PREC_ORDER, 0},
  {">=", BINOP_GEQ, PREC_ORDER, 0},
  {">", BINOP_GTR, PREC_ORDER, 0},
  {"<", BINOP_LESS, PREC_ORDER, 0},
  {"^", UNOP_IND, PREC_PREFIX, 0},
  {"@", BINOP_REPEAT, PREC_REPEAT, 0},
  {"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0},
  {"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0},
  {"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0},
  {"FLOAT", UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0},
  {"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0},
  {"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0},
  {"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0},
  {"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0},
  {"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0},
  {NULL, OP_NULL, PREC_BUILTIN_FUNCTION, 0}
};
\f
/* The built-in types of Modula-2.  */

enum m2_primitive_types {
  m2_primitive_type_char,
  m2_primitive_type_int,
  m2_primitive_type_card,
  m2_primitive_type_real,
  m2_primitive_type_bool,
  nr_m2_primitive_types
};

static void
m2_language_arch_info (struct gdbarch *gdbarch,
		       struct language_arch_info *lai)
{
  const struct builtin_m2_type *builtin = builtin_m2_type (gdbarch);

  lai->string_char_type = builtin->builtin_char;
  lai->primitive_type_vector
    = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_m2_primitive_types + 1,
                              struct type *);

  lai->primitive_type_vector [m2_primitive_type_char]
    = builtin->builtin_char;
  lai->primitive_type_vector [m2_primitive_type_int]
    = builtin->builtin_int;
  lai->primitive_type_vector [m2_primitive_type_card]
    = builtin->builtin_card;
  lai->primitive_type_vector [m2_primitive_type_real]
    = builtin->builtin_real;
  lai->primitive_type_vector [m2_primitive_type_bool]
    = builtin->builtin_bool;

  lai->bool_type_symbol = "BOOLEAN";
  lai->bool_type_default = builtin->builtin_bool;
}

const struct exp_descriptor exp_descriptor_modula2 = 
{
  print_subexp_standard,
  operator_length_standard,
  operator_check_standard,
  op_name_standard,
  dump_subexp_body_standard,
  evaluate_subexp_modula2
};

extern const struct language_defn m2_language_defn =
{
  "modula-2",
  "Modula-2",
  language_m2,
  range_check_on,
  case_sensitive_on,
  array_row_major,
  macro_expansion_no,
  NULL,
  &exp_descriptor_modula2,
  m2_parse,			/* parser */
  null_post_parser,
  m2_printchar,			/* Print character constant */
  m2_printstr,			/* function to print string constant */
  m2_emit_char,			/* Function to print a single character */
  m2_print_type,		/* Print a type using appropriate syntax */
  m2_print_typedef,		/* Print a typedef using appropriate syntax */
  m2_val_print,			/* Print a value using appropriate syntax */
  c_value_print,		/* Print a top-level value */
  default_read_var_value,	/* la_read_var_value */
  NULL,				/* Language specific skip_trampoline */
  NULL,		                /* name_of_this */
  false,			/* la_store_sym_names_in_linkage_form_p */
  basic_lookup_symbol_nonlocal,	/* lookup_symbol_nonlocal */
  basic_lookup_transparent_type,/* lookup_transparent_type */
  NULL,				/* Language specific symbol demangler */
  NULL,
  NULL,				/* Language specific
				   class_name_from_physname */
  m2_op_print_tab,		/* expression operators for printing */
  0,				/* arrays are first-class (not c-style) */
  0,				/* String lower bound */
  default_word_break_characters,
  default_collect_symbol_completion_matches,
  m2_language_arch_info,
  default_print_array_index,
  default_pass_by_reference,
  default_get_string,
  c_watch_location_expression,
  NULL,				/* la_get_symbol_name_matcher */
  iterate_over_symbols,
  default_search_name_hash,
  &default_varobj_ops,
  NULL,
  NULL,
  m2_is_string_type_p,
  "{...}"			/* la_struct_too_deep_ellipsis */
};

static void *
build_m2_types (struct gdbarch *gdbarch)
{
  struct builtin_m2_type *builtin_m2_type
    = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_m2_type);

  /* Modula-2 "pervasive" types.  NOTE:  these can be redefined!!! */
  builtin_m2_type->builtin_int
    = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 0, "INTEGER");
  builtin_m2_type->builtin_card
    = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "CARDINAL");
  builtin_m2_type->builtin_real
    = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch), "REAL",
		       gdbarch_float_format (gdbarch));
  builtin_m2_type->builtin_char
    = arch_character_type (gdbarch, TARGET_CHAR_BIT, 1, "CHAR");
  builtin_m2_type->builtin_bool
    = arch_boolean_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "BOOLEAN");

  return builtin_m2_type;
}

static struct gdbarch_data *m2_type_data;

const struct builtin_m2_type *
builtin_m2_type (struct gdbarch *gdbarch)
{
  return (const struct builtin_m2_type *) gdbarch_data (gdbarch, m2_type_data);
}


/* Initialization for Modula-2 */

void
_initialize_m2_language (void)
{
  m2_type_data = gdbarch_data_register_post_init (build_m2_types);
}
Commit	Line	Data
c906108c	1	/* Modula 2 language support routines for GDB, the GNU debugger.
ce27fb25	2
42a4f53d	3	Copyright (C) 1992-2019 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
	20	#include "defs.h"
	21	#include "symtab.h"
	22	#include "gdbtypes.h"
	23	#include "expression.h"
	24	#include "parser-defs.h"
	25	#include "language.h"
a53b64ea	26	#include "varobj.h"
c906108c SS	27	#include "m2-lang.h"
c906108c SS	28	#include "c-lang.h"
745b8ca0	29	#include "valprint.h"
c906108c	30
6c7a06a3 TT	31	static void m2_printchar (int, struct type , struct ui_file );
6c7a06a3 TT	32	static void m2_emit_char (int, struct type , struct ui_file , int);
c906108c SS	33
	34	/* Print the character C on STREAM as part of the contents of a literal
	35	string whose delimiter is QUOTER. Note that that format for printing
	36	characters and strings is language specific.
	37	FIXME: This is a copy of the same function from c-exp.y. It should
844781a1	38	be replaced with a true Modula version. */
c906108c SS	39
c906108c SS	40	static void
6c7a06a3	41	m2_emit_char (int c, struct type type, struct ui_file stream, int quoter)
c906108c SS	42	{
c906108c SS	43
025bb325	44	c &= 0xFF; /* Avoid sign bit follies. */
c906108c SS	45
	46	if (PRINT_LITERAL_FORM (c))
	47	{
	48	if (c == '\\' \|\| c == quoter)
	49	{
	50	fputs_filtered ("\\", stream);
	51	}
	52	fprintf_filtered (stream, "%c", c);
	53	}
	54	else
	55	{
	56	switch (c)
	57	{
	58	case '\n':
	59	fputs_filtered ("\\n", stream);
	60	break;
	61	case '\b':
	62	fputs_filtered ("\\b", stream);
	63	break;
	64	case '\t':
	65	fputs_filtered ("\\t", stream);
	66	break;
	67	case '\f':
	68	fputs_filtered ("\\f", stream);
	69	break;
	70	case '\r':
	71	fputs_filtered ("\\r", stream);
	72	break;
	73	case '\033':
	74	fputs_filtered ("\\e", stream);
	75	break;
	76	case '\007':
	77	fputs_filtered ("\\a", stream);
	78	break;
	79	default:
	80	fprintf_filtered (stream, "\\%.3o", (unsigned int) c);
	81	break;
	82	}
	83	}
	84	}
	85
	86	/* FIXME: This is a copy of the same function from c-exp.y. It should
844781a1	87	be replaced with a true Modula version. */
c906108c SS	88
c906108c SS	89	static void
6c7a06a3	90	m2_printchar (int c, struct type type, struct ui_file stream)
c906108c SS	91	{
c906108c SS	92	fputs_filtered ("'", stream);
6c7a06a3	93	LA_EMIT_CHAR (c, type, stream, '\'');
c906108c SS	94	fputs_filtered ("'", stream);
	95	}
	96
	97	/* Print the character string STRING, printing at most LENGTH characters.
	98	Printing stops early if the number hits print_max; repeat counts
	99	are printed as appropriate. Print ellipses at the end if we
	100	had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
	101	FIXME: This is a copy of the same function from c-exp.y. It should
844781a1	102	be replaced with a true Modula version. */
c906108c SS	103
c906108c SS	104	static void
6c7a06a3	105	m2_printstr (struct ui_file stream, struct type type, const gdb_byte *string,
be759fcf	106	unsigned int length, const char *encoding, int force_ellipses,
79a45b7d	107	const struct value_print_options *options)
c906108c	108	{
f86f5ca3	109	unsigned int i;
c906108c SS	110	unsigned int things_printed = 0;
	111	int in_quotes = 0;
	112	int need_comma = 0;
c906108c SS	113
	114	if (length == 0)
	115	{
	116	fputs_filtered ("\"\"", gdb_stdout);
	117	return;
	118	}
	119
79a45b7d	120	for (i = 0; i < length && things_printed < options->print_max; ++i)
c906108c SS	121	{
c906108c SS	122	/* Position of the character we are examining
c5aa993b	123	to see whether it is repeated. */
c906108c SS	124	unsigned int rep1;
	125	/* Number of repetitions we have detected so far. */
	126	unsigned int reps;
	127
	128	QUIT;
	129
	130	if (need_comma)
	131	{
	132	fputs_filtered (", ", stream);
	133	need_comma = 0;
	134	}
	135
	136	rep1 = i + 1;
	137	reps = 1;
	138	while (rep1 < length && string[rep1] == string[i])
	139	{
	140	++rep1;
	141	++reps;
	142	}
	143
79a45b7d	144	if (reps > options->repeat_count_threshold)
c906108c SS	145	{
	146	if (in_quotes)
	147	{
e93a8774	148	fputs_filtered ("\", ", stream);
c906108c SS	149	in_quotes = 0;
c906108c SS	150	}
6c7a06a3	151	m2_printchar (string[i], type, stream);
c906108c SS	152	fprintf_filtered (stream, " <repeats %u times>", reps);
c906108c SS	153	i = rep1 - 1;
79a45b7d	154	things_printed += options->repeat_count_threshold;
c906108c SS	155	need_comma = 1;
	156	}
	157	else
	158	{
	159	if (!in_quotes)
	160	{
e93a8774	161	fputs_filtered ("\"", stream);
c906108c SS	162	in_quotes = 1;
c906108c SS	163	}
6c7a06a3	164	LA_EMIT_CHAR (string[i], type, stream, '"');
c906108c SS	165	++things_printed;
	166	}
	167	}
	168
	169	/* Terminate the quotes if necessary. */
	170	if (in_quotes)
e93a8774	171	fputs_filtered ("\"", stream);
c906108c SS	172
	173	if (force_ellipses \|\| i < length)
	174	fputs_filtered ("...", stream);
	175	}
	176
4be290b2 AB	177	/* Return true if TYPE is a string. */
	178
	179	static bool
	180	m2_is_string_type_p (struct type *type)
	181	{
	182	type = check_typedef (type);
	183	if (TYPE_CODE (type) == TYPE_CODE_ARRAY
	184	&& TYPE_LENGTH (type) > 0
	185	&& TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0)
	186	{
	187	struct type *elttype = check_typedef (TYPE_TARGET_TYPE (type));
	188
	189	if (TYPE_LENGTH (elttype) == 1
	190	&& (TYPE_CODE (elttype) == TYPE_CODE_INT
	191	\|\| TYPE_CODE (elttype) == TYPE_CODE_CHAR))
	192	return true;
	193	}
	194
	195	return false;
	196	}
	197
844781a1 GM	198	static struct value *
	199	evaluate_subexp_modula2 (struct type expect_type, struct expression exp,
	200	int *pos, enum noside noside)
	201	{
	202	enum exp_opcode op = exp->elts[*pos].opcode;
	203	struct value *arg1;
	204	struct value *arg2;
	205	struct type *type;
b8d56208	206
844781a1 GM	207	switch (op)
	208	{
	209	case UNOP_HIGH:
	210	(*pos)++;
	211	arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
	212
	213	if (noside == EVAL_SKIP \|\| noside == EVAL_AVOID_SIDE_EFFECTS)
	214	return arg1;
	215	else
	216	{
	217	arg1 = coerce_ref (arg1);
	218	type = check_typedef (value_type (arg1));
	219
	220	if (m2_is_unbounded_array (type))
	221	{
	222	struct value *temp = arg1;
b8d56208	223
844781a1 GM	224	type = TYPE_FIELD_TYPE (type, 1);
	225	/* i18n: Do not translate the "_m2_high" part! */
	226	arg1 = value_struct_elt (&temp, NULL, "_m2_high", NULL,
	227	_("unbounded structure "
	228	"missing _m2_high field"));
	229
	230	if (value_type (arg1) != type)
	231	arg1 = value_cast (type, arg1);
	232	}
	233	}
	234	return arg1;
	235
	236	case BINOP_SUBSCRIPT:
	237	(*pos)++;
	238	arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
	239	arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
	240	if (noside == EVAL_SKIP)
	241	goto nosideret;
	242	/* If the user attempts to subscript something that is not an
	243	array or pointer type (like a plain int variable for example),
	244	then report this as an error. */
	245
	246	arg1 = coerce_ref (arg1);
	247	type = check_typedef (value_type (arg1));
	248
	249	if (m2_is_unbounded_array (type))
	250	{
	251	struct value *temp = arg1;
	252	type = TYPE_FIELD_TYPE (type, 0);
b8d56208 MS	253	if (type == NULL \|\| (TYPE_CODE (type) != TYPE_CODE_PTR))
b8d56208 MS	254	{
025bb325 MS	255	warning (_("internal error: unbounded "
025bb325 MS	256	"array structure is unknown"));
b8d56208 MS	257	return evaluate_subexp_standard (expect_type, exp, pos, noside);
b8d56208 MS	258	}
844781a1 GM	259	/* i18n: Do not translate the "_m2_contents" part! */
	260	arg1 = value_struct_elt (&temp, NULL, "_m2_contents", NULL,
	261	_("unbounded structure "
	262	"missing _m2_contents field"));
	263
	264	if (value_type (arg1) != type)
	265	arg1 = value_cast (type, arg1);
	266
976aa66e	267	check_typedef (value_type (arg1));
2497b498	268	return value_ind (value_ptradd (arg1, value_as_long (arg2)));
844781a1 GM	269	}
	270	else
	271	if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
	272	{
	273	if (TYPE_NAME (type))
	274	error (_("cannot subscript something of type `%s'"),
	275	TYPE_NAME (type));
	276	else
	277	error (_("cannot subscript requested type"));
	278	}
	279
	280	if (noside == EVAL_AVOID_SIDE_EFFECTS)
	281	return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
	282	else
2497b498	283	return value_subscript (arg1, value_as_long (arg2));
844781a1 GM	284
	285	default:
	286	return evaluate_subexp_standard (expect_type, exp, pos, noside);
	287	}
	288
	289	nosideret:
22601c15	290	return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
844781a1	291	}
c906108c	292	\f
c5aa993b	293
c906108c SS	294	/* Table of operators and their precedences for printing expressions. */
c906108c SS	295
c5aa993b JM	296	static const struct op_print m2_op_print_tab[] =
	297	{
	298	{"+", BINOP_ADD, PREC_ADD, 0},
	299	{"+", UNOP_PLUS, PREC_PREFIX, 0},
	300	{"-", BINOP_SUB, PREC_ADD, 0},
	301	{"-", UNOP_NEG, PREC_PREFIX, 0},
	302	{"*", BINOP_MUL, PREC_MUL, 0},
	303	{"/", BINOP_DIV, PREC_MUL, 0},
	304	{"DIV", BINOP_INTDIV, PREC_MUL, 0},
	305	{"MOD", BINOP_REM, PREC_MUL, 0},
	306	{":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
	307	{"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
	308	{"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
	309	{"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
	310	{"=", BINOP_EQUAL, PREC_EQUAL, 0},
	311	{"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
	312	{"<=", BINOP_LEQ, PREC_ORDER, 0},
	313	{">=", BINOP_GEQ, PREC_ORDER, 0},
	314	{">", BINOP_GTR, PREC_ORDER, 0},
	315	{"<", BINOP_LESS, PREC_ORDER, 0},
	316	{"^", UNOP_IND, PREC_PREFIX, 0},
	317	{"@", BINOP_REPEAT, PREC_REPEAT, 0},
	318	{"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0},
	319	{"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0},
	320	{"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0},
	321	{"FLOAT", UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0},
	322	{"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0},
	323	{"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0},
	324	{"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0},
	325	{"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0},
	326	{"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0},
f486487f	327	{NULL, OP_NULL, PREC_BUILTIN_FUNCTION, 0}
c906108c SS	328	};
	329	\f
	330	/* The built-in types of Modula-2. */
	331
cad351d1 UW	332	enum m2_primitive_types {
	333	m2_primitive_type_char,
	334	m2_primitive_type_int,
	335	m2_primitive_type_card,
	336	m2_primitive_type_real,
	337	m2_primitive_type_bool,
	338	nr_m2_primitive_types
c906108c SS	339	};
c906108c SS	340
cad351d1 UW	341	static void
	342	m2_language_arch_info (struct gdbarch *gdbarch,
	343	struct language_arch_info *lai)
	344	{
5760b90a UW	345	const struct builtin_m2_type *builtin = builtin_m2_type (gdbarch);
	346
	347	lai->string_char_type = builtin->builtin_char;
cad351d1 UW	348	lai->primitive_type_vector
	349	= GDBARCH_OBSTACK_CALLOC (gdbarch, nr_m2_primitive_types + 1,
	350	struct type *);
	351
	352	lai->primitive_type_vector [m2_primitive_type_char]
5760b90a	353	= builtin->builtin_char;
cad351d1	354	lai->primitive_type_vector [m2_primitive_type_int]
5760b90a	355	= builtin->builtin_int;
cad351d1	356	lai->primitive_type_vector [m2_primitive_type_card]
5760b90a	357	= builtin->builtin_card;
cad351d1	358	lai->primitive_type_vector [m2_primitive_type_real]
5760b90a	359	= builtin->builtin_real;
cad351d1	360	lai->primitive_type_vector [m2_primitive_type_bool]
5760b90a	361	= builtin->builtin_bool;
fbb06eb1 UW	362
	363	lai->bool_type_symbol = "BOOLEAN";
	364	lai->bool_type_default = builtin->builtin_bool;
cad351d1 UW	365	}
cad351d1 UW	366
844781a1 GM	367	const struct exp_descriptor exp_descriptor_modula2 =
	368	{
	369	print_subexp_standard,
	370	operator_length_standard,
c0201579	371	operator_check_standard,
844781a1 GM	372	op_name_standard,
	373	dump_subexp_body_standard,
	374	evaluate_subexp_modula2
	375	};
	376
47e77640	377	extern const struct language_defn m2_language_defn =
c5aa993b	378	{
c906108c	379	"modula-2",
6abde28f	380	"Modula-2",
c906108c	381	language_m2,
c906108c	382	range_check_on,
63872f9d	383	case_sensitive_on,
7ca2d3a3	384	array_row_major,
9a044a89	385	macro_expansion_no,
56618e20	386	NULL,
844781a1	387	&exp_descriptor_modula2,
c906108c	388	m2_parse, /* parser */
e85c3284	389	null_post_parser,
c906108c SS	390	m2_printchar, /* Print character constant */
	391	m2_printstr, /* function to print string constant */
	392	m2_emit_char, /* Function to print a single character */
c906108c	393	m2_print_type, /* Print a type using appropriate syntax */
5c6ce71d	394	m2_print_typedef, /* Print a typedef using appropriate syntax */
c906108c SS	395	m2_val_print, /* Print a value using appropriate syntax */
c906108c SS	396	c_value_print, /* Print a top-level value */
a5ee536b	397	default_read_var_value, /* la_read_var_value */
f636b87d	398	NULL, /* Language specific skip_trampoline */
2b2d9e11	399	NULL, /* name_of_this */
59cc4834	400	false, /* la_store_sym_names_in_linkage_form_p */
5f9a71c3	401	basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
b368761e	402	basic_lookup_transparent_type,/* lookup_transparent_type */
9a3d7dfd	403	NULL, /* Language specific symbol demangler */
8b302db8	404	NULL,
025bb325 MS	405	NULL, /* Language specific
025bb325 MS	406	class_name_from_physname */
c906108c SS	407	m2_op_print_tab, /* expression operators for printing */
	408	0, /* arrays are first-class (not c-style) */
	409	0, /* String lower bound */
6084f43a	410	default_word_break_characters,
eb3ff9a5	411	default_collect_symbol_completion_matches,
cad351d1	412	m2_language_arch_info,
e79af960	413	default_print_array_index,
41f1b697	414	default_pass_by_reference,
ae6a3a4c	415	default_get_string,
43cc5389	416	c_watch_location_expression,
b5ec771e	417	NULL, /* la_get_symbol_name_matcher */
f8eba3c6	418	iterate_over_symbols,
5ffa0793	419	default_search_name_hash,
a53b64ea	420	&default_varobj_ops,
bb2ec1b3	421	NULL,
721b08c6	422	NULL,
4be290b2	423	m2_is_string_type_p,
721b08c6	424	"{...}" /* la_struct_too_deep_ellipsis */
c906108c SS	425	};
c906108c SS	426
5760b90a UW	427	static void *
5760b90a UW	428	build_m2_types (struct gdbarch *gdbarch)
c906108c	429	{
5760b90a UW	430	struct builtin_m2_type *builtin_m2_type
	431	= GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_m2_type);
	432
c906108c	433	/* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
e9bb382b UW	434	builtin_m2_type->builtin_int
	435	= arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 0, "INTEGER");
	436	builtin_m2_type->builtin_card
	437	= arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "CARDINAL");
	438	builtin_m2_type->builtin_real
49f190bc UW	439	= arch_float_type (gdbarch, gdbarch_float_bit (gdbarch), "REAL",
49f190bc UW	440	gdbarch_float_format (gdbarch));
e9bb382b UW	441	builtin_m2_type->builtin_char
	442	= arch_character_type (gdbarch, TARGET_CHAR_BIT, 1, "CHAR");
	443	builtin_m2_type->builtin_bool
	444	= arch_boolean_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "BOOLEAN");
c906108c	445
5760b90a UW	446	return builtin_m2_type;
	447	}
	448
	449	static struct gdbarch_data *m2_type_data;
	450
	451	const struct builtin_m2_type *
	452	builtin_m2_type (struct gdbarch *gdbarch)
	453	{
9a3c8263	454	return (const struct builtin_m2_type *) gdbarch_data (gdbarch, m2_type_data);
5760b90a UW	455	}
	456
	457
	458	/* Initialization for Modula-2 */
	459
	460	void
	461	_initialize_m2_language (void)
	462	{
	463	m2_type_data = gdbarch_data_register_post_init (build_m2_types);
c906108c	464	}