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

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

   Copyright (C) 1992-2013 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 "m2-lang.h"
#include "c-lang.h"
#include "valprint.h"

extern void _initialize_m2_language (void);
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)
	    {
	      if (options->inspect_it)
		fputs_filtered ("\\\", ", stream);
	      else
		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)
	    {
	      if (options->inspect_it)
		fputs_filtered ("\\\"", stream);
	      else
		fputs_filtered ("\"", stream);
	      in_quotes = 1;
	    }
	  LA_EMIT_CHAR (string[i], type, stream, '"');
	  ++things_printed;
	}
    }

  /* Terminate the quotes if necessary.  */
  if (in_quotes)
    {
      if (options->inspect_it)
	fputs_filtered ("\\\"", stream);
      else
	fputs_filtered ("\"", stream);
    }

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

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, 0, 0, 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
};

const struct language_defn m2_language_defn =
{
  "modula-2",
  language_m2,
  range_check_on,
  case_sensitive_on,
  array_row_major,
  macro_expansion_no,
  &exp_descriptor_modula2,
  m2_parse,			/* parser */
  m2_error,			/* parser error function */
  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 */
  basic_lookup_symbol_nonlocal,	/* lookup_symbol_nonlocal */
  basic_lookup_transparent_type,/* lookup_transparent_type */
  NULL,				/* Language specific symbol demangler */
  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_make_symbol_completion_list,
  m2_language_arch_info,
  default_print_array_index,
  default_pass_by_reference,
  default_get_string,
  NULL,				/* la_get_symbol_name_cmp */
  iterate_over_symbols,
  LANG_MAGIC
};

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", NULL);
  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 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);

  add_language (&m2_language_defn);
}
Commit	Line	Data
c906108c	1	/* Modula 2 language support routines for GDB, the GNU debugger.
ce27fb25	2
28e7fd62	3	Copyright (C) 1992-2013 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"
	26	#include "m2-lang.h"
	27	#include "c-lang.h"
745b8ca0	28	#include "valprint.h"
c906108c	29
a14ed312	30	extern void _initialize_m2_language (void);
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	{
79a45b7d	148	if (options->inspect_it)
c906108c SS	149	fputs_filtered ("\\\", ", stream);
	150	else
	151	fputs_filtered ("\", ", stream);
	152	in_quotes = 0;
	153	}
6c7a06a3	154	m2_printchar (string[i], type, stream);
c906108c SS	155	fprintf_filtered (stream, " <repeats %u times>", reps);
c906108c SS	156	i = rep1 - 1;
79a45b7d	157	things_printed += options->repeat_count_threshold;
c906108c SS	158	need_comma = 1;
	159	}
	160	else
	161	{
	162	if (!in_quotes)
	163	{
79a45b7d	164	if (options->inspect_it)
c906108c SS	165	fputs_filtered ("\\\"", stream);
	166	else
	167	fputs_filtered ("\"", stream);
	168	in_quotes = 1;
	169	}
6c7a06a3	170	LA_EMIT_CHAR (string[i], type, stream, '"');
c906108c SS	171	++things_printed;
	172	}
	173	}
	174
	175	/* Terminate the quotes if necessary. */
	176	if (in_quotes)
	177	{
79a45b7d	178	if (options->inspect_it)
c906108c SS	179	fputs_filtered ("\\\"", stream);
	180	else
	181	fputs_filtered ("\"", stream);
	182	}
	183
	184	if (force_ellipses \|\| i < length)
	185	fputs_filtered ("...", stream);
	186	}
	187
