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

/* Modula 2 language support routines for GDB, the GNU debugger.

   Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 2000, 2002, 2003, 2004,
   2005, 2007 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., 51 Franklin Street, Fifth Floor,
   Boston, MA 02110-1301, 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_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 (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 (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 (struct ui_file *stream, const gdb_byte *string,
	     unsigned int length, int width, int force_ellipses)
{
  unsigned int i;
  unsigned int things_printed = 0;
  int in_quotes = 0;
  int need_comma = 0;

  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 (struct objfile *objfile, int typeid)
{
  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 (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,
  case_sensitive_on,
  array_row_major,
  &exp_descriptor_standard,
  m2_parse,			/* parser */
  m2_error,			/* parser error function */
  null_post_parser,
  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 */
  NULL,				/* Language specific skip_trampoline */
  value_of_this,		/* value_of_this */
  basic_lookup_symbol_nonlocal,	/* lookup_symbol_nonlocal */
  basic_lookup_transparent_type,/* lookup_transparent_type */
  NULL,				/* Language specific symbol demangler */
  NULL,				/* Language specific class_name_from_physname */
  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 */
  default_word_break_characters,
  NULL, /* FIXME: la_language_arch_info.  */
  default_print_array_index,
  LANG_MAGIC
};

/* Initialization for Modula-2 */

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