[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 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)
{
  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 < 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 > repeat_count_threshold)
	{
	  if (in_quotes)
	    {
	      if (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 += repeat_count_threshold;
	  need_comma = 1;
	}
      else
	{
	  if (!in_quotes)
	    {
	      if (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 (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_add (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_long, (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;
}

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,
  &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_val_print,			/* Print a value using appropriate syntax */
  c_value_print,		/* Print a top-level value */
  NULL,				/* Language specific skip_trampoline */
  value_of_this,		/* value_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,
9b254dd1	4	2005, 2007, 2008 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,
ce27fb25	107	unsigned int length, int width, int force_ellipses)
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
	120	for (i = 0; i < length && things_printed < print_max; ++i)
	121	{
	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
	144	if (reps > repeat_count_threshold)
	145	{
	146	if (in_quotes)
	147	{
	148	if (inspect_it)
	149	fputs_filtered ("\\\", ", stream);
	150	else
	151	fputs_filtered ("\", ", stream);
	152	in_quotes = 0;
	153	}
	154	m2_printchar (string[i], stream);
	155	fprintf_filtered (stream, " <repeats %u times>", reps);
	156	i = rep1 - 1;
	157	things_printed += repeat_count_threshold;
	158	need_comma = 1;
	159	}
	160	else
	161	{
	162	if (!in_quotes)
	163	{
	164	if (inspect_it)
	165	fputs_filtered ("\\\"", stream);
	166	else
	167	fputs_filtered ("\"", stream);
	168	in_quotes = 1;
	169	}
	170	LA_EMIT_CHAR (string[i], stream, '"');
	171	++things_printed;
	172	}
	173	}
	174
	175	/* Terminate the quotes if necessary. */
	176	if (in_quotes)
	177	{
	178	if (inspect_it)
	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;
	196	switch (op)
	197	{
	198	case UNOP_HIGH:
	199	(*pos)++;
	200	arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
	201
	202	if (noside == EVAL_SKIP \|\| noside == EVAL_AVOID_SIDE_EFFECTS)
	203	return arg1;
	204	else
	205	{
	206	arg1 = coerce_ref (arg1);
	207	type = check_typedef (value_type (arg1));
	208
	209	if (m2_is_unbounded_array (type))
	210	{
	211	struct value *temp = arg1;
	212	type = TYPE_FIELD_TYPE (type, 1);
	213	/* i18n: Do not translate the "_m2_high" part! */
	214	arg1 = value_struct_elt (&temp, NULL, "_m2_high", NULL,
	215	_("unbounded structure "
	216	"missing _m2_high field"));
	217
	218	if (value_type (arg1) != type)
	219	arg1 = value_cast (type, arg1);
	220	}
	221	}
	222	return arg1;
	223
	224	case BINOP_SUBSCRIPT:
	225	(*pos)++;
	226	arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
	227	arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
	228	if (noside == EVAL_SKIP)
	229	goto nosideret;
	230	/* If the user attempts to subscript something that is not an
	231	array or pointer type (like a plain int variable for example),
	232	then report this as an error. */
	233
	234	arg1 = coerce_ref (arg1);
	235	type = check_typedef (value_type (arg1));
	236
	237	if (m2_is_unbounded_array (type))
	238	{
	239	struct value *temp = arg1;
	240	type = TYPE_FIELD_TYPE (type, 0);
	241	if (type == NULL \|\| (TYPE_CODE (type) != TYPE_CODE_PTR)) {
	242	warning (_("internal error: unbounded array structure is unknown"));
	243	return evaluate_subexp_standard (expect_type, exp, pos, noside);
	244	}
	245	/* i18n: Do not translate the "_m2_contents" part! */
	246	arg1 = value_struct_elt (&temp, NULL, "_m2_contents", NULL,
	247	_("unbounded structure "
	248	"missing _m2_contents field"));
	249
	250	if (value_type (arg1) != type)
	251	arg1 = value_cast (type, arg1);
252
253	type = check_typedef (value_type (arg1));
254	return value_ind (value_add (arg1, arg2));
255	}
256	else
257	if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
258	{
259	if (TYPE_NAME (type))
260	error (_("cannot subscript something of type `%s'"),
261	TYPE_NAME (type));
262	else
263	error (_("cannot subscript requested type"));
264	}
265
266	if (noside == EVAL_AVOID_SIDE_EFFECTS)
267	return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
268	else
269	return value_subscript (arg1, arg2);
270
271	default:
272	return evaluate_subexp_standard (expect_type, exp, pos, noside);
273	}
274
275	nosideret:
276	return value_from_longest (builtin_type_long, (LONGEST) 1);
277	}
c906108c	278	\f
c5aa993b	279
c906108c SS	280	/* Table of operators and their precedences for printing expressions. */
c906108c SS	281
c5aa993b JM	282	static const struct op_print m2_op_print_tab[] =
	283	{
	284	{"+", BINOP_ADD, PREC_ADD, 0},
	285	{"+", UNOP_PLUS, PREC_PREFIX, 0},
	286	{"-", BINOP_SUB, PREC_ADD, 0},
	287	{"-", UNOP_NEG, PREC_PREFIX, 0},
	288	{"*", BINOP_MUL, PREC_MUL, 0},
	289	{"/", BINOP_DIV, PREC_MUL, 0},
	290	{"DIV", BINOP_INTDIV, PREC_MUL, 0},
	291	{"MOD", BINOP_REM, PREC_MUL, 0},
	292	{":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
	293	{"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
	294	{"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
	295	{"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
	296	{"=", BINOP_EQUAL, PREC_EQUAL, 0},
	297	{"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
	298	{"<=", BINOP_LEQ, PREC_ORDER, 0},
	299	{">=", BINOP_GEQ, PREC_ORDER, 0},
	300	{">", BINOP_GTR, PREC_ORDER, 0},
	301	{"<", BINOP_LESS, PREC_ORDER, 0},
	302	{"^", UNOP_IND, PREC_PREFIX, 0},
	303	{"@", BINOP_REPEAT, PREC_REPEAT, 0},
	304	{"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0},
	305	{"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0},
	306	{"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0},
	307	{"FLOAT", UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0},
	308	{"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0},
	309	{"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0},
	310	{"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0},
	311	{"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0},
	312	{"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0},
	313	{NULL, 0, 0, 0}
c906108c SS	314	};
	315	\f
	316	/* The built-in types of Modula-2. */
	317
cad351d1 UW	318	enum m2_primitive_types {
	319	m2_primitive_type_char,
	320	m2_primitive_type_int,
	321	m2_primitive_type_card,
	322	m2_primitive_type_real,
	323	m2_primitive_type_bool,
	324	nr_m2_primitive_types
c906108c SS	325	};
c906108c SS	326
cad351d1 UW	327	static void
	328	m2_language_arch_info (struct gdbarch *gdbarch,
	329	struct language_arch_info *lai)
	330	{
5760b90a UW	331	const struct builtin_m2_type *builtin = builtin_m2_type (gdbarch);
	332
	333	lai->string_char_type = builtin->builtin_char;
cad351d1 UW	334	lai->primitive_type_vector
	335	= GDBARCH_OBSTACK_CALLOC (gdbarch, nr_m2_primitive_types + 1,
	336	struct type *);
	337
	338	lai->primitive_type_vector [m2_primitive_type_char]
5760b90a	339	= builtin->builtin_char;
cad351d1	340	lai->primitive_type_vector [m2_primitive_type_int]
5760b90a	341	= builtin->builtin_int;
cad351d1	342	lai->primitive_type_vector [m2_primitive_type_card]
5760b90a	343	= builtin->builtin_card;
cad351d1	344	lai->primitive_type_vector [m2_primitive_type_real]
5760b90a	345	= builtin->builtin_real;
cad351d1	346	lai->primitive_type_vector [m2_primitive_type_bool]
5760b90a	347	= builtin->builtin_bool;
cad351d1 UW	348	}
cad351d1 UW	349
844781a1 GM	350	const struct exp_descriptor exp_descriptor_modula2 =
	351	{
	352	print_subexp_standard,
	353	operator_length_standard,
	354	op_name_standard,
	355	dump_subexp_body_standard,
	356	evaluate_subexp_modula2
	357	};
	358
c5aa993b JM	359	const struct language_defn m2_language_defn =
c5aa993b JM	360	{
c906108c SS	361	"modula-2",
c906108c SS	362	language_m2,
c906108c SS	363	range_check_on,
c906108c SS	364	type_check_on,
63872f9d	365	case_sensitive_on,
7ca2d3a3	366	array_row_major,
844781a1	367	&exp_descriptor_modula2,
c906108c SS	368	m2_parse, /* parser */
c906108c SS	369	m2_error, /* parser error function */
e85c3284	370	null_post_parser,
c906108c SS	371	m2_printchar, /* Print character constant */
	372	m2_printstr, /* function to print string constant */
	373	m2_emit_char, /* Function to print a single character */
c906108c SS	374	m2_print_type, /* Print a type using appropriate syntax */
	375	m2_val_print, /* Print a value using appropriate syntax */
	376	c_value_print, /* Print a top-level value */
f636b87d	377	NULL, /* Language specific skip_trampoline */
5f9a71c3 DC	378	value_of_this, /* value_of_this */
5f9a71c3 DC	379	basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
b368761e	380	basic_lookup_transparent_type,/* lookup_transparent_type */
9a3d7dfd	381	NULL, /* Language specific symbol demangler */
31c27f77	382	NULL, /* Language specific class_name_from_physname */
c906108c SS	383	m2_op_print_tab, /* expression operators for printing */
	384	0, /* arrays are first-class (not c-style) */
	385	0, /* String lower bound */
6084f43a	386	default_word_break_characters,
41d27058	387	default_make_symbol_completion_list,
cad351d1	388	m2_language_arch_info,
e79af960	389	default_print_array_index,
41f1b697	390	default_pass_by_reference,
c906108c SS	391	LANG_MAGIC
	392	};
	393
5760b90a UW	394	static void *
5760b90a UW	395	build_m2_types (struct gdbarch *gdbarch)
c906108c	396	{
5760b90a UW	397	struct builtin_m2_type *builtin_m2_type
	398	= GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_m2_type);
	399
c906108c	400	/* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
5760b90a	401	builtin_m2_type->builtin_int =
40a6adc1 MD	402	init_type (TYPE_CODE_INT,
40a6adc1 MD	403	gdbarch_int_bit (gdbarch) / TARGET_CHAR_BIT,
9a76efb6	404	0, "INTEGER", (struct objfile *) NULL);
5760b90a	405	builtin_m2_type->builtin_card =
9a76efb6	406	init_type (TYPE_CODE_INT,
40a6adc1	407	gdbarch_int_bit (gdbarch) / TARGET_CHAR_BIT,
c906108c SS	408	TYPE_FLAG_UNSIGNED,
c906108c SS	409	"CARDINAL", (struct objfile *) NULL);
5760b90a	410	builtin_m2_type->builtin_real =
ea06eb3d	411	init_type (TYPE_CODE_FLT,
40a6adc1	412	gdbarch_float_bit (gdbarch) / TARGET_CHAR_BIT,
c906108c SS	413	0,
c906108c SS	414	"REAL", (struct objfile *) NULL);
5760b90a	415	builtin_m2_type->builtin_char =
c906108c SS	416	init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	417	TYPE_FLAG_UNSIGNED,
	418	"CHAR", (struct objfile *) NULL);
5760b90a	419	builtin_m2_type->builtin_bool =
9a76efb6	420	init_type (TYPE_CODE_BOOL,
40a6adc1	421	gdbarch_int_bit (gdbarch) / TARGET_CHAR_BIT,
c906108c SS	422	TYPE_FLAG_UNSIGNED,
	423	"BOOLEAN", (struct objfile *) NULL);
	424
5760b90a UW	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 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
c906108c SS	444	add_language (&m2_language_defn);
c906108c SS	445	}