binutils-gdb/gdb/m2-lang.c
Joel Brobecker 3666a04883 Update copyright year range in all GDB files
This commits the result of running gdb/copyright.py as per our Start
of New Year procedure...

gdb/ChangeLog

        Update copyright year range in copyright header of all GDB files.
2021-01-01 12:12:21 +04:00

377 lines
9.8 KiB
C
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

/* 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);
}
/* 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}
};
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);
}