[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"
#include "m2-exp.h"

/* A helper function for UNOP_HIGH.  */

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.  */

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