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

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

   Copyright (C) 1992-2021 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"

/* A helper function for UNOP_HIGH.  */

static struct value *
eval_op_m2_high (struct type *expect_type, struct expression *exp,
		 enum noside noside,
		 struct value *arg1)
{
  if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
    return arg1;
  else
    {
      arg1 = coerce_ref (arg1);
      struct type *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;
}

/* A helper function for BINOP_SUBSCRIPT.  */

static struct value *
eval_op_m2_subscript (struct type *expect_type, struct expression *exp,
		      enum noside noside,
		      struct value *arg1, struct value *arg2)
{
  if (noside == EVAL_SKIP)
    return eval_skip_value (exp);
  /* 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);
  struct type *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))
	error (_("internal error: unbounded "
		 "array structure is unknown"));
      /* 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));
}

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;

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

    case BINOP_SUBSCRIPT:
      (*pos)++;
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
      return eval_op_m2_subscript (expect_type, exp, noside, arg1, arg2);

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

/* Table of operators and their precedences for printing expressions.  */

const struct op_print m2_language::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

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

/* Single instance of the M2 language.  */

static m2_language m2_language_defn;

/* See language.h.  */

void
m2_language::language_arch_info (struct gdbarch *gdbarch,
				 struct language_arch_info *lai) const
{
  const struct builtin_m2_type *builtin = builtin_m2_type (gdbarch);

  /* Helper function to allow shorter lines below.  */
  auto add  = [&] (struct type * t)
  {
    lai->add_primitive_type (t);
  };

  add (builtin->builtin_char);
  add (builtin->builtin_int);
  add (builtin->builtin_card);
  add (builtin->builtin_real);
  add (builtin->builtin_bool);

  lai->set_string_char_type (builtin->builtin_char);
  lai->set_bool_type (builtin->builtin_bool, "BOOLEAN");
}

/* See languge.h.  */

void
m2_language::printchar (int c, struct type *type,
			struct ui_file *stream) const
{
  fputs_filtered ("'", stream);
  emitchar (c, type, stream, '\'');
  fputs_filtered ("'", stream);
}

/* See language.h.  */

void
m2_language::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
{
  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;
	    }
	  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;
	    }
	  emitchar (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);
}

/* See language.h.  */

void
m2_language::emitchar (int ch, struct type *chtype,
		       struct ui_file *stream, int quoter) const
{
  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;
	}
    }
}

/* Called during architecture gdbarch initialisation to create language
   specific types.  */

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
c906108c	1	/* Modula 2 language support routines for GDB, the GNU debugger.
ce27fb25	2
3666a048	3	Copyright (C) 1992-2021 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
c5aa993b JM	8	it under the terms of the GNU General Public License as published by
a9762ec7	9	the Free Software Foundation; either version 3 of the License, or
c5aa993b	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	17	You should have received a copy of the GNU General Public License
a9762ec7	18	along with this program. If not, see <http://www.gnu.org/licenses/>. */
c906108c SS	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"
a53b64ea	26	#include "varobj.h"
c906108c SS	27	#include "m2-lang.h"
c906108c SS	28	#include "c-lang.h"
745b8ca0	29	#include "valprint.h"
0d12e84c	30	#include "gdbarch.h"
c906108c	31
41bdced5 TT	32	/* A helper function for UNOP_HIGH. */
	33
	34	static struct value *
	35	eval_op_m2_high (struct type expect_type, struct expression exp,
	36	enum noside noside,
	37	struct value *arg1)
	38	{
	39	if (noside == EVAL_SKIP \|\| noside == EVAL_AVOID_SIDE_EFFECTS)
	40	return arg1;
	41	else
	42	{
	43	arg1 = coerce_ref (arg1);
	44	struct type *type = check_typedef (value_type (arg1));
	45
	46	if (m2_is_unbounded_array (type))
	47	{
	48	struct value *temp = arg1;
	49
	50	type = type->field (1).type ();
	51	/* i18n: Do not translate the "_m2_high" part! */
	52	arg1 = value_struct_elt (&temp, NULL, "_m2_high", NULL,
	53	_("unbounded structure "
	54	"missing _m2_high field"));
	55
	56	if (value_type (arg1) != type)
	57	arg1 = value_cast (type, arg1);
	58	}
	59	}
	60	return arg1;
	61	}
	62
