123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316 |
- /* Modula 2 language support routines for GDB, the GNU debugger.
- Copyright (C) 1992-2022 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_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, {}, "_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 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, {}, "_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));
- }
- /* 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
- {
- gdb_puts ("'", stream);
- emitchar (c, type, stream, '\'');
- gdb_puts ("'", 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)
- {
- gdb_puts ("\"\"");
- 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)
- {
- gdb_puts (", ", 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)
- {
- gdb_puts ("\", ", stream);
- in_quotes = 0;
- }
- printchar (string[i], elttype, stream);
- gdb_printf (stream, " <repeats %u times>", reps);
- i = rep1 - 1;
- things_printed += options->repeat_count_threshold;
- need_comma = 1;
- }
- else
- {
- if (!in_quotes)
- {
- gdb_puts ("\"", stream);
- in_quotes = 1;
- }
- emitchar (string[i], elttype, stream, '"');
- ++things_printed;
- }
- }
- /* Terminate the quotes if necessary. */
- if (in_quotes)
- gdb_puts ("\"", stream);
- if (force_ellipses || i < length)
- gdb_puts ("...", 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)
- gdb_puts ("\\", stream);
- gdb_printf (stream, "%c", ch);
- }
- else
- {
- switch (ch)
- {
- case '\n':
- gdb_puts ("\\n", stream);
- break;
- case '\b':
- gdb_puts ("\\b", stream);
- break;
- case '\t':
- gdb_puts ("\\t", stream);
- break;
- case '\f':
- gdb_puts ("\\f", stream);
- break;
- case '\r':
- gdb_puts ("\\r", stream);
- break;
- case '\033':
- gdb_puts ("\\e", stream);
- break;
- case '\007':
- gdb_puts ("\\a", stream);
- break;
- default:
- gdb_printf (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);
- }
|