[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 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 struct type *m2_create_fundamental_type (struct objfile *, int);
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);
}

/* FIXME:  This is a copy of c_create_fundamental_type(), before
   all the non-C types were stripped from it.  Needs to be fixed
   by an experienced Modula programmer.  */

static struct type *
m2_create_fundamental_type (struct objfile *objfile, int typeid)
{
  struct type *type = NULL;

  switch (typeid)
    {
    default:
      /* FIXME:  For now, if we are asked to produce a type not in this
         language, create the equivalent of a C integer type with the
         name "<?type?>".  When all the dust settles from the type
         reconstruction work, this should probably become an error.  */
      type = init_type (TYPE_CODE_INT,
			gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
			0, "<?type?>", objfile);
      warning (_("internal error: no Modula fundamental type %d"), typeid);
      break;
    case FT_VOID:
      type = init_type (TYPE_CODE_VOID,
			TARGET_CHAR_BIT / TARGET_CHAR_BIT,
			0, "void", objfile);
      break;
    case FT_BOOLEAN:
      type = init_type (TYPE_CODE_BOOL,
			TARGET_CHAR_BIT / TARGET_CHAR_BIT,
			TYPE_FLAG_UNSIGNED, "boolean", objfile);
      break;
    case FT_STRING:
      type = init_type (TYPE_CODE_STRING,
			TARGET_CHAR_BIT / TARGET_CHAR_BIT,
			0, "string", objfile);
      break;
    case FT_CHAR:
      type = init_type (TYPE_CODE_INT,
			TARGET_CHAR_BIT / TARGET_CHAR_BIT,
			0, "char", objfile);
      break;
    case FT_SIGNED_CHAR:
      type = init_type (TYPE_CODE_INT,
			TARGET_CHAR_BIT / TARGET_CHAR_BIT,
			0, "signed char", objfile);
      break;
    case FT_UNSIGNED_CHAR:
      type = init_type (TYPE_CODE_INT,
			TARGET_CHAR_BIT / TARGET_CHAR_BIT,
			TYPE_FLAG_UNSIGNED, "unsigned char", objfile);
      break;
    case FT_SHORT:
      type = init_type (TYPE_CODE_INT,
			gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
			0, "short", objfile);
      break;
    case FT_SIGNED_SHORT:
      type = init_type (TYPE_CODE_INT,
			gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
			0, "short", objfile);	/* FIXME-fnf */
      break;
    case FT_UNSIGNED_SHORT:
      type = init_type (TYPE_CODE_INT,
			gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
			TYPE_FLAG_UNSIGNED, "unsigned short", objfile);
      break;
    case FT_INTEGER:
      type = init_type (TYPE_CODE_INT,
			gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
			0, "int", objfile);
      break;
    case FT_SIGNED_INTEGER:
      type = init_type (TYPE_CODE_INT,
			gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
			0, "int", objfile);	/* FIXME -fnf */
      break;
    case FT_UNSIGNED_INTEGER:
      type = init_type (TYPE_CODE_INT,
			gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
			TYPE_FLAG_UNSIGNED, "unsigned int", objfile);
      break;
    case FT_FIXED_DECIMAL:
      type = init_type (TYPE_CODE_INT,
			gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
			0, "fixed decimal", objfile);
      break;
    case FT_LONG:
      type = init_type (TYPE_CODE_INT,
			gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
			0, "long", objfile);
      break;
    case FT_SIGNED_LONG:
      type = init_type (TYPE_CODE_INT,
			gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
			0, "long", objfile);	/* FIXME -fnf */
      break;
    case FT_UNSIGNED_LONG:
      type = init_type (TYPE_CODE_INT,
			gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
			TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
      break;
    case FT_LONG_LONG:
      type = init_type (TYPE_CODE_INT,
			gdbarch_long_long_bit (current_gdbarch)
			  / TARGET_CHAR_BIT,
			0, "long long", objfile);
      break;
    case FT_SIGNED_LONG_LONG:
      type = init_type (TYPE_CODE_INT,
			gdbarch_long_long_bit (current_gdbarch)
			  / TARGET_CHAR_BIT,
			0, "signed long long", objfile);
      break;
    case FT_UNSIGNED_LONG_LONG:
      type = init_type (TYPE_CODE_INT,
			gdbarch_long_long_bit (current_gdbarch)
			  / TARGET_CHAR_BIT,
			TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
      break;
    case FT_FLOAT:
      type = init_type (TYPE_CODE_FLT,
			gdbarch_float_bit (current_gdbarch) / TARGET_CHAR_BIT,
			0, "float", objfile);
      break;
    case FT_DBL_PREC_FLOAT:
      type = init_type (TYPE_CODE_FLT,
			gdbarch_double_bit (current_gdbarch) / TARGET_CHAR_BIT,
			0, "double", objfile);
      break;
    case FT_FLOAT_DECIMAL:
      type = init_type (TYPE_CODE_FLT,
			gdbarch_double_bit (current_gdbarch) / TARGET_CHAR_BIT,
			0, "floating decimal", objfile);
      break;
    case FT_EXT_PREC_FLOAT:
      type = init_type (TYPE_CODE_FLT,
			gdbarch_long_double_bit (current_gdbarch)
			  / TARGET_CHAR_BIT,
			0, "long double", objfile);
      break;
    case FT_COMPLEX:
      type = init_type (TYPE_CODE_COMPLEX,
			2 * gdbarch_float_bit (current_gdbarch)
			  / TARGET_CHAR_BIT,
			0, "complex", objfile);
      TYPE_TARGET_TYPE (type)
	= m2_create_fundamental_type (objfile, FT_FLOAT);
      break;
    case FT_DBL_PREC_COMPLEX:
      type = init_type (TYPE_CODE_COMPLEX,
			2 * gdbarch_double_bit (current_gdbarch)
			  / TARGET_CHAR_BIT,
			0, "double complex", objfile);
      TYPE_TARGET_TYPE (type)
	= m2_create_fundamental_type (objfile, FT_DBL_PREC_FLOAT);
      break;
    case FT_EXT_PREC_COMPLEX:
      type = init_type (TYPE_CODE_COMPLEX,
			2 * gdbarch_long_double_bit (current_gdbarch)
			  / TARGET_CHAR_BIT,
			0, "long double complex", objfile);
      TYPE_TARGET_TYPE (type)
	= m2_create_fundamental_type (objfile, FT_EXT_PREC_FLOAT);
      break;
    }
  return (type);
}
\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_create_fundamental_type,	/* Create fundamental type in this language */
  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,
  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 (current_gdbarch) / TARGET_CHAR_BIT,
	       0, "INTEGER", (struct objfile *) NULL);
  builtin_m2_type->builtin_card =
    init_type (TYPE_CODE_INT, 
	       gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
	       TYPE_FLAG_UNSIGNED,
	       "CARDINAL", (struct objfile *) NULL);
  builtin_m2_type->builtin_real =
    init_type (TYPE_CODE_FLT,
	       gdbarch_float_bit (current_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 (current_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 DJ	3	Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 2000, 2002, 2003, 2004,
6aba47ca DJ	4	2005, 2007 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 KB	31	extern void _initialize_m2_language (void);
a14ed312 KB	32	static struct type m2_create_fundamental_type (struct objfile , int);
d9fcf2fb JM	33	static void m2_printchar (int, struct ui_file *);
d9fcf2fb JM	34	static void m2_emit_char (int, struct ui_file *, int);
c906108c SS	35
	36	/* Print the character C on STREAM as part of the contents of a literal
	37	string whose delimiter is QUOTER. Note that that format for printing
	38	characters and strings is language specific.
	39	FIXME: This is a copy of the same function from c-exp.y. It should
844781a1	40	be replaced with a true Modula version. */
c906108c SS	41
c906108c SS	42	static void
f86f5ca3	43	m2_emit_char (int c, struct ui_file *stream, int quoter)
c906108c SS	44	{
	45
	46	c &= 0xFF; /* Avoid sign bit follies */
	47
	48	if (PRINT_LITERAL_FORM (c))
	49	{
	50	if (c == '\\' \|\| c == quoter)
	51	{
	52	fputs_filtered ("\\", stream);
	53	}
	54	fprintf_filtered (stream, "%c", c);
	55	}
	56	else
	57	{
	58	switch (c)
	59	{
	60	case '\n':
	61	fputs_filtered ("\\n", stream);
	62	break;
	63	case '\b':
	64	fputs_filtered ("\\b", stream);
	65	break;
	66	case '\t':
	67	fputs_filtered ("\\t", stream);
	68	break;
	69	case '\f':
	70	fputs_filtered ("\\f", stream);
	71	break;
	72	case '\r':
	73	fputs_filtered ("\\r", stream);
	74	break;
	75	case '\033':
	76	fputs_filtered ("\\e", stream);
	77	break;
	78	case '\007':
	79	fputs_filtered ("\\a", stream);
	80	break;
	81	default:
	82	fprintf_filtered (stream, "\\%.3o", (unsigned int) c);
	83	break;
	84	}
	85	}
	86	}
	87
	88	/* FIXME: This is a copy of the same function from c-exp.y. It should
844781a1	89	be replaced with a true Modula version. */
c906108c SS	90
c906108c SS	91	static void
fba45db2	92	m2_printchar (int c, struct ui_file *stream)
c906108c SS	93	{
	94	fputs_filtered ("'", stream);
	95	LA_EMIT_CHAR (c, stream, '\'');
	96	fputs_filtered ("'", stream);
	97	}
	98
	99	/* Print the character string STRING, printing at most LENGTH characters.
	100	Printing stops early if the number hits print_max; repeat counts
	101	are printed as appropriate. Print ellipses at the end if we
	102	had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
	103	FIXME: This is a copy of the same function from c-exp.y. It should
844781a1	104	be replaced with a true Modula version. */
c906108c SS	105
c906108c SS	106	static void
fc1a4b47	107	m2_printstr (struct ui_file stream, const gdb_byte string,
ce27fb25	108	unsigned int length, int width, int force_ellipses)
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
	121	for (i = 0; i < length && things_printed < print_max; ++i)
	122	{
	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
	145	if (reps > repeat_count_threshold)
	146	{
	147	if (in_quotes)
	148	{
	149	if (inspect_it)
	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;
	158	things_printed += repeat_count_threshold;
	159	need_comma = 1;
	160	}
	161	else
	162	{
	163	if (!in_quotes)
	164	{
	165	if (inspect_it)
	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	{
	179	if (inspect_it)
	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));
255	return value_ind (value_add (arg1, arg2));
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:
277	return value_from_longest (builtin_type_long, (LONGEST) 1);
278	}
279
c906108c SS	280	/* FIXME: This is a copy of c_create_fundamental_type(), before
c906108c SS	281	all the non-C types were stripped from it. Needs to be fixed
844781a1	282	by an experienced Modula programmer. */
c906108c SS	283
c906108c SS	284	static struct type *
fba45db2	285	m2_create_fundamental_type (struct objfile *objfile, int typeid)
c906108c	286	{
f86f5ca3	287	struct type *type = NULL;
c906108c SS	288
	289	switch (typeid)
	290	{
c5aa993b JM	291	default:
	292	/* FIXME: For now, if we are asked to produce a type not in this
	293	language, create the equivalent of a C integer type with the
	294	name "<?type?>". When all the dust settles from the type
844781a1	295	reconstruction work, this should probably become an error. */
c5aa993b	296	type = init_type (TYPE_CODE_INT,
9a76efb6	297	gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b	298	0, "<?type?>", objfile);
8a3fe4f8	299	warning (_("internal error: no Modula fundamental type %d"), typeid);
c5aa993b JM	300	break;
	301	case FT_VOID:
	302	type = init_type (TYPE_CODE_VOID,
	303	TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	304	0, "void", objfile);
	305	break;
	306	case FT_BOOLEAN:
	307	type = init_type (TYPE_CODE_BOOL,
	308	TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	309	TYPE_FLAG_UNSIGNED, "boolean", objfile);
	310	break;
	311	case FT_STRING:
	312	type = init_type (TYPE_CODE_STRING,
	313	TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	314	0, "string", objfile);
	315	break;
	316	case FT_CHAR:
	317	type = init_type (TYPE_CODE_INT,
	318	TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	319	0, "char", objfile);
	320	break;
	321	case FT_SIGNED_CHAR:
	322	type = init_type (TYPE_CODE_INT,
	323	TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	324	0, "signed char", objfile);
	325	break;
	326	case FT_UNSIGNED_CHAR:
	327	type = init_type (TYPE_CODE_INT,
	328	TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	329	TYPE_FLAG_UNSIGNED, "unsigned char", objfile);
	330	break;
	331	case FT_SHORT:
	332	type = init_type (TYPE_CODE_INT,
9a76efb6	333	gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	334	0, "short", objfile);
	335	break;
	336	case FT_SIGNED_SHORT:
	337	type = init_type (TYPE_CODE_INT,
9a76efb6	338	gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	339	0, "short", objfile); /* FIXME-fnf */
	340	break;
	341	case FT_UNSIGNED_SHORT:
	342	type = init_type (TYPE_CODE_INT,
9a76efb6	343	gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	344	TYPE_FLAG_UNSIGNED, "unsigned short", objfile);
	345	break;
	346	case FT_INTEGER:
	347	type = init_type (TYPE_CODE_INT,
9a76efb6	348	gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	349	0, "int", objfile);
	350	break;
	351	case FT_SIGNED_INTEGER:
	352	type = init_type (TYPE_CODE_INT,
9a76efb6	353	gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	354	0, "int", objfile); /* FIXME -fnf */
	355	break;
	356	case FT_UNSIGNED_INTEGER:
	357	type = init_type (TYPE_CODE_INT,
9a76efb6	358	gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	359	TYPE_FLAG_UNSIGNED, "unsigned int", objfile);
	360	break;
	361	case FT_FIXED_DECIMAL:
	362	type = init_type (TYPE_CODE_INT,
9a76efb6	363	gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	364	0, "fixed decimal", objfile);
	365	break;
	366	case FT_LONG:
	367	type = init_type (TYPE_CODE_INT,
9a76efb6	368	gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	369	0, "long", objfile);
	370	break;
	371	case FT_SIGNED_LONG:
	372	type = init_type (TYPE_CODE_INT,
9a76efb6	373	gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	374	0, "long", objfile); /* FIXME -fnf */
	375	break;
	376	case FT_UNSIGNED_LONG:
	377	type = init_type (TYPE_CODE_INT,
9a76efb6	378	gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	379	TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
	380	break;
	381	case FT_LONG_LONG:
	382	type = init_type (TYPE_CODE_INT,
9a76efb6 UW	383	gdbarch_long_long_bit (current_gdbarch)
9a76efb6 UW	384	/ TARGET_CHAR_BIT,
c5aa993b JM	385	0, "long long", objfile);
	386	break;
	387	case FT_SIGNED_LONG_LONG:
	388	type = init_type (TYPE_CODE_INT,
9a76efb6 UW	389	gdbarch_long_long_bit (current_gdbarch)
9a76efb6 UW	390	/ TARGET_CHAR_BIT,
c5aa993b JM	391	0, "signed long long", objfile);
	392	break;
	393	case FT_UNSIGNED_LONG_LONG:
	394	type = init_type (TYPE_CODE_INT,
9a76efb6 UW	395	gdbarch_long_long_bit (current_gdbarch)
9a76efb6 UW	396	/ TARGET_CHAR_BIT,
c5aa993b JM	397	TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
	398	break;
	399	case FT_FLOAT:
	400	type = init_type (TYPE_CODE_FLT,
ea06eb3d	401	gdbarch_float_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	402	0, "float", objfile);
	403	break;
	404	case FT_DBL_PREC_FLOAT:
	405	type = init_type (TYPE_CODE_FLT,
ea06eb3d	406	gdbarch_double_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	407	0, "double", objfile);
	408	break;
	409	case FT_FLOAT_DECIMAL:
	410	type = init_type (TYPE_CODE_FLT,
ea06eb3d	411	gdbarch_double_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	412	0, "floating decimal", objfile);
	413	break;
	414	case FT_EXT_PREC_FLOAT:
	415	type = init_type (TYPE_CODE_FLT,
ea06eb3d UW	416	gdbarch_long_double_bit (current_gdbarch)
ea06eb3d UW	417	/ TARGET_CHAR_BIT,
c5aa993b JM	418	0, "long double", objfile);
	419	break;
	420	case FT_COMPLEX:
	421	type = init_type (TYPE_CODE_COMPLEX,
ea06eb3d UW	422	2 * gdbarch_float_bit (current_gdbarch)
ea06eb3d UW	423	/ TARGET_CHAR_BIT,
c5aa993b JM	424	0, "complex", objfile);
	425	TYPE_TARGET_TYPE (type)
	426	= m2_create_fundamental_type (objfile, FT_FLOAT);
	427	break;
	428	case FT_DBL_PREC_COMPLEX:
	429	type = init_type (TYPE_CODE_COMPLEX,
ea06eb3d UW	430	2 * gdbarch_double_bit (current_gdbarch)
ea06eb3d UW	431	/ TARGET_CHAR_BIT,
c5aa993b JM	432	0, "double complex", objfile);
	433	TYPE_TARGET_TYPE (type)
	434	= m2_create_fundamental_type (objfile, FT_DBL_PREC_FLOAT);
	435	break;
	436	case FT_EXT_PREC_COMPLEX:
	437	type = init_type (TYPE_CODE_COMPLEX,
ea06eb3d UW	438	2 * gdbarch_long_double_bit (current_gdbarch)
ea06eb3d UW	439	/ TARGET_CHAR_BIT,
c5aa993b JM	440	0, "long double complex", objfile);
	441	TYPE_TARGET_TYPE (type)
	442	= m2_create_fundamental_type (objfile, FT_EXT_PREC_FLOAT);
	443	break;
	444	}
c906108c SS	445	return (type);
c906108c SS	446	}
c906108c	447	\f
c5aa993b	448
c906108c SS	449	/* Table of operators and their precedences for printing expressions. */
c906108c SS	450
c5aa993b JM	451	static const struct op_print m2_op_print_tab[] =
	452	{
	453	{"+", BINOP_ADD, PREC_ADD, 0},
	454	{"+", UNOP_PLUS, PREC_PREFIX, 0},
	455	{"-", BINOP_SUB, PREC_ADD, 0},
	456	{"-", UNOP_NEG, PREC_PREFIX, 0},
	457	{"*", BINOP_MUL, PREC_MUL, 0},
	458	{"/", BINOP_DIV, PREC_MUL, 0},
	459	{"DIV", BINOP_INTDIV, PREC_MUL, 0},
	460	{"MOD", BINOP_REM, PREC_MUL, 0},
	461	{":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
	462	{"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
	463	{"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
	464	{"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
	465	{"=", BINOP_EQUAL, PREC_EQUAL, 0},
	466	{"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
	467	{"<=", BINOP_LEQ, PREC_ORDER, 0},
	468	{">=", BINOP_GEQ, PREC_ORDER, 0},
	469	{">", BINOP_GTR, PREC_ORDER, 0},
	470	{"<", BINOP_LESS, PREC_ORDER, 0},
	471	{"^", UNOP_IND, PREC_PREFIX, 0},
	472	{"@", BINOP_REPEAT, PREC_REPEAT, 0},
	473	{"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0},
	474	{"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0},
	475	{"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0},
	476	{"FLOAT", UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0},
	477	{"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0},
	478	{"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0},
	479	{"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0},
	480	{"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0},
	481	{"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0},
	482	{NULL, 0, 0, 0}
c906108c SS	483	};
	484	\f
	485	/* The built-in types of Modula-2. */
	486
cad351d1 UW	487	enum m2_primitive_types {
	488	m2_primitive_type_char,
	489	m2_primitive_type_int,
	490	m2_primitive_type_card,
	491	m2_primitive_type_real,
	492	m2_primitive_type_bool,
	493	nr_m2_primitive_types
c906108c SS	494	};
c906108c SS	495
cad351d1 UW	496	static void
	497	m2_language_arch_info (struct gdbarch *gdbarch,
	498	struct language_arch_info *lai)
	499	{
5760b90a UW	500	const struct builtin_m2_type *builtin = builtin_m2_type (gdbarch);
	501
	502	lai->string_char_type = builtin->builtin_char;
cad351d1 UW	503	lai->primitive_type_vector
	504	= GDBARCH_OBSTACK_CALLOC (gdbarch, nr_m2_primitive_types + 1,
	505	struct type *);
	506
	507	lai->primitive_type_vector [m2_primitive_type_char]
5760b90a	508	= builtin->builtin_char;
cad351d1	509	lai->primitive_type_vector [m2_primitive_type_int]
5760b90a	510	= builtin->builtin_int;
cad351d1	511	lai->primitive_type_vector [m2_primitive_type_card]
5760b90a	512	= builtin->builtin_card;
cad351d1	513	lai->primitive_type_vector [m2_primitive_type_real]
5760b90a	514	= builtin->builtin_real;
cad351d1	515	lai->primitive_type_vector [m2_primitive_type_bool]
5760b90a	516	= builtin->builtin_bool;
cad351d1 UW	517	}
cad351d1 UW	518
844781a1 GM	519	const struct exp_descriptor exp_descriptor_modula2 =
	520	{
	521	print_subexp_standard,
	522	operator_length_standard,
	523	op_name_standard,
	524	dump_subexp_body_standard,
	525	evaluate_subexp_modula2
	526	};
	527
c5aa993b JM	528	const struct language_defn m2_language_defn =
c5aa993b JM	529	{
c906108c SS	530	"modula-2",
c906108c SS	531	language_m2,
c906108c SS	532	range_check_on,
c906108c SS	533	type_check_on,
63872f9d	534	case_sensitive_on,
7ca2d3a3	535	array_row_major,
844781a1	536	&exp_descriptor_modula2,
c906108c SS	537	m2_parse, /* parser */
c906108c SS	538	m2_error, /* parser error function */
e85c3284	539	null_post_parser,
c906108c SS	540	m2_printchar, /* Print character constant */
	541	m2_printstr, /* function to print string constant */
	542	m2_emit_char, /* Function to print a single character */
	543	m2_create_fundamental_type, /* Create fundamental type in this language */
	544	m2_print_type, /* Print a type using appropriate syntax */
	545	m2_val_print, /* Print a value using appropriate syntax */
	546	c_value_print, /* Print a top-level value */
f636b87d	547	NULL, /* Language specific skip_trampoline */
5f9a71c3 DC	548	value_of_this, /* value_of_this */
5f9a71c3 DC	549	basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
b368761e	550	basic_lookup_transparent_type,/* lookup_transparent_type */
9a3d7dfd	551	NULL, /* Language specific symbol demangler */
31c27f77	552	NULL, /* Language specific class_name_from_physname */
c906108c SS	553	m2_op_print_tab, /* expression operators for printing */
	554	0, /* arrays are first-class (not c-style) */
	555	0, /* String lower bound */
6084f43a	556	default_word_break_characters,
cad351d1	557	m2_language_arch_info,
e79af960	558	default_print_array_index,
41f1b697	559	default_pass_by_reference,
c906108c SS	560	LANG_MAGIC
	561	};
	562
5760b90a UW	563	static void *
5760b90a UW	564	build_m2_types (struct gdbarch *gdbarch)
c906108c	565	{
5760b90a UW	566	struct builtin_m2_type *builtin_m2_type
	567	= GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_m2_type);
	568
c906108c	569	/* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
5760b90a	570	builtin_m2_type->builtin_int =
9a76efb6 UW	571	init_type (TYPE_CODE_INT,
	572	gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
	573	0, "INTEGER", (struct objfile *) NULL);
5760b90a	574	builtin_m2_type->builtin_card =
9a76efb6 UW	575	init_type (TYPE_CODE_INT,
9a76efb6 UW	576	gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
c906108c SS	577	TYPE_FLAG_UNSIGNED,
c906108c SS	578	"CARDINAL", (struct objfile *) NULL);
5760b90a	579	builtin_m2_type->builtin_real =
ea06eb3d UW	580	init_type (TYPE_CODE_FLT,
ea06eb3d UW	581	gdbarch_float_bit (current_gdbarch) / TARGET_CHAR_BIT,
c906108c SS	582	0,
c906108c SS	583	"REAL", (struct objfile *) NULL);
5760b90a	584	builtin_m2_type->builtin_char =
c906108c SS	585	init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	586	TYPE_FLAG_UNSIGNED,
	587	"CHAR", (struct objfile *) NULL);
5760b90a	588	builtin_m2_type->builtin_bool =
9a76efb6 UW	589	init_type (TYPE_CODE_BOOL,
9a76efb6 UW	590	gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
c906108c SS	591	TYPE_FLAG_UNSIGNED,
	592	"BOOLEAN", (struct objfile *) NULL);
	593
5760b90a UW	594	return builtin_m2_type;
	595	}
	596
	597	static struct gdbarch_data *m2_type_data;
	598
	599	const struct builtin_m2_type *
	600	builtin_m2_type (struct gdbarch *gdbarch)
	601	{
	602	return gdbarch_data (gdbarch, m2_type_data);
	603	}
	604
	605
	606	/* Initialization for Modula-2 */
	607
	608	void
	609	_initialize_m2_language (void)
	610	{
	611	m2_type_data = gdbarch_data_register_post_init (build_m2_types);
	612
c906108c SS	613	add_language (&m2_language_defn);
c906108c SS	614	}