[deliverable/binutils-gdb.git] / gdb / m2-lang.c

/* Modula 2 language support routines for GDB, the GNU debugger.
   Copyright 1992, 1993, 1994, 1995, 1996, 1998, 2000, 2002
   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., 59 Temple Place - Suite 330,
   Boston, MA 02111-1307, 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_printstr (struct ui_file * stream, char *string,
			 unsigned int length, int width,
			 int force_ellipses);
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 (register 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, char *string, unsigned int length,
	     int width, int force_ellipses)
{
  register unsigned int i;
  unsigned int things_printed = 0;
  int in_quotes = 0;
  int need_comma = 0;
  extern int inspect_it;

  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)
{
  register 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,
			TARGET_INT_BIT / 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,
			TARGET_SHORT_BIT / TARGET_CHAR_BIT,
			0, "short", objfile);
      break;
    case FT_SIGNED_SHORT:
      type = init_type (TYPE_CODE_INT,
			TARGET_SHORT_BIT / TARGET_CHAR_BIT,
			0, "short", objfile);	/* FIXME-fnf */
      break;
    case FT_UNSIGNED_SHORT:
      type = init_type (TYPE_CODE_INT,
			TARGET_SHORT_BIT / TARGET_CHAR_BIT,
			TYPE_FLAG_UNSIGNED, "unsigned short", objfile);
      break;
    case FT_INTEGER:
      type = init_type (TYPE_CODE_INT,
			TARGET_INT_BIT / TARGET_CHAR_BIT,
			0, "int", objfile);
      break;
    case FT_SIGNED_INTEGER:
      type = init_type (TYPE_CODE_INT,
			TARGET_INT_BIT / TARGET_CHAR_BIT,
			0, "int", objfile);	/* FIXME -fnf */
      break;
    case FT_UNSIGNED_INTEGER:
      type = init_type (TYPE_CODE_INT,
			TARGET_INT_BIT / TARGET_CHAR_BIT,
			TYPE_FLAG_UNSIGNED, "unsigned int", objfile);
      break;
    case FT_FIXED_DECIMAL:
      type = init_type (TYPE_CODE_INT,
			TARGET_INT_BIT / TARGET_CHAR_BIT,
			0, "fixed decimal", objfile);
      break;
    case FT_LONG:
      type = init_type (TYPE_CODE_INT,
			TARGET_LONG_BIT / TARGET_CHAR_BIT,
			0, "long", objfile);
      break;
    case FT_SIGNED_LONG:
      type = init_type (TYPE_CODE_INT,
			TARGET_LONG_BIT / TARGET_CHAR_BIT,
			0, "long", objfile);	/* FIXME -fnf */
      break;
    case FT_UNSIGNED_LONG:
      type = init_type (TYPE_CODE_INT,
			TARGET_LONG_BIT / TARGET_CHAR_BIT,
			TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
      break;
    case FT_LONG_LONG:
      type = init_type (TYPE_CODE_INT,
			TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
			0, "long long", objfile);
      break;
    case FT_SIGNED_LONG_LONG:
      type = init_type (TYPE_CODE_INT,
			TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
			0, "signed long long", objfile);
      break;
    case FT_UNSIGNED_LONG_LONG:
      type = init_type (TYPE_CODE_INT,
			TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
			TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
      break;
    case FT_FLOAT:
      type = init_type (TYPE_CODE_FLT,
			TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
			0, "float", objfile);
      break;
    case FT_DBL_PREC_FLOAT:
      type = init_type (TYPE_CODE_FLT,
			TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
			0, "double", objfile);
      break;
    case FT_FLOAT_DECIMAL:
      type = init_type (TYPE_CODE_FLT,
			TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
			0, "floating decimal", objfile);
      break;
    case FT_EXT_PREC_FLOAT:
      type = init_type (TYPE_CODE_FLT,
			TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
			0, "long double", objfile);
      break;
    case FT_COMPLEX:
      type = init_type (TYPE_CODE_COMPLEX,
			2 * TARGET_FLOAT_BIT / 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 * TARGET_DOUBLE_BIT / 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 * TARGET_LONG_DOUBLE_BIT / 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;

struct type **const (m2_builtin_types[]) =
{
  &builtin_type_m2_char,
    &builtin_type_m2_int,
    &builtin_type_m2_card,
    &builtin_type_m2_real,
    &builtin_type_m2_bool,
    0
};

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