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 2 of the License, or
+ 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,
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, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor,
- Boston, MA 02110-1301, USA. */
+ along with this program. If not, see <http://www.gnu.org/licenses/>. */
#include "defs.h"
#include "symtab.h"
string whose delimiter is QUOTER. Note that that format for printing
characters and strings is language specific.
FIXME: This is a copy of the same function from c-exp.y. It should
- be replaced with a true Modula version.
- */
+ be replaced with a true Modula version. */
static void
m2_emit_char (int c, struct ui_file *stream, int quoter)
}
/* FIXME: This is a copy of the same function from c-exp.y. It should
- be replaced with a true Modula version. */
+ be replaced with a true Modula version. */
static void
m2_printchar (int c, struct ui_file *stream)
are printed as appropriate. Print ellipses at the end if we
had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
FIXME: This is a copy of the same function from c-exp.y. It should
- be replaced with a true Modula version. */
+ be replaced with a true Modula version. */
static void
m2_printstr (struct ui_file *stream, const gdb_byte *string,
fputs_filtered ("...", stream);
}
+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_TYPE (type, 1);
+ /* 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_TYPE (type, 0);
+ if (type == NULL || (TYPE_CODE (type) != 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);
+
+ type = check_typedef (value_type (arg1));
+ return value_ind (value_add (arg1, arg2));
+ }
+ else
+ if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
+ {
+ if (TYPE_NAME (type))
+ error (_("cannot subscript something of type `%s'"),
+ TYPE_NAME (type));
+ 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, arg2);
+
+ default:
+ return evaluate_subexp_standard (expect_type, exp, pos, noside);
+ }
+
+ nosideret:
+ return value_from_longest (builtin_type_long, (LONGEST) 1);
+}
+
/* FIXME: This is a copy of c_create_fundamental_type(), before
all the non-C types were stripped from it. Needs to be fixed
- by an experienced Modula programmer. */
+ by an experienced Modula programmer. */
static struct type *
m2_create_fundamental_type (struct objfile *objfile, int typeid)
/* FIXME: For now, if we are asked to produce a type not in this
language, create the equivalent of a C integer type with the
name "<?type?>". When all the dust settles from the type
- reconstruction work, this should probably become an error. */
+ reconstruction work, this should probably become an error. */
type = init_type (TYPE_CODE_INT,
gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
0, "<?type?>", objfile);
\f
/* The built-in types of Modula-2. */
-struct type *builtin_type_m2_char;
-struct type *builtin_type_m2_int;
-struct type *builtin_type_m2_card;
-struct type *builtin_type_m2_real;
-struct type *builtin_type_m2_bool;
-
enum m2_primitive_types {
m2_primitive_type_char,
m2_primitive_type_int,
m2_language_arch_info (struct gdbarch *gdbarch,
struct language_arch_info *lai)
{
- lai->string_char_type = builtin_type_m2_char;
+ const struct builtin_m2_type *builtin = builtin_m2_type (gdbarch);
+
+ lai->string_char_type = builtin->builtin_char;
lai->primitive_type_vector
= GDBARCH_OBSTACK_CALLOC (gdbarch, nr_m2_primitive_types + 1,
struct type *);
lai->primitive_type_vector [m2_primitive_type_char]
- = builtin_type_m2_char;
+ = builtin->builtin_char;
lai->primitive_type_vector [m2_primitive_type_int]
- = builtin_type_m2_int;
+ = builtin->builtin_int;
lai->primitive_type_vector [m2_primitive_type_card]
- = builtin_type_m2_card;
+ = builtin->builtin_card;
lai->primitive_type_vector [m2_primitive_type_real]
- = builtin_type_m2_real;
+ = builtin->builtin_real;
lai->primitive_type_vector [m2_primitive_type_bool]
- = builtin_type_m2_bool;
+ = builtin->builtin_bool;
}
+const struct exp_descriptor exp_descriptor_modula2 =
+{
+ print_subexp_standard,
+ operator_length_standard,
+ op_name_standard,
+ dump_subexp_body_standard,
+ evaluate_subexp_modula2
+};
+
const struct language_defn m2_language_defn =
{
"modula-2",
language_m2,
- NULL,
range_check_on,
type_check_on,
case_sensitive_on,
array_row_major,
- &exp_descriptor_standard,
+ &exp_descriptor_modula2,
m2_parse, /* parser */
m2_error, /* parser error function */
null_post_parser,
m2_op_print_tab, /* expression operators for printing */
0, /* arrays are first-class (not c-style) */
0, /* String lower bound */
- NULL,
default_word_break_characters,
m2_language_arch_info,
default_print_array_index,
+ default_pass_by_reference,
LANG_MAGIC
};
-/* Initialization for Modula-2 */
-
-void
-_initialize_m2_language (void)
+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_type_m2_int =
+ builtin_m2_type->builtin_int =
init_type (TYPE_CODE_INT,
gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
0, "INTEGER", (struct objfile *) NULL);
- builtin_type_m2_card =
+ builtin_m2_type->builtin_card =
init_type (TYPE_CODE_INT,
gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
TYPE_FLAG_UNSIGNED,
"CARDINAL", (struct objfile *) NULL);
- builtin_type_m2_real =
+ builtin_m2_type->builtin_real =
init_type (TYPE_CODE_FLT,
gdbarch_float_bit (current_gdbarch) / TARGET_CHAR_BIT,
0,
"REAL", (struct objfile *) NULL);
- builtin_type_m2_char =
+ builtin_m2_type->builtin_char =
init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
TYPE_FLAG_UNSIGNED,
"CHAR", (struct objfile *) NULL);
- builtin_type_m2_bool =
+ builtin_m2_type->builtin_bool =
init_type (TYPE_CODE_BOOL,
gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
TYPE_FLAG_UNSIGNED,
"BOOLEAN", (struct objfile *) NULL);
+ return builtin_m2_type;
+}
+
+static struct gdbarch_data *m2_type_data;
+
+const struct builtin_m2_type *
+builtin_m2_type (struct gdbarch *gdbarch)
+{
+ return gdbarch_data (gdbarch, m2_type_data);
+}
+
+
+/* Initialization for Modula-2 */
+
+void
+_initialize_m2_language (void)
+{
+ m2_type_data = gdbarch_data_register_post_init (build_m2_types);
+
add_language (&m2_language_defn);
}