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

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

   Copyright (C) 1992-2018 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);
}

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 */
  m2_yyerror,			/* 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 */
  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,
  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",
		       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
	1	/* Modula 2 language support routines for GDB, the GNU debugger.
	2
	3	Copyright (C) 1992-2018 Free Software Foundation, Inc.
	4
	5	This file is part of GDB.
	6
	7	This program is free software; you can redistribute it and/or modify
	8	it under the terms of the GNU General Public License as published by
	9	the Free Software Foundation; either version 3 of the License, or
	10	(at your option) any later version.
	11
	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.
	16
	17	You should have received a copy of the GNU General Public License
	18	along with this program. If not, see <http://www.gnu.org/licenses/>. */
	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 "varobj.h"
	27	#include "m2-lang.h"
	28	#include "c-lang.h"
	29	#include "valprint.h"
	30
	31	static void m2_printchar (int, struct type , struct ui_file );
	32	static void m2_emit_char (int, struct type , struct ui_file , int);
	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
	38	be replaced with a true Modula version. */
	39
	40	static void
	41	m2_emit_char (int c, struct type type, struct ui_file stream, int quoter)
	42	{
	43
	44	c &= 0xFF; /* Avoid sign bit follies. */
	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
	87	be replaced with a true Modula version. */
	88
	89	static void
	90	m2_printchar (int c, struct type type, struct ui_file stream)
	91	{
	92	fputs_filtered ("'", stream);
	93	LA_EMIT_CHAR (c, type, stream, '\'');
	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
	102	be replaced with a true Modula version. */
	103
	104	static void
	105	m2_printstr (struct ui_file stream, struct type type, const gdb_byte *string,
	106	unsigned int length, const char *encoding, int force_ellipses,
	107	const struct value_print_options *options)
	108	{
	109	unsigned int i;
	110	unsigned int things_printed = 0;
	111	int in_quotes = 0;
	112	int need_comma = 0;
	113
	114	if (length == 0)
	115	{
	116	fputs_filtered ("\"\"", gdb_stdout);
	117	return;
	118	}
	119
	120	for (i = 0; i < length && things_printed < options->print_max; ++i)
	121	{
	122	/* Position of the character we are examining
	123	to see whether it is repeated. */
	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
	144	if (reps > options->repeat_count_threshold)
	145	{
	146	if (in_quotes)
	147	{
	148	fputs_filtered ("\", ", stream);
	149	in_quotes = 0;
	150	}
	151	m2_printchar (string[i], type, stream);
	152	fprintf_filtered (stream, " <repeats %u times>", reps);
	153	i = rep1 - 1;
	154	things_printed += options->repeat_count_threshold;
	155	need_comma = 1;
	156	}
	157	else
	158	{
	159	if (!in_quotes)
	160	{
	161	fputs_filtered ("\"", stream);
	162	in_quotes = 1;
	163	}
	164	LA_EMIT_CHAR (string[i], type, stream, '"');
	165	++things_printed;
	166	}
	167	}
	168
	169	/* Terminate the quotes if necessary. */
	170	if (in_quotes)
	171	fputs_filtered ("\"", stream);
	172
	173	if (force_ellipses \|\| i < length)
	174	fputs_filtered ("...", stream);
	175	}
	176
	177	static struct value *
	178	evaluate_subexp_modula2 (struct type expect_type, struct expression exp,
	179	int *pos, enum noside noside)
	180	{
	181	enum exp_opcode op = exp->elts[*pos].opcode;
	182	struct value *arg1;
	183	struct value *arg2;
	184	struct type *type;
	185
	186	switch (op)
	187	{
	188	case UNOP_HIGH:
	189	(*pos)++;
	190	arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
	191
	192	if (noside == EVAL_SKIP \|\| noside == EVAL_AVOID_SIDE_EFFECTS)
	193	return arg1;
	194	else
	195	{
	196	arg1 = coerce_ref (arg1);
	197	type = check_typedef (value_type (arg1));
	198
	199	if (m2_is_unbounded_array (type))
	200	{
	201	struct value *temp = arg1;
	202
	203	type = TYPE_FIELD_TYPE (type, 1);
	204	/* i18n: Do not translate the "_m2_high" part! */
	205	arg1 = value_struct_elt (&temp, NULL, "_m2_high", NULL,
	206	_("unbounded structure "
	207	"missing _m2_high field"));
	208
	209	if (value_type (arg1) != type)
	210	arg1 = value_cast (type, arg1);
	211	}
	212	}
	213	return arg1;
	214
	215	case BINOP_SUBSCRIPT:
	216	(*pos)++;
	217	arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
	218	arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
	219	if (noside == EVAL_SKIP)
	220	goto nosideret;
	221	/* If the user attempts to subscript something that is not an
	222	array or pointer type (like a plain int variable for example),
	223	then report this as an error. */
	224
	225	arg1 = coerce_ref (arg1);
	226	type = check_typedef (value_type (arg1));
	227
	228	if (m2_is_unbounded_array (type))
	229	{
	230	struct value *temp = arg1;
	231	type = TYPE_FIELD_TYPE (type, 0);
	232	if (type == NULL \|\| (TYPE_CODE (type) != TYPE_CODE_PTR))
	233	{
	234	warning (_("internal error: unbounded "
	235	"array structure is unknown"));
	236	return evaluate_subexp_standard (expect_type, exp, pos, noside);
	237	}
	238	/* i18n: Do not translate the "_m2_contents" part! */
	239	arg1 = value_struct_elt (&temp, NULL, "_m2_contents", NULL,
	240	_("unbounded structure "
	241	"missing _m2_contents field"));
	242
	243	if (value_type (arg1) != type)
	244	arg1 = value_cast (type, arg1);
	245
	246	check_typedef (value_type (arg1));
	247	return value_ind (value_ptradd (arg1, value_as_long (arg2)));
	248	}
	249	else
	250	if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
	251	{
	252	if (TYPE_NAME (type))
	253	error (_("cannot subscript something of type `%s'"),
	254	TYPE_NAME (type));
	255	else
	256	error (_("cannot subscript requested type"));
	257	}
	258
	259	if (noside == EVAL_AVOID_SIDE_EFFECTS)
	260	return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
	261	else
	262	return value_subscript (arg1, value_as_long (arg2));
	263
	264	default:
	265	return evaluate_subexp_standard (expect_type, exp, pos, noside);
	266	}
	267
	268	nosideret:
	269	return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
	270	}
	271	\f
	272
	273	/* Table of operators and their precedences for printing expressions. */
	274
	275	static const struct op_print m2_op_print_tab[] =
	276	{
	277	{"+", BINOP_ADD, PREC_ADD, 0},
	278	{"+", UNOP_PLUS, PREC_PREFIX, 0},
	279	{"-", BINOP_SUB, PREC_ADD, 0},
	280	{"-", UNOP_NEG, PREC_PREFIX, 0},
	281	{"*", BINOP_MUL, PREC_MUL, 0},
	282	{"/", BINOP_DIV, PREC_MUL, 0},
	283	{"DIV", BINOP_INTDIV, PREC_MUL, 0},
	284	{"MOD", BINOP_REM, PREC_MUL, 0},
	285	{":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
	286	{"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
	287	{"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
	288	{"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
	289	{"=", BINOP_EQUAL, PREC_EQUAL, 0},
	290	{"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
	291	{"<=", BINOP_LEQ, PREC_ORDER, 0},
	292	{">=", BINOP_GEQ, PREC_ORDER, 0},
	293	{">", BINOP_GTR, PREC_ORDER, 0},
	294	{"<", BINOP_LESS, PREC_ORDER, 0},
	295	{"^", UNOP_IND, PREC_PREFIX, 0},
	296	{"@", BINOP_REPEAT, PREC_REPEAT, 0},
	297	{"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0},
	298	{"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0},
	299	{"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0},
	300	{"FLOAT", UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0},
	301	{"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0},
	302	{"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0},
	303	{"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0},
	304	{"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0},
	305	{"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0},
	306	{NULL, OP_NULL, PREC_BUILTIN_FUNCTION, 0}
	307	};
	308	\f
	309	/* The built-in types of Modula-2. */
	310
	311	enum m2_primitive_types {
	312	m2_primitive_type_char,
	313	m2_primitive_type_int,
	314	m2_primitive_type_card,
	315	m2_primitive_type_real,
	316	m2_primitive_type_bool,
	317	nr_m2_primitive_types
	318	};
	319
	320	static void
	321	m2_language_arch_info (struct gdbarch *gdbarch,
	322	struct language_arch_info *lai)
	323	{
	324	const struct builtin_m2_type *builtin = builtin_m2_type (gdbarch);
	325
	326	lai->string_char_type = builtin->builtin_char;
	327	lai->primitive_type_vector
	328	= GDBARCH_OBSTACK_CALLOC (gdbarch, nr_m2_primitive_types + 1,
	329	struct type *);
	330
	331	lai->primitive_type_vector [m2_primitive_type_char]
	332	= builtin->builtin_char;
	333	lai->primitive_type_vector [m2_primitive_type_int]
	334	= builtin->builtin_int;
	335	lai->primitive_type_vector [m2_primitive_type_card]
	336	= builtin->builtin_card;
	337	lai->primitive_type_vector [m2_primitive_type_real]
	338	= builtin->builtin_real;
	339	lai->primitive_type_vector [m2_primitive_type_bool]
	340	= builtin->builtin_bool;
	341
	342	lai->bool_type_symbol = "BOOLEAN";
	343	lai->bool_type_default = builtin->builtin_bool;
	344	}
	345
	346	const struct exp_descriptor exp_descriptor_modula2 =
	347	{
	348	print_subexp_standard,
	349	operator_length_standard,
	350	operator_check_standard,
	351	op_name_standard,
	352	dump_subexp_body_standard,
	353	evaluate_subexp_modula2
	354	};
	355
	356	extern const struct language_defn m2_language_defn =
	357	{
	358	"modula-2",
	359	"Modula-2",
	360	language_m2,
	361	range_check_on,
	362	case_sensitive_on,
	363	array_row_major,
	364	macro_expansion_no,
	365	NULL,
	366	&exp_descriptor_modula2,
	367	m2_parse, /* parser */
	368	m2_yyerror, /* parser error function */
	369	null_post_parser,
	370	m2_printchar, /* Print character constant */
	371	m2_printstr, /* function to print string constant */
	372	m2_emit_char, /* Function to print a single character */
	373	m2_print_type, /* Print a type using appropriate syntax */
	374	m2_print_typedef, /* Print a typedef using appropriate syntax */
	375	m2_val_print, /* Print a value using appropriate syntax */
	376	c_value_print, /* Print a top-level value */
	377	default_read_var_value, /* la_read_var_value */
	378	NULL, /* Language specific skip_trampoline */
	379	NULL, /* name_of_this */
	380	false, /* la_store_sym_names_in_linkage_form_p */
	381	basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
	382	basic_lookup_transparent_type,/* lookup_transparent_type */
	383	NULL, /* Language specific symbol demangler */
	384	NULL,
	385	NULL, /* Language specific
	386	class_name_from_physname */
	387	m2_op_print_tab, /* expression operators for printing */
	388	0, /* arrays are first-class (not c-style) */
	389	0, /* String lower bound */
	390	default_word_break_characters,
	391	default_collect_symbol_completion_matches,
	392	m2_language_arch_info,
	393	default_print_array_index,
	394	default_pass_by_reference,
	395	default_get_string,
	396	c_watch_location_expression,
	397	NULL, /* la_get_symbol_name_matcher */
	398	iterate_over_symbols,
	399	default_search_name_hash,
	400	&default_varobj_ops,
	401	NULL,
	402	NULL,
	403	LANG_MAGIC
	404	};
	405
	406	static void *
	407	build_m2_types (struct gdbarch *gdbarch)
	408	{
	409	struct builtin_m2_type *builtin_m2_type
	410	= GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_m2_type);
	411
	412	/* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
	413	builtin_m2_type->builtin_int
	414	= arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 0, "INTEGER");
	415	builtin_m2_type->builtin_card
	416	= arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "CARDINAL");
	417	builtin_m2_type->builtin_real
	418	= arch_float_type (gdbarch, gdbarch_float_bit (gdbarch), "REAL",
	419	gdbarch_float_format (gdbarch));
	420	builtin_m2_type->builtin_char
	421	= arch_character_type (gdbarch, TARGET_CHAR_BIT, 1, "CHAR");
	422	builtin_m2_type->builtin_bool
	423	= arch_boolean_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "BOOLEAN");
	424
	425	return builtin_m2_type;
	426	}
	427
	428	static struct gdbarch_data *m2_type_data;
	429
	430	const struct builtin_m2_type *
	431	builtin_m2_type (struct gdbarch *gdbarch)
	432	{
	433	return (const struct builtin_m2_type *) gdbarch_data (gdbarch, m2_type_data);
	434	}
	435
	436
	437	/* Initialization for Modula-2 */
	438
	439	void
	440	_initialize_m2_language (void)
	441	{
	442	m2_type_data = gdbarch_data_register_post_init (build_m2_types);
	443	}