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

/* 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 language_defn m2_language_defn =
{
  "modula-2",
  language_m2,
  NULL,
  range_check_on,
  type_check_on,
  case_sensitive_on,
  array_row_major,
  &exp_descriptor_standard,
  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 */
  NULL,
  default_word_break_characters,
  m2_language_arch_info,
  default_print_array_index,
  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
	40	be replaced with a true Modula version.
	41	*/
	42
	43	static void
f86f5ca3	44	m2_emit_char (int c, struct ui_file *stream, int quoter)
c906108c SS	45	{
	46
	47	c &= 0xFF; /* Avoid sign bit follies */
	48
	49	if (PRINT_LITERAL_FORM (c))
	50	{
	51	if (c == '\\' \|\| c == quoter)
	52	{
	53	fputs_filtered ("\\", stream);
	54	}
	55	fprintf_filtered (stream, "%c", c);
	56	}
	57	else
	58	{
	59	switch (c)
	60	{
	61	case '\n':
	62	fputs_filtered ("\\n", stream);
	63	break;
	64	case '\b':
	65	fputs_filtered ("\\b", stream);
	66	break;
	67	case '\t':
	68	fputs_filtered ("\\t", stream);
	69	break;
	70	case '\f':
	71	fputs_filtered ("\\f", stream);
	72	break;
	73	case '\r':
	74	fputs_filtered ("\\r", stream);
	75	break;
	76	case '\033':
	77	fputs_filtered ("\\e", stream);
	78	break;
	79	case '\007':
	80	fputs_filtered ("\\a", stream);
	81	break;
	82	default:
	83	fprintf_filtered (stream, "\\%.3o", (unsigned int) c);
	84	break;
	85	}
	86	}
	87	}
	88
	89	/* FIXME: This is a copy of the same function from c-exp.y. It should
	90	be replaced with a true Modula version. */
	91
	92	static void
fba45db2	93	m2_printchar (int c, struct ui_file *stream)
c906108c SS	94	{
	95	fputs_filtered ("'", stream);
	96	LA_EMIT_CHAR (c, stream, '\'');
	97	fputs_filtered ("'", stream);
	98	}
	99
	100	/* Print the character string STRING, printing at most LENGTH characters.
	101	Printing stops early if the number hits print_max; repeat counts
	102	are printed as appropriate. Print ellipses at the end if we
	103	had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
	104	FIXME: This is a copy of the same function from c-exp.y. It should
	105	be replaced with a true Modula version. */
	106
	107	static void
fc1a4b47	108	m2_printstr (struct ui_file stream, const gdb_byte string,
ce27fb25	109	unsigned int length, int width, int force_ellipses)
c906108c	110	{
f86f5ca3	111	unsigned int i;
c906108c SS	112	unsigned int things_printed = 0;
	113	int in_quotes = 0;
	114	int need_comma = 0;
c906108c SS	115
	116	if (length == 0)
	117	{
	118	fputs_filtered ("\"\"", gdb_stdout);
	119	return;
	120	}
	121
	122	for (i = 0; i < length && things_printed < print_max; ++i)
	123	{
	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
	146	if (reps > repeat_count_threshold)
	147	{
	148	if (in_quotes)
	149	{
	150	if (inspect_it)
	151	fputs_filtered ("\\\", ", stream);
	152	else
	153	fputs_filtered ("\", ", stream);
	154	in_quotes = 0;
	155	}
	156	m2_printchar (string[i], stream);
	157	fprintf_filtered (stream, " <repeats %u times>", reps);
	158	i = rep1 - 1;
	159	things_printed += repeat_count_threshold;
	160	need_comma = 1;
	161	}
	162	else
	163	{
	164	if (!in_quotes)
	165	{
	166	if (inspect_it)
	167	fputs_filtered ("\\\"", stream);
	168	else
	169	fputs_filtered ("\"", stream);
	170	in_quotes = 1;
	171	}
	172	LA_EMIT_CHAR (string[i], stream, '"');
	173	++things_printed;
	174	}
	175	}
	176
	177	/* Terminate the quotes if necessary. */
	178	if (in_quotes)
	179	{
	180	if (inspect_it)
	181	fputs_filtered ("\\\"", stream);
	182	else
	183	fputs_filtered ("\"", stream);
	184	}
	185
	186	if (force_ellipses \|\| i < length)
	187	fputs_filtered ("...", stream);
	188	}
	189
