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

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