[thirdparty/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"

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