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

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

   Copyright (C) 1992-2020 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 3 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, see <http://www.gnu.org/licenses/>.  */

#include "defs.h"
#include "symtab.h"
#include "gdbtypes.h"
#include "expression.h"
#include "parser-defs.h"
#include "language.h"
#include "varobj.h"
#include "m2-lang.h"
#include "c-lang.h"
#include "valprint.h"
#include "gdbarch.h"

static void m2_printchar (int, struct type *, struct ui_file *);

/* 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 type *type, struct ui_file *stream)
{
  fputs_filtered ("'", stream);
  LA_EMIT_CHAR (c, type, stream, '\'');
  fputs_filtered ("'", stream);
}

/* Return true if TYPE is a string.  */

static bool
m2_is_string_type_p (struct type *type)
{
  type = check_typedef (type);
  if (type->code () == TYPE_CODE_ARRAY
      && TYPE_LENGTH (type) > 0
      && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0)
    {
      struct type *elttype = check_typedef (TYPE_TARGET_TYPE (type));

      if (TYPE_LENGTH (elttype) == 1
	  && (elttype->code () == TYPE_CODE_INT
	      || elttype->code () == TYPE_CODE_CHAR))
	return true;
    }

  return false;
}

static struct value *
evaluate_subexp_modula2 (struct type *expect_type, struct expression *exp,
			 int *pos, enum noside noside)
{
  enum exp_opcode op = exp->elts[*pos].opcode;
  struct value *arg1;
  struct value *arg2;
  struct type *type;

  switch (op)
    {
    case UNOP_HIGH:
      (*pos)++;
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);

      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
	return arg1;
      else
	{
	  arg1 = coerce_ref (arg1);
	  type = check_typedef (value_type (arg1));

	  if (m2_is_unbounded_array (type))
	    {
	      struct value *temp = arg1;

	      type = type->field (1).type ();
	      /* i18n: Do not translate the "_m2_high" part!  */
	      arg1 = value_struct_elt (&temp, NULL, "_m2_high", NULL,
				       _("unbounded structure "
					 "missing _m2_high field"));
	  
	      if (value_type (arg1) != type)
		arg1 = value_cast (type, arg1);
	    }
	}
      return arg1;

    case BINOP_SUBSCRIPT:
      (*pos)++;
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
      if (noside == EVAL_SKIP)
	goto nosideret;
      /* If the user attempts to subscript something that is not an
         array or pointer type (like a plain int variable for example),
         then report this as an error.  */

      arg1 = coerce_ref (arg1);
      type = check_typedef (value_type (arg1));

      if (m2_is_unbounded_array (type))
	{
	  struct value *temp = arg1;
	  type = type->field (0).type ();
	  if (type == NULL || (type->code () != TYPE_CODE_PTR))
	    {
	      warning (_("internal error: unbounded "
			 "array structure is unknown"));
	      return evaluate_subexp_standard (expect_type, exp, pos, noside);
	    }
	  /* i18n: Do not translate the "_m2_contents" part!  */
	  arg1 = value_struct_elt (&temp, NULL, "_m2_contents", NULL,
				   _("unbounded structure "
				     "missing _m2_contents field"));
	  
	  if (value_type (arg1) != type)
	    arg1 = value_cast (type, arg1);

	  check_typedef (value_type (arg1));
	  return value_ind (value_ptradd (arg1, value_as_long (arg2)));
	}
      else
	if (type->code () != TYPE_CODE_ARRAY)
	  {
	    if (type->name ())
	      error (_("cannot subscript something of type `%s'"),
		     type->name ());
	    else
	      error (_("cannot subscript requested type"));
	  }

      if (noside == EVAL_AVOID_SIDE_EFFECTS)
	return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
      else
	return value_subscript (arg1, value_as_long (arg2));

    default:
      return evaluate_subexp_standard (expect_type, exp, pos, noside);
    }

 nosideret:
  return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
}
\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, OP_NULL, PREC_BUILTIN_FUNCTION, 0}
};
\f
/* The built-in types of Modula-2.  */

enum m2_primitive_types {
  m2_primitive_type_char,
  m2_primitive_type_int,
  m2_primitive_type_card,
  m2_primitive_type_real,
  m2_primitive_type_bool,
  nr_m2_primitive_types
};

