[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 2 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, write to the Free Software
   Foundation, Inc., 51 Franklin Street, Fifth Floor,
   Boston, MA 02110-1301, USA.  */

#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.  */

struct type *builtin_type_m2_char;
struct type *builtin_type_m2_int;
struct type *builtin_type_m2_card;
struct type *builtin_type_m2_real;
struct type *builtin_type_m2_bool;

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)
{
  lai->string_char_type = builtin_type_m2_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_type_m2_char;
  lai->primitive_type_vector [m2_primitive_type_int]
    = builtin_type_m2_int;
  lai->primitive_type_vector [m2_primitive_type_card]
    = builtin_type_m2_card;
  lai->primitive_type_vector [m2_primitive_type_real]
    = builtin_type_m2_real;
  lai->primitive_type_vector [m2_primitive_type_bool]
    = builtin_type_m2_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
};

/* Initialization for Modula-2 */

void
_initialize_m2_language (void)
{
  /* Modula-2 "pervasive" types.  NOTE:  these can be redefined!!! */
  builtin_type_m2_int =
    init_type (TYPE_CODE_INT, 
	       gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
	       0, "INTEGER", (struct objfile *) NULL);
  builtin_type_m2_card =
    init_type (TYPE_CODE_INT, 
	       gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
	       TYPE_FLAG_UNSIGNED,
	       "CARDINAL", (struct objfile *) NULL);
  builtin_type_m2_real =
    init_type (TYPE_CODE_FLT,
	       gdbarch_float_bit (current_gdbarch) / TARGET_CHAR_BIT,
	       0,
	       "REAL", (struct objfile *) NULL);
  builtin_type_m2_char =
    init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	       TYPE_FLAG_UNSIGNED,
	       "CHAR", (struct objfile *) NULL);
  builtin_type_m2_bool =
    init_type (TYPE_CODE_BOOL, 
	       gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
	       TYPE_FLAG_UNSIGNED,
	       "BOOLEAN", (struct objfile *) NULL);

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