This is the mail archive of the
gdb-patches@sourceware.org
mailing list for the GDB project.
[PATCH] Unbounded array support implemented (for Modula-2)
- From: Gaius Mulley <gaius at glam dot ac dot uk>
- To: gdb-patches at sources dot redhat dot com
- Date: Thu, 26 Jul 2007 01:22:43 +0100
- Subject: [PATCH] Unbounded array support implemented (for Modula-2)
Hi,
The patch below allows users debugging Modula-2 programs to print
unbounded parameter contents, ptype the parameter declaration and
perform unbounded array subscript queries. It also adds TSIZE
(pseudonym for SIZE) and implements HIGH (yields the last legal index
for an unbounded array).
Wondering whether this is okay to commit? Feel free to suggest
improvements etc,
regards,
Gaius
I've run check-gdb and get the following final results:
# of expected passes 11389
# of unexpected failures 78
# of unexpected successes 2
# of expected failures 41
# of known failures 39
# of unresolved testcases 1
# of untested testcases 8
# of unsupported tests 14
... build-gdb/gdb/testsuite/../../gdb/gdb version
# 6.6.50.20070724-cvs -nx
2004-07-26 Gaius Mulley <gaius@glam.ac.uk>
* doc/gdb.texinfo: Add TSIZE definition, removed
statement about unbounded arrays being unimplemented.
* m2-valprint.c (m2_print_array_contents): New function.
(m2_print_unbounded_array): New function.
(m2_print_array_contents): New function.
* m2-typeprint.c (m2_unbounded_array): New function.
(m2_is_unbounded_array): New function.
(m2_print_type): Test for unbounded array when walking
across structs.
* m2-lang.h: Added extern m2_is_unbounded_array.
* m2-lang.c (evaluate_subexp_modula2): New function.
(exp_descriptor_modula2): New structure.
(m2_language_defn): Use exp_descriptor_modula2.
* m2-exp.y: Added TSIZE and binary subscript.
--- gdb-cvs/src/gdb/doc/gdb.texinfo 2007-07-12 08:57:57.000000000 +0100
+++ gdb-cvs-modified/src/gdb/doc/gdb.texinfo 2007-07-25 23:50:48.000000000 +0100
@@ -9908,6 +9908,9 @@
@item TRUNC(@var{r})
Returns the integral part of @var{r}.
+@item TSIZE(@var{x})
+Returns the size of its argument. @var{x} can be a variable or a type.
+
@item VAL(@var{t},@var{i})
Returns the member of the type @var{t} whose ordinal value is @var{i}.
@end table
@@ -10038,7 +10041,7 @@
Note that the array handling is not yet complete and although the type
is printed correctly, expression handling still assumes that all
arrays have a lower bound of zero and not @code{-10} as in the example
-above. Unbounded arrays are also not yet recognized in @value{GDBN}.
+above.
Here are some more type related Modula-2 examples:
--- gdb-cvs/src/gdb/m2-valprint.c 2007-01-09 17:58:51.000000000 +0000
+++ gdb-cvs-modified/src/gdb/m2-valprint.c 2007-07-26 00:35:17.000000000 +0100
@@ -35,6 +35,12 @@
int print_unpacked_pointer (struct type *type,
CORE_ADDR address, CORE_ADDR addr,
int format, struct ui_file *stream);
+static void
+m2_print_array_contents (struct type *type, const gdb_byte *valaddr,
+ int embedded_offset, CORE_ADDR address,
+ struct ui_file *stream, int format,
+ enum val_prettyprint pretty,
+ int deref_ref, int recurse, int len);
/* Print function pointer with inferior address ADDRESS onto stdio
@@ -178,6 +184,36 @@
}
}
+static void
+m2_print_unbounded_array (struct type *type, const gdb_byte *valaddr,
+ int embedded_offset, CORE_ADDR address,
+ struct ui_file *stream, int format,
+ int deref_ref, enum val_prettyprint pretty,
+ int recurse)
+{
+ struct type *content_type;
+ CORE_ADDR addr;
+ LONGEST len;
+ struct value *val;
+
+ CHECK_TYPEDEF (type);
+ content_type = TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 0));
+
+ addr = unpack_pointer (TYPE_FIELD_TYPE (type, 0),
+ (TYPE_FIELD_BITPOS (type, 0) / 8) +
+ valaddr + embedded_offset);
+
+ val = value_at_lazy (TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 0)),
+ addr);
+ len = unpack_field_as_long (type, valaddr + embedded_offset, 1);
+
+ fprintf_filtered (stream, "{");
+ m2_print_array_contents (value_type (val), value_contents(val),
+ value_embedded_offset (val), addr, stream,
+ format, deref_ref, pretty, recurse, len);
+ fprintf_filtered (stream, ", HIGH = %d}", (int) len);
+}
+
int
print_unpacked_pointer (struct type *type,
CORE_ADDR address, CORE_ADDR addr,
@@ -203,13 +239,15 @@
&& TYPE_CODE (elttype) == TYPE_CODE_INT
&& (format == 0 || format == 's')
&& addr != 0)
- return val_print_string (addr, -1, TYPE_LENGTH (elttype), stream);
+ return val_print_string (addr, -1, TYPE_LENGTH (elttype),
+ stream);
return 0;
}
static void
-print_variable_at_address (struct type *type, const gdb_byte *valaddr,
+print_variable_at_address (struct type *type,
+ const gdb_byte *valaddr,
struct ui_file *stream, int format,
int deref_ref, int recurse,
enum val_prettyprint pretty)
@@ -235,6 +273,49 @@
fputs_filtered ("???", stream);
}
+
+/*
+ * m2_print_array_contents - prints out the contents of an
+ * array up to a max_print values.
+ * It prints arrays of char as a string
+ * and all other data types as comma
+ * separated values.
+ */
+
+static void
+m2_print_array_contents (struct type *type, const gdb_byte *valaddr,
+ int embedded_offset, CORE_ADDR address,
+ struct ui_file *stream, int format,
+ enum val_prettyprint pretty,
+ int deref_ref, int recurse, int len)
+{
+ int eltlen;
+ CHECK_TYPEDEF (type);
+
+ if (TYPE_LENGTH (type) > 0)
+ {
+ eltlen = TYPE_LENGTH (type);
+ if (prettyprint_arrays)
+ print_spaces_filtered (2 + 2 * recurse, stream);
+ /* For an array of chars, print with string syntax. */
+ if (eltlen == 1 &&
+ ((TYPE_CODE (type) == TYPE_CODE_INT)
+ || ((current_language->la_language == language_m2)
+ && (TYPE_CODE (type) == TYPE_CODE_CHAR)))
+ && (format == 0 || format == 's'))
+ val_print_string (address, len+1, eltlen, stream);
+ else
+ {
+ fprintf_filtered (stream, "{");
+ val_print_array_elements (type, valaddr + embedded_offset,
+ address, stream, format,
+ deref_ref, recurse, pretty, 0);
+ fprintf_filtered (stream, "}");
+ }
+ }
+}
+
+
/* Print data of type TYPE located at VALADDR (within GDB), which came from
the inferior at address ADDRESS, onto stdio stream STREAM according to
FORMAT (a letter or 0 for natural format). The data at VALADDR is in
@@ -366,6 +447,10 @@
if (m2_is_long_set (type))
m2_print_long_set (type, valaddr, embedded_offset, address,
stream, format, pretty);
+ else if (m2_is_unbounded_array (type))
+ m2_print_unbounded_array (type, valaddr, embedded_offset,
+ address, stream, format, deref_ref,
+ pretty, recurse);
else
cp_print_value_fields (type, type, valaddr, embedded_offset,
address, stream, format,
--- gdb-cvs/src/gdb/m2-typeprint.c 2007-06-29 01:35:08.000000000 +0100
+++ gdb-cvs-modified/src/gdb/m2-typeprint.c 2007-07-25 20:58:40.000000000 +0100
@@ -55,6 +55,8 @@
int show, int level);
static int m2_long_set (struct type *type, struct ui_file *stream,
int show, int level);
+static int m2_unbounded_array (struct type *type, struct ui_file *stream,
+ int show, int level);
static void m2_record_fields (struct type *type, struct ui_file *stream,
int show, int level);
static void m2_unknown (const char *s, struct type *type,
@@ -62,6 +64,7 @@
int m2_is_long_set (struct type *type);
int m2_is_long_set_of_type (struct type *type, struct type **of_type);
+int m2_is_unbounded_array (struct type *type);
void
@@ -90,7 +93,8 @@
break;
case TYPE_CODE_STRUCT:
- if (m2_long_set (type, stream, show, level))
+ if (m2_long_set (type, stream, show, level)
+ || m2_unbounded_array (type, stream, show, level))
break;
m2_record_fields (type, stream, show, level);
break;
@@ -474,6 +478,57 @@
return 0;
}
+/*
+ * m2_is_unbounded_array - returns TRUE if, type, should be regarded
+ * as a Modula-2 unbounded ARRAY type.
+ */
+
+int
+m2_is_unbounded_array (struct type *type)
+{
+ if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
+ {
+ /*
+ * check if we have a structure with exactly two fields named
+ * _m2_contents and _m2_high. It also checks to see if the
+ * type of _m2_contents is a pointer. The TYPE_TARGET_TYPE
+ * of the pointer determines the unbounded ARRAY OF type.
+ */
+ if (TYPE_NFIELDS (type) != 2)
+ return 0;
+ if (strcmp (TYPE_FIELD_NAME (type, 0), "_m2_contents") != 0)
+ return 0;
+ if (strcmp (TYPE_FIELD_NAME (type, 1), "_m2_high") != 0)
+ return 0;
+ if (TYPE_CODE (TYPE_FIELD_TYPE (type, 0)) != TYPE_CODE_PTR)
+ return 0;
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ * m2_unbounded_array - if the struct type matches a Modula-2 unbounded
+ * parameter type then display the type as an
+ * ARRAY OF type. Returns TRUE if an unbounded
+ * array type was detected.
+ */
+
+static int
+m2_unbounded_array (struct type *type, struct ui_file *stream, int show, int level)
+{
+ struct type *of_type;
+
+ if (m2_is_unbounded_array (type))
+ {
+ fputs_filtered ("ARRAY OF ", stream);
+ m2_print_type (TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 0)),
+ "", stream, 0, level);
+ return 1;
+ }
+ return 0;
+}
+
void
m2_record_fields (struct type *type, struct ui_file *stream, int show,
int level)
--- gdb-cvs/src/gdb/m2-lang.h 2007-01-09 17:58:51.000000000 +0000
+++ gdb-cvs-modified/src/gdb/m2-lang.h 2007-07-25 18:33:42.000000000 +0100
@@ -28,6 +28,7 @@
int);
extern int m2_is_long_set (struct type *type);
+extern int m2_is_unbounded_array (struct type *type);
extern int m2_val_print (struct type *, const gdb_byte *, int, CORE_ADDR,
struct ui_file *, int, int, int,
--- gdb-cvs/src/gdb/m2-lang.c 2007-06-16 21:10:51.000000000 +0100
+++ gdb-cvs-modified/src/gdb/m2-lang.c 2007-07-26 00:44:38.000000000 +0100
@@ -189,6 +189,100 @@
fputs_filtered ("...", stream);
}
+static struct value *
+evaluate_subexp_modula2 (struct type *expect_type, struct expression *exp,
+ int *pos, enum noside noside)
+{
+ int pc = *pos;
+ int i;
+ char *name;
+ 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. */
@@ -428,6 +522,15 @@
= 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",
@@ -437,7 +540,7 @@
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,
--- gdb-cvs/src/gdb/m2-exp.y 2007-01-09 17:58:51.000000000 +0000
+++ gdb-cvs-modified/src/gdb/m2-exp.y 2007-07-25 21:16:14.000000000 +0100
@@ -174,6 +174,7 @@
%token <sval> TYPENAME
%token SIZE CAP ORD HIGH ABS MIN_FUNC MAX_FUNC FLOAT_FUNC VAL CHR ODD TRUNC
+%token TSIZE
%token INC DEC INCL EXCL
/* The GDB scope operator */
@@ -288,6 +289,10 @@
{ write_exp_elt_opcode (UNOP_TRUNC); }
;
+exp : TSIZE '(' exp ')'
+ { write_exp_elt_opcode (UNOP_SIZEOF); }
+ ;
+
exp : SIZE exp %prec UNARY
{ write_exp_elt_opcode (UNOP_SIZEOF); }
;
@@ -353,6 +358,10 @@
write_exp_elt_opcode (MULTI_SUBSCRIPT); }
;
+exp : exp '[' exp ']'
+ { write_exp_elt_opcode (BINOP_SUBSCRIPT); }
+ ;
+
exp : exp '('
/* This is to save the value of arglist_len
being accumulated by an outer function call. */
@@ -809,6 +818,7 @@
{"SIZE", SIZE },
{"FLOAT", FLOAT_FUNC },
{"TRUNC", TRUNC },
+ {"TSIZE", SIZE },
};