190	/* FIXME: This is a copy of c_create_fundamental_type(), before
191	all the non-C types were stripped from it. Needs to be fixed
192	by an experienced Modula programmer. */
193
194	static struct type *
fba45db2	195	m2_create_fundamental_type (struct objfile *objfile, int typeid)
c906108c	196	{
f86f5ca3	197	struct type *type = NULL;
c906108c SS	198
	199	switch (typeid)
	200	{
c5aa993b JM	201	default:
	202	/* FIXME: For now, if we are asked to produce a type not in this
	203	language, create the equivalent of a C integer type with the
	204	name "<?type?>". When all the dust settles from the type
	205	reconstruction work, this should probably become an error. */
	206	type = init_type (TYPE_CODE_INT,
9a76efb6	207	gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b	208	0, "<?type?>", objfile);
8a3fe4f8	209	warning (_("internal error: no Modula fundamental type %d"), typeid);
c5aa993b JM	210	break;
	211	case FT_VOID:
	212	type = init_type (TYPE_CODE_VOID,
	213	TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	214	0, "void", objfile);
	215	break;
	216	case FT_BOOLEAN:
	217	type = init_type (TYPE_CODE_BOOL,
	218	TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	219	TYPE_FLAG_UNSIGNED, "boolean", objfile);
	220	break;
	221	case FT_STRING:
	222	type = init_type (TYPE_CODE_STRING,
	223	TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	224	0, "string", objfile);
	225	break;
	226	case FT_CHAR:
	227	type = init_type (TYPE_CODE_INT,
	228	TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	229	0, "char", objfile);
	230	break;
	231	case FT_SIGNED_CHAR:
	232	type = init_type (TYPE_CODE_INT,
	233	TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	234	0, "signed char", objfile);
	235	break;
	236	case FT_UNSIGNED_CHAR:
	237	type = init_type (TYPE_CODE_INT,
	238	TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	239	TYPE_FLAG_UNSIGNED, "unsigned char", objfile);
	240	break;
	241	case FT_SHORT:
	242	type = init_type (TYPE_CODE_INT,
9a76efb6	243	gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	244	0, "short", objfile);
	245	break;
	246	case FT_SIGNED_SHORT:
	247	type = init_type (TYPE_CODE_INT,
9a76efb6	248	gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	249	0, "short", objfile); /* FIXME-fnf */
	250	break;
	251	case FT_UNSIGNED_SHORT:
	252	type = init_type (TYPE_CODE_INT,
9a76efb6	253	gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	254	TYPE_FLAG_UNSIGNED, "unsigned short", objfile);
	255	break;
	256	case FT_INTEGER:
	257	type = init_type (TYPE_CODE_INT,
9a76efb6	258	gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	259	0, "int", objfile);
	260	break;
	261	case FT_SIGNED_INTEGER:
	262	type = init_type (TYPE_CODE_INT,
9a76efb6	263	gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	264	0, "int", objfile); /* FIXME -fnf */
	265	break;
	266	case FT_UNSIGNED_INTEGER:
	267	type = init_type (TYPE_CODE_INT,
9a76efb6	268	gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	269	TYPE_FLAG_UNSIGNED, "unsigned int", objfile);
	270	break;
	271	case FT_FIXED_DECIMAL:
	272	type = init_type (TYPE_CODE_INT,
9a76efb6	273	gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	274	0, "fixed decimal", objfile);
	275	break;
	276	case FT_LONG:
	277	type = init_type (TYPE_CODE_INT,
9a76efb6	278	gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	279	0, "long", objfile);
	280	break;
	281	case FT_SIGNED_LONG:
	282	type = init_type (TYPE_CODE_INT,
9a76efb6	283	gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	284	0, "long", objfile); /* FIXME -fnf */
	285	break;
	286	case FT_UNSIGNED_LONG:
	287	type = init_type (TYPE_CODE_INT,
9a76efb6	288	gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	289	TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
	290	break;
	291	case FT_LONG_LONG:
	292	type = init_type (TYPE_CODE_INT,
9a76efb6 UW	293	gdbarch_long_long_bit (current_gdbarch)
9a76efb6 UW	294	/ TARGET_CHAR_BIT,
c5aa993b JM	295	0, "long long", objfile);
	296	break;
	297	case FT_SIGNED_LONG_LONG:
	298	type = init_type (TYPE_CODE_INT,
9a76efb6 UW	299	gdbarch_long_long_bit (current_gdbarch)
9a76efb6 UW	300	/ TARGET_CHAR_BIT,
c5aa993b JM	301	0, "signed long long", objfile);
	302	break;
	303	case FT_UNSIGNED_LONG_LONG:
	304	type = init_type (TYPE_CODE_INT,
9a76efb6 UW	305	gdbarch_long_long_bit (current_gdbarch)
9a76efb6 UW	306	/ TARGET_CHAR_BIT,
c5aa993b JM	307	TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
	308	break;
	309	case FT_FLOAT:
	310	type = init_type (TYPE_CODE_FLT,
ea06eb3d	311	gdbarch_float_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	312	0, "float", objfile);
	313	break;
	314	case FT_DBL_PREC_FLOAT:
	315	type = init_type (TYPE_CODE_FLT,
ea06eb3d	316	gdbarch_double_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	317	0, "double", objfile);
	318	break;
	319	case FT_FLOAT_DECIMAL:
	320	type = init_type (TYPE_CODE_FLT,
ea06eb3d	321	gdbarch_double_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	322	0, "floating decimal", objfile);
	323	break;
	324	case FT_EXT_PREC_FLOAT:
	325	type = init_type (TYPE_CODE_FLT,
ea06eb3d UW	326	gdbarch_long_double_bit (current_gdbarch)
ea06eb3d UW	327	/ TARGET_CHAR_BIT,
c5aa993b JM	328	0, "long double", objfile);
	329	break;
	330	case FT_COMPLEX:
	331	type = init_type (TYPE_CODE_COMPLEX,
ea06eb3d UW	332	2 * gdbarch_float_bit (current_gdbarch)
ea06eb3d UW	333	/ TARGET_CHAR_BIT,
c5aa993b JM	334	0, "complex", objfile);
	335	TYPE_TARGET_TYPE (type)
	336	= m2_create_fundamental_type (objfile, FT_FLOAT);
	337	break;
	338	case FT_DBL_PREC_COMPLEX:
	339	type = init_type (TYPE_CODE_COMPLEX,
ea06eb3d UW	340	2 * gdbarch_double_bit (current_gdbarch)
ea06eb3d UW	341	/ TARGET_CHAR_BIT,
c5aa993b JM	342	0, "double complex", objfile);
	343	TYPE_TARGET_TYPE (type)
	344	= m2_create_fundamental_type (objfile, FT_DBL_PREC_FLOAT);
	345	break;
	346	case FT_EXT_PREC_COMPLEX:
	347	type = init_type (TYPE_CODE_COMPLEX,
ea06eb3d UW	348	2 * gdbarch_long_double_bit (current_gdbarch)
ea06eb3d UW	349	/ TARGET_CHAR_BIT,
c5aa993b JM	350	0, "long double complex", objfile);
	351	TYPE_TARGET_TYPE (type)
	352	= m2_create_fundamental_type (objfile, FT_EXT_PREC_FLOAT);
	353	break;
	354	}
c906108c SS	355	return (type);
c906108c SS	356	}
c906108c	357	\f
c5aa993b	358
c906108c SS	359	/* Table of operators and their precedences for printing expressions. */
c906108c SS	360
c5aa993b JM	361	static const struct op_print m2_op_print_tab[] =
	362	{
	363	{"+", BINOP_ADD, PREC_ADD, 0},
	364	{"+", UNOP_PLUS, PREC_PREFIX, 0},
	365	{"-", BINOP_SUB, PREC_ADD, 0},
	366	{"-", UNOP_NEG, PREC_PREFIX, 0},
	367	{"*", BINOP_MUL, PREC_MUL, 0},
	368	{"/", BINOP_DIV, PREC_MUL, 0},
	369	{"DIV", BINOP_INTDIV, PREC_MUL, 0},
	370	{"MOD", BINOP_REM, PREC_MUL, 0},
	371	{":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
	372	{"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
	373	{"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
	374	{"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
	375	{"=", BINOP_EQUAL, PREC_EQUAL, 0},
	376	{"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
	377	{"<=", BINOP_LEQ, PREC_ORDER, 0},
	378	{">=", BINOP_GEQ, PREC_ORDER, 0},
	379	{">", BINOP_GTR, PREC_ORDER, 0},
	380	{"<", BINOP_LESS, PREC_ORDER, 0},
	381	{"^", UNOP_IND, PREC_PREFIX, 0},
	382	{"@", BINOP_REPEAT, PREC_REPEAT, 0},
	383	{"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0},
	384	{"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0},
	385	{"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0},
	386	{"FLOAT", UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0},
	387	{"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0},
	388	{"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0},
	389	{"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0},
	390	{"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0},
	391	{"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0},
	392	{NULL, 0, 0, 0}
c906108c SS	393	};
	394	\f
	395	/* The built-in types of Modula-2. */
	396
cad351d1 UW	397	enum m2_primitive_types {
	398	m2_primitive_type_char,
	399	m2_primitive_type_int,
	400	m2_primitive_type_card,
	401	m2_primitive_type_real,
	402	m2_primitive_type_bool,
	403	nr_m2_primitive_types
c906108c SS	404	};
c906108c SS	405
cad351d1 UW	406	static void
	407	m2_language_arch_info (struct gdbarch *gdbarch,
	408	struct language_arch_info *lai)
	409	{
5760b90a UW	410	const struct builtin_m2_type *builtin = builtin_m2_type (gdbarch);
	411
	412	lai->string_char_type = builtin->builtin_char;
cad351d1 UW	413	lai->primitive_type_vector
	414	= GDBARCH_OBSTACK_CALLOC (gdbarch, nr_m2_primitive_types + 1,
	415	struct type *);
	416
	417	lai->primitive_type_vector [m2_primitive_type_char]
5760b90a	418	= builtin->builtin_char;
cad351d1	419	lai->primitive_type_vector [m2_primitive_type_int]
5760b90a	420	= builtin->builtin_int;
cad351d1	421	lai->primitive_type_vector [m2_primitive_type_card]
5760b90a	422	= builtin->builtin_card;
cad351d1	423	lai->primitive_type_vector [m2_primitive_type_real]
5760b90a	424	= builtin->builtin_real;
cad351d1	425	lai->primitive_type_vector [m2_primitive_type_bool]
5760b90a	426	= builtin->builtin_bool;
cad351d1 UW	427	}
cad351d1 UW	428
c5aa993b JM	429	const struct language_defn m2_language_defn =
c5aa993b JM	430	{
c906108c SS	431	"modula-2",
c906108c SS	432	language_m2,
cad351d1	433	NULL,
c906108c SS	434	range_check_on,
c906108c SS	435	type_check_on,
63872f9d	436	case_sensitive_on,
7ca2d3a3	437	array_row_major,
5f9769d1	438	&exp_descriptor_standard,
c906108c SS	439	m2_parse, /* parser */
c906108c SS	440	m2_error, /* parser error function */
e85c3284	441	null_post_parser,
c906108c SS	442	m2_printchar, /* Print character constant */
	443	m2_printstr, /* function to print string constant */
	444	m2_emit_char, /* Function to print a single character */
	445	m2_create_fundamental_type, /* Create fundamental type in this language */
	446	m2_print_type, /* Print a type using appropriate syntax */
	447	m2_val_print, /* Print a value using appropriate syntax */
	448	c_value_print, /* Print a top-level value */
f636b87d	449	NULL, /* Language specific skip_trampoline */
5f9a71c3 DC	450	value_of_this, /* value_of_this */
5f9a71c3 DC	451	basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
b368761e	452	basic_lookup_transparent_type,/* lookup_transparent_type */
9a3d7dfd	453	NULL, /* Language specific symbol demangler */
31c27f77	454	NULL, /* Language specific class_name_from_physname */
c906108c SS	455	m2_op_print_tab, /* expression operators for printing */
	456	0, /* arrays are first-class (not c-style) */
	457	0, /* String lower bound */
cad351d1	458	NULL,
6084f43a	459	default_word_break_characters,
cad351d1	460	m2_language_arch_info,
e79af960	461	default_print_array_index,
c906108c SS	462	LANG_MAGIC
	463	};
	464
5760b90a UW	465	static void *
5760b90a UW	466	build_m2_types (struct gdbarch *gdbarch)
c906108c	467	{
5760b90a UW	468	struct builtin_m2_type *builtin_m2_type
	469	= GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_m2_type);
	470
c906108c	471	/* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
5760b90a	472	builtin_m2_type->builtin_int =
9a76efb6 UW	473	init_type (TYPE_CODE_INT,
	474	gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
	475	0, "INTEGER", (struct objfile *) NULL);
5760b90a	476	builtin_m2_type->builtin_card =
9a76efb6 UW	477	init_type (TYPE_CODE_INT,
9a76efb6 UW	478	gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
c906108c SS	479	TYPE_FLAG_UNSIGNED,
c906108c SS	480	"CARDINAL", (struct objfile *) NULL);
5760b90a	481	builtin_m2_type->builtin_real =
ea06eb3d UW	482	init_type (TYPE_CODE_FLT,
ea06eb3d UW	483	gdbarch_float_bit (current_gdbarch) / TARGET_CHAR_BIT,
c906108c SS	484	0,
c906108c SS	485	"REAL", (struct objfile *) NULL);
5760b90a	486	builtin_m2_type->builtin_char =
c906108c SS	487	init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	488	TYPE_FLAG_UNSIGNED,
	489	"CHAR", (struct objfile *) NULL);
5760b90a	490	builtin_m2_type->builtin_bool =
9a76efb6 UW	491	init_type (TYPE_CODE_BOOL,
9a76efb6 UW	492	gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
c906108c SS	493	TYPE_FLAG_UNSIGNED,
	494	"BOOLEAN", (struct objfile *) NULL);
	495
5760b90a UW	496	return builtin_m2_type;
	497	}
	498
	499	static struct gdbarch_data *m2_type_data;
	500
	501	const struct builtin_m2_type *
	502	builtin_m2_type (struct gdbarch *gdbarch)
	503	{
	504	return gdbarch_data (gdbarch, m2_type_data);
	505	}
	506
	507
	508	/* Initialization for Modula-2 */
	509
	510	void
	511	_initialize_m2_language (void)
	512	{
	513	m2_type_data = gdbarch_data_register_post_init (build_m2_types);
	514
c906108c SS	515	add_language (&m2_language_defn);
c906108c SS	516	}