static struct type *ada_lookup_struct_elt_type (struct type *, char *,
int, int, int *);
-static struct value *evaluate_subexp (struct type *, struct expression *,
- int *, enum noside);
-
static struct value *evaluate_subexp_type (struct expression *, int *);
static int is_dynamic_field (struct type *, int);
static struct type *to_fixed_array_type (struct type *, struct value *, int);
static struct type *to_fixed_range_type (char *, struct value *,
- struct objfile *);
+ struct type *);
static struct type *to_static_fixed_type (struct type *);
static struct type *static_unwrap_type (struct type *type);
struct type *type;
arr = ada_coerce_ref (arr);
+
+ /* If our value is a pointer, then dererence it. Make sure that
+ this operation does not cause the target type to be fixed, as
+ this would indirectly cause this array to be decoded. The rest
+ of the routine assumes that the array hasn't been decoded yet,
+ so we use the basic "value_ind" routine to perform the dereferencing,
+ as opposed to using "ada_value_ind". */
if (TYPE_CODE (value_type (arr)) == TYPE_CODE_PTR)
- arr = ada_value_ind (arr);
+ arr = value_ind (arr);
type = decode_packed_array_type (value_type (arr));
if (type == NULL)
{
if (TYPE_CODE (elt_type) != TYPE_CODE_ARRAY)
error (_("too many subscripts (%d expected)"), k);
- elt = value_subscript (elt, value_pos_atr (builtin_type_int32, ind[k]));
+ elt = value_subscript (elt, pos_atr (ind[k]));
}
return elt;
}
for (k = 0; k < arity; k += 1)
{
LONGEST lwb, upb;
- struct value *idx;
if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
error (_("too many subscripts (%d expected)"), k);
arr = value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
value_copy (arr));
get_discrete_bounds (TYPE_INDEX_TYPE (type), &lwb, &upb);
- idx = value_pos_atr (builtin_type_int32, ind[k]);
- if (lwb != 0)
- idx = value_binop (idx, value_from_longest (value_type (idx), lwb),
- BINOP_SUB);
-
- arr = value_ptradd (arr, idx);
+ arr = value_ptradd (arr, pos_atr (ind[k]) - lwb);
type = TYPE_TARGET_TYPE (type);
}
}
/* The type of nth index in arrays of given type (n numbering from 1).
- Does not examine memory. */
+ Does not examine memory. Throws an error if N is invalid or TYPE
+ is not an array type. NAME is the name of the Ada attribute being
+ evaluated ('range, 'first, 'last, or 'length); it is used in building
+ the error message. */
-struct type *
-ada_index_type (struct type *type, int n)
+static struct type *
+ada_index_type (struct type *type, int n, const char *name)
{
struct type *result_type;
type = desc_base_type (type);
- if (n > ada_array_arity (type))
- return NULL;
+ if (n < 0 || n > ada_array_arity (type))
+ error (_("invalid dimension number to '%s"), name);
if (ada_is_simple_array_type (type))
{
/* FIXME: The stabs type r(0,0);bound;bound in an array type
has a target type of TYPE_CODE_UNDEF. We compensate here, but
perhaps stabsread.c would make more sense. */
- if (result_type == NULL || TYPE_CODE (result_type) == TYPE_CODE_UNDEF)
- result_type = builtin_type_int32;
-
- return result_type;
+ if (result_type && TYPE_CODE (result_type) == TYPE_CODE_UNDEF)
+ result_type = NULL;
}
else
- return desc_index_type (desc_bounds_type (type), n);
+ {
+ result_type = desc_index_type (desc_bounds_type (type), n);
+ if (result_type == NULL)
+ error (_("attempt to take bound of something that is not an array"));
+ }
+
+ return result_type;
}
/* Given that arr is an array type, returns the lower bound of the
Nth index (numbering from 1) if WHICH is 0, and the upper bound if
WHICH is 1. This returns bounds 0 .. -1 if ARR_TYPE is an
- array-descriptor type. If TYPEP is non-null, *TYPEP is set to the
- bounds type. It works for other arrays with bounds supplied by
- run-time quantities other than discriminants. */
+ array-descriptor type. It works for other arrays with bounds supplied
+ by run-time quantities other than discriminants. */
static LONGEST
-ada_array_bound_from_type (struct type * arr_type, int n, int which,
- struct type ** typep)
+ada_array_bound_from_type (struct type * arr_type, int n, int which)
{
- struct type *type, *index_type_desc, *index_type;
+ struct type *type, *elt_type, *index_type_desc, *index_type;
LONGEST retval;
+ int i;
gdb_assert (which == 0 || which == 1);
arr_type = decode_packed_array_type (arr_type);
if (arr_type == NULL || !ada_is_simple_array_type (arr_type))
- {
- if (typep != NULL)
- *typep = builtin_type_int32;
- return (LONGEST) - which;
- }
+ return (LONGEST) - which;
if (TYPE_CODE (arr_type) == TYPE_CODE_PTR)
type = TYPE_TARGET_TYPE (arr_type);
else
type = arr_type;
+ elt_type = type;
+ for (i = n; i > 1; i--)
+ elt_type = TYPE_TARGET_TYPE (type);
+
index_type_desc = ada_find_parallel_type (type, "___XA");
if (index_type_desc != NULL)
index_type = to_fixed_range_type (TYPE_FIELD_NAME (index_type_desc, n - 1),
- NULL, TYPE_OBJFILE (arr_type));
+ NULL, TYPE_INDEX_TYPE (elt_type));
else
- {
- while (n > 1)
- {
- type = TYPE_TARGET_TYPE (type);
- n -= 1;
- }
-
- index_type = TYPE_INDEX_TYPE (type);
- }
+ index_type = TYPE_INDEX_TYPE (elt_type);
switch (TYPE_CODE (index_type))
{
internal_error (__FILE__, __LINE__, _("invalid type code of index type"));
}
- if (typep != NULL)
- *typep = index_type;
-
return retval;
}
WHICH is 1. This routine will also work for arrays with bounds
supplied by run-time quantities other than discriminants. */
-struct value *
+static LONGEST
ada_array_bound (struct value *arr, int n, int which)
{
struct type *arr_type = value_type (arr);
if (ada_is_packed_array_type (arr_type))
return ada_array_bound (decode_packed_array (arr), n, which);
else if (ada_is_simple_array_type (arr_type))
- {
- struct type *type;
- LONGEST v = ada_array_bound_from_type (arr_type, n, which, &type);
- return value_from_longest (type, v);
- }
+ return ada_array_bound_from_type (arr_type, n, which);
else
- return desc_one_bound (desc_bounds (arr), n, which);
+ return value_as_long (desc_one_bound (desc_bounds (arr), n, which));
}
/* Given that arr is an array value, returns the length of the
Does not work for arrays indexed by enumeration types with representation
clauses at the moment. */
-static struct value *
+static LONGEST
ada_array_length (struct value *arr, int n)
{
struct type *arr_type = ada_check_typedef (value_type (arr));
return ada_array_length (decode_packed_array (arr), n);
if (ada_is_simple_array_type (arr_type))
- {
- struct type *type;
- LONGEST v =
- ada_array_bound_from_type (arr_type, n, 1, &type) -
- ada_array_bound_from_type (arr_type, n, 0, NULL) + 1;
- return value_from_longest (type, v);
- }
+ return (ada_array_bound_from_type (arr_type, n, 1)
+ - ada_array_bound_from_type (arr_type, n, 0) + 1);
else
- return
- value_from_longest (builtin_type_int32,
- value_as_long (desc_one_bound (desc_bounds (arr),
- n, 1))
- - value_as_long (desc_one_bound (desc_bounds (arr),
- n, 0)) + 1);
+ return (value_as_long (desc_one_bound (desc_bounds (arr), n, 1))
+ - value_as_long (desc_one_bound (desc_bounds (arr), n, 0)) + 1);
}
/* An empty array whose type is that of ARR_TYPE (an array type),
static void
resolve (struct expression **expp, int void_context_p)
{
- int pc;
- pc = 0;
- resolve_subexp (expp, &pc, 1, void_context_p ? builtin_type_void : NULL);
+ struct type *context_type = NULL;
+ int pc = 0;
+
+ if (void_context_p)
+ context_type = builtin_type ((*expp)->gdbarch)->builtin_void;
+
+ resolve_subexp (expp, &pc, 1, context_type);
}
/* Resolve the operator of the subexpression beginning at
int nsyms, struct value **args, int nargs,
const char *name, struct type *context_type)
{
+ int fallback;
int k;
int m; /* Number of hits */
- struct type *fallback;
- struct type *return_type;
-
- return_type = context_type;
- if (context_type == NULL)
- fallback = builtin_type_void;
- else
- fallback = NULL;
m = 0;
- while (1)
+ /* In the first pass of the loop, we only accept functions matching
+ context_type. If none are found, we add a second pass of the loop
+ where every function is accepted. */
+ for (fallback = 0; m == 0 && fallback < 2; fallback++)
{
for (k = 0; k < nsyms; k += 1)
{
struct type *type = ada_check_typedef (SYMBOL_TYPE (syms[k].sym));
if (ada_args_match (syms[k].sym, args, nargs)
- && return_match (type, return_type))
+ && (fallback || return_match (type, context_type)))
{
syms[m] = syms[k];
m += 1;
}
}
- if (m > 0 || return_type == fallback)
- break;
- else
- return_type = fallback;
}
if (m == 0)
for (i = ada_array_arity (ada_check_typedef (value_type (arr))); i > 0; i -= 1)
{
modify_general_field (value_contents_writeable (bounds),
- value_as_long (ada_array_bound (arr, i, 0)),
+ ada_array_bound (arr, i, 0),
desc_bound_bitpos (bounds_type, i, 0),
desc_bound_bitsize (bounds_type, i, 0));
modify_general_field (value_contents_writeable (bounds),
- value_as_long (ada_array_bound (arr, i, 1)),
+ ada_array_bound (arr, i, 1),
desc_bound_bitpos (bounds_type, i, 1),
desc_bound_bitsize (bounds_type, i, 1));
}
valp = value_cast (info_type, args->tag);
if (valp == NULL)
return 0;
- val = value_ind (value_ptradd (valp,
- value_from_longest (builtin_type_int8, -1)));
+ val = value_ind (value_ptradd (valp, -1));
if (val == NULL)
return 0;
val = ada_value_struct_elt (val, "expanded_name", 1);
/* Assuming that VAR_TYPE is a variant wrapper (type of the variant part)
whose discriminants are contained in the record type OUTER_TYPE,
- returns the type of the controlling discriminant for the variant. */
+ returns the type of the controlling discriminant for the variant.
+ May return NULL if the type could not be found. */
struct type *
ada_variant_discrim_type (struct type *var_type, struct type *outer_type)
{
char *name = ada_variant_discrim_name (var_type);
- struct type *type =
- ada_lookup_struct_elt_type (outer_type, name, 1, 1, NULL);
- if (type == NULL)
- return builtin_type_int32;
- else
- return type;
+ return ada_lookup_struct_elt_type (outer_type, name, 1, 1, NULL);
}
/* Assuming that TYPE is the type of a variant wrapper, and FIELD_NUM is a
}
else if (is_dynamic_field (type, f))
{
+ const gdb_byte *field_valaddr = valaddr;
+ CORE_ADDR field_address = address;
+ struct type *field_type =
+ TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, f));
+
if (dval0 == NULL)
{
/* rtype's length is computed based on the run-time
else
dval = dval0;
- /* Get the fixed type of the field. Note that, in this case, we
- do not want to get the real type out of the tag: if the current
- field is the parent part of a tagged record, we will get the
- tag of the object. Clearly wrong: the real type of the parent
- is not the real type of the child. We would end up in an infinite
- loop. */
- TYPE_FIELD_TYPE (rtype, f) =
- ada_to_fixed_type
- (ada_get_base_type
- (TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, f))),
- cond_offset_host (valaddr, off / TARGET_CHAR_BIT),
- cond_offset_target (address, off / TARGET_CHAR_BIT), dval, 0);
+ /* If the type referenced by this field is an aligner type, we need
+ to unwrap that aligner type, because its size might not be set.
+ Keeping the aligner type would cause us to compute the wrong
+ size for this field, impacting the offset of the all the fields
+ that follow this one. */
+ if (ada_is_aligner_type (field_type))
+ {
+ long field_offset = TYPE_FIELD_BITPOS (field_type, f);
+
+ field_valaddr = cond_offset_host (field_valaddr, field_offset);
+ field_address = cond_offset_target (field_address, field_offset);
+ field_type = ada_aligned_type (field_type);
+ }
+
+ field_valaddr = cond_offset_host (field_valaddr,
+ off / TARGET_CHAR_BIT);
+ field_address = cond_offset_target (field_address,
+ off / TARGET_CHAR_BIT);
+
+ /* Get the fixed type of the field. Note that, in this case,
+ we do not want to get the real type out of the tag: if
+ the current field is the parent part of a tagged record,
+ we will get the tag of the object. Clearly wrong: the real
+ type of the parent is not the real type of the child. We
+ would end up in an infinite loop. */
+ field_type = ada_get_base_type (field_type);
+ field_type = ada_to_fixed_type (field_type, field_valaddr,
+ field_address, dval, 0);
+
+ TYPE_FIELD_TYPE (rtype, f) = field_type;
TYPE_FIELD_NAME (rtype, f) = TYPE_FIELD_NAME (type, f);
bit_incr = fld_bit_len =
TYPE_LENGTH (TYPE_FIELD_TYPE (rtype, f)) * TARGET_CHAR_BIT;
{
struct type *index_type_desc;
struct type *result;
+ int packed_array_p;
- if (ada_is_packed_array_type (type0) /* revisit? */
- || TYPE_FIXED_INSTANCE (type0))
+ if (TYPE_FIXED_INSTANCE (type0))
return type0;
+ packed_array_p = ada_is_packed_array_type (type0);
+ if (packed_array_p)
+ type0 = decode_packed_array_type (type0);
+
index_type_desc = ada_find_parallel_type (type0, "___XA");
if (index_type_desc == NULL)
{
consult the object tag. */
struct type *elt_type = ada_to_fixed_type (elt_type0, 0, 0, dval, 1);
- if (elt_type0 == elt_type)
+ /* Make sure we always create a new array type when dealing with
+ packed array types, since we're going to fix-up the array
+ type length and element bitsize a little further down. */
+ if (elt_type0 == elt_type && !packed_array_p)
result = type0;
else
result = create_array_type (alloc_type (TYPE_OBJFILE (type0)),
consult the object tag. */
result =
ada_to_fixed_type (ada_check_typedef (elt_type0), 0, 0, dval, 1);
+
+ elt_type0 = type0;
for (i = TYPE_NFIELDS (index_type_desc) - 1; i >= 0; i -= 1)
{
struct type *range_type =
to_fixed_range_type (TYPE_FIELD_NAME (index_type_desc, i),
- dval, TYPE_OBJFILE (type0));
- result = create_array_type (alloc_type (TYPE_OBJFILE (type0)),
+ dval, TYPE_INDEX_TYPE (elt_type0));
+ result = create_array_type (alloc_type (TYPE_OBJFILE (elt_type0)),
result, range_type);
+ elt_type0 = TYPE_TARGET_TYPE (elt_type0);
}
if (!ignore_too_big && TYPE_LENGTH (result) > varsize_limit)
error (_("array type with dynamic size is larger than varsize-limit"));
}
+ if (packed_array_p)
+ {
+ /* So far, the resulting type has been created as if the original
+ type was a regular (non-packed) array type. As a result, the
+ bitsize of the array elements needs to be set again, and the array
+ length needs to be recomputed based on that bitsize. */
+ int len = TYPE_LENGTH (result) / TYPE_LENGTH (TYPE_TARGET_TYPE (result));
+ int elt_bitsize = TYPE_FIELD_BITSIZE (type0, 0);
+
+ TYPE_FIELD_BITSIZE (result, 0) = TYPE_FIELD_BITSIZE (type0, 0);
+ TYPE_LENGTH (result) = len * elt_bitsize / HOST_CHAR_BIT;
+ if (TYPE_LENGTH (result) * HOST_CHAR_BIT < len * elt_bitsize)
+ TYPE_LENGTH (result)++;
+ }
+
TYPE_FIXED_INSTANCE (result) = 1;
return result;
}
if (raw_type == NULL || TYPE_CODE (raw_type) != TYPE_CODE_STRUCT)
return raw_type;
+ if (ada_is_aligner_type (raw_type))
+ /* The encoding specifies that we should always use the aligner type.
+ So, even if this aligner type has an associated XVS type, we should
+ simply ignore it.
+
+ According to the compiler gurus, an XVS type parallel to an aligner
+ type may exist because of a stabs limitation. In stabs, aligner
+ types are empty because the field has a variable-sized type, and
+ thus cannot actually be used as an aligner type. As a result,
+ we need the associated parallel XVS type to decode the type.
+ Since the policy in the compiler is to not change the internal
+ representation based on the debugging info format, we sometimes
+ end up having a redundant XVS type parallel to the aligner type. */
+ return raw_type;
+
real_type_namer = ada_find_parallel_type (raw_type, "___XVS");
if (real_type_namer == NULL
|| TYPE_CODE (real_type_namer) != TYPE_CODE_STRUCT
}
}
-static struct value *
-evaluate_subexp (struct type *expect_type, struct expression *exp, int *pos,
- enum noside noside)
-{
- return (*exp->language_defn->la_exp_desc->evaluate_exp)
- (expect_type, exp, pos, noside);
-}
-
/* Evaluate the subexpression of EXP starting at *POS as for
evaluate_type, updating *POS to point just past the evaluated
expression. */
static struct value *
evaluate_subexp_type (struct expression *exp, int *pos)
{
- return (*exp->language_defn->la_exp_desc->evaluate_exp)
- (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
+ return evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
}
/* If VAL is wrapped in an aligner or subtype wrapper, return the
return value_cast (type, arg2);
}
+/* Evaluating Ada expressions, and printing their result.
+ ------------------------------------------------------
+
+ We usually evaluate an Ada expression in order to print its value.
+ We also evaluate an expression in order to print its type, which
+ happens during the EVAL_AVOID_SIDE_EFFECTS phase of the evaluation,
+ but we'll focus mostly on the EVAL_NORMAL phase. In practice, the
+ EVAL_AVOID_SIDE_EFFECTS phase allows us to simplify certain aspects of
+ the evaluation compared to the EVAL_NORMAL, but is otherwise very
+ similar.
+
+ Evaluating expressions is a little more complicated for Ada entities
+ than it is for entities in languages such as C. The main reason for
+ this is that Ada provides types whose definition might be dynamic.
+ One example of such types is variant records. Or another example
+ would be an array whose bounds can only be known at run time.
+
+ The following description is a general guide as to what should be
+ done (and what should NOT be done) in order to evaluate an expression
+ involving such types, and when. This does not cover how the semantic
+ information is encoded by GNAT as this is covered separatly. For the
+ document used as the reference for the GNAT encoding, see exp_dbug.ads
+ in the GNAT sources.
+
+ Ideally, we should embed each part of this description next to its
+ associated code. Unfortunately, the amount of code is so vast right
+ now that it's hard to see whether the code handling a particular
+ situation might be duplicated or not. One day, when the code is
+ cleaned up, this guide might become redundant with the comments
+ inserted in the code, and we might want to remove it.
+
+ When evaluating Ada expressions, the tricky issue is that they may
+ reference entities whose type contents and size are not statically
+ known. Consider for instance a variant record:
+
+ type Rec (Empty : Boolean := True) is record
+ case Empty is
+ when True => null;
+ when False => Value : Integer;
+ end case;
+ end record;
+ Yes : Rec := (Empty => False, Value => 1);
+ No : Rec := (empty => True);
+
+ The size and contents of that record depends on the value of the
+ descriminant (Rec.Empty). At this point, neither the debugging
+ information nor the associated type structure in GDB are able to
+ express such dynamic types. So what the debugger does is to create
+ "fixed" versions of the type that applies to the specific object.
+ We also informally refer to this opperation as "fixing" an object,
+ which means creating its associated fixed type.
+
+ Example: when printing the value of variable "Yes" above, its fixed
+ type would look like this:
+
+ type Rec is record
+ Empty : Boolean;
+ Value : Integer;
+ end record;
+
+ On the other hand, if we printed the value of "No", its fixed type
+ would become:
+
+ type Rec is record
+ Empty : Boolean;
+ end record;
+
+ Things become a little more complicated when trying to fix an entity
+ with a dynamic type that directly contains another dynamic type,
+ such as an array of variant records, for instance. There are
+ two possible cases: Arrays, and records.
+
+ Arrays are a little simpler to handle, because the same amount of
+ memory is allocated for each element of the array, even if the amount
+ of space used by each element changes from element to element.
+ Consider for instance the following array of type Rec:
+
+ type Rec_Array is array (1 .. 2) of Rec;
+
+ The type structure in GDB describes an array in terms of its
+ bounds, and the type of its elements. By design, all elements
+ in the array have the same type. So we cannot use a fixed type
+ for the array elements in this case, since the fixed type depends
+ on the actual value of each element.
+
+ Fortunately, what happens in practice is that each element of
+ the array has the same size, which is the maximum size that
+ might be needed in order to hold an object of the element type.
+ And the compiler shows it in the debugging information by wrapping
+ the array element inside a private PAD type. This type should not
+ be shown to the user, and must be "unwrap"'ed before printing. Note
+ that we also use the adjective "aligner" in our code to designate
+ these wrapper types.
+
+ These wrapper types should have a constant size, which is the size
+ of each element of the array. In the case when the size is statically
+ known, the PAD type will already have the right size, and the array
+ element type should remain unfixed. But there are cases when
+ this size is not statically known. For instance, assuming that
+ "Five" is an integer variable:
+
+ type Dynamic is array (1 .. Five) of Integer;
+ type Wrapper (Has_Length : Boolean := False) is record
+ Data : Dynamic;
+ case Has_Length is
+ when True => Length : Integer;
+ when False => null;
+ end case;
+ end record;
+ type Wrapper_Array is array (1 .. 2) of Wrapper;
+
+ Hello : Wrapper_Array := (others => (Has_Length => True,
+ Data => (others => 17),
+ Length => 1));
+
+
+ The debugging info would describe variable Hello as being an
+ array of a PAD type. The size of that PAD type is not statically
+ known, but can be determined using a parallel XVZ variable.
+ In that case, a copy of the PAD type with the correct size should
+ be used for the fixed array.
+
+ However, things are slightly different in the case of dynamic
+ record types. In this case, in order to compute the associated
+ fixed type, we need to determine the size and offset of each of
+ its components. This, in turn, requires us to compute the fixed
+ type of each of these components.
+
+ Consider for instance the example:
+
+ type Bounded_String (Max_Size : Natural) is record
+ Str : String (1 .. Max_Size);
+ Length : Natural;
+ end record;
+ My_String : Bounded_String (Max_Size => 10);
+
+ In that case, the position of field "Length" depends on the size
+ of field Str, which itself depends on the value of the Max_Size
+ discriminant. In order to fix the type of variable My_String,
+ we need to fix the type of field Str. Therefore, fixing a variant
+ record requires us to fix each of its components.
+
+ However, if a component does not have a dynamic size, the component
+ should not be fixed. In particular, fields that use a PAD type
+ should not fixed. Here is an example where this might happen
+ (assuming type Rec above):
+
+ type Container (Big : Boolean) is record
+ First : Rec;
+ After : Integer;
+ case Big is
+ when True => Another : Integer;
+ when False => null;
+ end case;
+ end record;
+ My_Container : Container := (Big => False,
+ First => (Empty => True),
+ After => 42);
+
+ In that example, the compiler creates a PAD type for component First,
+ whose size is constant, and then positions the component After just
+ right after it. The offset of component After is therefore constant
+ in this case.
+
+ The debugger computes the position of each field based on an algorithm
+ that uses, among other things, the actual position and size of the field
+ preceding it. Let's now imagine that the user is trying to print the
+ value of My_Container. If the type fixing was recursive, we would
+ end up computing the offset of field After based on the size of the
+ fixed version of field First. And since in our example First has
+ only one actual field, the size of the fixed type is actually smaller
+ than the amount of space allocated to that field, and thus we would
+ compute the wrong offset of field After.
+
+ Unfortunately, we need to watch out for dynamic components of variant
+ records (identified by the ___XVL suffix in the component name).
+ Even if the target type is a PAD type, the size of that type might
+ not be statically known. So the PAD type needs to be unwrapped and
+ the resulting type needs to be fixed. Otherwise, we might end up
+ with the wrong size for our component. This can be observed with
+ the following type declarations:
+
+ type Octal is new Integer range 0 .. 7;
+ type Octal_Array is array (Positive range <>) of Octal;
+ pragma Pack (Octal_Array);
+
+ type Octal_Buffer (Size : Positive) is record
+ Buffer : Octal_Array (1 .. Size);
+ Length : Integer;
+ end record;
+
+ In that case, Buffer is a PAD type whose size is unset and needs
+ to be computed by fixing the unwrapped type.
+
+ Lastly, when should the sub-elements of a type that remained unfixed
+ thus far, be actually fixed?
+
+ The answer is: Only when referencing that element. For instance
+ when selecting one component of a record, this specific component
+ should be fixed at that point in time. Or when printing the value
+ of a record, each component should be fixed before its value gets
+ printed. Similarly for arrays, the element of the array should be
+ fixed when printing each element of the array, or when extracting
+ one element out of that array. On the other hand, fixing should
+ not be performed on the elements when taking a slice of an array!
+
+ Note that one of the side-effects of miscomputing the offset and
+ size of each field is that we end up also miscomputing the size
+ of the containing type. This can have adverse results when computing
+ the value of an entity. GDB fetches the value of an entity based
+ on the size of its type, and thus a wrong size causes GDB to fetch
+ the wrong amount of memory. In the case where the computed size is
+ too small, GDB fetches too little data to print the value of our
+ entiry. Results in this case as unpredicatble, as we usually read
+ past the buffer containing the data =:-o. */
+
+/* Implement the evaluate_exp routine in the exp_descriptor structure
+ for the Ada language. */
+
static struct value *
ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
int *pos, enum noside noside)
}
else
{
- arg1 =
- unwrap_value (evaluate_subexp_standard
- (expect_type, exp, pos, noside));
+ arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
+ arg1 = unwrap_value (arg1);
return ada_to_fixed_value (arg1);
}
if (ada_is_packed_array_type (desc_base_type (value_type (argvec[0]))))
argvec[0] = ada_coerce_to_simple_array (argvec[0]);
+ else if (TYPE_CODE (value_type (argvec[0])) == TYPE_CODE_ARRAY
+ && TYPE_FIELD_BITSIZE (value_type (argvec[0]), 0) != 0)
+ /* This is a packed array that has already been fixed, and
+ therefore already coerced to a simple array. Nothing further
+ to do. */
+ ;
else if (TYPE_CODE (value_type (argvec[0])) == TYPE_CODE_REF
|| (TYPE_CODE (value_type (argvec[0])) == TYPE_CODE_ARRAY
&& VALUE_LVAL (argvec[0]) == lval_memory))
tem = longest_to_int (exp->elts[pc + 1].longconst);
- if (tem < 1 || tem > ada_array_arity (value_type (arg2)))
- error (_("invalid dimension number to 'range"));
+ type = ada_index_type (value_type (arg2), tem, "range");
+ if (!type)
+ type = value_type (arg1);
- arg3 = ada_array_bound (arg2, tem, 1);
- arg2 = ada_array_bound (arg2, tem, 0);
+ arg3 = value_from_longest (type, ada_array_bound (arg2, tem, 1));
+ arg2 = value_from_longest (type, ada_array_bound (arg2, tem, 0));
binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg3);
if (ada_is_packed_array_type (value_type (arg1)))
arg1 = ada_coerce_to_simple_array (arg1);
- if (tem < 1 || tem > ada_array_arity (value_type (arg1)))
- error (_("invalid dimension number to '%s"),
- ada_attribute_name (op));
+ type = ada_index_type (value_type (arg1), tem,
+ ada_attribute_name (op));
+ if (type == NULL)
+ type = builtin_type (exp->gdbarch)->builtin_int;
if (noside == EVAL_AVOID_SIDE_EFFECTS)
- {
- type = ada_index_type (value_type (arg1), tem);
- if (type == NULL)
- error
- (_("attempt to take bound of something that is not an array"));
- return allocate_value (type);
- }
+ return allocate_value (type);
switch (op)
{
default: /* Should never happen. */
error (_("unexpected attribute encountered"));
case OP_ATR_FIRST:
- return ada_array_bound (arg1, tem, 0);
+ return value_from_longest
+ (type, ada_array_bound (arg1, tem, 0));
case OP_ATR_LAST:
- return ada_array_bound (arg1, tem, 1);
+ return value_from_longest
+ (type, ada_array_bound (arg1, tem, 1));
case OP_ATR_LENGTH:
- return ada_array_length (arg1, tem);
+ return value_from_longest
+ (type, ada_array_length (arg1, tem));
}
}
else if (discrete_type_p (type_arg))
char *name = ada_type_name (type_arg);
range_type = NULL;
if (name != NULL && TYPE_CODE (type_arg) != TYPE_CODE_ENUM)
- range_type =
- to_fixed_range_type (name, NULL, TYPE_OBJFILE (type_arg));
+ range_type = to_fixed_range_type (name, NULL, type_arg);
if (range_type == NULL)
range_type = type_arg;
switch (op)
if (ada_is_packed_array_type (type_arg))
type_arg = decode_packed_array_type (type_arg);
- if (tem < 1 || tem > ada_array_arity (type_arg))
- error (_("invalid dimension number to '%s"),
- ada_attribute_name (op));
-
- type = ada_index_type (type_arg, tem);
+ type = ada_index_type (type_arg, tem, ada_attribute_name (op));
if (type == NULL)
- error
- (_("attempt to take bound of something that is not an array"));
+ type = builtin_type (exp->gdbarch)->builtin_int;
+
if (noside == EVAL_AVOID_SIDE_EFFECTS)
return allocate_value (type);
default:
error (_("unexpected attribute encountered"));
case OP_ATR_FIRST:
- low = ada_array_bound_from_type (type_arg, tem, 0, &type);
+ low = ada_array_bound_from_type (type_arg, tem, 0);
return value_from_longest (type, low);
case OP_ATR_LAST:
- high = ada_array_bound_from_type (type_arg, tem, 1, &type);
+ high = ada_array_bound_from_type (type_arg, tem, 1);
return value_from_longest (type, high);
case OP_ATR_LENGTH:
- low = ada_array_bound_from_type (type_arg, tem, 0, &type);
- high = ada_array_bound_from_type (type_arg, tem, 1, NULL);
+ low = ada_array_bound_from_type (type_arg, tem, 0);
+ high = ada_array_bound_from_type (type_arg, tem, 1);
return value_from_longest (type, high - low + 1);
}
}
in some extension of the type. Return an object of
"type" void, which will match any formal
(see ada_type_match). */
- return value_zero (builtin_type_void, lval_memory);
+ return value_zero (builtin_type (exp->gdbarch)->builtin_void,
+ lval_memory);
}
else
type =
return value_zero (ada_aligned_type (type), lval_memory);
}
else
- return
- ada_to_fixed_value (unwrap_value
- (ada_value_struct_elt
- (arg1, &exp->elts[pc + 2].string, 0)));
+ arg1 = ada_value_struct_elt (arg1, &exp->elts[pc + 2].string, 0);
+ arg1 = unwrap_value (arg1);
+ return ada_to_fixed_value (arg1);
+
case OP_TYPE:
/* The value is not supposed to be used. This is here to make it
easier to accommodate expressions that contain types. */
/* Return a range type whose base type is that of the range type named
NAME in the current environment, and whose bounds are calculated
from NAME according to the GNAT range encoding conventions.
- Extract discriminant values, if needed, from DVAL. If a new type
- must be created, allocate in OBJFILE's space. The bounds
- information, in general, is encoded in NAME, the base type given in
- the named range type. */
+ Extract discriminant values, if needed, from DVAL. ORIG_TYPE is the
+ corresponding range type from debug information; fall back to using it
+ if symbol lookup fails. If a new type must be created, allocate it
+ like ORIG_TYPE was. The bounds information, in general, is encoded
+ in NAME, the base type given in the named range type. */
static struct type *
-to_fixed_range_type (char *name, struct value *dval, struct objfile *objfile)
+to_fixed_range_type (char *name, struct value *dval, struct type *orig_type)
{
struct type *raw_type = ada_find_any_type (name);
struct type *base_type;
char *subtype_info;
- /* Also search primitive types if type symbol could not be found. */
+ /* Fall back to the original type if symbol lookup failed. */
if (raw_type == NULL)
- raw_type = language_lookup_primitive_type_by_name
- (language_def (language_ada), current_gdbarch, name);
+ raw_type = orig_type;
- if (raw_type == NULL)
- base_type = builtin_type_int32;
- else if (TYPE_CODE (raw_type) == TYPE_CODE_RANGE)
+ if (TYPE_CODE (raw_type) == TYPE_CODE_RANGE)
base_type = TYPE_TARGET_TYPE (raw_type);
else
base_type = raw_type;
if (L < INT_MIN || U > INT_MAX)
return raw_type;
else
- return create_range_type (alloc_type (objfile), raw_type,
+ return create_range_type (alloc_type (TYPE_OBJFILE (orig_type)),
+ raw_type,
discrete_type_low_bound (raw_type),
discrete_type_high_bound (raw_type));
}
}
}
- if (objfile == NULL)
- objfile = TYPE_OBJFILE (base_type);
- type = create_range_type (alloc_type (objfile), base_type, L, U);
+ type = create_range_type (alloc_type (TYPE_OBJFILE (orig_type)),
+ base_type, L, U);
TYPE_NAME (type) = name;
return type;
}
projects / deliverable / binutils-gdb.git / blobdiff