[deliverable/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,
			gdbarch_int_bit (current_gdbarch) / 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,
			gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
			0, "short", objfile);
      break;
    case FT_SIGNED_SHORT:
      type = init_type (TYPE_CODE_INT,
			gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
			0, "short", objfile);	/* FIXME-fnf */
      break;
    case FT_UNSIGNED_SHORT:
      type = init_type (TYPE_CODE_INT,
			gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
			TYPE_FLAG_UNSIGNED, "unsigned short", objfile);
      break;
    case FT_INTEGER:
      type = init_type (TYPE_CODE_INT,
			gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
			0, "int", objfile);
      break;
    case FT_SIGNED_INTEGER:
      type = init_type (TYPE_CODE_INT,
			gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
			0, "int", objfile);	/* FIXME -fnf */
      break;
    case FT_UNSIGNED_INTEGER:
      type = init_type (TYPE_CODE_INT,
			gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
			TYPE_FLAG_UNSIGNED, "unsigned int", objfile);
      break;
    case FT_FIXED_DECIMAL:
      type = init_type (TYPE_CODE_INT,
			gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
			0, "fixed decimal", objfile);
      break;
    case FT_LONG:
      type = init_type (TYPE_CODE_INT,
			gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
			0, "long", objfile);
      break;
    case FT_SIGNED_LONG:
      type = init_type (TYPE_CODE_INT,
			gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
			0, "long", objfile);	/* FIXME -fnf */
      break;
    case FT_UNSIGNED_LONG:
      type = init_type (TYPE_CODE_INT,
			gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
			TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
      break;
    case FT_LONG_LONG:
      type = init_type (TYPE_CODE_INT,
			gdbarch_long_long_bit (current_gdbarch)
			  / TARGET_CHAR_BIT,
			0, "long long", objfile);
      break;
    case FT_SIGNED_LONG_LONG:
      type = init_type (TYPE_CODE_INT,
			gdbarch_long_long_bit (current_gdbarch)
			  / TARGET_CHAR_BIT,
			0, "signed long long", objfile);
      break;
    case FT_UNSIGNED_LONG_LONG:
      type = init_type (TYPE_CODE_INT,
			gdbarch_long_long_bit (current_gdbarch)
			  / 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, 
	       gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
	       0, "INTEGER", (struct objfile *) NULL);
  builtin_type_m2_card =
    init_type (TYPE_CODE_INT, 
	       gdbarch_int_bit (current_gdbarch) / 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, 
	       gdbarch_int_bit (current_gdbarch) / 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,
9a76efb6	209	gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b	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,
9a76efb6	245	gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	246	0, "short", objfile);
	247	break;
	248	case FT_SIGNED_SHORT:
	249	type = init_type (TYPE_CODE_INT,
9a76efb6	250	gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	251	0, "short", objfile); /* FIXME-fnf */
	252	break;
	253	case FT_UNSIGNED_SHORT:
	254	type = init_type (TYPE_CODE_INT,
9a76efb6	255	gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	256	TYPE_FLAG_UNSIGNED, "unsigned short", objfile);
	257	break;
	258	case FT_INTEGER:
	259	type = init_type (TYPE_CODE_INT,
9a76efb6	260	gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	261	0, "int", objfile);
	262	break;
	263	case FT_SIGNED_INTEGER:
	264	type = init_type (TYPE_CODE_INT,
9a76efb6	265	gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	266	0, "int", objfile); /* FIXME -fnf */
	267	break;
	268	case FT_UNSIGNED_INTEGER:
	269	type = init_type (TYPE_CODE_INT,
9a76efb6	270	gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	271	TYPE_FLAG_UNSIGNED, "unsigned int", objfile);
	272	break;
	273	case FT_FIXED_DECIMAL:
	274	type = init_type (TYPE_CODE_INT,
9a76efb6	275	gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	276	0, "fixed decimal", objfile);
	277	break;
	278	case FT_LONG:
	279	type = init_type (TYPE_CODE_INT,
9a76efb6	280	gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	281	0, "long", objfile);
	282	break;
	283	case FT_SIGNED_LONG:
	284	type = init_type (TYPE_CODE_INT,
9a76efb6	285	gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	286	0, "long", objfile); /* FIXME -fnf */
	287	break;
	288	case FT_UNSIGNED_LONG:
	289	type = init_type (TYPE_CODE_INT,
9a76efb6	290	gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
c5aa993b JM	291	TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
	292	break;
	293	case FT_LONG_LONG:
	294	type = init_type (TYPE_CODE_INT,
9a76efb6 UW	295	gdbarch_long_long_bit (current_gdbarch)
9a76efb6 UW	296	/ TARGET_CHAR_BIT,
c5aa993b JM	297	0, "long long", objfile);
	298	break;
	299	case FT_SIGNED_LONG_LONG:
	300	type = init_type (TYPE_CODE_INT,
9a76efb6 UW	301	gdbarch_long_long_bit (current_gdbarch)
9a76efb6 UW	302	/ TARGET_CHAR_BIT,
c5aa993b JM	303	0, "signed long long", objfile);
	304	break;
	305	case FT_UNSIGNED_LONG_LONG:
	306	type = init_type (TYPE_CODE_INT,
9a76efb6 UW	307	gdbarch_long_long_bit (current_gdbarch)
9a76efb6 UW	308	/ TARGET_CHAR_BIT,
c5aa993b JM	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_COMPLEX,
	333	2 * TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
	334	0, "complex", objfile);
	335	TYPE_TARGET_TYPE (type)
	336	= m2_create_fundamental_type (objfile, FT_FLOAT);
	337	break;
	338	case FT_DBL_PREC_COMPLEX:
	339	type = init_type (TYPE_CODE_COMPLEX,
	340	2 * TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
	341	0, "double complex", objfile);
	342	TYPE_TARGET_TYPE (type)
	343	= m2_create_fundamental_type (objfile, FT_DBL_PREC_FLOAT);
	344	break;
	345	case FT_EXT_PREC_COMPLEX:
	346	type = init_type (TYPE_CODE_COMPLEX,
	347	2 * TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
	348	0, "long double complex", objfile);
	349	TYPE_TARGET_TYPE (type)
	350	= m2_create_fundamental_type (objfile, FT_EXT_PREC_FLOAT);
	351	break;
	352	}
c906108c SS	353	return (type);
c906108c SS	354	}
c906108c	355	\f
c5aa993b	356
c906108c SS	357	/* Table of operators and their precedences for printing expressions. */
c906108c SS	358
c5aa993b JM	359	static const struct op_print m2_op_print_tab[] =
	360	{
	361	{"+", BINOP_ADD, PREC_ADD, 0},
	362	{"+", UNOP_PLUS, PREC_PREFIX, 0},
	363	{"-", BINOP_SUB, PREC_ADD, 0},
	364	{"-", UNOP_NEG, PREC_PREFIX, 0},
	365	{"*", BINOP_MUL, PREC_MUL, 0},
	366	{"/", BINOP_DIV, PREC_MUL, 0},
	367	{"DIV", BINOP_INTDIV, PREC_MUL, 0},
	368	{"MOD", BINOP_REM, PREC_MUL, 0},
	369	{":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
	370	{"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
	371	{"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
	372	{"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
	373	{"=", BINOP_EQUAL, PREC_EQUAL, 0},
	374	{"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
	375	{"<=", BINOP_LEQ, PREC_ORDER, 0},
	376	{">=", BINOP_GEQ, PREC_ORDER, 0},
	377	{">", BINOP_GTR, PREC_ORDER, 0},
	378	{"<", BINOP_LESS, PREC_ORDER, 0},
	379	{"^", UNOP_IND, PREC_PREFIX, 0},
	380	{"@", BINOP_REPEAT, PREC_REPEAT, 0},
	381	{"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0},
	382	{"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0},
	383	{"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0},
	384	{"FLOAT", UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0},
	385	{"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0},
	386	{"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0},
	387	{"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0},
	388	{"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0},
	389	{"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0},
	390	{NULL, 0, 0, 0}
c906108c SS	391	};
	392	\f
	393	/* The built-in types of Modula-2. */
	394
	395	struct type *builtin_type_m2_char;
	396	struct type *builtin_type_m2_int;
	397	struct type *builtin_type_m2_card;
	398	struct type *builtin_type_m2_real;
	399	struct type *builtin_type_m2_bool;
	400
6c6ea35e	401	struct type **const (m2_builtin_types[]) =
c906108c SS	402	{
c906108c SS	403	&builtin_type_m2_char,
c5aa993b JM	404	&builtin_type_m2_int,
	405	&builtin_type_m2_card,
	406	&builtin_type_m2_real,
	407	&builtin_type_m2_bool,
	408	0
c906108c SS	409	};
c906108c SS	410
c5aa993b JM	411	const struct language_defn m2_language_defn =
c5aa993b JM	412	{
c906108c SS	413	"modula-2",
	414	language_m2,
	415	m2_builtin_types,
	416	range_check_on,
	417	type_check_on,
63872f9d	418	case_sensitive_on,
7ca2d3a3	419	array_row_major,
5f9769d1	420	&exp_descriptor_standard,
c906108c SS	421	m2_parse, /* parser */
c906108c SS	422	m2_error, /* parser error function */
e85c3284	423	null_post_parser,
c906108c SS	424	m2_printchar, /* Print character constant */
	425	m2_printstr, /* function to print string constant */
	426	m2_emit_char, /* Function to print a single character */
	427	m2_create_fundamental_type, /* Create fundamental type in this language */
	428	m2_print_type, /* Print a type using appropriate syntax */
	429	m2_val_print, /* Print a value using appropriate syntax */
	430	c_value_print, /* Print a top-level value */
f636b87d	431	NULL, /* Language specific skip_trampoline */
5f9a71c3 DC	432	value_of_this, /* value_of_this */
5f9a71c3 DC	433	basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
b368761e	434	basic_lookup_transparent_type,/* lookup_transparent_type */
9a3d7dfd	435	NULL, /* Language specific symbol demangler */
31c27f77	436	NULL, /* Language specific class_name_from_physname */
c906108c SS	437	m2_op_print_tab, /* expression operators for printing */
	438	0, /* arrays are first-class (not c-style) */
	439	0, /* String lower bound */
c5aa993b	440	&builtin_type_m2_char, /* Type of string elements */
6084f43a	441	default_word_break_characters,
f290d38e	442	NULL, /* FIXME: la_language_arch_info. */
e79af960	443	default_print_array_index,
c906108c SS	444	LANG_MAGIC
	445	};
	446
	447	/* Initialization for Modula-2 */
	448
	449	void
fba45db2	450	_initialize_m2_language (void)
c906108c SS	451	{
	452	/* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
	453	builtin_type_m2_int =
9a76efb6 UW	454	init_type (TYPE_CODE_INT,
	455	gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
	456	0, "INTEGER", (struct objfile *) NULL);
c906108c	457	builtin_type_m2_card =
9a76efb6 UW	458	init_type (TYPE_CODE_INT,
9a76efb6 UW	459	gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
c906108c SS	460	TYPE_FLAG_UNSIGNED,
	461	"CARDINAL", (struct objfile *) NULL);
	462	builtin_type_m2_real =
	463	init_type (TYPE_CODE_FLT, TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
	464	0,
	465	"REAL", (struct objfile *) NULL);
	466	builtin_type_m2_char =
	467	init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	468	TYPE_FLAG_UNSIGNED,
	469	"CHAR", (struct objfile *) NULL);
	470	builtin_type_m2_bool =
9a76efb6 UW	471	init_type (TYPE_CODE_BOOL,
9a76efb6 UW	472	gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
c906108c SS	473	TYPE_FLAG_UNSIGNED,
	474	"BOOLEAN", (struct objfile *) NULL);
	475
	476	add_language (&m2_language_defn);
	477	}