844781a1 GM	188	static struct value *
	189	evaluate_subexp_modula2 (struct type expect_type, struct expression exp,
	190	int *pos, enum noside noside)
	191	{
	192	enum exp_opcode op = exp->elts[*pos].opcode;
	193	struct value *arg1;
	194	struct value *arg2;
	195	struct type *type;
b8d56208	196
844781a1 GM	197	switch (op)
	198	{
	199	case UNOP_HIGH:
	200	(*pos)++;
	201	arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
	202
	203	if (noside == EVAL_SKIP \|\| noside == EVAL_AVOID_SIDE_EFFECTS)
	204	return arg1;
	205	else
	206	{
	207	arg1 = coerce_ref (arg1);
	208	type = check_typedef (value_type (arg1));
	209
	210	if (m2_is_unbounded_array (type))
	211	{
	212	struct value *temp = arg1;
b8d56208	213
844781a1 GM	214	type = TYPE_FIELD_TYPE (type, 1);
	215	/* i18n: Do not translate the "_m2_high" part! */
	216	arg1 = value_struct_elt (&temp, NULL, "_m2_high", NULL,
	217	_("unbounded structure "
	218	"missing _m2_high field"));
	219
	220	if (value_type (arg1) != type)
	221	arg1 = value_cast (type, arg1);
	222	}
	223	}
	224	return arg1;
	225
	226	case BINOP_SUBSCRIPT:
	227	(*pos)++;
	228	arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
	229	arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
	230	if (noside == EVAL_SKIP)
	231	goto nosideret;
	232	/* If the user attempts to subscript something that is not an
	233	array or pointer type (like a plain int variable for example),
	234	then report this as an error. */
	235
	236	arg1 = coerce_ref (arg1);
	237	type = check_typedef (value_type (arg1));
	238
	239	if (m2_is_unbounded_array (type))
	240	{
	241	struct value *temp = arg1;
	242	type = TYPE_FIELD_TYPE (type, 0);
b8d56208 MS	243	if (type == NULL \|\| (TYPE_CODE (type) != TYPE_CODE_PTR))
b8d56208 MS	244	{
025bb325 MS	245	warning (_("internal error: unbounded "
025bb325 MS	246	"array structure is unknown"));
b8d56208 MS	247	return evaluate_subexp_standard (expect_type, exp, pos, noside);
b8d56208 MS	248	}
844781a1 GM	249	/* i18n: Do not translate the "_m2_contents" part! */
	250	arg1 = value_struct_elt (&temp, NULL, "_m2_contents", NULL,
	251	_("unbounded structure "
	252	"missing _m2_contents field"));
	253
	254	if (value_type (arg1) != type)
	255	arg1 = value_cast (type, arg1);
	256
976aa66e	257	check_typedef (value_type (arg1));
2497b498	258	return value_ind (value_ptradd (arg1, value_as_long (arg2)));
844781a1 GM	259	}
	260	else
	261	if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
	262	{
	263	if (TYPE_NAME (type))
	264	error (_("cannot subscript something of type `%s'"),
	265	TYPE_NAME (type));
	266	else
	267	error (_("cannot subscript requested type"));
	268	}
	269
	270	if (noside == EVAL_AVOID_SIDE_EFFECTS)
	271	return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
	272	else
2497b498	273	return value_subscript (arg1, value_as_long (arg2));
844781a1 GM	274
	275	default:
	276	return evaluate_subexp_standard (expect_type, exp, pos, noside);
	277	}
	278
	279	nosideret:
22601c15	280	return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
844781a1	281	}
c906108c	282	\f
c5aa993b	283
c906108c SS	284	/* Table of operators and their precedences for printing expressions. */
c906108c SS	285
c5aa993b JM	286	static const struct op_print m2_op_print_tab[] =
	287	{
	288	{"+", BINOP_ADD, PREC_ADD, 0},
	289	{"+", UNOP_PLUS, PREC_PREFIX, 0},
	290	{"-", BINOP_SUB, PREC_ADD, 0},
	291	{"-", UNOP_NEG, PREC_PREFIX, 0},
	292	{"*", BINOP_MUL, PREC_MUL, 0},
	293	{"/", BINOP_DIV, PREC_MUL, 0},
	294	{"DIV", BINOP_INTDIV, PREC_MUL, 0},
	295	{"MOD", BINOP_REM, PREC_MUL, 0},
	296	{":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
	297	{"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
	298	{"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
	299	{"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
	300	{"=", BINOP_EQUAL, PREC_EQUAL, 0},
	301	{"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
	302	{"<=", BINOP_LEQ, PREC_ORDER, 0},
	303	{">=", BINOP_GEQ, PREC_ORDER, 0},
	304	{">", BINOP_GTR, PREC_ORDER, 0},
	305	{"<", BINOP_LESS, PREC_ORDER, 0},
	306	{"^", UNOP_IND, PREC_PREFIX, 0},
	307	{"@", BINOP_REPEAT, PREC_REPEAT, 0},
	308	{"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0},
	309	{"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0},
	310	{"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0},
	311	{"FLOAT", UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0},
	312	{"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0},
	313	{"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0},
	314	{"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0},
	315	{"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0},
	316	{"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0},
	317	{NULL, 0, 0, 0}
c906108c SS	318	};
	319	\f
	320	/* The built-in types of Modula-2. */
	321
cad351d1 UW	322	enum m2_primitive_types {
	323	m2_primitive_type_char,
	324	m2_primitive_type_int,
	325	m2_primitive_type_card,
	326	m2_primitive_type_real,
	327	m2_primitive_type_bool,
	328	nr_m2_primitive_types
c906108c SS	329	};
c906108c SS	330
cad351d1 UW	331	static void
	332	m2_language_arch_info (struct gdbarch *gdbarch,
	333	struct language_arch_info *lai)
	334	{
5760b90a UW	335	const struct builtin_m2_type *builtin = builtin_m2_type (gdbarch);
	336
	337	lai->string_char_type = builtin->builtin_char;
cad351d1 UW	338	lai->primitive_type_vector
	339	= GDBARCH_OBSTACK_CALLOC (gdbarch, nr_m2_primitive_types + 1,
	340	struct type *);
	341
	342	lai->primitive_type_vector [m2_primitive_type_char]
5760b90a	343	= builtin->builtin_char;
cad351d1	344	lai->primitive_type_vector [m2_primitive_type_int]
5760b90a	345	= builtin->builtin_int;
cad351d1	346	lai->primitive_type_vector [m2_primitive_type_card]
5760b90a	347	= builtin->builtin_card;
cad351d1	348	lai->primitive_type_vector [m2_primitive_type_real]
5760b90a	349	= builtin->builtin_real;
cad351d1	350	lai->primitive_type_vector [m2_primitive_type_bool]
5760b90a	351	= builtin->builtin_bool;
fbb06eb1 UW	352
	353	lai->bool_type_symbol = "BOOLEAN";
	354	lai->bool_type_default = builtin->builtin_bool;
cad351d1 UW	355	}
cad351d1 UW	356
844781a1 GM	357	const struct exp_descriptor exp_descriptor_modula2 =
	358	{
	359	print_subexp_standard,
	360	operator_length_standard,
c0201579	361	operator_check_standard,
844781a1 GM	362	op_name_standard,
	363	dump_subexp_body_standard,
	364	evaluate_subexp_modula2
	365	};
	366
c5aa993b JM	367	const struct language_defn m2_language_defn =
c5aa993b JM	368	{
c906108c SS	369	"modula-2",
c906108c SS	370	language_m2,
c906108c	371	range_check_on,
63872f9d	372	case_sensitive_on,
7ca2d3a3	373	array_row_major,
9a044a89	374	macro_expansion_no,
844781a1	375	&exp_descriptor_modula2,
c906108c SS	376	m2_parse, /* parser */
c906108c SS	377	m2_error, /* parser error function */
e85c3284	378	null_post_parser,
c906108c SS	379	m2_printchar, /* Print character constant */
	380	m2_printstr, /* function to print string constant */
	381	m2_emit_char, /* Function to print a single character */
c906108c	382	m2_print_type, /* Print a type using appropriate syntax */
5c6ce71d	383	m2_print_typedef, /* Print a typedef using appropriate syntax */
c906108c SS	384	m2_val_print, /* Print a value using appropriate syntax */
c906108c SS	385	c_value_print, /* Print a top-level value */
a5ee536b	386	default_read_var_value, /* la_read_var_value */
f636b87d	387	NULL, /* Language specific skip_trampoline */
2b2d9e11	388	NULL, /* name_of_this */
5f9a71c3	389	basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
b368761e	390	basic_lookup_transparent_type,/* lookup_transparent_type */
9a3d7dfd	391	NULL, /* Language specific symbol demangler */
025bb325 MS	392	NULL, /* Language specific
025bb325 MS	393	class_name_from_physname */
c906108c SS	394	m2_op_print_tab, /* expression operators for printing */
	395	0, /* arrays are first-class (not c-style) */
	396	0, /* String lower bound */
6084f43a	397	default_word_break_characters,
41d27058	398	default_make_symbol_completion_list,
cad351d1	399	m2_language_arch_info,
e79af960	400	default_print_array_index,
41f1b697	401	default_pass_by_reference,
ae6a3a4c	402	default_get_string,
1a119f36	403	NULL, /* la_get_symbol_name_cmp */
f8eba3c6	404	iterate_over_symbols,
c906108c SS	405	LANG_MAGIC
	406	};
	407
5760b90a UW	408	static void *
5760b90a UW	409	build_m2_types (struct gdbarch *gdbarch)
c906108c	410	{
5760b90a UW	411	struct builtin_m2_type *builtin_m2_type
	412	= GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_m2_type);
	413
c906108c	414	/* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
e9bb382b UW	415	builtin_m2_type->builtin_int
	416	= arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 0, "INTEGER");
	417	builtin_m2_type->builtin_card
	418	= arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "CARDINAL");
	419	builtin_m2_type->builtin_real
	420	= arch_float_type (gdbarch, gdbarch_float_bit (gdbarch), "REAL", NULL);
	421	builtin_m2_type->builtin_char
	422	= arch_character_type (gdbarch, TARGET_CHAR_BIT, 1, "CHAR");
	423	builtin_m2_type->builtin_bool
	424	= arch_boolean_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "BOOLEAN");
c906108c	425
5760b90a UW	426	return builtin_m2_type;
	427	}
	428
	429	static struct gdbarch_data *m2_type_data;
	430
	431	const struct builtin_m2_type *
	432	builtin_m2_type (struct gdbarch *gdbarch)
	433	{
	434	return gdbarch_data (gdbarch, m2_type_data);
	435	}
	436
	437
	438	/* Initialization for Modula-2 */
	439
	440	void
	441	_initialize_m2_language (void)
	442	{
	443	m2_type_data = gdbarch_data_register_post_init (build_m2_types);
	444
c906108c SS	445	add_language (&m2_language_defn);
c906108c SS	446	}