const struct exp_descriptor exp_descriptor_modula2 = 
{
  print_subexp_standard,
  operator_length_standard,
  operator_check_standard,
  op_name_standard,
  dump_subexp_body_standard,
  evaluate_subexp_modula2
};

/* Constant data describing the M2 language.  */

extern const struct language_data m2_language_data =
{
  "modula-2",
  "Modula-2",
  language_m2,
  range_check_on,
  case_sensitive_on,
  array_row_major,
  macro_expansion_no,
  NULL,
  &exp_descriptor_modula2,
  m2_print_typedef,		/* Print a typedef using appropriate syntax */
  NULL,		                /* name_of_this */
  false,			/* la_store_sym_names_in_linkage_form_p */
  m2_op_print_tab,		/* expression operators for printing */
  0,				/* arrays are first-class (not c-style) */
  0,				/* String lower bound */
  &default_varobj_ops,
  m2_is_string_type_p,
  "{...}"			/* la_struct_too_deep_ellipsis */
};

/* Class representing the M2 language.  */

class m2_language : public language_defn
{
public:
  m2_language ()
    : language_defn (language_m2, m2_language_data)
  { /* Nothing.  */ }

  /* See language.h.  */
  void language_arch_info (struct gdbarch *gdbarch,
			   struct language_arch_info *lai) const override
  {
    const struct builtin_m2_type *builtin = builtin_m2_type (gdbarch);

    lai->string_char_type = builtin->builtin_char;
    lai->primitive_type_vector
      = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_m2_primitive_types + 1,
				struct type *);

    lai->primitive_type_vector [m2_primitive_type_char]
      = builtin->builtin_char;
    lai->primitive_type_vector [m2_primitive_type_int]
      = builtin->builtin_int;
    lai->primitive_type_vector [m2_primitive_type_card]
      = builtin->builtin_card;
    lai->primitive_type_vector [m2_primitive_type_real]
      = builtin->builtin_real;
    lai->primitive_type_vector [m2_primitive_type_bool]
      = builtin->builtin_bool;

    lai->bool_type_symbol = "BOOLEAN";
    lai->bool_type_default = builtin->builtin_bool;
  }

  /* See language.h.  */

  void print_type (struct type *type, const char *varstring,
		   struct ui_file *stream, int show, int level,
		   const struct type_print_options *flags) const override
  {
    m2_print_type (type, varstring, stream, show, level, flags);
  }

  /* See language.h.  */

  void value_print_inner
	(struct value *val, struct ui_file *stream, int recurse,
	 const struct value_print_options *options) const override
  {
    return m2_value_print_inner (val, stream, recurse, options);
  }

  /* See language.h.  */

  int parser (struct parser_state *ps) const override
  {
    return m2_parse (ps);
  }

  /* See language.h.  */

  void emitchar (int ch, struct type *chtype,
		 struct ui_file *stream, int quoter) const override
  {
    ch &= 0xFF;			/* Avoid sign bit follies.  */

    if (PRINT_LITERAL_FORM (ch))
      {
	if (ch == '\\' || ch == quoter)
	  fputs_filtered ("\\", stream);
	fprintf_filtered (stream, "%c", ch);
      }
    else
      {
	switch (ch)
	  {
	  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) ch);
	    break;
	  }
      }
  }

  /* See language.h.  */

  void printchar (int ch, struct type *chtype,
		  struct ui_file *stream) const override
  {
    m2_printchar (ch, chtype, stream);
  }

  /* See language.h.  */

  void printstr (struct ui_file *stream, struct type *elttype,
		 const gdb_byte *string, unsigned int length,
		 const char *encoding, int force_ellipses,
		 const struct value_print_options *options) const override
  {
    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 < options->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 > options->repeat_count_threshold)
	  {
	    if (in_quotes)
	      {
		fputs_filtered ("\", ", stream);
		in_quotes = 0;
	      }
	    m2_printchar (string[i], elttype, stream);
	    fprintf_filtered (stream, " <repeats %u times>", reps);
	    i = rep1 - 1;
	    things_printed += options->repeat_count_threshold;
	    need_comma = 1;
	  }
	else
	  {
	    if (!in_quotes)
	      {
		fputs_filtered ("\"", stream);
		in_quotes = 1;
	      }
	    LA_EMIT_CHAR (string[i], elttype, stream, '"');
	    ++things_printed;
	  }
      }

    /* Terminate the quotes if necessary.  */
    if (in_quotes)
      fputs_filtered ("\"", stream);

    if (force_ellipses || i < length)
      fputs_filtered ("...", stream);
  }
};

