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

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

   Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 2000, 2002, 2003, 2004,
   2005, 2007, 2008, 2009 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 ui_file *);
static void m2_emit_char (int, 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 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 ui_file *stream)
{
  fputs_filtered ("'", stream);
  LA_EMIT_CHAR (c, 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, const gdb_byte *string,
	     unsigned int length, int width, 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], 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], 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);

	  type = check_typedef (value_type (arg1));
	  return value_ind (value_ptradd (arg1, 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, arg2);

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

 nosideret:
  return value_from_longest (builtin_type_int8, (LONGEST) 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,
  op_name_standard,
  dump_subexp_body_standard,
  evaluate_subexp_modula2
};

const struct language_defn m2_language_defn =
{
  "modula-2",
  language_m2,
  range_check_on,
  type_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 */
  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,
  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 =
    init_type (TYPE_CODE_INT,
	       gdbarch_int_bit (gdbarch) / TARGET_CHAR_BIT,
	       0, "INTEGER", (struct objfile *) NULL);
  builtin_m2_type->builtin_card =
    init_type (TYPE_CODE_INT, 
	       gdbarch_int_bit (gdbarch) / TARGET_CHAR_BIT,
	       TYPE_FLAG_UNSIGNED,
	       "CARDINAL", (struct objfile *) NULL);
  builtin_m2_type->builtin_real =
    init_type (TYPE_CODE_FLT,
	       gdbarch_float_bit (gdbarch) / TARGET_CHAR_BIT,
	       0,
	       "REAL", (struct objfile *) NULL);
  builtin_m2_type->builtin_char =
    init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	       TYPE_FLAG_UNSIGNED,
	       "CHAR", (struct objfile *) NULL);
  builtin_m2_type->builtin_bool =
    init_type (TYPE_CODE_BOOL, 
	       gdbarch_int_bit (gdbarch) / TARGET_CHAR_BIT,
	       TYPE_FLAG_UNSIGNED,
	       "BOOLEAN", (struct objfile *) NULL);

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