[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"

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

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