diff options
Diffstat (limited to 'gdb/ada-lang.c')
-rw-r--r-- | gdb/ada-lang.c | 158 |
1 files changed, 137 insertions, 21 deletions
diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index ee2f765..a34ba29 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -6009,6 +6009,15 @@ ada_tag_type (struct value *val) return ada_lookup_struct_elt_type (value_type (val), "_tag", 1, 0, NULL); } +/* Return 1 if TAG follows the old scheme for Ada tags (used for Ada 95, + retired at Ada 05). */ + +static int +is_ada95_tag (struct value *tag) +{ + return ada_value_struct_elt (tag, "tsd", 1) != NULL; +} + /* The value of the tag on VAL. */ struct value * @@ -6052,6 +6061,88 @@ type_from_tag (struct value *tag) return NULL; } +/* Given a value OBJ of a tagged type, return a value of this + type at the base address of the object. The base address, as + defined in Ada.Tags, it is the address of the primary tag of + the object, and therefore where the field values of its full + view can be fetched. */ + +struct value * +ada_tag_value_at_base_address (struct value *obj) +{ + volatile struct gdb_exception e; + struct value *val; + LONGEST offset_to_top = 0; + struct type *ptr_type, *obj_type; + struct value *tag; + CORE_ADDR base_address; + + obj_type = value_type (obj); + + /* It is the responsability of the caller to deref pointers. */ + + if (TYPE_CODE (obj_type) == TYPE_CODE_PTR + || TYPE_CODE (obj_type) == TYPE_CODE_REF) + return obj; + + tag = ada_value_tag (obj); + if (!tag) + return obj; + + /* Base addresses only appeared with Ada 05 and multiple inheritance. */ + + if (is_ada95_tag (tag)) + return obj; + + ptr_type = builtin_type (target_gdbarch ())->builtin_data_ptr; + ptr_type = lookup_pointer_type (ptr_type); + val = value_cast (ptr_type, tag); + if (!val) + return obj; + + /* It is perfectly possible that an exception be raised while + trying to determine the base address, just like for the tag; + see ada_tag_name for more details. We do not print the error + message for the same reason. */ + + TRY_CATCH (e, RETURN_MASK_ERROR) + { + offset_to_top = value_as_long (value_ind (value_ptradd (val, -2))); + } + + if (e.reason < 0) + return obj; + + /* If offset is null, nothing to do. */ + + if (offset_to_top == 0) + return obj; + + /* -1 is a special case in Ada.Tags; however, what should be done + is not quite clear from the documentation. So do nothing for + now. */ + + if (offset_to_top == -1) + return obj; + + base_address = value_address (obj) - offset_to_top; + tag = value_tag_from_contents_and_address (obj_type, NULL, base_address); + + /* Make sure that we have a proper tag at the new address. + Otherwise, offset_to_top is bogus (which can happen when + the object is not initialized yet). */ + + if (!tag) + return obj; + + obj_type = type_from_tag (tag); + + if (!obj_type) + return obj; + + return value_from_contents_and_address (obj_type, NULL, base_address); +} + /* Return the "ada__tags__type_specific_data" type. */ static struct type * @@ -6707,9 +6798,9 @@ ada_value_struct_elt (struct value *arg, char *name, int no_err) CORE_ADDR address; if (TYPE_CODE (t) == TYPE_CODE_PTR) - address = value_as_address (arg); + address = value_address (ada_value_ind (arg)); else - address = unpack_pointer (t, value_contents (arg)); + address = value_address (ada_coerce_ref (arg)); t1 = ada_to_fixed_type (ada_get_base_type (t1), NULL, address, NULL, 1); if (find_struct_field (name, t1, 0, @@ -6985,6 +7076,9 @@ ada_value_ind (struct value *val0) { struct value *val = value_ind (val0); + if (ada_is_tagged_type (value_type (val), 0)) + val = ada_tag_value_at_base_address (val); + return ada_to_fixed_value (val); } @@ -6999,6 +7093,10 @@ ada_coerce_ref (struct value *val0) struct value *val = val0; val = coerce_ref (val); + + if (ada_is_tagged_type (value_type (val), 0)) + val = ada_tag_value_at_base_address (val); + return ada_to_fixed_value (val); } else @@ -7982,14 +8080,20 @@ ada_to_fixed_type_1 (struct type *type, const gdb_byte *valaddr, if (check_tag && address != 0 && ada_is_tagged_type (static_type, 0)) { - struct type *real_type = - type_from_tag (value_tag_from_contents_and_address - (fixed_record_type, - valaddr, - address)); - + struct value *tag = + value_tag_from_contents_and_address + (fixed_record_type, + valaddr, + address); + struct type *real_type = type_from_tag (tag); + struct value *obj = + value_from_contents_and_address (fixed_record_type, + valaddr, + address); if (real_type != NULL) - return to_fixed_record_type (real_type, valaddr, address, NULL); + return to_fixed_record_type + (real_type, NULL, + value_address (ada_tag_value_at_base_address (obj)), NULL); } /* Check to see if there is a parallel ___XVZ variable. @@ -9692,19 +9796,31 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp, a fixed type would result in the loss of that type name, thus preventing us from printing the name of the ancestor type in the type description. */ - struct type *actual_type; - arg1 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_NORMAL); - actual_type = type_from_tag (ada_value_tag (arg1)); - if (actual_type == NULL) - /* If, for some reason, we were unable to determine - the actual type from the tag, then use the static - approximation that we just computed as a fallback. - This can happen if the debugging information is - incomplete, for instance. */ - actual_type = type; - - return value_zero (actual_type, not_lval); + + if (TYPE_CODE (type) != TYPE_CODE_REF) + { + struct type *actual_type; + + actual_type = type_from_tag (ada_value_tag (arg1)); + if (actual_type == NULL) + /* If, for some reason, we were unable to determine + the actual type from the tag, then use the static + approximation that we just computed as a fallback. + This can happen if the debugging information is + incomplete, for instance. */ + actual_type = type; + return value_zero (actual_type, not_lval); + } + else + { + /* In the case of a ref, ada_coerce_ref takes care + of determining the actual type. But the evaluation + should return a ref as it should be valid to ask + for its address; so rebuild a ref after coerce. */ + arg1 = ada_coerce_ref (arg1); + return value_ref (arg1); + } } *pos += 4; |