[binutils.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., 675 Mass Ave, Cambridge, MA 02139, USA.  */

#include "defs.h"
#include "symtab.h"
#include "gdbtypes.h"
#include "expression.h"
#include "parser-defs.h"
#include "language.h"
#include "m2-lang.h"

/* 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_FLT,
			  TARGET_COMPLEX_BIT / TARGET_CHAR_BIT,
			  0, "complex", objfile);
	break;
      case FT_DBL_PREC_COMPLEX:
	type = init_type (TYPE_CODE_FLT,
			  TARGET_DOUBLE_COMPLEX_BIT / TARGET_CHAR_BIT,
			  0, "double complex", objfile);
	break;
      case FT_EXT_PREC_COMPLEX:
	type = init_type (TYPE_CODE_FLT,
			  TARGET_DOUBLE_COMPLEX_BIT / TARGET_CHAR_BIT,
			  0, "long double complex", objfile);
	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},
    {NULL,  0, 0, 0}
};
\f
/* The built-in types of Modula-2.  */

struct type *builtin_type_m2_char;
struct type *builtin_type_m2_int;
struct type *builtin_type_m2_card;
struct type *builtin_type_m2_real;
struct type *builtin_type_m2_bool;

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

const struct language_defn m2_language_defn = {
  "modula-2",
  language_m2,
  m2_builtin_types,
  range_check_on,
  type_check_on,
  m2_parse,			/* parser */
  m2_error,			/* parser error function */
  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 */
  &builtin_type_m2_int,		/* longest signed   integral type */
  &builtin_type_m2_card,	/* longest unsigned integral type */
  &builtin_type_m2_real,	/* longest floating point type */
  {"",      "",   "",   ""},	/* 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 */
  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);

  TYPE_NFIELDS(builtin_type_m2_bool) = 2;
  TYPE_FIELDS(builtin_type_m2_bool) = 
     (struct field *) xmalloc (sizeof (struct field) * 2);
  TYPE_FIELD_BITPOS(builtin_type_m2_bool,0) = 0;
  TYPE_FIELD_NAME(builtin_type_m2_bool,0) = (char *)xmalloc(6);
  strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,0),"FALSE");
  TYPE_FIELD_BITPOS(builtin_type_m2_bool,1) = 1;
  TYPE_FIELD_NAME(builtin_type_m2_bool,1) = (char *)xmalloc(5);
  strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,1),"TRUE");

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