a49881f7 TT	63	/* A helper function for BINOP_SUBSCRIPT. */
	64
	65	static struct value *
	66	eval_op_m2_subscript (struct type expect_type, struct expression exp,
	67	enum noside noside,
	68	struct value arg1, struct value arg2)
	69	{
	70	if (noside == EVAL_SKIP)
	71	return eval_skip_value (exp);
	72	/* If the user attempts to subscript something that is not an
	73	array or pointer type (like a plain int variable for example),
	74	then report this as an error. */
	75
	76	arg1 = coerce_ref (arg1);
	77	struct type *type = check_typedef (value_type (arg1));
	78
	79	if (m2_is_unbounded_array (type))
	80	{
	81	struct value *temp = arg1;
	82	type = type->field (0).type ();
	83	if (type == NULL \|\| (type->code () != TYPE_CODE_PTR))
	84	error (_("internal error: unbounded "
	85	"array structure is unknown"));
	86	/* i18n: Do not translate the "_m2_contents" part! */
	87	arg1 = value_struct_elt (&temp, NULL, "_m2_contents", NULL,
	88	_("unbounded structure "
	89	"missing _m2_contents field"));
	90
	91	if (value_type (arg1) != type)
	92	arg1 = value_cast (type, arg1);
	93
	94	check_typedef (value_type (arg1));
	95	return value_ind (value_ptradd (arg1, value_as_long (arg2)));
	96	}
	97	else
	98	if (type->code () != TYPE_CODE_ARRAY)
	99	{
	100	if (type->name ())
	101	error (_("cannot subscript something of type `%s'"),
	102	type->name ());
	103	else
	104	error (_("cannot subscript requested type"));
	105	}
	106
	107	if (noside == EVAL_AVOID_SIDE_EFFECTS)
	108	return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
	109	else
	110	return value_subscript (arg1, value_as_long (arg2));
	111	}
	112
