[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 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, 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;
  int width = TYPE_LENGTH (type);

  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);

	  type = 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,
  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,
  default_get_string,
  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_float_type (gdbarch_float_bit (gdbarch), "REAL", 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);
6c7a06a3 TT	32	static void m2_printchar (int, struct type , struct ui_file );
6c7a06a3 TT	33	static void m2_emit_char (int, struct type , 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
6c7a06a3	42	m2_emit_char (int c, struct type type, 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
6c7a06a3	91	m2_printchar (int c, struct type type, struct ui_file stream)
c906108c SS	92	{
c906108c SS	93	fputs_filtered ("'", stream);
6c7a06a3	94	LA_EMIT_CHAR (c, type, stream, '\'');
c906108c SS	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
6c7a06a3 TT	106	m2_printstr (struct ui_file stream, struct type type, const gdb_byte *string,
6c7a06a3 TT	107	unsigned int length, int force_ellipses,
79a45b7d	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;
6c7a06a3	114	int width = TYPE_LENGTH (type);
c906108c SS	115
	116	if (length == 0)
	117	{
	118	fputs_filtered ("\"\"", gdb_stdout);
	119	return;
	120	}
	121
79a45b7d	122	for (i = 0; i < length && things_printed < options->print_max; ++i)
c906108c SS	123	{
c906108c SS	124	/* Position of the character we are examining
c5aa993b	125	to see whether it is repeated. */
c906108c SS	126	unsigned int rep1;
	127	/* Number of repetitions we have detected so far. */
	128	unsigned int reps;
	129
	130	QUIT;
	131
	132	if (need_comma)
	133	{
	134	fputs_filtered (", ", stream);
	135	need_comma = 0;
	136	}
	137
	138	rep1 = i + 1;
	139	reps = 1;
	140	while (rep1 < length && string[rep1] == string[i])
	141	{
	142	++rep1;
	143	++reps;
	144	}
	145
79a45b7d	146	if (reps > options->repeat_count_threshold)
c906108c SS	147	{
	148	if (in_quotes)
	149	{
79a45b7d	150	if (options->inspect_it)
c906108c SS	151	fputs_filtered ("\\\", ", stream);
	152	else
	153	fputs_filtered ("\", ", stream);
	154	in_quotes = 0;
	155	}
6c7a06a3	156	m2_printchar (string[i], type, stream);
c906108c SS	157	fprintf_filtered (stream, " <repeats %u times>", reps);
c906108c SS	158	i = rep1 - 1;
79a45b7d	159	things_printed += options->repeat_count_threshold;
c906108c SS	160	need_comma = 1;
	161	}
	162	else
	163	{
	164	if (!in_quotes)
	165	{
79a45b7d	166	if (options->inspect_it)
c906108c SS	167	fputs_filtered ("\\\"", stream);
	168	else
	169	fputs_filtered ("\"", stream);
	170	in_quotes = 1;
	171	}
6c7a06a3	172	LA_EMIT_CHAR (string[i], type, stream, '"');
c906108c SS	173	++things_printed;
	174	}
	175	}
	176
	177	/* Terminate the quotes if necessary. */
	178	if (in_quotes)
	179	{
79a45b7d	180	if (options->inspect_it)
c906108c SS	181	fputs_filtered ("\\\"", stream);
	182	else
	183	fputs_filtered ("\"", stream);
	184	}
	185
	186	if (force_ellipses \|\| i < length)
	187	fputs_filtered ("...", stream);
	188	}
	189
844781a1 GM	190	static struct value *
	191	evaluate_subexp_modula2 (struct type expect_type, struct expression exp,
	192	int *pos, enum noside noside)
	193	{
	194	enum exp_opcode op = exp->elts[*pos].opcode;
	195	struct value *arg1;
	196	struct value *arg2;
	197	struct type *type;
	198	switch (op)
	199	{
	200	case UNOP_HIGH:
	201	(*pos)++;
	202	arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
	203
	204	if (noside == EVAL_SKIP \|\| noside == EVAL_AVOID_SIDE_EFFECTS)
	205	return arg1;
	206	else
	207	{
	208	arg1 = coerce_ref (arg1);
	209	type = check_typedef (value_type (arg1));
	210
	211	if (m2_is_unbounded_array (type))
	212	{
	213	struct value *temp = arg1;
	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);
	243	if (type == NULL \|\| (TYPE_CODE (type) != TYPE_CODE_PTR)) {
	244	warning (_("internal error: unbounded array structure is unknown"));
	245	return evaluate_subexp_standard (expect_type, exp, pos, noside);
	246	}
	247	/* i18n: Do not translate the "_m2_contents" part! */
	248	arg1 = value_struct_elt (&temp, NULL, "_m2_contents", NULL,
	249	_("unbounded structure "
	250	"missing _m2_contents field"));
	251
	252	if (value_type (arg1) != type)
	253	arg1 = value_cast (type, arg1);
254
255	type = check_typedef (value_type (arg1));
2497b498	256	return value_ind (value_ptradd (arg1, value_as_long (arg2)));
844781a1 GM	257	}
	258	else
	259	if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
	260	{
	261	if (TYPE_NAME (type))
	262	error (_("cannot subscript something of type `%s'"),
	263	TYPE_NAME (type));
	264	else
	265	error (_("cannot subscript requested type"));
	266	}
	267
	268	if (noside == EVAL_AVOID_SIDE_EFFECTS)
	269	return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
	270	else
2497b498	271	return value_subscript (arg1, value_as_long (arg2));
844781a1 GM	272
	273	default:
	274	return evaluate_subexp_standard (expect_type, exp, pos, noside);
	275	}
	276
	277	nosideret:
22601c15	278	return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
844781a1	279	}
c906108c	280	\f
c5aa993b	281
c906108c SS	282	/* Table of operators and their precedences for printing expressions. */
c906108c SS	283
c5aa993b JM	284	static const struct op_print m2_op_print_tab[] =
	285	{
	286	{"+", BINOP_ADD, PREC_ADD, 0},
	287	{"+", UNOP_PLUS, PREC_PREFIX, 0},
	288	{"-", BINOP_SUB, PREC_ADD, 0},
	289	{"-", UNOP_NEG, PREC_PREFIX, 0},
	290	{"*", BINOP_MUL, PREC_MUL, 0},
	291	{"/", BINOP_DIV, PREC_MUL, 0},
	292	{"DIV", BINOP_INTDIV, PREC_MUL, 0},
	293	{"MOD", BINOP_REM, PREC_MUL, 0},
	294	{":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
	295	{"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
	296	{"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
	297	{"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
	298	{"=", BINOP_EQUAL, PREC_EQUAL, 0},
	299	{"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
	300	{"<=", BINOP_LEQ, PREC_ORDER, 0},
	301	{">=", BINOP_GEQ, PREC_ORDER, 0},
	302	{">", BINOP_GTR, PREC_ORDER, 0},
	303	{"<", BINOP_LESS, PREC_ORDER, 0},
	304	{"^", UNOP_IND, PREC_PREFIX, 0},
	305	{"@", BINOP_REPEAT, PREC_REPEAT, 0},
	306	{"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0},
	307	{"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0},
	308	{"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0},
	309	{"FLOAT", UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0},
	310	{"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0},
	311	{"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0},
	312	{"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0},
	313	{"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0},
	314	{"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0},
	315	{NULL, 0, 0, 0}
c906108c SS	316	};
	317	\f
	318	/* The built-in types of Modula-2. */
	319
cad351d1 UW	320	enum m2_primitive_types {
	321	m2_primitive_type_char,
	322	m2_primitive_type_int,
	323	m2_primitive_type_card,
	324	m2_primitive_type_real,
	325	m2_primitive_type_bool,
	326	nr_m2_primitive_types
c906108c SS	327	};
c906108c SS	328
cad351d1 UW	329	static void
	330	m2_language_arch_info (struct gdbarch *gdbarch,
	331	struct language_arch_info *lai)
	332	{
5760b90a UW	333	const struct builtin_m2_type *builtin = builtin_m2_type (gdbarch);
	334
	335	lai->string_char_type = builtin->builtin_char;
cad351d1 UW	336	lai->primitive_type_vector
	337	= GDBARCH_OBSTACK_CALLOC (gdbarch, nr_m2_primitive_types + 1,
	338	struct type *);
	339
	340	lai->primitive_type_vector [m2_primitive_type_char]
5760b90a	341	= builtin->builtin_char;
cad351d1	342	lai->primitive_type_vector [m2_primitive_type_int]
5760b90a	343	= builtin->builtin_int;
cad351d1	344	lai->primitive_type_vector [m2_primitive_type_card]
5760b90a	345	= builtin->builtin_card;
cad351d1	346	lai->primitive_type_vector [m2_primitive_type_real]
5760b90a	347	= builtin->builtin_real;
cad351d1	348	lai->primitive_type_vector [m2_primitive_type_bool]
5760b90a	349	= builtin->builtin_bool;
fbb06eb1 UW	350
	351	lai->bool_type_symbol = "BOOLEAN";
	352	lai->bool_type_default = builtin->builtin_bool;
cad351d1 UW	353	}
cad351d1 UW	354
844781a1 GM	355	const struct exp_descriptor exp_descriptor_modula2 =
	356	{
	357	print_subexp_standard,
	358	operator_length_standard,
	359	op_name_standard,
	360	dump_subexp_body_standard,
	361	evaluate_subexp_modula2
	362	};
	363
c5aa993b JM	364	const struct language_defn m2_language_defn =
c5aa993b JM	365	{
c906108c SS	366	"modula-2",
c906108c SS	367	language_m2,
c906108c SS	368	range_check_on,
c906108c SS	369	type_check_on,
63872f9d	370	case_sensitive_on,
7ca2d3a3	371	array_row_major,
9a044a89	372	macro_expansion_no,
844781a1	373	&exp_descriptor_modula2,
c906108c SS	374	m2_parse, /* parser */
c906108c SS	375	m2_error, /* parser error function */
e85c3284	376	null_post_parser,
c906108c SS	377	m2_printchar, /* Print character constant */
	378	m2_printstr, /* function to print string constant */
	379	m2_emit_char, /* Function to print a single character */
c906108c	380	m2_print_type, /* Print a type using appropriate syntax */
5c6ce71d	381	m2_print_typedef, /* Print a typedef using appropriate syntax */
c906108c SS	382	m2_val_print, /* Print a value using appropriate syntax */
c906108c SS	383	c_value_print, /* Print a top-level value */
f636b87d	384	NULL, /* Language specific skip_trampoline */
2b2d9e11	385	NULL, /* name_of_this */
5f9a71c3	386	basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
b368761e	387	basic_lookup_transparent_type,/* lookup_transparent_type */
9a3d7dfd	388	NULL, /* Language specific symbol demangler */
31c27f77	389	NULL, /* Language specific class_name_from_physname */
c906108c SS	390	m2_op_print_tab, /* expression operators for printing */
	391	0, /* arrays are first-class (not c-style) */
	392	0, /* String lower bound */
6084f43a	393	default_word_break_characters,
41d27058	394	default_make_symbol_completion_list,
cad351d1	395	m2_language_arch_info,
e79af960	396	default_print_array_index,
41f1b697	397	default_pass_by_reference,
ae6a3a4c	398	default_get_string,
c906108c SS	399	LANG_MAGIC
	400	};
	401
5760b90a UW	402	static void *
5760b90a UW	403	build_m2_types (struct gdbarch *gdbarch)
c906108c	404	{
5760b90a UW	405	struct builtin_m2_type *builtin_m2_type
	406	= GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_m2_type);
	407
c906108c	408	/* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
5760b90a	409	builtin_m2_type->builtin_int =
40a6adc1 MD	410	init_type (TYPE_CODE_INT,
40a6adc1 MD	411	gdbarch_int_bit (gdbarch) / TARGET_CHAR_BIT,
9a76efb6	412	0, "INTEGER", (struct objfile *) NULL);
5760b90a	413	builtin_m2_type->builtin_card =
9a76efb6	414	init_type (TYPE_CODE_INT,
40a6adc1	415	gdbarch_int_bit (gdbarch) / TARGET_CHAR_BIT,
c906108c SS	416	TYPE_FLAG_UNSIGNED,
c906108c SS	417	"CARDINAL", (struct objfile *) NULL);
5760b90a	418	builtin_m2_type->builtin_real =
27067745	419	init_float_type (gdbarch_float_bit (gdbarch), "REAL", NULL);
5760b90a	420	builtin_m2_type->builtin_char =
c906108c SS	421	init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	422	TYPE_FLAG_UNSIGNED,
	423	"CHAR", (struct objfile *) NULL);
5760b90a	424	builtin_m2_type->builtin_bool =
9a76efb6	425	init_type (TYPE_CODE_BOOL,
40a6adc1	426	gdbarch_int_bit (gdbarch) / TARGET_CHAR_BIT,
c906108c SS	427	TYPE_FLAG_UNSIGNED,
	428	"BOOLEAN", (struct objfile *) NULL);
	429
5760b90a UW	430	return builtin_m2_type;
	431	}
	432
	433	static struct gdbarch_data *m2_type_data;
	434
	435	const struct builtin_m2_type *
	436	builtin_m2_type (struct gdbarch *gdbarch)
	437	{
	438	return gdbarch_data (gdbarch, m2_type_data);
	439	}
	440
	441
	442	/* Initialization for Modula-2 */
	443
	444	void
	445	_initialize_m2_language (void)
	446	{
	447	m2_type_data = gdbarch_data_register_post_init (build_m2_types);
	448
c906108c SS	449	add_language (&m2_language_defn);
c906108c SS	450	}