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

/* Modula 2 language support routines for GDB, the GNU debugger.
   Copyright 1992 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"

extern void _initialize_m2_language PARAMS ((void));
static struct type *m2_create_fundamental_type PARAMS ((struct objfile *, int));
static void m2_printstr PARAMS ((GDB_FILE *stream, char *string, unsigned int length, int width, int force_ellipses));
static void m2_printchar PARAMS ((int, GDB_FILE *));
static void m2_emit_char PARAMS ((int, GDB_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 (c, stream, quoter)
     register int c;
     GDB_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 (c, stream)
     int c;
     GDB_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 (stream, string, length, width, force_ellipses)
     GDB_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;
  extern int repeat_count_threshold;
  extern int print_max;

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