844781a1 GM	113	static struct value *
	114	evaluate_subexp_modula2 (struct type expect_type, struct expression exp,
	115	int *pos, enum noside noside)
	116	{
	117	enum exp_opcode op = exp->elts[*pos].opcode;
	118	struct value *arg1;
	119	struct value *arg2;
b8d56208	120
844781a1 GM	121	switch (op)
	122	{
	123	case UNOP_HIGH:
	124	(*pos)++;
	125	arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
41bdced5	126	return eval_op_m2_high (expect_type, exp, noside, arg1);
844781a1 GM	127
	128	case BINOP_SUBSCRIPT:
	129	(*pos)++;
	130	arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
	131	arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
a49881f7	132	return eval_op_m2_subscript (expect_type, exp, noside, arg1, arg2);
844781a1 GM	133
	134	default:
	135	return evaluate_subexp_standard (expect_type, exp, pos, noside);
	136	}
844781a1	137	}
c906108c	138	\f
c5aa993b	139
c906108c SS	140	/* Table of operators and their precedences for printing expressions. */
c906108c SS	141
790e2a12	142	const struct op_print m2_language::op_print_tab[] =
c5aa993b JM	143	{
	144	{"+", BINOP_ADD, PREC_ADD, 0},
	145	{"+", UNOP_PLUS, PREC_PREFIX, 0},
	146	{"-", BINOP_SUB, PREC_ADD, 0},
	147	{"-", UNOP_NEG, PREC_PREFIX, 0},
	148	{"*", BINOP_MUL, PREC_MUL, 0},
	149	{"/", BINOP_DIV, PREC_MUL, 0},
	150	{"DIV", BINOP_INTDIV, PREC_MUL, 0},
	151	{"MOD", BINOP_REM, PREC_MUL, 0},
	152	{":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
	153	{"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
	154	{"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
	155	{"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
	156	{"=", BINOP_EQUAL, PREC_EQUAL, 0},
	157	{"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
	158	{"<=", BINOP_LEQ, PREC_ORDER, 0},
	159	{">=", BINOP_GEQ, PREC_ORDER, 0},
	160	{">", BINOP_GTR, PREC_ORDER, 0},
	161	{"<", BINOP_LESS, PREC_ORDER, 0},
	162	{"^", UNOP_IND, PREC_PREFIX, 0},
	163	{"@", BINOP_REPEAT, PREC_REPEAT, 0},
	164	{"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0},
	165	{"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0},
	166	{"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0},
	167	{"FLOAT", UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0},
	168	{"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0},
	169	{"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0},
	170	{"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0},
	171	{"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0},
	172	{"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0},
f486487f	173	{NULL, OP_NULL, PREC_BUILTIN_FUNCTION, 0}
c906108c SS	174	};
c906108c SS	175	\f
c906108c	176
790e2a12	177	const struct exp_descriptor m2_language::exp_descriptor_modula2 =
844781a1 GM	178	{
	179	print_subexp_standard,
	180	operator_length_standard,
c0201579	181	operator_check_standard,
844781a1 GM	182	dump_subexp_body_standard,
	183	evaluate_subexp_modula2
	184	};
	185
790e2a12	186	/* Single instance of the M2 language. */
d711ee67	187
790e2a12	188	static m2_language m2_language_defn;
4ffc13fb	189
790e2a12	190	/* See language.h. */
4ffc13fb	191
790e2a12 AB	192	void
	193	m2_language::language_arch_info (struct gdbarch *gdbarch,
	194	struct language_arch_info *lai) const
	195	{
	196	const struct builtin_m2_type *builtin = builtin_m2_type (gdbarch);
	197
7bea47f0 AB	198	/* Helper function to allow shorter lines below. */
	199	auto add = [&] (struct type * t)
	200	{
	201	lai->add_primitive_type (t);
	202	};
	203
	204	add (builtin->builtin_char);
	205	add (builtin->builtin_int);
	206	add (builtin->builtin_card);
	207	add (builtin->builtin_real);
	208	add (builtin->builtin_bool);
	209
	210	lai->set_string_char_type (builtin->builtin_char);
	211	lai->set_bool_type (builtin->builtin_bool, "BOOLEAN");
790e2a12	212	}
4ffc13fb	213
790e2a12	214	/* See languge.h. */
39e7ecca	215
790e2a12 AB	216	void
	217	m2_language::printchar (int c, struct type *type,
	218	struct ui_file *stream) const
	219	{
	220	fputs_filtered ("'", stream);
	221	emitchar (c, type, stream, '\'');
	222	fputs_filtered ("'", stream);
	223	}
39e7ecca	224
790e2a12	225	/* See language.h. */
39e7ecca	226
790e2a12 AB	227	void
	228	m2_language::printstr (struct ui_file stream, struct type elttype,
	229	const gdb_byte *string, unsigned int length,
	230	const char *encoding, int force_ellipses,
	231	const struct value_print_options *options) const
	232	{
	233	unsigned int i;
	234	unsigned int things_printed = 0;
	235	int in_quotes = 0;
	236	int need_comma = 0;
67bd3fd5	237
790e2a12 AB	238	if (length == 0)
	239	{
	240	fputs_filtered ("\"\"", gdb_stdout);
	241	return;
	242	}
67bd3fd5	243
790e2a12 AB	244	for (i = 0; i < length && things_printed < options->print_max; ++i)
	245	{
	246	/* Position of the character we are examining
	247	to see whether it is repeated. */
	248	unsigned int rep1;
	249	/* Number of repetitions we have detected so far. */
	250	unsigned int reps;
22c12a6c	251
790e2a12	252	QUIT;
22c12a6c	253
790e2a12 AB	254	if (need_comma)
	255	{
	256	fputs_filtered (", ", stream);
	257	need_comma = 0;
	258	}
efdf6a73	259
790e2a12 AB	260	rep1 = i + 1;
	261	reps = 1;
	262	while (rep1 < length && string[rep1] == string[i])
	263	{
	264	++rep1;
	265	++reps;
	266	}
efdf6a73	267
790e2a12 AB	268	if (reps > options->repeat_count_threshold)
	269	{
	270	if (in_quotes)
	271	{
	272	fputs_filtered ("\", ", stream);
	273	in_quotes = 0;
	274	}
	275	printchar (string[i], elttype, stream);
	276	fprintf_filtered (stream, " <repeats %u times>", reps);
	277	i = rep1 - 1;
	278	things_printed += options->repeat_count_threshold;
	279	need_comma = 1;
	280	}
	281	else
	282	{
	283	if (!in_quotes)
	284	{
	285	fputs_filtered ("\"", stream);
	286	in_quotes = 1;
	287	}
	288	emitchar (string[i], elttype, stream, '"');
	289	++things_printed;
	290	}
	291	}
5aba6ebe	292
790e2a12 AB	293	/* Terminate the quotes if necessary. */
	294	if (in_quotes)
	295	fputs_filtered ("\"", stream);
5aba6ebe	296
790e2a12 AB	297	if (force_ellipses \|\| i < length)
	298	fputs_filtered ("...", stream);
	299	}
b7c6e27d	300
790e2a12	301	/* See language.h. */
b7c6e27d	302
790e2a12 AB	303	void
	304	m2_language::emitchar (int ch, struct type *chtype,
	305	struct ui_file *stream, int quoter) const
	306	{
	307	ch &= 0xFF; /* Avoid sign bit follies. */
0874fd07	308
790e2a12 AB	309	if (PRINT_LITERAL_FORM (ch))
	310	{
	311	if (ch == '\\' \|\| ch == quoter)
	312	fputs_filtered ("\\", stream);
	313	fprintf_filtered (stream, "%c", ch);
	314	}
	315	else
	316	{
	317	switch (ch)
	318	{
	319	case '\n':
	320	fputs_filtered ("\\n", stream);
	321	break;
	322	case '\b':
	323	fputs_filtered ("\\b", stream);
	324	break;
	325	case '\t':
	326	fputs_filtered ("\\t", stream);
	327	break;
	328	case '\f':
	329	fputs_filtered ("\\f", stream);
	330	break;
	331	case '\r':
	332	fputs_filtered ("\\r", stream);
	333	break;
	334	case '\033':
	335	fputs_filtered ("\\e", stream);
	336	break;
	337	case '\007':
	338	fputs_filtered ("\\a", stream);
	339	break;
	340	default:
	341	fprintf_filtered (stream, "\\%.3o", (unsigned int) ch);
	342	break;
	343	}
	344	}
	345	}
0874fd07	346
790e2a12 AB	347	/* Called during architecture gdbarch initialisation to create language
790e2a12 AB	348	specific types. */
0874fd07	349
5760b90a UW	350	static void *
5760b90a UW	351	build_m2_types (struct gdbarch *gdbarch)
c906108c	352	{
5760b90a UW	353	struct builtin_m2_type *builtin_m2_type
	354	= GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_m2_type);
	355
c906108c	356	/* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
e9bb382b UW	357	builtin_m2_type->builtin_int
	358	= arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 0, "INTEGER");
	359	builtin_m2_type->builtin_card
	360	= arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "CARDINAL");
	361	builtin_m2_type->builtin_real
49f190bc UW	362	= arch_float_type (gdbarch, gdbarch_float_bit (gdbarch), "REAL",
49f190bc UW	363	gdbarch_float_format (gdbarch));
e9bb382b UW	364	builtin_m2_type->builtin_char
	365	= arch_character_type (gdbarch, TARGET_CHAR_BIT, 1, "CHAR");
	366	builtin_m2_type->builtin_bool
	367	= arch_boolean_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "BOOLEAN");
c906108c	368
5760b90a UW	369	return builtin_m2_type;
	370	}
	371
	372	static struct gdbarch_data *m2_type_data;
	373
	374	const struct builtin_m2_type *
	375	builtin_m2_type (struct gdbarch *gdbarch)
	376	{
9a3c8263	377	return (const struct builtin_m2_type *) gdbarch_data (gdbarch, m2_type_data);
5760b90a UW	378	}
	379
	380
	381	/* Initialization for Modula-2 */
	382
6c265988	383	void _initialize_m2_language ();
5760b90a	384	void
6c265988	385	_initialize_m2_language ()
5760b90a UW	386	{
5760b90a UW	387	m2_type_data = gdbarch_data_register_post_init (build_m2_types);
c906108c	388	}