/* Ada language support routines for GDB, the GNU debugger.
- Copyright (C) 1992-2020 Free Software Foundation, Inc.
+ Copyright (C) 1992-2021 Free Software Foundation, Inc.
This file is part of GDB.
#include "gdbsupport/function-view.h"
#include "gdbsupport/byte-vector.h"
#include <algorithm>
+#include "ada-exp.h"
/* Define whether or not the C operator '/' truncates towards zero for
differently signed operands (truncation direction is undefined in C).
static struct value *make_array_descriptor (struct type *, struct value *);
-static void ada_add_block_symbols (struct obstack *,
+static void ada_add_block_symbols (std::vector<struct block_symbol> &,
const struct block *,
const lookup_name_info &lookup_name,
domain_enum, struct objfile *);
-static void ada_add_all_symbols (struct obstack *, const struct block *,
+static void ada_add_all_symbols (std::vector<struct block_symbol> &,
+ const struct block *,
const lookup_name_info &lookup_name,
domain_enum, int, int *);
-static int is_nonfunction (struct block_symbol *, int);
+static int is_nonfunction (const std::vector<struct block_symbol> &);
-static void add_defn_to_vec (struct obstack *, struct symbol *,
+static void add_defn_to_vec (std::vector<struct block_symbol> &,
+ struct symbol *,
const struct block *);
-static int num_defns_collected (struct obstack *);
-
-static struct block_symbol *defns_collected (struct obstack *, int);
-
static struct value *resolve_subexp (expression_up *, int *, int,
struct type *, int,
innermost_block_tracker *);
static int possible_user_operator_p (enum exp_opcode, struct value **);
-static const char *ada_op_name (enum exp_opcode);
-
static const char *ada_decoded_op_name (enum exp_opcode);
static int numeric_type_p (struct type *);
static struct value *decode_constrained_packed_array (struct value *);
-static int ada_is_packed_array_type (struct type *);
-
static int ada_is_unconstrained_packed_array_type (struct type *);
static struct value *value_subscript_packed (struct value *, int,
static struct value *val_atr (struct type *, LONGEST);
-static struct value *value_val_atr (struct type *, struct value *);
-
static struct symbol *standard_lookup (const char *, const struct block *,
domain_enum);
static int find_struct_field (const char *, struct type *, int,
struct type **, int *, int *, int *, int *);
-static int ada_resolve_function (struct block_symbol *, int,
+static int ada_resolve_function (std::vector<struct block_symbol> &,
struct value **, int, const char *,
struct type *, int);
struct expression *,
int *, enum noside);
-static void aggregate_assign_from_choices (struct value *, struct value *,
+static void aggregate_assign_from_choices (struct value *, struct value *,
struct expression *,
- int *, LONGEST *, int *,
- int, LONGEST, LONGEST);
+ int *, std::vector<LONGEST> &,
+ LONGEST, LONGEST);
static void aggregate_assign_positional (struct value *, struct value *,
struct expression *,
- int *, LONGEST *, int *, int,
+ int *, std::vector<LONGEST> &,
LONGEST, LONGEST);
static void aggregate_assign_others (struct value *, struct value *,
struct expression *,
- int *, LONGEST *, int, LONGEST, LONGEST);
+ int *, std::vector<LONGEST> &,
+ LONGEST, LONGEST);
-static void add_component_interval (LONGEST, LONGEST, LONGEST *, int *, int);
+static void add_component_interval (LONGEST, LONGEST, std::vector<LONGEST> &);
static struct value *ada_evaluate_subexp (struct type *, struct expression *,
struct ada_symbol_cache
{
/* An obstack used to store the entries in our cache. */
- struct obstack cache_space;
+ struct auto_obstack cache_space;
/* The root of the hash table used to implement our symbol cache. */
- struct cache_entry *root[HASH_SIZE];
+ struct cache_entry *root[HASH_SIZE] {};
};
-static void ada_free_symbol_cache (struct ada_symbol_cache *sym_cache);
-
/* Maximum-sized dynamic type. */
static unsigned int varsize_limit;
/* This module's per-program-space data. */
struct ada_pspace_data
{
- ~ada_pspace_data ()
- {
- if (sym_cache != NULL)
- ada_free_symbol_cache (sym_cache);
- }
-
/* The Ada symbol cache. */
- struct ada_symbol_cache *sym_cache = nullptr;
+ std::unique_ptr<ada_symbol_cache> sym_cache;
};
/* Key to our per-program-space data. */
return string_printf ("<%s>", str);
}
-/* Assuming V points to an array of S objects, make sure that it contains at
- least M objects, updating V and S as necessary. */
-
-#define GROW_VECT(v, s, m) \
- if ((s) < (m)) (v) = (char *) grow_vect (v, &(s), m, sizeof *(v));
-
-/* Assuming VECT points to an array of *SIZE objects of size
- ELEMENT_SIZE, grow it to contain at least MIN_SIZE objects,
- updating *SIZE as necessary and returning the (new) array. */
-
-static void *
-grow_vect (void *vect, size_t *size, size_t min_size, int element_size)
-{
- if (*size < min_size)
- {
- *size *= 2;
- if (*size < min_size)
- *size = min_size;
- vect = xrealloc (vect, *size * element_size);
- }
- return vect;
-}
-
/* True (non-zero) iff TARGET matches FIELD_NAME up to any trailing
suffix of FIELD_NAME beginning "___". */
trying to allocate some memory for it. */
ada_ensure_varsize_limit (type);
- if (value_lazy (val)
- || TYPE_LENGTH (type) > TYPE_LENGTH (value_type (val)))
+ if (value_optimized_out (val))
+ result = allocate_optimized_out_value (type);
+ else if (value_lazy (val)
+ /* Be careful not to make a lazy not_lval value. */
+ || (VALUE_LVAL (val) != not_lval
+ && TYPE_LENGTH (type) > TYPE_LENGTH (value_type (val))))
result = allocate_value_lazy (type);
else
{
result = allocate_value (type);
- value_contents_copy_raw (result, 0, val, 0, TYPE_LENGTH (type));
+ value_contents_copy (result, 0, val, 0, TYPE_LENGTH (type));
}
set_value_component_location (result, val);
set_value_bitsize (result, value_bitsize (val));
quotes, unfolded, but with the quotes stripped away. Result good
to next call. */
-static char *
+static const char *
ada_fold_name (gdb::string_view name)
{
- static char *fold_buffer = NULL;
- static size_t fold_buffer_size = 0;
-
- int len = name.size ();
- GROW_VECT (fold_buffer, fold_buffer_size, len + 1);
+ static std::string fold_storage;
- if (name[0] == '\'')
- {
- strncpy (fold_buffer, name.data () + 1, len - 2);
- fold_buffer[len - 2] = '\000';
- }
+ if (!name.empty () && name[0] == '\'')
+ fold_storage = gdb::to_string (name.substr (1, name.size () - 2));
else
{
- int i;
-
- for (i = 0; i <= len; i += 1)
- fold_buffer[i] = tolower (name[i]);
+ fold_storage = gdb::to_string (name);
+ for (int i = 0; i < name.size (); i += 1)
+ fold_storage[i] = tolower (fold_storage[i]);
}
- return fold_buffer;
+ return fold_storage.c_str ();
}
/* Return nonzero if C is either a digit or a lowercase alphabet character. */
/* Non-zero iff TYPE represents a standard GNAT packed-array type. */
static int
-ada_is_packed_array_type (struct type *type)
+ada_is_gnat_encoded_packed_array_type (struct type *type)
{
if (type == NULL)
return 0;
int
ada_is_constrained_packed_array_type (struct type *type)
{
- return ada_is_packed_array_type (type)
+ return ada_is_gnat_encoded_packed_array_type (type)
&& !ada_is_array_descriptor_type (type);
}
static int
ada_is_unconstrained_packed_array_type (struct type *type)
{
- return ada_is_packed_array_type (type)
- && ada_is_array_descriptor_type (type);
+ if (!ada_is_array_descriptor_type (type))
+ return 0;
+
+ if (ada_is_gnat_encoded_packed_array_type (type))
+ return 1;
+
+ /* If we saw GNAT encodings, then the above code is sufficient.
+ However, with minimal encodings, we will just have a thick
+ pointer instead. */
+ if (is_thick_pntr (type))
+ {
+ type = desc_base_type (type);
+ /* The structure's first field is a pointer to an array, so this
+ fetches the array type. */
+ type = TYPE_TARGET_TYPE (type->field (0).type ());
+ /* Now we can see if the array elements are packed. */
+ return TYPE_FIELD_BITSIZE (type, 0) > 0;
+ }
+
+ return 0;
+}
+
+/* Return true if TYPE is a (Gnat-encoded) constrained packed array
+ type, or if it is an ordinary (non-Gnat-encoded) packed array. */
+
+static bool
+ada_is_any_packed_array_type (struct type *type)
+{
+ return (ada_is_constrained_packed_array_type (type)
+ || (type->code () == TYPE_CODE_ARRAY
+ && TYPE_FIELD_BITSIZE (type, 0) % 8 != 0));
}
/* Given that TYPE encodes a packed array type (constrained or unconstrained),
return 0;
tail = strstr (raw_name, "___XP");
- gdb_assert (tail != NULL);
+ if (tail == nullptr)
+ {
+ gdb_assert (is_thick_pntr (type));
+ /* The structure's first field is a pointer to an array, so this
+ fetches the array type. */
+ type = TYPE_TARGET_TYPE (type->field (0).type ());
+ /* Now we can see if the array elements are packed. */
+ return TYPE_FIELD_BITSIZE (type, 0);
+ }
if (sscanf (tail + sizeof ("___XP") - 1, "%ld", &bits) != 1)
{
if ((check_typedef (index_type)->code () == TYPE_CODE_RANGE
&& is_dynamic_type (check_typedef (index_type)))
- || get_discrete_bounds (index_type, &low_bound, &high_bound) < 0)
+ || !get_discrete_bounds (index_type, &low_bound, &high_bound))
low_bound = high_bound = 0;
if (high_bound < low_bound)
*elt_bits = TYPE_LENGTH (new_type) = 0;
return constrained_packed_array_type (shadow_type, &bits);
}
+/* Helper function for decode_constrained_packed_array. Set the field
+ bitsize on a series of packed arrays. Returns the number of
+ elements in TYPE. */
+
+static LONGEST
+recursively_update_array_bitsize (struct type *type)
+{
+ gdb_assert (type->code () == TYPE_CODE_ARRAY);
+
+ LONGEST low, high;
+ if (!get_discrete_bounds (type->index_type (), &low, &high)
+ || low > high)
+ return 0;
+ LONGEST our_len = high - low + 1;
+
+ struct type *elt_type = TYPE_TARGET_TYPE (type);
+ if (elt_type->code () == TYPE_CODE_ARRAY)
+ {
+ LONGEST elt_len = recursively_update_array_bitsize (elt_type);
+ LONGEST elt_bitsize = elt_len * TYPE_FIELD_BITSIZE (elt_type, 0);
+ TYPE_FIELD_BITSIZE (type, 0) = elt_bitsize;
+
+ TYPE_LENGTH (type) = ((our_len * elt_bitsize + HOST_CHAR_BIT - 1)
+ / HOST_CHAR_BIT);
+ }
+
+ return our_len;
+}
+
/* Given that ARR is a struct value *indicating a GNAT constrained packed
array, returns a simple array that denotes that array. Its type is a
standard GDB array type except that the BITSIZEs of the array
return NULL;
}
+ /* Decoding the packed array type could not correctly set the field
+ bitsizes for any dimension except the innermost, because the
+ bounds may be variable and were not passed to that function. So,
+ we further resolve the array bounds here and then update the
+ sizes. */
+ const gdb_byte *valaddr = value_contents_for_printing (arr);
+ CORE_ADDR address = value_address (arr);
+ gdb::array_view<const gdb_byte> view
+ = gdb::make_array_view (valaddr, TYPE_LENGTH (type));
+ type = resolve_dynamic_type (type, view, address);
+ recursively_update_array_bitsize (type);
+
if (type_byte_order (value_type (arr)) == BFD_ENDIAN_BIG
&& ada_is_modular_type (value_type (arr)))
{
LONGEST lowerbound, upperbound;
LONGEST idx;
- if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
+ if (!get_discrete_bounds (range_type, &lowerbound, &upperbound))
{
lim_warning (_("don't know bounds of array"));
lowerbound = upperbound = 0;
type0->dyn_prop (DYN_PROP_BYTE_STRIDE),
TYPE_FIELD_BITSIZE (type0, 0));
int base_low = ada_discrete_type_low_bound (type0->index_type ());
- LONGEST base_low_pos, low_pos;
+ gdb::optional<LONGEST> base_low_pos, low_pos;
CORE_ADDR base;
- if (!discrete_position (base_index_type, low, &low_pos)
- || !discrete_position (base_index_type, base_low, &base_low_pos))
+ low_pos = discrete_position (base_index_type, low);
+ base_low_pos = discrete_position (base_index_type, base_low);
+
+ if (!low_pos.has_value () || !base_low_pos.has_value ())
{
warning (_("unable to get positions in slice, use bounds instead"));
low_pos = low;
base_low_pos = base_low;
}
- base = value_as_address (array_ptr)
- + ((low_pos - base_low_pos)
- * TYPE_LENGTH (TYPE_TARGET_TYPE (type0)));
+ ULONGEST stride = TYPE_FIELD_BITSIZE (slice_type, 0) / 8;
+ if (stride == 0)
+ stride = TYPE_LENGTH (TYPE_TARGET_TYPE (type0));
+
+ base = value_as_address (array_ptr) + (*low_pos - *base_low_pos) * stride;
return value_at_lazy (slice_type, base);
}
(NULL, TYPE_TARGET_TYPE (type), index_type,
type->dyn_prop (DYN_PROP_BYTE_STRIDE),
TYPE_FIELD_BITSIZE (type, 0));
- LONGEST low_pos, high_pos;
+ gdb::optional<LONGEST> low_pos, high_pos;
- if (!discrete_position (base_index_type, low, &low_pos)
- || !discrete_position (base_index_type, high, &high_pos))
+
+ low_pos = discrete_position (base_index_type, low);
+ high_pos = discrete_position (base_index_type, high);
+
+ if (!low_pos.has_value () || !high_pos.has_value ())
{
warning (_("unable to get positions in slice, use bounds instead"));
low_pos = low;
}
return value_cast (slice_type,
- value_slice (array, low, high_pos - low_pos + 1));
+ value_slice (array, low, *high_pos - *low_pos + 1));
}
/* If type is a record type in the form of a standard GNAT array
return n_chosen;
}
+/* See ada-lang.h. */
+
+block_symbol
+ada_find_operator_symbol (enum exp_opcode op, int parse_completion,
+ int nargs, value *argvec[])
+{
+ if (possible_user_operator_p (op, argvec))
+ {
+ std::vector<struct block_symbol> candidates
+ = ada_lookup_symbol_list (ada_decoded_op_name (op),
+ NULL, VAR_DOMAIN);
+
+ int i = ada_resolve_function (candidates, argvec,
+ nargs, ada_decoded_op_name (op), NULL,
+ parse_completion);
+ if (i >= 0)
+ return candidates[i];
+ }
+ return {};
+}
+
+/* See ada-lang.h. */
+
+block_symbol
+ada_resolve_funcall (struct symbol *sym, const struct block *block,
+ struct type *context_type,
+ int parse_completion,
+ int nargs, value *argvec[],
+ innermost_block_tracker *tracker)
+{
+ std::vector<struct block_symbol> candidates
+ = ada_lookup_symbol_list (sym->linkage_name (), block, VAR_DOMAIN);
+
+ int i;
+ if (candidates.size () == 1)
+ i = 0;
+ else
+ {
+ i = ada_resolve_function
+ (candidates,
+ argvec, nargs,
+ sym->linkage_name (),
+ context_type, parse_completion);
+ if (i < 0)
+ error (_("Could not find a match for %s"), sym->print_name ());
+ }
+
+ tracker->update (candidates[i]);
+ return candidates[i];
+}
+
+/* See ada-lang.h. */
+
+block_symbol
+ada_resolve_variable (struct symbol *sym, const struct block *block,
+ struct type *context_type,
+ int parse_completion,
+ int deprocedure_p,
+ innermost_block_tracker *tracker)
+{
+ std::vector<struct block_symbol> candidates
+ = ada_lookup_symbol_list (sym->linkage_name (), block, VAR_DOMAIN);
+
+ if (std::any_of (candidates.begin (),
+ candidates.end (),
+ [] (block_symbol &bsym)
+ {
+ switch (SYMBOL_CLASS (bsym.symbol))
+ {
+ case LOC_REGISTER:
+ case LOC_ARG:
+ case LOC_REF_ARG:
+ case LOC_REGPARM_ADDR:
+ case LOC_LOCAL:
+ case LOC_COMPUTED:
+ return true;
+ default:
+ return false;
+ }
+ }))
+ {
+ /* Types tend to get re-introduced locally, so if there
+ are any local symbols that are not types, first filter
+ out all types. */
+ candidates.erase
+ (std::remove_if
+ (candidates.begin (),
+ candidates.end (),
+ [] (block_symbol &bsym)
+ {
+ return SYMBOL_CLASS (bsym.symbol) == LOC_TYPEDEF;
+ }),
+ candidates.end ());
+ }
+
+ int i;
+ if (candidates.empty ())
+ error (_("No definition found for %s"), sym->print_name ());
+ else if (candidates.size () == 1)
+ i = 0;
+ else if (deprocedure_p && !is_nonfunction (candidates))
+ {
+ i = ada_resolve_function
+ (candidates, NULL, 0,
+ sym->linkage_name (),
+ context_type, parse_completion);
+ if (i < 0)
+ error (_("Could not find a match for %s"), sym->print_name ());
+ }
+ else
+ {
+ printf_filtered (_("Multiple matches for %s\n"), sym->print_name ());
+ user_select_syms (candidates.data (), candidates.size (), 1);
+ i = 0;
+ }
+
+ tracker->update (candidates[i]);
+ return candidates[i];
+}
+
/* Resolve the operator of the subexpression beginning at
position *POS of *EXPP. "Resolving" consists of replacing
the symbols that have undefined namespaces in OP_VAR_VALUE nodes
struct value **argvec; /* Vector of operand types (alloca'ed). */
int nargs; /* Number of operands. */
int oplen;
+ /* If we're resolving an expression like ARRAY(ARG...), then we set
+ this to the type of the array, so we can use the index types as
+ the expected types for resolution. */
+ struct type *array_type = nullptr;
+ /* The arity of ARRAY_TYPE. */
+ int array_arity = 0;
argvec = NULL;
nargs = 0;
else
{
*pos += 3;
- resolve_subexp (expp, pos, 0, NULL, parse_completion, tracker);
+ struct value *lhs = resolve_subexp (expp, pos, 0, NULL,
+ parse_completion, tracker);
+ struct type *lhstype = ada_check_typedef (value_type (lhs));
+ array_arity = ada_array_arity (lhstype);
+ if (array_arity > 0)
+ array_type = lhstype;
}
nargs = longest_to_int (exp->elts[pc + 1].longconst);
break;
argvec = XALLOCAVEC (struct value *, nargs + 1);
for (i = 0; i < nargs; i += 1)
- argvec[i] = resolve_subexp (expp, pos, 1, NULL, parse_completion,
- tracker);
+ {
+ struct type *subtype = nullptr;
+ if (i < array_arity)
+ subtype = ada_index_type (array_type, i + 1, "array type");
+ argvec[i] = resolve_subexp (expp, pos, 1, subtype, parse_completion,
+ tracker);
+ }
argvec[i] = NULL;
exp = expp->get ();
case OP_VAR_VALUE:
if (SYMBOL_DOMAIN (exp->elts[pc + 2].symbol) == UNDEF_DOMAIN)
{
- std::vector<struct block_symbol> candidates;
- int n_candidates;
-
- n_candidates =
- ada_lookup_symbol_list (exp->elts[pc + 2].symbol->linkage_name (),
- exp->elts[pc + 1].block, VAR_DOMAIN,
- &candidates);
-
- if (n_candidates > 1)
- {
- /* Types tend to get re-introduced locally, so if there
- are any local symbols that are not types, first filter
- out all types. */
- int j;
- for (j = 0; j < n_candidates; j += 1)
- switch (SYMBOL_CLASS (candidates[j].symbol))
- {
- case LOC_REGISTER:
- case LOC_ARG:
- case LOC_REF_ARG:
- case LOC_REGPARM_ADDR:
- case LOC_LOCAL:
- case LOC_COMPUTED:
- goto FoundNonType;
- default:
- break;
- }
- FoundNonType:
- if (j < n_candidates)
- {
- j = 0;
- while (j < n_candidates)
- {
- if (SYMBOL_CLASS (candidates[j].symbol) == LOC_TYPEDEF)
- {
- candidates[j] = candidates[n_candidates - 1];
- n_candidates -= 1;
- }
- else
- j += 1;
- }
- }
- }
-
- if (n_candidates == 0)
- error (_("No definition found for %s"),
- exp->elts[pc + 2].symbol->print_name ());
- else if (n_candidates == 1)
- i = 0;
- else if (deprocedure_p
- && !is_nonfunction (candidates.data (), n_candidates))
- {
- i = ada_resolve_function
- (candidates.data (), n_candidates, NULL, 0,
- exp->elts[pc + 2].symbol->linkage_name (),
- context_type, parse_completion);
- if (i < 0)
- error (_("Could not find a match for %s"),
- exp->elts[pc + 2].symbol->print_name ());
- }
- else
- {
- printf_filtered (_("Multiple matches for %s\n"),
- exp->elts[pc + 2].symbol->print_name ());
- user_select_syms (candidates.data (), n_candidates, 1);
- i = 0;
- }
-
- exp->elts[pc + 1].block = candidates[i].block;
- exp->elts[pc + 2].symbol = candidates[i].symbol;
- tracker->update (candidates[i]);
+ block_symbol resolved
+ = ada_resolve_variable (exp->elts[pc + 2].symbol,
+ exp->elts[pc + 1].block,
+ context_type, parse_completion,
+ deprocedure_p, tracker);
+ exp->elts[pc + 1].block = resolved.block;
+ exp->elts[pc + 2].symbol = resolved.symbol;
}
if (deprocedure_p
if (exp->elts[pc + 3].opcode == OP_VAR_VALUE
&& SYMBOL_DOMAIN (exp->elts[pc + 5].symbol) == UNDEF_DOMAIN)
{
- std::vector<struct block_symbol> candidates;
- int n_candidates;
-
- n_candidates =
- ada_lookup_symbol_list (exp->elts[pc + 5].symbol->linkage_name (),
- exp->elts[pc + 4].block, VAR_DOMAIN,
- &candidates);
-
- if (n_candidates == 1)
- i = 0;
- else
- {
- i = ada_resolve_function
- (candidates.data (), n_candidates,
- argvec, nargs,
- exp->elts[pc + 5].symbol->linkage_name (),
- context_type, parse_completion);
- if (i < 0)
- error (_("Could not find a match for %s"),
- exp->elts[pc + 5].symbol->print_name ());
- }
-
- exp->elts[pc + 4].block = candidates[i].block;
- exp->elts[pc + 5].symbol = candidates[i].symbol;
- tracker->update (candidates[i]);
+ block_symbol resolved
+ = ada_resolve_funcall (exp->elts[pc + 5].symbol,
+ exp->elts[pc + 4].block,
+ context_type, parse_completion,
+ nargs, argvec,
+ tracker);
+ exp->elts[pc + 4].block = resolved.block;
+ exp->elts[pc + 5].symbol = resolved.symbol;
}
}
break;
case UNOP_PLUS:
case UNOP_LOGICAL_NOT:
case UNOP_ABS:
- if (possible_user_operator_p (op, argvec))
- {
- std::vector<struct block_symbol> candidates;
- int n_candidates;
-
- n_candidates =
- ada_lookup_symbol_list (ada_decoded_op_name (op),
- NULL, VAR_DOMAIN,
- &candidates);
-
- i = ada_resolve_function (candidates.data (), n_candidates, argvec,
- nargs, ada_decoded_op_name (op), NULL,
- parse_completion);
- if (i < 0)
- break;
+ {
+ block_symbol found = ada_find_operator_symbol (op, parse_completion,
+ nargs, argvec);
+ if (found.symbol == nullptr)
+ break;
- replace_operator_with_call (expp, pc, nargs, 1,
- candidates[i].symbol,
- candidates[i].block);
- exp = expp->get ();
- }
+ replace_operator_with_call (expp, pc, nargs, 1,
+ found.symbol, found.block);
+ exp = expp->get ();
+ }
break;
case OP_TYPE:
}
-/* Returns the index in SYMS[0..NSYMS-1] that contains the symbol for the
+/* Returns the index in SYMS that contains the symbol for the
function (if any) that matches the types of the NARGS arguments in
ARGS. If CONTEXT_TYPE is non-null and there is at least one match
that returns that type, then eliminate matches that don't. If
the process; the index returned is for the modified vector. */
static int
-ada_resolve_function (struct block_symbol syms[],
- int nsyms, struct value **args, int nargs,
+ada_resolve_function (std::vector<struct block_symbol> &syms,
+ struct value **args, int nargs,
const char *name, struct type *context_type,
int parse_completion)
{
where every function is accepted. */
for (fallback = 0; m == 0 && fallback < 2; fallback++)
{
- for (k = 0; k < nsyms; k += 1)
+ for (k = 0; k < syms.size (); k += 1)
{
struct type *type = ada_check_typedef (SYMBOL_TYPE (syms[k].symbol));
else if (m > 1 && !parse_completion)
{
printf_filtered (_("Multiple matches for %s\n"), name);
- user_select_syms (syms, m, 1);
+ user_select_syms (syms.data (), m, 1);
return 0;
}
return 0;
int oplen, struct symbol *sym,
const struct block *block)
{
- /* A new expression, with 6 more elements (3 for funcall, 4 for function
- symbol, -oplen for operator being replaced). */
- struct expression *newexp = (struct expression *)
- xzalloc (sizeof (struct expression)
- + EXP_ELEM_TO_BYTES ((*expp)->nelts + 7 - oplen));
+ /* We want to add 6 more elements (3 for funcall, 4 for function
+ symbol, -OPLEN for operator being replaced) to the
+ expression. */
struct expression *exp = expp->get ();
+ int save_nelts = exp->nelts;
+ int extra_elts = 7 - oplen;
+ exp->nelts += extra_elts;
- newexp->nelts = exp->nelts + 7 - oplen;
- newexp->language_defn = exp->language_defn;
- newexp->gdbarch = exp->gdbarch;
- memcpy (newexp->elts, exp->elts, EXP_ELEM_TO_BYTES (pc));
- memcpy (newexp->elts + pc + 7, exp->elts + pc + oplen,
- EXP_ELEM_TO_BYTES (exp->nelts - pc - oplen));
-
- newexp->elts[pc].opcode = newexp->elts[pc + 2].opcode = OP_FUNCALL;
- newexp->elts[pc + 1].longconst = (LONGEST) nargs;
+ if (extra_elts > 0)
+ exp->resize (exp->nelts);
+ memmove (exp->elts + pc + 7, exp->elts + pc + oplen,
+ EXP_ELEM_TO_BYTES (save_nelts - pc - oplen));
+ if (extra_elts < 0)
+ exp->resize (exp->nelts);
- newexp->elts[pc + 3].opcode = newexp->elts[pc + 6].opcode = OP_VAR_VALUE;
- newexp->elts[pc + 4].block = block;
- newexp->elts[pc + 5].symbol = sym;
+ exp->elts[pc].opcode = exp->elts[pc + 2].opcode = OP_FUNCALL;
+ exp->elts[pc + 1].longconst = (LONGEST) nargs;
- expp->reset (newexp);
+ exp->elts[pc + 3].opcode = exp->elts[pc + 6].opcode = OP_VAR_VALUE;
+ exp->elts[pc + 4].block = block;
+ exp->elts[pc + 5].symbol = sym;
}
/* Type-class predicates */
t1 = ada_to_fixed_type (ada_get_base_type (t1), NULL,
address, NULL, check_tag);
+ /* Resolve the dynamic type as well. */
+ arg = value_from_contents_and_address (t1, nullptr, address);
+ t1 = value_type (arg);
+
if (find_struct_field (name, t1, 0,
&field_type, &byte_offset, &bit_offset,
&bit_size, NULL))
static CORE_ADDR
value_pointer (struct value *value, struct type *type)
{
- struct gdbarch *gdbarch = get_type_arch (type);
unsigned len = TYPE_LENGTH (type);
gdb_byte *buf = (gdb_byte *) alloca (len);
CORE_ADDR addr;
addr = value_address (value);
- gdbarch_address_to_pointer (gdbarch, type, buf, addr);
+ gdbarch_address_to_pointer (type->arch (), type, buf, addr);
addr = extract_unsigned_integer (buf, len, type_byte_order (type));
return addr;
}
even in this case, some expensive name-based symbol searches are still
sometimes necessary - to find an XVZ variable, mostly. */
-/* Initialize the contents of SYM_CACHE. */
-
-static void
-ada_init_symbol_cache (struct ada_symbol_cache *sym_cache)
-{
- obstack_init (&sym_cache->cache_space);
- memset (sym_cache->root, '\000', sizeof (sym_cache->root));
-}
-
-/* Free the memory used by SYM_CACHE. */
-
-static void
-ada_free_symbol_cache (struct ada_symbol_cache *sym_cache)
-{
- obstack_free (&sym_cache->cache_space, NULL);
- xfree (sym_cache);
-}
-
/* Return the symbol cache associated to the given program space PSPACE.
If not allocated for this PSPACE yet, allocate and initialize one. */
{
struct ada_pspace_data *pspace_data = get_ada_pspace_data (pspace);
- if (pspace_data->sym_cache == NULL)
- {
- pspace_data->sym_cache = XCNEW (struct ada_symbol_cache);
- ada_init_symbol_cache (pspace_data->sym_cache);
- }
+ if (pspace_data->sym_cache == nullptr)
+ pspace_data->sym_cache.reset (new ada_symbol_cache);
- return pspace_data->sym_cache;
+ return pspace_data->sym_cache.get ();
}
/* Clear all entries from the symbol cache. */
static void
-ada_clear_symbol_cache (void)
+ada_clear_symbol_cache ()
{
- struct ada_symbol_cache *sym_cache
- = ada_get_symbol_cache (current_program_space);
+ struct ada_pspace_data *pspace_data
+ = get_ada_pspace_data (current_program_space);
- obstack_free (&sym_cache->cache_space, NULL);
- ada_init_symbol_cache (sym_cache);
+ if (pspace_data->sym_cache != nullptr)
+ pspace_data->sym_cache.reset ();
}
/* Search our cache for an entry matching NAME and DOMAIN.
/* Non-zero iff there is at least one non-function/non-enumeral symbol
- in the symbol fields of SYMS[0..N-1]. We treat enumerals as functions,
+ in the symbol fields of SYMS. We treat enumerals as functions,
since they contend in overloading in the same way. */
static int
-is_nonfunction (struct block_symbol syms[], int n)
+is_nonfunction (const std::vector<struct block_symbol> &syms)
{
- int i;
-
- for (i = 0; i < n; i += 1)
- if (SYMBOL_TYPE (syms[i].symbol)->code () != TYPE_CODE_FUNC
- && (SYMBOL_TYPE (syms[i].symbol)->code () != TYPE_CODE_ENUM
- || SYMBOL_CLASS (syms[i].symbol) != LOC_CONST))
+ for (const block_symbol &sym : syms)
+ if (SYMBOL_TYPE (sym.symbol)->code () != TYPE_CODE_FUNC
+ && (SYMBOL_TYPE (sym.symbol)->code () != TYPE_CODE_ENUM
+ || SYMBOL_CLASS (sym.symbol) != LOC_CONST))
return 1;
return 0;
}
}
-/* Append (SYM,BLOCK,SYMTAB) to the end of the array of struct block_symbol
- records in OBSTACKP. Do nothing if SYM is a duplicate. */
+/* Append (SYM,BLOCK) to the end of the array of struct block_symbol
+ records in RESULT. Do nothing if SYM is a duplicate. */
static void
-add_defn_to_vec (struct obstack *obstackp,
+add_defn_to_vec (std::vector<struct block_symbol> &result,
struct symbol *sym,
const struct block *block)
{
- int i;
- struct block_symbol *prevDefns = defns_collected (obstackp, 0);
-
/* Do not try to complete stub types, as the debugger is probably
already scanning all symbols matching a certain name at the
time when this function is called. Trying to replace the stub
matches, with at least one of them complete. It can then filter
out the stub ones if needed. */
- for (i = num_defns_collected (obstackp) - 1; i >= 0; i -= 1)
+ for (int i = result.size () - 1; i >= 0; i -= 1)
{
- if (lesseq_defined_than (sym, prevDefns[i].symbol))
+ if (lesseq_defined_than (sym, result[i].symbol))
return;
- else if (lesseq_defined_than (prevDefns[i].symbol, sym))
+ else if (lesseq_defined_than (result[i].symbol, sym))
{
- prevDefns[i].symbol = sym;
- prevDefns[i].block = block;
+ result[i].symbol = sym;
+ result[i].block = block;
return;
}
}
- {
- struct block_symbol info;
-
- info.symbol = sym;
- info.block = block;
- obstack_grow (obstackp, &info, sizeof (struct block_symbol));
- }
-}
-
-/* Number of block_symbol structures currently collected in current vector in
- OBSTACKP. */
-
-static int
-num_defns_collected (struct obstack *obstackp)
-{
- return obstack_object_size (obstackp) / sizeof (struct block_symbol);
-}
-
-/* Vector of block_symbol structures currently collected in current vector in
- OBSTACKP. If FINISH, close off the vector and return its final address. */
-
-static struct block_symbol *
-defns_collected (struct obstack *obstackp, int finish)
-{
- if (finish)
- return (struct block_symbol *) obstack_finish (obstackp);
- else
- return (struct block_symbol *) obstack_base (obstackp);
+ struct block_symbol info;
+ info.symbol = sym;
+ info.block = block;
+ result.push_back (info);
}
/* Return a bound minimal symbol matching NAME according to Ada
/* For all subprograms that statically enclose the subprogram of the
selected frame, add symbols matching identifier NAME in DOMAIN
- and their blocks to the list of data in OBSTACKP, as for
+ and their blocks to the list of data in RESULT, as for
ada_add_block_symbols (q.v.). If WILD_MATCH_P, treat as NAME
with a wildcard prefix. */
static void
-add_symbols_from_enclosing_procs (struct obstack *obstackp,
+add_symbols_from_enclosing_procs (std::vector<struct block_symbol> &result,
const lookup_name_info &lookup_name,
domain_enum domain)
{
duplicate other symbols in the list (The only case I know of where
this happens is when object files containing stabs-in-ecoff are
linked with files containing ordinary ecoff debugging symbols (or no
- debugging symbols)). Modifies SYMS to squeeze out deleted entries.
- Returns the number of items in the modified list. */
+ debugging symbols)). Modifies SYMS to squeeze out deleted entries. */
-static int
+static void
remove_extra_symbols (std::vector<struct block_symbol> *syms)
{
int i, j;
cannot be any extra symbol in that case. But it's easy to
handle, since we have nothing to do in that case. */
if (syms->size () < 2)
- return syms->size ();
+ return;
i = 0;
while (i < syms->size ())
isn't missing some choices that were identical and yet distinct. */
if (symbols_are_identical_enums (*syms))
syms->resize (1);
-
- return syms->size ();
}
/* Given a type that corresponds to a renaming entity, use the type name
is not visible from the function associated with CURRENT_BLOCK or
that is superfluous due to the presence of more specific renaming
information. Places surviving symbols in the initial entries of
- SYMS and returns the number of surviving symbols.
-
+ SYMS.
+
Rationale:
First, in cases where an object renaming is implemented as a
reference variable, GNAT may produce both the actual reference
has been changed by an "Export" pragma. As a consequence,
the user will be unable to print such rename entities. */
-static int
+static void
remove_irrelevant_renamings (std::vector<struct block_symbol> *syms,
const struct block *current_block)
{
(*syms)[k] = (*syms)[j];
k += 1;
}
- return k;
+ syms->resize (k);
+ return;
}
/* Extract the function name associated to CURRENT_BLOCK.
Abort if unable to do so. */
if (current_block == NULL)
- return syms->size ();
+ return;
current_function = block_linkage_function (current_block);
if (current_function == NULL)
- return syms->size ();
+ return;
current_function_name = current_function->linkage_name ();
if (current_function_name == NULL)
- return syms->size ();
+ return;
/* Check each of the symbols, and remove it from the list if it is
a type corresponding to a renaming that is out of the scope of
else
i += 1;
}
-
- return syms->size ();
}
-/* Add to OBSTACKP all symbols from BLOCK (and its super-blocks)
+/* Add to RESULT all symbols from BLOCK (and its super-blocks)
whose name and domain match NAME and DOMAIN respectively.
If no match was found, then extend the search to "enclosing"
routines (in other words, if we're inside a nested function,
If WILD_MATCH_P is nonzero, perform the naming matching in
"wild" mode (see function "wild_match" for more info).
- Note: This function assumes that OBSTACKP has 0 (zero) element in it. */
+ Note: This function assumes that RESULT has 0 (zero) element in it. */
static void
-ada_add_local_symbols (struct obstack *obstackp,
+ada_add_local_symbols (std::vector<struct block_symbol> &result,
const lookup_name_info &lookup_name,
const struct block *block, domain_enum domain)
{
while (block != NULL)
{
block_depth += 1;
- ada_add_block_symbols (obstackp, block, lookup_name, domain, NULL);
+ ada_add_block_symbols (result, block, lookup_name, domain, NULL);
/* If we found a non-function match, assume that's the one. */
- if (is_nonfunction (defns_collected (obstackp, 0),
- num_defns_collected (obstackp)))
+ if (is_nonfunction (result))
return;
block = BLOCK_SUPERBLOCK (block);
/* If no luck so far, try to find NAME as a local symbol in some lexically
enclosing subprogram. */
- if (num_defns_collected (obstackp) == 0 && block_depth > 2)
- add_symbols_from_enclosing_procs (obstackp, lookup_name, domain);
+ if (result.empty () && block_depth > 2)
+ add_symbols_from_enclosing_procs (result, lookup_name, domain);
}
/* An object of this type is used as the user_data argument when
struct match_data
{
- struct objfile *objfile;
- struct obstack *obstackp;
- struct symbol *arg_sym;
- int found_sym;
+ explicit match_data (std::vector<struct block_symbol> *rp)
+ : resultp (rp)
+ {
+ }
+ DISABLE_COPY_AND_ASSIGN (match_data);
+
+ struct objfile *objfile = nullptr;
+ std::vector<struct block_symbol> *resultp;
+ struct symbol *arg_sym = nullptr;
+ bool found_sym = false;
};
/* A callback for add_nonlocal_symbols that adds symbol, found in BSYM,
to a list of symbols. DATA is a pointer to a struct match_data *
- containing the obstack that collects the symbol list, the file that SYM
+ containing the vector that collects the symbol list, the file that SYM
must come from, a flag indicating whether a non-argument symbol has
been found in the current block, and the last argument symbol
passed in SYM within the current block (if any). When SYM is null,
if (sym == NULL)
{
if (!data->found_sym && data->arg_sym != NULL)
- add_defn_to_vec (data->obstackp,
+ add_defn_to_vec (*data->resultp,
fixup_symbol_section (data->arg_sym, data->objfile),
block);
- data->found_sym = 0;
+ data->found_sym = false;
data->arg_sym = NULL;
}
else
data->arg_sym = sym;
else
{
- data->found_sym = 1;
- add_defn_to_vec (data->obstackp,
+ data->found_sym = true;
+ add_defn_to_vec (*data->resultp,
fixup_symbol_section (sym, data->objfile),
block);
}
/* Helper for add_nonlocal_symbols. Find symbols in DOMAIN which are
targeted by renamings matching LOOKUP_NAME in BLOCK. Add these
- symbols to OBSTACKP. Return whether we found such symbols. */
+ symbols to RESULT. Return whether we found such symbols. */
static int
-ada_add_block_renamings (struct obstack *obstackp,
+ada_add_block_renamings (std::vector<struct block_symbol> &result,
const struct block *block,
const lookup_name_info &lookup_name,
domain_enum domain)
{
struct using_direct *renaming;
- int defns_mark = num_defns_collected (obstackp);
+ int defns_mark = result.size ();
symbol_name_matcher_ftype *name_match
= ada_get_symbol_name_matcher (lookup_name);
{
lookup_name_info decl_lookup_name (renaming->declaration,
lookup_name.match_type ());
- ada_add_all_symbols (obstackp, block, decl_lookup_name, domain,
+ ada_add_all_symbols (result, block, decl_lookup_name, domain,
1, NULL);
}
renaming->searched = 0;
}
- return num_defns_collected (obstackp) != defns_mark;
+ return result.size () != defns_mark;
}
/* Implements compare_names, but only applying the comparision using
return lookup_name.ada ().lookup_name ().c_str ();
}
-/* Add to OBSTACKP all non-local symbols whose name and domain match
+/* Add to RESULT all non-local symbols whose name and domain match
LOOKUP_NAME and DOMAIN respectively. The search is performed on
GLOBAL_BLOCK symbols if GLOBAL is non-zero, or on STATIC_BLOCK
symbols otherwise. */
static void
-add_nonlocal_symbols (struct obstack *obstackp,
+add_nonlocal_symbols (std::vector<struct block_symbol> &result,
const lookup_name_info &lookup_name,
domain_enum domain, int global)
{
- struct match_data data;
-
- memset (&data, 0, sizeof data);
- data.obstackp = obstackp;
+ struct match_data data (&result);
bool is_wild_match = lookup_name.ada ().wild_match_p ();
{
data.objfile = objfile;
- objfile->sf->qf->map_matching_symbols (objfile, lookup_name,
- domain, global, callback,
- (is_wild_match
- ? NULL : compare_names));
+ if (objfile->sf != nullptr)
+ objfile->sf->qf->map_matching_symbols (objfile, lookup_name,
+ domain, global, callback,
+ (is_wild_match
+ ? NULL : compare_names));
for (compunit_symtab *cu : objfile->compunits ())
{
const struct block *global_block
= BLOCKVECTOR_BLOCK (COMPUNIT_BLOCKVECTOR (cu), GLOBAL_BLOCK);
- if (ada_add_block_renamings (obstackp, global_block, lookup_name,
+ if (ada_add_block_renamings (result, global_block, lookup_name,
domain))
- data.found_sym = 1;
+ data.found_sym = true;
}
}
- if (num_defns_collected (obstackp) == 0 && global && !is_wild_match)
+ if (result.empty () && global && !is_wild_match)
{
const char *name = ada_lookup_name (lookup_name);
std::string bracket_name = std::string ("<_ada_") + name + '>';
for (objfile *objfile : current_program_space->objfiles ())
{
data.objfile = objfile;
- objfile->sf->qf->map_matching_symbols (objfile, name1,
- domain, global, callback,
- compare_names);
+ if (objfile->sf != nullptr)
+ objfile->sf->qf->map_matching_symbols (objfile, name1,
+ domain, global, callback,
+ compare_names);
}
}
}
/* Find symbols in DOMAIN matching LOOKUP_NAME, in BLOCK and, if
FULL_SEARCH is non-zero, enclosing scope and in global scopes,
- returning the number of matches. Add these to OBSTACKP.
+ returning the number of matches. Add these to RESULT.
When FULL_SEARCH is non-zero, any non-function/non-enumeral
symbol match within the nest of blocks whose innermost member is BLOCK,
to lookup global symbols. */
static void
-ada_add_all_symbols (struct obstack *obstackp,
+ada_add_all_symbols (std::vector<struct block_symbol> &result,
const struct block *block,
const lookup_name_info &lookup_name,
domain_enum domain,
if (block != NULL)
{
if (full_search)
- ada_add_local_symbols (obstackp, lookup_name, block, domain);
+ ada_add_local_symbols (result, lookup_name, block, domain);
else
{
/* In the !full_search case we're are being called by
iterate_over_symbols, and we don't want to search
superblocks. */
- ada_add_block_symbols (obstackp, block, lookup_name, domain, NULL);
+ ada_add_block_symbols (result, block, lookup_name, domain, NULL);
}
- if (num_defns_collected (obstackp) > 0 || !full_search)
+ if (!result.empty () || !full_search)
return;
}
domain, &sym, &block))
{
if (sym != NULL)
- add_defn_to_vec (obstackp, sym, block);
+ add_defn_to_vec (result, sym, block);
return;
}
/* Search symbols from all global blocks. */
- add_nonlocal_symbols (obstackp, lookup_name, domain, 1);
+ add_nonlocal_symbols (result, lookup_name, domain, 1);
/* Now add symbols from all per-file blocks if we've gotten no hits
(not strictly correct, but perhaps better than an error). */
- if (num_defns_collected (obstackp) == 0)
- add_nonlocal_symbols (obstackp, lookup_name, domain, 0);
+ if (result.empty ())
+ add_nonlocal_symbols (result, lookup_name, domain, 0);
}
/* Find symbols in DOMAIN matching LOOKUP_NAME, in BLOCK and, if FULL_SEARCH
- is non-zero, enclosing scope and in global scopes, returning the number of
- matches.
- Fills *RESULTS with (SYM,BLOCK) tuples, indicating the symbols
- found and the blocks and symbol tables (if any) in which they were
- found.
+ is non-zero, enclosing scope and in global scopes.
+
+ Returns (SYM,BLOCK) tuples, indicating the symbols found and the
+ blocks and symbol tables (if any) in which they were found.
When full_search is non-zero, any non-function/non-enumeral
symbol match within the nest of blocks whose innermost member is BLOCK,
Names prefixed with "standard__" are handled specially: "standard__"
is first stripped off, and only static and global symbols are searched. */
-static int
+static std::vector<struct block_symbol>
ada_lookup_symbol_list_worker (const lookup_name_info &lookup_name,
const struct block *block,
domain_enum domain,
- std::vector<struct block_symbol> *results,
int full_search)
{
int syms_from_global_search;
- int ndefns;
- auto_obstack obstack;
+ std::vector<struct block_symbol> results;
- ada_add_all_symbols (&obstack, block, lookup_name,
+ ada_add_all_symbols (results, block, lookup_name,
domain, full_search, &syms_from_global_search);
- ndefns = num_defns_collected (&obstack);
-
- struct block_symbol *base = defns_collected (&obstack, 1);
- for (int i = 0; i < ndefns; ++i)
- results->push_back (base[i]);
+ remove_extra_symbols (&results);
- ndefns = remove_extra_symbols (results);
-
- if (ndefns == 0 && full_search && syms_from_global_search)
+ if (results.empty () && full_search && syms_from_global_search)
cache_symbol (ada_lookup_name (lookup_name), domain, NULL, NULL);
- if (ndefns == 1 && full_search && syms_from_global_search)
+ if (results.size () == 1 && full_search && syms_from_global_search)
cache_symbol (ada_lookup_name (lookup_name), domain,
- (*results)[0].symbol, (*results)[0].block);
-
- ndefns = remove_irrelevant_renamings (results, block);
+ results[0].symbol, results[0].block);
- return ndefns;
+ remove_irrelevant_renamings (&results, block);
+ return results;
}
/* Find symbols in DOMAIN matching NAME, in BLOCK and enclosing scope and
- in global scopes, returning the number of matches, and filling *RESULTS
- with (SYM,BLOCK) tuples.
+ in global scopes, returning (SYM,BLOCK) tuples.
See ada_lookup_symbol_list_worker for further details. */
-int
+std::vector<struct block_symbol>
ada_lookup_symbol_list (const char *name, const struct block *block,
- domain_enum domain,
- std::vector<struct block_symbol> *results)
+ domain_enum domain)
{
symbol_name_match_type name_match_type = name_match_type_from_name (name);
lookup_name_info lookup_name (name, name_match_type);
- return ada_lookup_symbol_list_worker (lookup_name, block, domain, results, 1);
+ return ada_lookup_symbol_list_worker (lookup_name, block, domain, 1);
}
/* The result is as for ada_lookup_symbol_list with FULL_SEARCH set
ada_lookup_name_info would re-encode/fold it again, and that
would e.g., incorrectly lowercase object renaming names like
"R28b" -> "r28b". */
- std::string verbatim = std::string ("<") + name + '>';
+ std::string verbatim = add_angle_brackets (name);
gdb_assert (info != NULL);
*info = ada_lookup_symbol (verbatim.c_str (), block, domain);
ada_lookup_symbol (const char *name, const struct block *block0,
domain_enum domain)
{
- std::vector<struct block_symbol> candidates;
- int n_candidates;
-
- n_candidates = ada_lookup_symbol_list (name, block0, domain, &candidates);
+ std::vector<struct block_symbol> candidates
+ = ada_lookup_symbol_list (name, block0, domain);
- if (n_candidates == 0)
+ if (candidates.empty ())
return {};
block_symbol info = candidates[0];
name += 2;
break;
}
+ else if (t1 == '_' && name[2] == 'B' && name[3] == '_')
+ {
+ /* Names like "pkg__B_N__name", where N is a number, are
+ block-local. We can handle these by simply skipping
+ the "B_" here. */
+ name += 4;
+ }
else
return 0;
}
}
}
-/* Returns true iff symbol name SYM_NAME matches SEARCH_NAME, ignoring
- any trailing suffixes that encode debugging information or leading
- _ada_ on SYM_NAME (see is_name_suffix commentary for the debugging
- information that is ignored). */
-
-static bool
-full_match (const char *sym_name, const char *search_name)
-{
- size_t search_name_len = strlen (search_name);
-
- if (strncmp (sym_name, search_name, search_name_len) == 0
- && is_name_suffix (sym_name + search_name_len))
- return true;
-
- if (startswith (sym_name, "_ada_")
- && strncmp (sym_name + 5, search_name, search_name_len) == 0
- && is_name_suffix (sym_name + search_name_len + 5))
- return true;
-
- return false;
-}
-
-/* Add symbols from BLOCK matching LOOKUP_NAME in DOMAIN to vector
- *defn_symbols, updating the list of symbols in OBSTACKP (if
+/* Add symbols from BLOCK matching LOOKUP_NAME in DOMAIN to RESULT (if
necessary). OBJFILE is the section containing BLOCK. */
static void
-ada_add_block_symbols (struct obstack *obstackp,
+ada_add_block_symbols (std::vector<struct block_symbol> &result,
const struct block *block,
const lookup_name_info &lookup_name,
domain_enum domain, struct objfile *objfile)
/* A matching argument symbol, if any. */
struct symbol *arg_sym;
/* Set true when we find a matching non-argument symbol. */
- int found_sym;
+ bool found_sym;
struct symbol *sym;
arg_sym = NULL;
- found_sym = 0;
+ found_sym = false;
for (sym = block_iter_match_first (block, lookup_name, &iter);
sym != NULL;
sym = block_iter_match_next (lookup_name, &iter))
arg_sym = sym;
else
{
- found_sym = 1;
- add_defn_to_vec (obstackp,
+ found_sym = true;
+ add_defn_to_vec (result,
fixup_symbol_section (sym, objfile),
block);
}
/* Handle renamings. */
- if (ada_add_block_renamings (obstackp, block, lookup_name, domain))
- found_sym = 1;
+ if (ada_add_block_renamings (result, block, lookup_name, domain))
+ found_sym = true;
if (!found_sym && arg_sym != NULL)
{
- add_defn_to_vec (obstackp,
+ add_defn_to_vec (result,
fixup_symbol_section (arg_sym, objfile),
block);
}
if (!lookup_name.ada ().wild_match_p ())
{
arg_sym = NULL;
- found_sym = 0;
+ found_sym = false;
const std::string &ada_lookup_name = lookup_name.ada ().lookup_name ();
const char *name = ada_lookup_name.c_str ();
size_t name_len = ada_lookup_name.size ();
arg_sym = sym;
else
{
- found_sym = 1;
- add_defn_to_vec (obstackp,
+ found_sym = true;
+ add_defn_to_vec (result,
fixup_symbol_section (sym, objfile),
block);
}
They aren't parameters, right? */
if (!found_sym && arg_sym != NULL)
{
- add_defn_to_vec (obstackp,
+ add_defn_to_vec (result,
fixup_symbol_section (arg_sym, objfile),
block);
}
const char *
ada_variant_discrim_name (struct type *type0)
{
- static char *result = NULL;
- static size_t result_len = 0;
+ static std::string result;
struct type *type;
const char *name;
const char *discrim_end;
break;
}
- GROW_VECT (result, result_len, discrim_end - discrim_start + 1);
- strncpy (result, discrim_start, discrim_end - discrim_start);
- result[discrim_end - discrim_start] = '\0';
- return result;
+ result = std::string (discrim_start, discrim_end - discrim_start);
+ return result.c_str ();
}
/* Scan STR for a subtype-encoded number, beginning at position K.
{
struct value *val = coerce_ref (arg);
struct type *type = value_type (val);
- LONGEST result;
if (!discrete_type_p (type))
error (_("'POS only defined on discrete types"));
- if (!discrete_position (type, value_as_long (val), &result))
+ gdb::optional<LONGEST> result = discrete_position (type, value_as_long (val));
+ if (!result.has_value ())
error (_("enumeration value is invalid: can't find 'POS"));
- return result;
+ return *result;
}
static struct value *
}
static struct value *
-value_val_atr (struct type *type, struct value *arg)
+ada_val_atr (enum noside noside, struct type *type, struct value *arg)
{
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return value_zero (type, not_lval);
+
if (!discrete_type_p (type))
error (_("'VAL only defined on discrete types"));
if (!integer_type_p (value_type (arg)))
const char *
ada_enum_name (const char *name)
{
- static char *result;
- static size_t result_len = 0;
+ static std::string storage;
const char *tmp;
/* First, unqualify the enumeration name:
|| (name[1] >= 'a' && name[1] <= 'z'))
&& name[2] == '\0')
{
- GROW_VECT (result, result_len, 4);
- xsnprintf (result, result_len, "'%c'", name[1]);
- return result;
+ storage = string_printf ("'%c'", name[1]);
+ return storage.c_str ();
}
else
return name;
- GROW_VECT (result, result_len, 16);
if (isascii (v) && isprint (v))
- xsnprintf (result, result_len, "'%c'", v);
+ storage = string_printf ("'%c'", v);
else if (name[1] == 'U')
- xsnprintf (result, result_len, "[\"%02x\"]", v);
+ storage = string_printf ("[\"%02x\"]", v);
else
- xsnprintf (result, result_len, "[\"%04x\"]", v);
+ storage = string_printf ("[\"%04x\"]", v);
- return result;
+ return storage.c_str ();
}
else
{
tmp = strstr (name, "$");
if (tmp != NULL)
{
- GROW_VECT (result, result_len, tmp - name + 1);
- strncpy (result, name, tmp - name);
- result[tmp - name] = '\0';
- return result;
+ storage = std::string (name, tmp - name);
+ return storage.c_str ();
}
return name;
}
}
-static struct value *
-cast_from_gnat_encoded_fixed_point_type (struct type *type, struct value *arg)
-{
- struct value *scale
- = gnat_encoded_fixed_point_scaling_factor (value_type (arg));
- arg = value_cast (value_type (scale), arg);
-
- arg = value_binop (arg, scale, BINOP_MUL);
- return value_cast (type, arg);
-}
-
-static struct value *
-cast_to_gnat_encoded_fixed_point_type (struct type *type, struct value *arg)
-{
- if (type == value_type (arg))
- return arg;
-
- struct value *scale = gnat_encoded_fixed_point_scaling_factor (type);
- if (ada_is_gnat_encoded_fixed_point_type (value_type (arg)))
- arg = cast_from_gnat_encoded_fixed_point_type (value_type (scale), arg);
- else
- arg = value_cast (value_type (scale), arg);
-
- arg = value_binop (arg, scale, BINOP_DIV);
- return value_cast (type, arg);
-}
-
/* Given two array types T1 and T2, return nonzero iff both arrays
contain the same number of elements. */
return value_equal (arg1, arg2);
}
-/* Total number of component associations in the aggregate starting at
- index PC in EXP. Assumes that index PC is the start of an
- OP_AGGREGATE. */
-
-static int
-num_component_specs (struct expression *exp, int pc)
-{
- int n, m, i;
-
- m = exp->elts[pc + 1].longconst;
- pc += 3;
- n = 0;
- for (i = 0; i < m; i += 1)
- {
- switch (exp->elts[pc].opcode)
- {
- default:
- n += 1;
- break;
- case OP_CHOICES:
- n += exp->elts[pc + 1].longconst;
- break;
- }
- ada_evaluate_subexp (NULL, exp, &pc, EVAL_SKIP);
- }
- return n;
-}
-
/* Assign the result of evaluating EXP starting at *POS to the INDEXth
component of LHS (a simple array or a record), updating *POS past
the expression, assuming that LHS is contained in CONTAINER. Does
struct type *lhs_type;
int n = exp->elts[*pos+1].longconst;
LONGEST low_index, high_index;
- int num_specs;
- LONGEST *indices;
- int max_indices, num_indices;
int i;
*pos += 3;
else
error (_("Left-hand side must be array or record."));
- num_specs = num_component_specs (exp, *pos - 3);
- max_indices = 4 * num_specs + 4;
- indices = XALLOCAVEC (LONGEST, max_indices);
+ std::vector<LONGEST> indices (4);
indices[0] = indices[1] = low_index - 1;
indices[2] = indices[3] = high_index + 1;
- num_indices = 4;
for (i = 0; i < n; i += 1)
{
switch (exp->elts[*pos].opcode)
{
case OP_CHOICES:
- aggregate_assign_from_choices (container, lhs, exp, pos, indices,
- &num_indices, max_indices,
+ aggregate_assign_from_choices (container, lhs, exp, pos, indices,
low_index, high_index);
break;
case OP_POSITIONAL:
aggregate_assign_positional (container, lhs, exp, pos, indices,
- &num_indices, max_indices,
low_index, high_index);
break;
case OP_OTHERS:
if (i != n-1)
error (_("Misplaced 'others' clause"));
- aggregate_assign_others (container, lhs, exp, pos, indices,
- num_indices, low_index, high_index);
+ aggregate_assign_others (container, lhs, exp, pos, indices,
+ low_index, high_index);
break;
default:
error (_("Internal error: bad aggregate clause"));
/* Assign into the component of LHS indexed by the OP_POSITIONAL
construct at *POS, updating *POS past the construct, given that
- the positions are relative to lower bound LOW, where HIGH is the
- upper bound. Record the position in INDICES[0 .. MAX_INDICES-1]
- updating *NUM_INDICES as needed. CONTAINER is as for
+ the positions are relative to lower bound LOW, where HIGH is the
+ upper bound. Record the position in INDICES. CONTAINER is as for
assign_aggregate. */
static void
aggregate_assign_positional (struct value *container,
struct value *lhs, struct expression *exp,
- int *pos, LONGEST *indices, int *num_indices,
- int max_indices, LONGEST low, LONGEST high)
+ int *pos, std::vector<LONGEST> &indices,
+ LONGEST low, LONGEST high)
{
LONGEST ind = longest_to_int (exp->elts[*pos + 1].longconst) + low;
warning (_("Extra components in aggregate ignored."));
if (ind <= high)
{
- add_component_interval (ind, ind, indices, num_indices, max_indices);
+ add_component_interval (ind, ind, indices);
*pos += 3;
assign_component (container, lhs, ind, exp, pos);
}
/* Assign into the components of LHS indexed by the OP_CHOICES
construct at *POS, updating *POS past the construct, given that
the allowable indices are LOW..HIGH. Record the indices assigned
- to in INDICES[0 .. MAX_INDICES-1], updating *NUM_INDICES as
- needed. CONTAINER is as for assign_aggregate. */
+ to in INDICES. CONTAINER is as for assign_aggregate. */
static void
aggregate_assign_from_choices (struct value *container,
struct value *lhs, struct expression *exp,
- int *pos, LONGEST *indices, int *num_indices,
- int max_indices, LONGEST low, LONGEST high)
+ int *pos, std::vector<LONGEST> &indices,
+ LONGEST low, LONGEST high)
{
int j;
int n_choices = longest_to_int (exp->elts[*pos+1].longconst);
if (lower <= upper && (lower < low || upper > high))
error (_("Index in component association out of bounds."));
- add_component_interval (lower, upper, indices, num_indices,
- max_indices);
+ add_component_interval (lower, upper, indices);
while (lower <= upper)
{
int pos1;
/* Assign the value of the expression in the OP_OTHERS construct in
EXP at *POS into the components of LHS indexed from LOW .. HIGH that
have not been previously assigned. The index intervals already assigned
- are in INDICES[0 .. NUM_INDICES-1]. Updates *POS to after the
- OP_OTHERS clause. CONTAINER is as for assign_aggregate. */
+ are in INDICES. Updates *POS to after the OP_OTHERS clause.
+ CONTAINER is as for assign_aggregate. */
static void
aggregate_assign_others (struct value *container,
struct value *lhs, struct expression *exp,
- int *pos, LONGEST *indices, int num_indices,
+ int *pos, std::vector<LONGEST> &indices,
LONGEST low, LONGEST high)
{
int i;
int expr_pc = *pos + 1;
+ int num_indices = indices.size ();
for (i = 0; i < num_indices - 2; i += 2)
{
LONGEST ind;
ada_evaluate_subexp (NULL, exp, pos, EVAL_SKIP);
}
-/* Add the interval [LOW .. HIGH] to the sorted set of intervals
- [ INDICES[0] .. INDICES[1] ],..., [ INDICES[*SIZE-2] .. INDICES[*SIZE-1] ],
- modifying *SIZE as needed. It is an error if *SIZE exceeds
- MAX_SIZE. The resulting intervals do not overlap. */
+/* Add the interval [LOW .. HIGH] to the sorted set of intervals
+ [ INDICES[0] .. INDICES[1] ],... The resulting intervals do not
+ overlap. */
static void
add_component_interval (LONGEST low, LONGEST high,
- LONGEST* indices, int *size, int max_size)
+ std::vector<LONGEST> &indices)
{
int i, j;
- for (i = 0; i < *size; i += 2) {
+ int size = indices.size ();
+ for (i = 0; i < size; i += 2) {
if (high >= indices[i] && low <= indices[i + 1])
{
int kh;
- for (kh = i + 2; kh < *size; kh += 2)
+ for (kh = i + 2; kh < size; kh += 2)
if (high < indices[kh])
break;
if (low < indices[i])
indices[i + 1] = indices[kh - 1];
if (high > indices[i + 1])
indices[i + 1] = high;
- memcpy (indices + i + 2, indices + kh, *size - kh);
- *size -= kh - i - 2;
+ memcpy (indices.data () + i + 2, indices.data () + kh, size - kh);
+ indices.resize (kh - i - 2);
return;
}
else if (high < indices[i])
break;
}
- if (*size == max_size)
- error (_("Internal error: miscounted aggregate components."));
- *size += 2;
- for (j = *size-1; j >= i+2; j -= 1)
+ indices.resize (indices.size () + 2);
+ for (j = indices.size () - 1; j >= i + 2; j -= 1)
indices[j] = indices[j - 2];
indices[i] = low;
indices[i + 1] = high;
if (type == ada_check_typedef (value_type (arg2)))
return arg2;
- if (ada_is_gnat_encoded_fixed_point_type (type))
- return cast_to_gnat_encoded_fixed_point_type (type, arg2);
-
- if (ada_is_gnat_encoded_fixed_point_type (value_type (arg2)))
- return cast_from_gnat_encoded_fixed_point_type (type, arg2);
-
return value_cast (type, arg2);
}
return ada_value_cast (to_type, val);
}
-/* Implement the evaluate_exp routine in the exp_descriptor structure
- for the Ada language. */
+/* A helper function for TERNOP_IN_RANGE. */
-static struct value *
-ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
- int *pos, enum noside noside)
+static value *
+eval_ternop_in_range (struct type *expect_type, struct expression *exp,
+ enum noside noside,
+ value *arg1, value *arg2, value *arg3)
{
- enum exp_opcode op;
- int tem;
- int pc;
- int preeval_pos;
- struct value *arg1 = NULL, *arg2 = NULL, *arg3;
- struct type *type;
- int nargs, oplen;
- struct value **argvec;
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
- pc = *pos;
- *pos += 1;
- op = exp->elts[pc].opcode;
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg3);
+ struct type *type = language_bool_type (exp->language_defn, exp->gdbarch);
+ return
+ value_from_longest (type,
+ (value_less (arg1, arg3)
+ || value_equal (arg1, arg3))
+ && (value_less (arg2, arg1)
+ || value_equal (arg2, arg1)));
+}
- switch (op)
- {
- default:
- *pos -= 1;
- arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
+/* A helper function for UNOP_NEG. */
+
+value *
+ada_unop_neg (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg1)
+{
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
+ unop_promote (exp->language_defn, exp->gdbarch, &arg1);
+ return value_neg (arg1);
+}
+
+/* A helper function for UNOP_IN_RANGE. */
+
+value *
+ada_unop_in_range (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg1, struct type *type)
+{
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
+
+ struct value *arg2, *arg3;
+ switch (type->code ())
+ {
+ default:
+ lim_warning (_("Membership test incompletely implemented; "
+ "always returns true"));
+ type = language_bool_type (exp->language_defn, exp->gdbarch);
+ return value_from_longest (type, (LONGEST) 1);
+
+ case TYPE_CODE_RANGE:
+ arg2 = value_from_longest (type,
+ type->bounds ()->low.const_val ());
+ arg3 = value_from_longest (type,
+ type->bounds ()->high.const_val ());
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg3);
+ type = language_bool_type (exp->language_defn, exp->gdbarch);
+ return
+ value_from_longest (type,
+ (value_less (arg1, arg3)
+ || value_equal (arg1, arg3))
+ && (value_less (arg2, arg1)
+ || value_equal (arg2, arg1)));
+ }
+}
+
+/* A helper function for OP_ATR_TAG. */
+
+value *
+ada_atr_tag (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg1)
+{
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return value_zero (ada_tag_type (arg1), not_lval);
+
+ return ada_value_tag (arg1);
+}
+
+/* A helper function for OP_ATR_SIZE. */
+
+value *
+ada_atr_size (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg1)
+{
+ struct type *type = value_type (arg1);
+
+ /* If the argument is a reference, then dereference its type, since
+ the user is really asking for the size of the actual object,
+ not the size of the pointer. */
+ if (type->code () == TYPE_CODE_REF)
+ type = TYPE_TARGET_TYPE (type);
+
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
+ else if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return value_zero (builtin_type (exp->gdbarch)->builtin_int, not_lval);
+ else
+ return value_from_longest (builtin_type (exp->gdbarch)->builtin_int,
+ TARGET_CHAR_BIT * TYPE_LENGTH (type));
+}
+
+/* A helper function for UNOP_ABS. */
+
+value *
+ada_abs (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg1)
+{
+ unop_promote (exp->language_defn, exp->gdbarch, &arg1);
+ if (value_less (arg1, value_zero (value_type (arg1), not_lval)))
+ return value_neg (arg1);
+ else
+ return arg1;
+}
+
+/* A helper function for BINOP_MUL. */
+
+static value *
+ada_mult_binop (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg1, struct value *arg2)
+{
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ {
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ return value_zero (value_type (arg1), not_lval);
+ }
+ else
+ {
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ return ada_value_binop (arg1, arg2, op);
+ }
+}
+
+/* A helper function for BINOP_EQUAL and BINOP_NOTEQUAL. */
+
+static value *
+ada_equal_binop (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg1, struct value *arg2)
+{
+ int tem;
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ tem = 0;
+ else
+ {
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ tem = ada_value_equal (arg1, arg2);
+ }
+ if (op == BINOP_NOTEQUAL)
+ tem = !tem;
+ struct type *type = language_bool_type (exp->language_defn, exp->gdbarch);
+ return value_from_longest (type, (LONGEST) tem);
+}
+
+/* A helper function for TERNOP_SLICE. */
+
+static value *
+ada_ternop_slice (struct expression *exp,
+ enum noside noside,
+ struct value *array, struct value *low_bound_val,
+ struct value *high_bound_val)
+{
+ LONGEST low_bound;
+ LONGEST high_bound;
+
+ low_bound_val = coerce_ref (low_bound_val);
+ high_bound_val = coerce_ref (high_bound_val);
+ low_bound = value_as_long (low_bound_val);
+ high_bound = value_as_long (high_bound_val);
+
+ /* If this is a reference to an aligner type, then remove all
+ the aligners. */
+ if (value_type (array)->code () == TYPE_CODE_REF
+ && ada_is_aligner_type (TYPE_TARGET_TYPE (value_type (array))))
+ TYPE_TARGET_TYPE (value_type (array)) =
+ ada_aligned_type (TYPE_TARGET_TYPE (value_type (array)));
+
+ if (ada_is_any_packed_array_type (value_type (array)))
+ error (_("cannot slice a packed array"));
+
+ /* If this is a reference to an array or an array lvalue,
+ convert to a pointer. */
+ if (value_type (array)->code () == TYPE_CODE_REF
+ || (value_type (array)->code () == TYPE_CODE_ARRAY
+ && VALUE_LVAL (array) == lval_memory))
+ array = value_addr (array);
+
+ if (noside == EVAL_AVOID_SIDE_EFFECTS
+ && ada_is_array_descriptor_type (ada_check_typedef
+ (value_type (array))))
+ return empty_array (ada_type_of_array (array, 0), low_bound,
+ high_bound);
+
+ array = ada_coerce_to_simple_array_ptr (array);
+
+ /* If we have more than one level of pointer indirection,
+ dereference the value until we get only one level. */
+ while (value_type (array)->code () == TYPE_CODE_PTR
+ && (TYPE_TARGET_TYPE (value_type (array))->code ()
+ == TYPE_CODE_PTR))
+ array = value_ind (array);
+
+ /* Make sure we really do have an array type before going further,
+ to avoid a SEGV when trying to get the index type or the target
+ type later down the road if the debug info generated by
+ the compiler is incorrect or incomplete. */
+ if (!ada_is_simple_array_type (value_type (array)))
+ error (_("cannot take slice of non-array"));
+
+ if (ada_check_typedef (value_type (array))->code ()
+ == TYPE_CODE_PTR)
+ {
+ struct type *type0 = ada_check_typedef (value_type (array));
+
+ if (high_bound < low_bound || noside == EVAL_AVOID_SIDE_EFFECTS)
+ return empty_array (TYPE_TARGET_TYPE (type0), low_bound, high_bound);
+ else
+ {
+ struct type *arr_type0 =
+ to_fixed_array_type (TYPE_TARGET_TYPE (type0), NULL, 1);
+
+ return ada_value_slice_from_ptr (array, arr_type0,
+ longest_to_int (low_bound),
+ longest_to_int (high_bound));
+ }
+ }
+ else if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return array;
+ else if (high_bound < low_bound)
+ return empty_array (value_type (array), low_bound, high_bound);
+ else
+ return ada_value_slice (array, longest_to_int (low_bound),
+ longest_to_int (high_bound));
+}
+
+/* A helper function for BINOP_IN_BOUNDS. */
+
+static value *
+ada_binop_in_bounds (struct expression *exp, enum noside noside,
+ struct value *arg1, struct value *arg2, int n)
+{
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ {
+ struct type *type = language_bool_type (exp->language_defn,
+ exp->gdbarch);
+ return value_zero (type, not_lval);
+ }
+
+ struct type *type = ada_index_type (value_type (arg2), n, "range");
+ if (!type)
+ type = value_type (arg1);
+
+ value *arg3 = value_from_longest (type, ada_array_bound (arg2, n, 1));
+ arg2 = value_from_longest (type, ada_array_bound (arg2, n, 0));
+
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg3);
+ type = language_bool_type (exp->language_defn, exp->gdbarch);
+ return value_from_longest (type,
+ (value_less (arg1, arg3)
+ || value_equal (arg1, arg3))
+ && (value_less (arg2, arg1)
+ || value_equal (arg2, arg1)));
+}
+
+/* A helper function for some attribute operations. */
+
+static value *
+ada_unop_atr (struct expression *exp, enum noside noside, enum exp_opcode op,
+ struct value *arg1, struct type *type_arg, int tem)
+{
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ {
+ if (type_arg == NULL)
+ type_arg = value_type (arg1);
+
+ if (ada_is_constrained_packed_array_type (type_arg))
+ type_arg = decode_constrained_packed_array_type (type_arg);
+
+ if (!discrete_type_p (type_arg))
+ {
+ switch (op)
+ {
+ default: /* Should never happen. */
+ error (_("unexpected attribute encountered"));
+ case OP_ATR_FIRST:
+ case OP_ATR_LAST:
+ type_arg = ada_index_type (type_arg, tem,
+ ada_attribute_name (op));
+ break;
+ case OP_ATR_LENGTH:
+ type_arg = builtin_type (exp->gdbarch)->builtin_int;
+ break;
+ }
+ }
+
+ return value_zero (type_arg, not_lval);
+ }
+ else if (type_arg == NULL)
+ {
+ arg1 = ada_coerce_ref (arg1);
+
+ if (ada_is_constrained_packed_array_type (value_type (arg1)))
+ arg1 = ada_coerce_to_simple_array (arg1);
+
+ struct type *type;
+ if (op == OP_ATR_LENGTH)
+ type = builtin_type (exp->gdbarch)->builtin_int;
+ else
+ {
+ type = ada_index_type (value_type (arg1), tem,
+ ada_attribute_name (op));
+ if (type == NULL)
+ type = builtin_type (exp->gdbarch)->builtin_int;
+ }
+
+ switch (op)
+ {
+ default: /* Should never happen. */
+ error (_("unexpected attribute encountered"));
+ case OP_ATR_FIRST:
+ return value_from_longest
+ (type, ada_array_bound (arg1, tem, 0));
+ case OP_ATR_LAST:
+ return value_from_longest
+ (type, ada_array_bound (arg1, tem, 1));
+ case OP_ATR_LENGTH:
+ return value_from_longest
+ (type, ada_array_length (arg1, tem));
+ }
+ }
+ else if (discrete_type_p (type_arg))
+ {
+ struct type *range_type;
+ const char *name = ada_type_name (type_arg);
+
+ range_type = NULL;
+ if (name != NULL && type_arg->code () != TYPE_CODE_ENUM)
+ range_type = to_fixed_range_type (type_arg, NULL);
+ if (range_type == NULL)
+ range_type = type_arg;
+ switch (op)
+ {
+ default:
+ error (_("unexpected attribute encountered"));
+ case OP_ATR_FIRST:
+ return value_from_longest
+ (range_type, ada_discrete_type_low_bound (range_type));
+ case OP_ATR_LAST:
+ return value_from_longest
+ (range_type, ada_discrete_type_high_bound (range_type));
+ case OP_ATR_LENGTH:
+ error (_("the 'length attribute applies only to array types"));
+ }
+ }
+ else if (type_arg->code () == TYPE_CODE_FLT)
+ error (_("unimplemented type attribute"));
+ else
+ {
+ LONGEST low, high;
+
+ if (ada_is_constrained_packed_array_type (type_arg))
+ type_arg = decode_constrained_packed_array_type (type_arg);
+
+ struct type *type;
+ if (op == OP_ATR_LENGTH)
+ type = builtin_type (exp->gdbarch)->builtin_int;
+ else
+ {
+ type = ada_index_type (type_arg, tem, ada_attribute_name (op));
+ if (type == NULL)
+ type = builtin_type (exp->gdbarch)->builtin_int;
+ }
+
+ switch (op)
+ {
+ default:
+ error (_("unexpected attribute encountered"));
+ case OP_ATR_FIRST:
+ 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);
+ return value_from_longest (type, high);
+ case OP_ATR_LENGTH:
+ 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);
+ }
+ }
+}
+
+/* A helper function for OP_ATR_MIN and OP_ATR_MAX. */
+
+static struct value *
+ada_binop_minmax (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg1, struct value *arg2)
+{
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return value_zero (value_type (arg1), not_lval);
+ else
+ {
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ return value_binop (arg1, arg2,
+ op == OP_ATR_MIN ? BINOP_MIN : BINOP_MAX);
+ }
+}
+
+/* A helper function for BINOP_EXP. */
+
+static struct value *
+ada_binop_exp (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg1, struct value *arg2)
+{
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return value_zero (value_type (arg1), not_lval);
+ else
+ {
+ /* For integer exponentiation operations,
+ only promote the first argument. */
+ if (is_integral_type (value_type (arg2)))
+ unop_promote (exp->language_defn, exp->gdbarch, &arg1);
+ else
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+
+ return value_binop (arg1, arg2, op);
+ }
+}
+
+namespace expr
+{
+
+value *
+ada_wrapped_operation::evaluate (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside)
+{
+ value *result = std::get<0> (m_storage)->evaluate (expect_type, exp, noside);
+ if (noside == EVAL_NORMAL)
+ result = unwrap_value (result);
+
+ /* If evaluating an OP_FLOAT and an EXPECT_TYPE was provided,
+ then we need to perform the conversion manually, because
+ evaluate_subexp_standard doesn't do it. This conversion is
+ necessary in Ada because the different kinds of float/fixed
+ types in Ada have different representations.
+
+ Similarly, we need to perform the conversion from OP_LONG
+ ourselves. */
+ if ((opcode () == OP_FLOAT || opcode () == OP_LONG) && expect_type != NULL)
+ result = ada_value_cast (expect_type, result);
+
+ return result;
+}
+
+value *
+ada_string_operation::evaluate (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside)
+{
+ value *result = string_operation::evaluate (expect_type, exp, noside);
+ /* The result type will have code OP_STRING, bashed there from
+ OP_ARRAY. Bash it back. */
+ if (value_type (result)->code () == TYPE_CODE_STRING)
+ value_type (result)->set_code (TYPE_CODE_ARRAY);
+ return result;
+}
+
+value *
+ada_qual_operation::evaluate (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside)
+{
+ struct type *type = std::get<1> (m_storage);
+ return std::get<0> (m_storage)->evaluate (type, exp, noside);
+}
+
+value *
+ada_ternop_range_operation::evaluate (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside)
+{
+ value *arg0 = std::get<0> (m_storage)->evaluate (nullptr, exp, noside);
+ value *arg1 = std::get<1> (m_storage)->evaluate (nullptr, exp, noside);
+ value *arg2 = std::get<2> (m_storage)->evaluate (nullptr, exp, noside);
+ return eval_ternop_in_range (expect_type, exp, noside, arg0, arg1, arg2);
+}
+
+}
+
+/* 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)
+{
+ enum exp_opcode op;
+ int tem;
+ int pc;
+ int preeval_pos;
+ struct value *arg1 = NULL, *arg2 = NULL, *arg3;
+ struct type *type;
+ int nargs, oplen;
+ struct value **argvec;
+
+ pc = *pos;
+ *pos += 1;
+ op = exp->elts[pc].opcode;
+
+ switch (op)
+ {
+ default:
+ *pos -= 1;
+ arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
if (noside == EVAL_NORMAL)
arg1 = unwrap_value (arg1);
{
/* Nothing. */
}
- else if (ada_is_gnat_encoded_fixed_point_type (value_type (arg1)))
- arg2 = cast_to_gnat_encoded_fixed_point_type (value_type (arg1), arg2);
- else if (ada_is_gnat_encoded_fixed_point_type (value_type (arg2)))
- error
- (_("Fixed-point values must be assigned to fixed-point variables"));
else
arg2 = coerce_for_assign (value_type (arg1), arg2);
return ada_value_assign (arg1, arg2);
return (value_from_longest
(value_type (arg2),
value_as_long (arg1) + value_as_long (arg2)));
- if ((ada_is_gnat_encoded_fixed_point_type (value_type (arg1))
- || ada_is_gnat_encoded_fixed_point_type (value_type (arg2)))
- && value_type (arg1) != value_type (arg2))
- error (_("Operands of fixed-point addition must have the same type"));
- /* Do the addition, and cast the result to the type of the first
- argument. We cannot cast the result to a reference type, so if
- ARG1 is a reference type, find its underlying type. */
+ /* Preserve the original type for use by the range case below.
+ We cannot cast the result to a reference type, so if ARG1 is
+ a reference type, find its underlying type. */
type = value_type (arg1);
while (type->code () == TYPE_CODE_REF)
type = TYPE_TARGET_TYPE (type);
binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
- return value_cast (type, value_binop (arg1, arg2, BINOP_ADD));
+ arg1 = value_binop (arg1, arg2, BINOP_ADD);
+ /* We need to special-case the result of adding to a range.
+ This is done for the benefit of "ptype". gdb's Ada support
+ historically used the LHS to set the result type here, so
+ preserve this behavior. */
+ if (type->code () == TYPE_CODE_RANGE)
+ arg1 = value_cast (type, arg1);
+ return arg1;
case BINOP_SUB:
arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
return (value_from_longest
(value_type (arg2),
value_as_long (arg1) - value_as_long (arg2)));
- if ((ada_is_gnat_encoded_fixed_point_type (value_type (arg1))
- || ada_is_gnat_encoded_fixed_point_type (value_type (arg2)))
- && value_type (arg1) != value_type (arg2))
- error (_("Operands of fixed-point subtraction "
- "must have the same type"));
- /* Do the substraction, and cast the result to the type of the first
- argument. We cannot cast the result to a reference type, so if
- ARG1 is a reference type, find its underlying type. */
+ /* Preserve the original type for use by the range case below.
+ We cannot cast the result to a reference type, so if ARG1 is
+ a reference type, find its underlying type. */
type = value_type (arg1);
while (type->code () == TYPE_CODE_REF)
type = TYPE_TARGET_TYPE (type);
binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
- return value_cast (type, value_binop (arg1, arg2, BINOP_SUB));
+ arg1 = value_binop (arg1, arg2, BINOP_SUB);
+ /* We need to special-case the result of adding to a range.
+ This is done for the benefit of "ptype". gdb's Ada support
+ historically used the LHS to set the result type here, so
+ preserve this behavior. */
+ if (type->code () == TYPE_CODE_RANGE)
+ arg1 = value_cast (type, arg1);
+ return arg1;
case BINOP_MUL:
case BINOP_DIV:
arg2 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
- {
- binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
- return value_zero (value_type (arg1), not_lval);
- }
- else
- {
- type = builtin_type (exp->gdbarch)->builtin_double;
- if (ada_is_gnat_encoded_fixed_point_type (value_type (arg1)))
- arg1 = cast_from_gnat_encoded_fixed_point_type (type, arg1);
- if (ada_is_gnat_encoded_fixed_point_type (value_type (arg2)))
- arg2 = cast_from_gnat_encoded_fixed_point_type (type, arg2);
- binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
- return ada_value_binop (arg1, arg2, op);
- }
+ return ada_mult_binop (expect_type, exp, noside, op,
+ arg1, arg2);
case BINOP_EQUAL:
case BINOP_NOTEQUAL:
arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- tem = 0;
- else
- {
- binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
- tem = ada_value_equal (arg1, arg2);
- }
- if (op == BINOP_NOTEQUAL)
- tem = !tem;
- type = language_bool_type (exp->language_defn, exp->gdbarch);
- return value_from_longest (type, (LONGEST) tem);
+ return ada_equal_binop (expect_type, exp, noside, op, arg1, arg2);
case UNOP_NEG:
arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
- else if (ada_is_gnat_encoded_fixed_point_type (value_type (arg1)))
- return value_cast (value_type (arg1), value_neg (arg1));
- else
- {
- unop_promote (exp->language_defn, exp->gdbarch, &arg1);
- return value_neg (arg1);
- }
+ return ada_unop_neg (expect_type, exp, noside, op, arg1);
case BINOP_LOGICAL_AND:
case BINOP_LOGICAL_OR:
= evaluate_subexp (nullptr, exp, pos, noside);
struct value *high_bound_val
= evaluate_subexp (nullptr, exp, pos, noside);
- LONGEST low_bound;
- LONGEST high_bound;
-
- low_bound_val = coerce_ref (low_bound_val);
- high_bound_val = coerce_ref (high_bound_val);
- low_bound = value_as_long (low_bound_val);
- high_bound = value_as_long (high_bound_val);
if (noside == EVAL_SKIP)
goto nosideret;
- /* If this is a reference to an aligner type, then remove all
- the aligners. */
- if (value_type (array)->code () == TYPE_CODE_REF
- && ada_is_aligner_type (TYPE_TARGET_TYPE (value_type (array))))
- TYPE_TARGET_TYPE (value_type (array)) =
- ada_aligned_type (TYPE_TARGET_TYPE (value_type (array)));
-
- if (ada_is_constrained_packed_array_type (value_type (array)))
- error (_("cannot slice a packed array"));
-
- /* If this is a reference to an array or an array lvalue,
- convert to a pointer. */
- if (value_type (array)->code () == TYPE_CODE_REF
- || (value_type (array)->code () == TYPE_CODE_ARRAY
- && VALUE_LVAL (array) == lval_memory))
- array = value_addr (array);
-
- if (noside == EVAL_AVOID_SIDE_EFFECTS
- && ada_is_array_descriptor_type (ada_check_typedef
- (value_type (array))))
- return empty_array (ada_type_of_array (array, 0), low_bound,
- high_bound);
-
- array = ada_coerce_to_simple_array_ptr (array);
-
- /* If we have more than one level of pointer indirection,
- dereference the value until we get only one level. */
- while (value_type (array)->code () == TYPE_CODE_PTR
- && (TYPE_TARGET_TYPE (value_type (array))->code ()
- == TYPE_CODE_PTR))
- array = value_ind (array);
-
- /* Make sure we really do have an array type before going further,
- to avoid a SEGV when trying to get the index type or the target
- type later down the road if the debug info generated by
- the compiler is incorrect or incomplete. */
- if (!ada_is_simple_array_type (value_type (array)))
- error (_("cannot take slice of non-array"));
-
- if (ada_check_typedef (value_type (array))->code ()
- == TYPE_CODE_PTR)
- {
- struct type *type0 = ada_check_typedef (value_type (array));
-
- if (high_bound < low_bound || noside == EVAL_AVOID_SIDE_EFFECTS)
- return empty_array (TYPE_TARGET_TYPE (type0), low_bound, high_bound);
- else
- {
- struct type *arr_type0 =
- to_fixed_array_type (TYPE_TARGET_TYPE (type0), NULL, 1);
-
- return ada_value_slice_from_ptr (array, arr_type0,
- longest_to_int (low_bound),
- longest_to_int (high_bound));
- }
- }
- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return array;
- else if (high_bound < low_bound)
- return empty_array (value_type (array), low_bound, high_bound);
- else
- return ada_value_slice (array, longest_to_int (low_bound),
- longest_to_int (high_bound));
+ return ada_ternop_slice (exp, noside, array, low_bound_val,
+ high_bound_val);
}
case UNOP_IN_RANGE:
(*pos) += 2;
arg1 = evaluate_subexp (nullptr, exp, pos, noside);
type = check_typedef (exp->elts[pc + 1].type);
-
- if (noside == EVAL_SKIP)
- goto nosideret;
-
- switch (type->code ())
- {
- default:
- lim_warning (_("Membership test incompletely implemented; "
- "always returns true"));
- type = language_bool_type (exp->language_defn, exp->gdbarch);
- return value_from_longest (type, (LONGEST) 1);
-
- case TYPE_CODE_RANGE:
- arg2 = value_from_longest (type,
- type->bounds ()->low.const_val ());
- arg3 = value_from_longest (type,
- type->bounds ()->high.const_val ());
- binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
- binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg3);
- type = language_bool_type (exp->language_defn, exp->gdbarch);
- return
- value_from_longest (type,
- (value_less (arg1, arg3)
- || value_equal (arg1, arg3))
- && (value_less (arg2, arg1)
- || value_equal (arg2, arg1)));
- }
+ return ada_unop_in_range (expect_type, exp, noside, op, arg1, type);
case BINOP_IN_BOUNDS:
(*pos) += 2;
if (noside == EVAL_SKIP)
goto nosideret;
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- {
- type = language_bool_type (exp->language_defn, exp->gdbarch);
- return value_zero (type, not_lval);
- }
-
tem = longest_to_int (exp->elts[pc + 1].longconst);
- type = ada_index_type (value_type (arg2), tem, "range");
- if (!type)
- type = value_type (arg1);
-
- 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);
- type = language_bool_type (exp->language_defn, exp->gdbarch);
- return
- value_from_longest (type,
- (value_less (arg1, arg3)
- || value_equal (arg1, arg3))
- && (value_less (arg2, arg1)
- || value_equal (arg2, arg1)));
+ return ada_binop_in_bounds (exp, noside, arg1, arg2, tem);
case TERNOP_IN_RANGE:
arg1 = evaluate_subexp (nullptr, exp, pos, noside);
arg2 = evaluate_subexp (nullptr, exp, pos, noside);
arg3 = evaluate_subexp (nullptr, exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
-
- binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
- binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg3);
- type = language_bool_type (exp->language_defn, exp->gdbarch);
- return
- value_from_longest (type,
- (value_less (arg1, arg3)
- || value_equal (arg1, arg3))
- && (value_less (arg2, arg1)
- || value_equal (arg2, arg1)));
+ return eval_ternop_in_range (expect_type, exp, noside, arg1, arg2, arg3);
case OP_ATR_FIRST:
case OP_ATR_LAST:
if (noside == EVAL_SKIP)
goto nosideret;
- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
- {
- if (type_arg == NULL)
- type_arg = value_type (arg1);
-
- if (ada_is_constrained_packed_array_type (type_arg))
- type_arg = decode_constrained_packed_array_type (type_arg);
-
- if (!discrete_type_p (type_arg))
- {
- switch (op)
- {
- default: /* Should never happen. */
- error (_("unexpected attribute encountered"));
- case OP_ATR_FIRST:
- case OP_ATR_LAST:
- type_arg = ada_index_type (type_arg, tem,
- ada_attribute_name (op));
- break;
- case OP_ATR_LENGTH:
- type_arg = builtin_type (exp->gdbarch)->builtin_int;
- break;
- }
- }
-
- return value_zero (type_arg, not_lval);
- }
- else if (type_arg == NULL)
- {
- arg1 = ada_coerce_ref (arg1);
- if (ada_is_constrained_packed_array_type (value_type (arg1)))
- arg1 = ada_coerce_to_simple_array (arg1);
-
- if (op == OP_ATR_LENGTH)
- type = builtin_type (exp->gdbarch)->builtin_int;
- else
- {
- type = ada_index_type (value_type (arg1), tem,
- ada_attribute_name (op));
- if (type == NULL)
- type = builtin_type (exp->gdbarch)->builtin_int;
- }
-
- switch (op)
- {
- default: /* Should never happen. */
- error (_("unexpected attribute encountered"));
- case OP_ATR_FIRST:
- return value_from_longest
- (type, ada_array_bound (arg1, tem, 0));
- case OP_ATR_LAST:
- return value_from_longest
- (type, ada_array_bound (arg1, tem, 1));
- case OP_ATR_LENGTH:
- return value_from_longest
- (type, ada_array_length (arg1, tem));
- }
- }
- else if (discrete_type_p (type_arg))
- {
- struct type *range_type;
- const char *name = ada_type_name (type_arg);
-
- range_type = NULL;
- if (name != NULL && type_arg->code () != TYPE_CODE_ENUM)
- range_type = to_fixed_range_type (type_arg, NULL);
- if (range_type == NULL)
- range_type = type_arg;
- switch (op)
- {
- default:
- error (_("unexpected attribute encountered"));
- case OP_ATR_FIRST:
- return value_from_longest
- (range_type, ada_discrete_type_low_bound (range_type));
- case OP_ATR_LAST:
- return value_from_longest
- (range_type, ada_discrete_type_high_bound (range_type));
- case OP_ATR_LENGTH:
- error (_("the 'length attribute applies only to array types"));
- }
- }
- else if (type_arg->code () == TYPE_CODE_FLT)
- error (_("unimplemented type attribute"));
- else
- {
- LONGEST low, high;
-
- if (ada_is_constrained_packed_array_type (type_arg))
- type_arg = decode_constrained_packed_array_type (type_arg);
-
- if (op == OP_ATR_LENGTH)
- type = builtin_type (exp->gdbarch)->builtin_int;
- else
- {
- type = ada_index_type (type_arg, tem, ada_attribute_name (op));
- if (type == NULL)
- type = builtin_type (exp->gdbarch)->builtin_int;
- }
-
- switch (op)
- {
- default:
- error (_("unexpected attribute encountered"));
- case OP_ATR_FIRST:
- 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);
- return value_from_longest (type, high);
- case OP_ATR_LENGTH:
- 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);
- }
- }
+ return ada_unop_atr (exp, noside, op, arg1, type_arg, tem);
}
case OP_ATR_TAG:
arg1 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
-
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (ada_tag_type (arg1), not_lval);
-
- return ada_value_tag (arg1);
+ return ada_atr_tag (expect_type, exp, noside, op, arg1);
case OP_ATR_MIN:
case OP_ATR_MAX:
arg2 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (value_type (arg1), not_lval);
- else
- {
- binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
- return value_binop (arg1, arg2,
- op == OP_ATR_MIN ? BINOP_MIN : BINOP_MAX);
- }
+ return ada_binop_minmax (expect_type, exp, noside, op, arg1, arg2);
case OP_ATR_MODULUS:
{
case OP_ATR_SIZE:
arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- type = value_type (arg1);
-
- /* If the argument is a reference, then dereference its type, since
- the user is really asking for the size of the actual object,
- not the size of the pointer. */
- if (type->code () == TYPE_CODE_REF)
- type = TYPE_TARGET_TYPE (type);
-
- if (noside == EVAL_SKIP)
- goto nosideret;
- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (builtin_type (exp->gdbarch)->builtin_int, not_lval);
- else
- return value_from_longest (builtin_type (exp->gdbarch)->builtin_int,
- TARGET_CHAR_BIT * TYPE_LENGTH (type));
+ return ada_atr_size (expect_type, exp, noside, op, arg1);
case OP_ATR_VAL:
evaluate_subexp (nullptr, exp, pos, EVAL_SKIP);
type = exp->elts[pc + 2].type;
if (noside == EVAL_SKIP)
goto nosideret;
- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (type, not_lval);
- else
- return value_val_atr (type, arg1);
+ return ada_val_atr (noside, type, arg1);
case BINOP_EXP:
arg1 = evaluate_subexp (nullptr, exp, pos, noside);
arg2 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (value_type (arg1), not_lval);
- else
- {
- /* For integer exponentiation operations,
- only promote the first argument. */
- if (is_integral_type (value_type (arg2)))
- unop_promote (exp->language_defn, exp->gdbarch, &arg1);
- else
- binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
-
- return value_binop (arg1, arg2, op);
- }
+ return ada_binop_exp (expect_type, exp, noside, op, arg1, arg2);
case UNOP_PLUS:
arg1 = evaluate_subexp (nullptr, exp, pos, noside);
arg1 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
- unop_promote (exp->language_defn, exp->gdbarch, &arg1);
- if (value_less (arg1, value_zero (value_type (arg1), not_lval)))
- return value_neg (arg1);
- else
- return arg1;
+ return ada_abs (expect_type, exp, noside, op, arg1);
case UNOP_IND:
preeval_pos = *pos;
}
\f
- /* Fixed point */
-
-/* If TYPE encodes an Ada fixed-point type, return the suffix of the
- type name that encodes the 'small and 'delta information.
- Otherwise, return NULL. */
-
-static const char *
-gnat_encoded_fixed_point_type_info (struct type *type)
-{
- const char *name = ada_type_name (type);
- enum type_code code = (type == NULL) ? TYPE_CODE_UNDEF : type->code ();
-
- if ((code == TYPE_CODE_INT || code == TYPE_CODE_RANGE) && name != NULL)
- {
- const char *tail = strstr (name, "___XF_");
-
- if (tail == NULL)
- return NULL;
- else
- return tail + 5;
- }
- else if (code == TYPE_CODE_RANGE && TYPE_TARGET_TYPE (type) != type)
- return gnat_encoded_fixed_point_type_info (TYPE_TARGET_TYPE (type));
- else
- return NULL;
-}
-
-/* Returns non-zero iff TYPE represents an Ada fixed-point type. */
-
-int
-ada_is_gnat_encoded_fixed_point_type (struct type *type)
-{
- return gnat_encoded_fixed_point_type_info (type) != NULL;
-}
-
/* Return non-zero iff TYPE represents a System.Address type. */
int
return (type->name () && strcmp (type->name (), "system__address") == 0);
}
-/* Assuming that TYPE is the representation of an Ada fixed-point
- type, return the target floating-point type to be used to represent
- of this type during internal computation. */
-
-static struct type *
-ada_scaling_type (struct type *type)
-{
- return builtin_type (get_type_arch (type))->builtin_long_double;
-}
-
-/* Assuming that TYPE is the representation of an Ada fixed-point
- type, return its delta, or NULL if the type is malformed and the
- delta cannot be determined. */
-
-struct value *
-gnat_encoded_fixed_point_delta (struct type *type)
-{
- const char *encoding = gnat_encoded_fixed_point_type_info (type);
- struct type *scale_type = ada_scaling_type (type);
-
- long long num, den;
-
- if (sscanf (encoding, "_%lld_%lld", &num, &den) < 2)
- return nullptr;
- else
- return value_binop (value_from_longest (scale_type, num),
- value_from_longest (scale_type, den), BINOP_DIV);
-}
-
-/* Assuming that ada_is_gnat_encoded_fixed_point_type (TYPE), return
- the scaling factor ('SMALL value) associated with the type. */
-
-struct value *
-gnat_encoded_fixed_point_scaling_factor (struct type *type)
-{
- const char *encoding = gnat_encoded_fixed_point_type_info (type);
- struct type *scale_type = ada_scaling_type (type);
-
- long long num0, den0, num1, den1;
- int n;
-
- n = sscanf (encoding, "_%lld_%lld_%lld_%lld",
- &num0, &den0, &num1, &den1);
-
- if (n < 2)
- return value_from_longest (scale_type, 1);
- else if (n == 4)
- return value_binop (value_from_longest (scale_type, num1),
- value_from_longest (scale_type, den1), BINOP_DIV);
- else
- return value_binop (value_from_longest (scale_type, num0),
- value_from_longest (scale_type, den0), BINOP_DIV);
-}
-
\f
/* Range types */
scan_discrim_bound (const char *str, int k, struct value *dval, LONGEST * px,
int *pnew_k)
{
- static char *bound_buffer = NULL;
- static size_t bound_buffer_len = 0;
+ static std::string storage;
const char *pstart, *pend, *bound;
struct value *bound_val;
int len = pend - pstart;
/* Strip __ and beyond. */
- GROW_VECT (bound_buffer, bound_buffer_len, len + 1);
- strncpy (bound_buffer, pstart, len);
- bound_buffer[len] = '\0';
-
- bound = bound_buffer;
+ storage = std::string (pstart, len);
+ bound = storage.c_str ();
k = pend - str;
}
return 1;
}
-/* Value of variable named NAME in the current environment. If
- no such variable found, then if ERR_MSG is null, returns 0, and
+/* Value of variable named NAME. Only exact matches are considered.
+ If no such variable found, then if ERR_MSG is null, returns 0, and
otherwise causes an error with message ERR_MSG. */
static struct value *
get_var_value (const char *name, const char *err_msg)
{
- lookup_name_info lookup_name (name, symbol_name_match_type::FULL);
+ std::string quoted_name = add_angle_brackets (name);
+
+ lookup_name_info lookup_name (quoted_name, symbol_name_match_type::FULL);
- std::vector<struct block_symbol> syms;
- int nsyms = ada_lookup_symbol_list_worker (lookup_name,
- get_selected_block (0),
- VAR_DOMAIN, &syms, 1);
+ std::vector<struct block_symbol> syms
+ = ada_lookup_symbol_list_worker (lookup_name,
+ get_selected_block (0),
+ VAR_DOMAIN, 1);
- if (nsyms != 1)
+ if (syms.size () != 1)
{
if (err_msg == NULL)
return 0;
}
else
{
- static char *name_buf = NULL;
- static size_t name_len = 0;
int prefix_len = subtype_info - name;
LONGEST L, U;
struct type *type;
const char *bounds_str;
int n;
- GROW_VECT (name_buf, name_len, prefix_len + 5);
- strncpy (name_buf, name, prefix_len);
- name_buf[prefix_len] = '\0';
-
subtype_info += 5;
bounds_str = strchr (subtype_info, '_');
n = 1;
}
else
{
- strcpy (name_buf + prefix_len, "___L");
- if (!get_int_var_value (name_buf, L))
+ std::string name_buf = std::string (name, prefix_len) + "___L";
+ if (!get_int_var_value (name_buf.c_str (), L))
{
lim_warning (_("Unknown lower bound, using 1."));
L = 1;
}
else
{
- strcpy (name_buf + prefix_len, "___U");
- if (!get_int_var_value (name_buf, U))
+ std::string name_buf = std::string (name, prefix_len) + "___U";
+ if (!get_int_var_value (name_buf.c_str (), U))
{
lim_warning (_("Unknown upper bound, using %ld."), (long) L);
U = L;
static void
check_status_exception (bpstat bs)
{
- bs->stop = should_stop_exception (bs->bp_location_at);
+ bs->stop = should_stop_exception (bs->bp_location_at.get ());
}
/* Implement the PRINT_IT method in the breakpoint_ops structure
/* Invoke callbacks for TYPE and OBJFILE if they were set as non-NULL. */
- if (type && TYPE_OBJFILE (type)
- && (*objfile_func) (TYPE_OBJFILE (type), data))
+ if (type != nullptr && type->objfile_owner () != nullptr
+ && objfile_func (type->objfile_owner (), data))
return 1;
return 0;
}
-static const char *
-ada_op_name (enum exp_opcode opcode)
-{
- switch (opcode)
- {
- default:
- return op_name_standard (opcode);
-
-#define OP_DEFN(op, len, args, binop) case op: return #op;
- ADA_OPERATORS;
-#undef OP_DEFN
-
- case OP_AGGREGATE:
- return "OP_AGGREGATE";
- case OP_CHOICES:
- return "OP_CHOICES";
- case OP_NAME:
- return "OP_NAME";
- }
-}
-
/* As for operator_length, but assumes PC is pointing at the first
element of the operator, and gives meaningful results only for the
Ada-specific operators, returning 0 for *OPLENP and *ARGSP otherwise. */
{"'size", OP_ATR_SIZE, PREC_SUFFIX, 1},
{NULL, OP_NULL, PREC_SUFFIX, 0}
};
-\f
-enum ada_primitive_types {
- ada_primitive_type_int,
- ada_primitive_type_long,
- ada_primitive_type_short,
- ada_primitive_type_char,
- ada_primitive_type_float,
- ada_primitive_type_double,
- ada_primitive_type_void,
- ada_primitive_type_long_long,
- ada_primitive_type_long_double,
- ada_primitive_type_natural,
- ada_primitive_type_positive,
- ada_primitive_type_system_address,
- ada_primitive_type_storage_offset,
- nr_ada_primitive_types
-};
-
\f
/* Language vector */
ada_print_subexp,
ada_operator_length,
ada_operator_check,
- ada_op_name,
ada_dump_subexp_body,
ada_evaluate_subexp
};
const lookup_name_info &lookup_name,
completion_match_result *comp_match_res)
{
- return full_match (symbol_search_name, ada_lookup_name (lookup_name));
+ const char *lname = lookup_name.ada ().lookup_name ().c_str ();
+
+ /* If both symbols start with "_ada_", just let the loop below
+ handle the comparison. However, if only the symbol name starts
+ with "_ada_", skip the prefix and let the match proceed as
+ usual. */
+ if (startswith (symbol_search_name, "_ada_")
+ && !startswith (lname, "_ada"))
+ symbol_search_name += 5;
+
+ int uscore_count = 0;
+ while (*lname != '\0')
+ {
+ if (*symbol_search_name != *lname)
+ {
+ if (*symbol_search_name == 'B' && uscore_count == 2
+ && symbol_search_name[1] == '_')
+ {
+ symbol_search_name += 2;
+ while (isdigit (*symbol_search_name))
+ ++symbol_search_name;
+ if (symbol_search_name[0] == '_'
+ && symbol_search_name[1] == '_')
+ {
+ symbol_search_name += 2;
+ continue;
+ }
+ }
+ return false;
+ }
+
+ if (*symbol_search_name == '_')
+ ++uscore_count;
+ else
+ uscore_count = 0;
+
+ ++symbol_search_name;
+ ++lname;
+ }
+
+ return is_name_suffix (symbol_search_name);
}
/* symbol_name_matcher_ftype for exact (verbatim) matches. */
{
gdb::string_view user_name = lookup_name.name ();
- if (user_name[0] == '<')
+ if (!user_name.empty () && user_name[0] == '<')
{
if (user_name.back () == '>')
m_encoded_name
{
const struct builtin_type *builtin = builtin_type (gdbarch);
- lai->primitive_type_vector
- = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_ada_primitive_types + 1,
- struct type *);
-
- lai->primitive_type_vector [ada_primitive_type_int]
- = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
- 0, "integer");
- lai->primitive_type_vector [ada_primitive_type_long]
- = arch_integer_type (gdbarch, gdbarch_long_bit (gdbarch),
- 0, "long_integer");
- lai->primitive_type_vector [ada_primitive_type_short]
- = arch_integer_type (gdbarch, gdbarch_short_bit (gdbarch),
- 0, "short_integer");
- lai->string_char_type
- = lai->primitive_type_vector [ada_primitive_type_char]
- = arch_character_type (gdbarch, TARGET_CHAR_BIT, 0, "character");
- lai->primitive_type_vector [ada_primitive_type_float]
- = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch),
- "float", gdbarch_float_format (gdbarch));
- lai->primitive_type_vector [ada_primitive_type_double]
- = arch_float_type (gdbarch, gdbarch_double_bit (gdbarch),
- "long_float", gdbarch_double_format (gdbarch));
- lai->primitive_type_vector [ada_primitive_type_long_long]
- = arch_integer_type (gdbarch, gdbarch_long_long_bit (gdbarch),
- 0, "long_long_integer");
- lai->primitive_type_vector [ada_primitive_type_long_double]
- = arch_float_type (gdbarch, gdbarch_long_double_bit (gdbarch),
- "long_long_float", gdbarch_long_double_format (gdbarch));
- lai->primitive_type_vector [ada_primitive_type_natural]
- = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
- 0, "natural");
- lai->primitive_type_vector [ada_primitive_type_positive]
- = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
- 0, "positive");
- lai->primitive_type_vector [ada_primitive_type_void]
- = builtin->builtin_void;
-
- lai->primitive_type_vector [ada_primitive_type_system_address]
+ /* Helper function to allow shorter lines below. */
+ auto add = [&] (struct type *t)
+ {
+ lai->add_primitive_type (t);
+ };
+
+ add (arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
+ 0, "integer"));
+ add (arch_integer_type (gdbarch, gdbarch_long_bit (gdbarch),
+ 0, "long_integer"));
+ add (arch_integer_type (gdbarch, gdbarch_short_bit (gdbarch),
+ 0, "short_integer"));
+ struct type *char_type = arch_character_type (gdbarch, TARGET_CHAR_BIT,
+ 0, "character");
+ lai->set_string_char_type (char_type);
+ add (char_type);
+ add (arch_float_type (gdbarch, gdbarch_float_bit (gdbarch),
+ "float", gdbarch_float_format (gdbarch)));
+ add (arch_float_type (gdbarch, gdbarch_double_bit (gdbarch),
+ "long_float", gdbarch_double_format (gdbarch)));
+ add (arch_integer_type (gdbarch, gdbarch_long_long_bit (gdbarch),
+ 0, "long_long_integer"));
+ add (arch_float_type (gdbarch, gdbarch_long_double_bit (gdbarch),
+ "long_long_float",
+ gdbarch_long_double_format (gdbarch)));
+ add (arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
+ 0, "natural"));
+ add (arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
+ 0, "positive"));
+ add (builtin->builtin_void);
+
+ struct type *system_addr_ptr
= lookup_pointer_type (arch_type (gdbarch, TYPE_CODE_VOID, TARGET_CHAR_BIT,
"void"));
- lai->primitive_type_vector [ada_primitive_type_system_address]
- ->set_name ("system__address");
+ system_addr_ptr->set_name ("system__address");
+ add (system_addr_ptr);
/* Create the equivalent of the System.Storage_Elements.Storage_Offset
type. This is a signed integral type whose size is the same as
the size of addresses. */
- {
- unsigned int addr_length = TYPE_LENGTH
- (lai->primitive_type_vector [ada_primitive_type_system_address]);
+ unsigned int addr_length = TYPE_LENGTH (system_addr_ptr);
+ add (arch_integer_type (gdbarch, addr_length * HOST_CHAR_BIT, 0,
+ "storage_offset"));
- lai->primitive_type_vector [ada_primitive_type_storage_offset]
- = arch_integer_type (gdbarch, addr_length * HOST_CHAR_BIT, 0,
- "storage_offset");
- }
-
- lai->bool_type_symbol = NULL;
- lai->bool_type_default = builtin->builtin_bool;
+ lai->set_bool_type (builtin->builtin_bool);
}
/* See language.h. */
domain_enum domain,
gdb::function_view<symbol_found_callback_ftype> callback) const override
{
- std::vector<struct block_symbol> results;
-
- ada_lookup_symbol_list_worker (name, block, domain, &results, 0);
+ std::vector<struct block_symbol> results
+ = ada_lookup_symbol_list_worker (name, block, domain, 0);
for (block_symbol &sym : results)
{
if (!callback (&sym))
A null CONTEXT_TYPE indicates that a non-void return type is
preferred. May change (expand) *EXP. */
- void post_parser (expression_up *expp, int void_context_p, int completing,
- innermost_block_tracker *tracker) const override
+ void post_parser (expression_up *expp, struct parser_state *ps)
+ const override
{
struct type *context_type = NULL;
int pc = 0;
- if (void_context_p)
+ if (ps->void_context_p)
context_type = builtin_type ((*expp)->gdbarch)->builtin_void;
- resolve_subexp (expp, &pc, 1, context_type, completing, tracker);
+ resolve_subexp (expp, &pc, 1, context_type, ps->parse_completion,
+ ps->block_tracker);
}
/* See language.h. */
projects / deliverable / binutils-gdb.git / blobdiff