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);
{
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
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"));
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 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