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

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