/* Single instance of the M2 language.  */

static m2_language m2_language_defn;

static void *
build_m2_types (struct gdbarch *gdbarch)
{
  struct builtin_m2_type *builtin_m2_type
    = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_m2_type);

  /* Modula-2 "pervasive" types.  NOTE:  these can be redefined!!! */
  builtin_m2_type->builtin_int
    = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 0, "INTEGER");
  builtin_m2_type->builtin_card
    = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "CARDINAL");
  builtin_m2_type->builtin_real
    = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch), "REAL",
		       gdbarch_float_format (gdbarch));
  builtin_m2_type->builtin_char
    = arch_character_type (gdbarch, TARGET_CHAR_BIT, 1, "CHAR");
  builtin_m2_type->builtin_bool
    = arch_boolean_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "BOOLEAN");

  return builtin_m2_type;
}

static struct gdbarch_data *m2_type_data;

const struct builtin_m2_type *
builtin_m2_type (struct gdbarch *gdbarch)
{
  return (const struct builtin_m2_type *) gdbarch_data (gdbarch, m2_type_data);
}


/* Initialization for Modula-2 */

void _initialize_m2_language ();
void
_initialize_m2_language ()
{
  m2_type_data = gdbarch_data_register_post_init (build_m2_types);
}
Commit	Line	Data
	1	/* Modula 2 language support routines for GDB, the GNU debugger.
	2
	3	Copyright (C) 1992-2020 Free Software Foundation, Inc.
	4
	5	This file is part of GDB.
	6
	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 3 of the License, or
	10	(at your option) any later version.
	11
	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.
	16
	17	You should have received a copy of the GNU General Public License
	18	along with this program. If not, see <http://www.gnu.org/licenses/>. */
	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 "varobj.h"
	27	#include "m2-lang.h"
	28	#include "c-lang.h"
	29	#include "valprint.h"
	30	#include "gdbarch.h"
	31
	32	static void m2_printchar (int, struct type , struct ui_file );
	33
	34	/* FIXME: This is a copy of the same function from c-exp.y. It should
	35	be replaced with a true Modula version. */
	36
	37	static void
	38	m2_printchar (int c, struct type type, struct ui_file stream)
	39	{
	40	fputs_filtered ("'", stream);
	41	LA_EMIT_CHAR (c, type, stream, '\'');
	42	fputs_filtered ("'", stream);
	43	}
	44
	45	/* Return true if TYPE is a string. */
	46
	47	static bool
	48	m2_is_string_type_p (struct type *type)
	49	{
	50	type = check_typedef (type);
	51	if (type->code () == TYPE_CODE_ARRAY
	52	&& TYPE_LENGTH (type) > 0
	53	&& TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0)
	54	{
	55	struct type *elttype = check_typedef (TYPE_TARGET_TYPE (type));
	56
	57	if (TYPE_LENGTH (elttype) == 1
	58	&& (elttype->code () == TYPE_CODE_INT
	59	\|\| elttype->code () == TYPE_CODE_CHAR))
	60	return true;
	61	}
	62
	63	return false;
	64	}
	65
	66	static struct value *
	67	evaluate_subexp_modula2 (struct type expect_type, struct expression exp,
	68	int *pos, enum noside noside)
	69	{
	70	enum exp_opcode op = exp->elts[*pos].opcode;
	71	struct value *arg1;
	72	struct value *arg2;
	73	struct type *type;
	74
	75	switch (op)
	76	{
	77	case UNOP_HIGH:
	78	(*pos)++;
	79	arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
	80
	81	if (noside == EVAL_SKIP \|\| noside == EVAL_AVOID_SIDE_EFFECTS)
	82	return arg1;
	83	else
	84	{
	85	arg1 = coerce_ref (arg1);
	86	type = check_typedef (value_type (arg1));
	87
	88	if (m2_is_unbounded_array (type))
	89	{
	90	struct value *temp = arg1;
	91
	92	type = type->field (1).type ();
	93	/* i18n: Do not translate the "_m2_high" part! */
	94	arg1 = value_struct_elt (&temp, NULL, "_m2_high", NULL,
	95	_("unbounded structure "
	96	"missing _m2_high field"));
	97
	98	if (value_type (arg1) != type)
	99	arg1 = value_cast (type, arg1);
	100	}
	101	}
	102	return arg1;
	103
	104	case BINOP_SUBSCRIPT:
	105	(*pos)++;
	106	arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
	107	arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
	108	if (noside == EVAL_SKIP)
	109	goto nosideret;
	110	/* If the user attempts to subscript something that is not an
	111	array or pointer type (like a plain int variable for example),
	112	then report this as an error. */
	113
	114	arg1 = coerce_ref (arg1);
	115	type = check_typedef (value_type (arg1));
	116
	117	if (m2_is_unbounded_array (type))
	118	{
	119	struct value *temp = arg1;
	120	type = type->field (0).type ();
	121	if (type == NULL \|\| (type->code () != TYPE_CODE_PTR))
	122	{
	123	warning (_("internal error: unbounded "
	124	"array structure is unknown"));
	125	return evaluate_subexp_standard (expect_type, exp, pos, noside);
	126	}
	127	/* i18n: Do not translate the "_m2_contents" part! */
	128	arg1 = value_struct_elt (&temp, NULL, "_m2_contents", NULL,
	129	_("unbounded structure "
	130	"missing _m2_contents field"));
	131
	132	if (value_type (arg1) != type)
	133	arg1 = value_cast (type, arg1);
	134
	135	check_typedef (value_type (arg1));
	136	return value_ind (value_ptradd (arg1, value_as_long (arg2)));
	137	}
	138	else
	139	if (type->code () != TYPE_CODE_ARRAY)
	140	{
	141	if (type->name ())
	142	error (_("cannot subscript something of type `%s'"),
	143	type->name ());
	144	else
	145	error (_("cannot subscript requested type"));
	146	}
	147
	148	if (noside == EVAL_AVOID_SIDE_EFFECTS)
	149	return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
	150	else
	151	return value_subscript (arg1, value_as_long (arg2));
	152
	153	default:
	154	return evaluate_subexp_standard (expect_type, exp, pos, noside);
	155	}
	156
	157	nosideret:
	158	return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
	159	}
	160	\f
	161
	162	/* Table of operators and their precedences for printing expressions. */
	163
	164	static const struct op_print m2_op_print_tab[] =
	165	{
	166	{"+", BINOP_ADD, PREC_ADD, 0},
	167	{"+", UNOP_PLUS, PREC_PREFIX, 0},
	168	{"-", BINOP_SUB, PREC_ADD, 0},
	169	{"-", UNOP_NEG, PREC_PREFIX, 0},
	170	{"*", BINOP_MUL, PREC_MUL, 0},
	171	{"/", BINOP_DIV, PREC_MUL, 0},
	172	{"DIV", BINOP_INTDIV, PREC_MUL, 0},
	173	{"MOD", BINOP_REM, PREC_MUL, 0},
	174	{":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
	175	{"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
	176	{"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
	177	{"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
	178	{"=", BINOP_EQUAL, PREC_EQUAL, 0},
	179	{"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
	180	{"<=", BINOP_LEQ, PREC_ORDER, 0},
	181	{">=", BINOP_GEQ, PREC_ORDER, 0},
	182	{">", BINOP_GTR, PREC_ORDER, 0},
	183	{"<", BINOP_LESS, PREC_ORDER, 0},
	184	{"^", UNOP_IND, PREC_PREFIX, 0},
	185	{"@", BINOP_REPEAT, PREC_REPEAT, 0},
	186	{"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0},
	187	{"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0},
	188	{"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0},
	189	{"FLOAT", UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0},
	190	{"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0},
	191	{"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0},
	192	{"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0},
	193	{"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0},
	194	{"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0},
	195	{NULL, OP_NULL, PREC_BUILTIN_FUNCTION, 0}
	196	};
	197	\f
	198	/* The built-in types of Modula-2. */
	199
	200	enum m2_primitive_types {
	201	m2_primitive_type_char,
	202	m2_primitive_type_int,
	203	m2_primitive_type_card,
	204	m2_primitive_type_real,
	205	m2_primitive_type_bool,
	206	nr_m2_primitive_types
	207	};
	208
	209	const struct exp_descriptor exp_descriptor_modula2 =
	210	{
	211	print_subexp_standard,
	212	operator_length_standard,
	213	operator_check_standard,
	214	op_name_standard,
	215	dump_subexp_body_standard,
	216	evaluate_subexp_modula2
	217	};
	218
	219	/* Constant data describing the M2 language. */
	220
	221	extern const struct language_data m2_language_data =
	222	{
	223	"modula-2",
	224	"Modula-2",
	225	language_m2,
	226	range_check_on,
	227	case_sensitive_on,
	228	array_row_major,
	229	macro_expansion_no,
	230	NULL,
	231	&exp_descriptor_modula2,
	232	m2_print_typedef, /* Print a typedef using appropriate syntax */
	233	NULL, /* name_of_this */
	234	false, /* la_store_sym_names_in_linkage_form_p */
	235	m2_op_print_tab, /* expression operators for printing */
	236	0, /* arrays are first-class (not c-style) */
	237	0, /* String lower bound */
	238	&default_varobj_ops,
	239	m2_is_string_type_p,
	240	"{...}" /* la_struct_too_deep_ellipsis */
	241	};
	242
	243	/* Class representing the M2 language. */
	244
	245	class m2_language : public language_defn
	246	{
	247	public:
	248	m2_language ()
	249	: language_defn (language_m2, m2_language_data)
	250	{ /* Nothing. */ }
	251
	252	/* See language.h. */
	253	void language_arch_info (struct gdbarch *gdbarch,
	254	struct language_arch_info *lai) const override
	255	{
	256	const struct builtin_m2_type *builtin = builtin_m2_type (gdbarch);
	257
	258	lai->string_char_type = builtin->builtin_char;
	259	lai->primitive_type_vector
	260	= GDBARCH_OBSTACK_CALLOC (gdbarch, nr_m2_primitive_types + 1,
	261	struct type *);
	262
	263	lai->primitive_type_vector [m2_primitive_type_char]
	264	= builtin->builtin_char;
	265	lai->primitive_type_vector [m2_primitive_type_int]
	266	= builtin->builtin_int;
	267	lai->primitive_type_vector [m2_primitive_type_card]
	268	= builtin->builtin_card;
	269	lai->primitive_type_vector [m2_primitive_type_real]
	270	= builtin->builtin_real;
	271	lai->primitive_type_vector [m2_primitive_type_bool]
	272	= builtin->builtin_bool;
	273
	274	lai->bool_type_symbol = "BOOLEAN";
	275	lai->bool_type_default = builtin->builtin_bool;
	276	}
	277
	278	/* See language.h. */
	279
	280	void print_type (struct type type, const char varstring,
	281	struct ui_file *stream, int show, int level,
	282	const struct type_print_options *flags) const override
	283	{
	284	m2_print_type (type, varstring, stream, show, level, flags);
	285	}
	286
	287	/* See language.h. */
	288
	289	void value_print_inner
	290	(struct value val, struct ui_file stream, int recurse,
	291	const struct value_print_options *options) const override
	292	{
	293	return m2_value_print_inner (val, stream, recurse, options);
	294	}
	295
	296	/* See language.h. */
	297
	298	int parser (struct parser_state *ps) const override
	299	{
	300	return m2_parse (ps);
	301	}
	302
	303	/* See language.h. */
	304
	305	void emitchar (int ch, struct type *chtype,
	306	struct ui_file *stream, int quoter) const override
	307	{
	308	ch &= 0xFF; /* Avoid sign bit follies. */
	309
	310	if (PRINT_LITERAL_FORM (ch))
	311	{
	312	if (ch == '\\' \|\| ch == quoter)
	313	fputs_filtered ("\\", stream);
	314	fprintf_filtered (stream, "%c", ch);
	315	}
	316	else
	317	{
	318	switch (ch)
	319	{
	320	case '\n':
	321	fputs_filtered ("\\n", stream);
	322	break;
	323	case '\b':
	324	fputs_filtered ("\\b", stream);
	325	break;
	326	case '\t':
	327	fputs_filtered ("\\t", stream);
	328	break;
	329	case '\f':
	330	fputs_filtered ("\\f", stream);
	331	break;
	332	case '\r':
	333	fputs_filtered ("\\r", stream);
	334	break;
	335	case '\033':
	336	fputs_filtered ("\\e", stream);
	337	break;
	338	case '\007':
	339	fputs_filtered ("\\a", stream);
	340	break;
	341	default:
	342	fprintf_filtered (stream, "\\%.3o", (unsigned int) ch);
	343	break;
	344	}
	345	}
	346	}
	347
	348	/* See language.h. */
	349
	350	void printchar (int ch, struct type *chtype,
	351	struct ui_file *stream) const override
	352	{
	353	m2_printchar (ch, chtype, stream);
	354	}
	355
	356	/* See language.h. */
	357
	358	void printstr (struct ui_file stream, struct type elttype,
	359	const gdb_byte *string, unsigned int length,
	360	const char *encoding, int force_ellipses,
	361	const struct value_print_options *options) const override
	362	{
	363	unsigned int i;
	364	unsigned int things_printed = 0;
	365	int in_quotes = 0;
	366	int need_comma = 0;
	367
	368	if (length == 0)
	369	{
	370	fputs_filtered ("\"\"", gdb_stdout);
	371	return;
	372	}
	373
	374	for (i = 0; i < length && things_printed < options->print_max; ++i)
	375	{
	376	/* Position of the character we are examining
	377	to see whether it is repeated. */
	378	unsigned int rep1;
	379	/* Number of repetitions we have detected so far. */
	380	unsigned int reps;
	381
	382	QUIT;
	383
	384	if (need_comma)
	385	{
	386	fputs_filtered (", ", stream);
	387	need_comma = 0;
	388	}
	389
	390	rep1 = i + 1;
	391	reps = 1;
	392	while (rep1 < length && string[rep1] == string[i])
	393	{
	394	++rep1;
	395	++reps;
	396	}
	397
	398	if (reps > options->repeat_count_threshold)
	399	{
	400	if (in_quotes)
	401	{
	402	fputs_filtered ("\", ", stream);
	403	in_quotes = 0;
	404	}
	405	m2_printchar (string[i], elttype, stream);
	406	fprintf_filtered (stream, " <repeats %u times>", reps);
	407	i = rep1 - 1;
	408	things_printed += options->repeat_count_threshold;
	409	need_comma = 1;
	410	}
	411	else
	412	{
	413	if (!in_quotes)
	414	{
	415	fputs_filtered ("\"", stream);
	416	in_quotes = 1;
	417	}
	418	LA_EMIT_CHAR (string[i], elttype, stream, '"');
	419	++things_printed;
	420	}
	421	}
	422
	423	/* Terminate the quotes if necessary. */
	424	if (in_quotes)
	425	fputs_filtered ("\"", stream);
	426
	427	if (force_ellipses \|\| i < length)
	428	fputs_filtered ("...", stream);
	429	}
	430	};
	431
	432	/* Single instance of the M2 language. */
	433
	434	static m2_language m2_language_defn;
	435
	436	static void *
	437	build_m2_types (struct gdbarch *gdbarch)
	438	{
	439	struct builtin_m2_type *builtin_m2_type
	440	= GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_m2_type);
	441
	442	/* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
	443	builtin_m2_type->builtin_int
	444	= arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 0, "INTEGER");
	445	builtin_m2_type->builtin_card
	446	= arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "CARDINAL");
	447	builtin_m2_type->builtin_real
	448	= arch_float_type (gdbarch, gdbarch_float_bit (gdbarch), "REAL",
	449	gdbarch_float_format (gdbarch));
	450	builtin_m2_type->builtin_char
	451	= arch_character_type (gdbarch, TARGET_CHAR_BIT, 1, "CHAR");
	452	builtin_m2_type->builtin_bool
	453	= arch_boolean_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "BOOLEAN");
	454
	455	return builtin_m2_type;
	456	}
	457
	458	static struct gdbarch_data *m2_type_data;
	459
	460	const struct builtin_m2_type *
	461	builtin_m2_type (struct gdbarch *gdbarch)
	462	{
	463	return (const struct builtin_m2_type *) gdbarch_data (gdbarch, m2_type_data);
	464	}
	465
	466
	467	/* Initialization for Modula-2 */
	468
	469	void _initialize_m2_language ();
	470	void
	471	_initialize_m2_language ()
	472	{
	473	m2_type_data = gdbarch_data_register_post_init (build_m2_types);
	474	}