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

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