/* Ada language support routines for GDB, the GNU debugger.
- Copyright (C) 1992-2017 Free Software Foundation, Inc.
+ Copyright (C) 1992-2018 Free Software Foundation, Inc.
This file is part of GDB.
#include "annotate.h"
#include "valprint.h"
#include "source.h"
-#include "observer.h"
+#include "observable.h"
#include "vec.h"
#include "stack.h"
#include "gdb_vecs.h"
#include "cli/cli-utils.h"
#include "common/function-view.h"
#include "common/byte-vector.h"
+#include <algorithm>
/* Define whether or not the C operator '/' truncates towards zero for
differently signed operands (truncation direction is undefined in C).
static int ada_args_match (struct symbol *, struct value **, int);
-static int full_match (const char *, const char *);
-
static struct value *make_array_descriptor (struct type *, struct value *);
static void ada_add_block_symbols (struct obstack *,
- const struct block *, const char *,
- domain_enum, struct objfile *, int);
+ const struct block *,
+ const lookup_name_info &lookup_name,
+ domain_enum, struct objfile *);
static void ada_add_all_symbols (struct obstack *, const struct block *,
- const char *, domain_enum, int, int *);
+ const lookup_name_info &lookup_name,
+ domain_enum, int, int *);
static int is_nonfunction (struct block_symbol *, int);
static struct block_symbol *defns_collected (struct obstack *, int);
-static struct value *resolve_subexp (struct expression **, int *, int,
+static struct value *resolve_subexp (expression_up *, int *, int,
struct type *);
-static void replace_operator_with_call (struct expression **, int, int, int,
+static void replace_operator_with_call (expression_up *, int, int, int,
struct symbol *, const struct block *);
static int possible_user_operator_p (enum exp_opcode, struct value **);
const struct block *);
static struct type *ada_lookup_struct_elt_type (struct type *, const char *,
- int, int, int *);
+ int, int);
static struct value *evaluate_subexp_type (struct expression *, int *);
static struct value *coerce_unspec_val_to_type (struct value *,
struct type *);
-static struct value *get_var_value (char *, char *);
-
static int lesseq_defined_than (struct symbol *, struct symbol *);
static int equiv_types (struct type *, struct type *);
static int advance_wild_match (const char **, const char *, int);
-static int wild_match (const char *, const char *);
+static bool wild_match (const char *name, const char *patn);
static struct value *ada_coerce_ref (struct value *);
static int find_struct_field (const char *, struct type *, int,
struct type **, int *, int *, int *, int *);
-static struct value *ada_to_fixed_value_create (struct type *, CORE_ADDR,
- struct value *);
-
static int ada_resolve_function (struct block_symbol *, int,
struct value **, int, const char *,
struct type *);
int *);
static struct type *ada_find_any_type (const char *name);
+
+static symbol_name_matcher_ftype *ada_get_symbol_name_matcher
+ (const lookup_name_info &lookup_name);
+
\f
/* The result of a symbol lookup to be stored in our symbol cache. */
ADA_KNOWN_AUXILIARY_FUNCTION_NAME_PATTERNS NULL
};
-/* Space for allocating results of ada_lookup_symbol_list. */
-static struct obstack symbol_list_obstack;
-
/* Maintenance-related settings for this module. */
static struct cmd_list_element *maint_set_ada_cmdlist;
/* Implement the "maintenance set ada" (prefix) command. */
static void
-maint_set_ada_cmd (char *args, int from_tty)
+maint_set_ada_cmd (const char *args, int from_tty)
{
help_list (maint_set_ada_cmdlist, "maintenance set ada ", all_commands,
gdb_stdout);
/* Implement the "maintenance show ada" (prefix) command. */
static void
-maint_show_ada_cmd (char *args, int from_tty)
+maint_show_ada_cmd (const char *args, int from_tty)
{
cmd_show_list (maint_show_ada_cmdlist, from_tty, "");
}
ada_main_name (void)
{
struct bound_minimal_symbol msym;
- static char *main_program_name = NULL;
+ static gdb::unique_xmalloc_ptr<char> main_program_name;
/* For Ada, the name of the main procedure is stored in a specific
string constant, generated by the binder. Look for that symbol,
if (main_program_name_addr == 0)
error (_("Invalid address for Ada main program name."));
- xfree (main_program_name);
target_read_string (main_program_name_addr, &main_program_name,
1024, &err_code);
if (err_code != 0)
return NULL;
- return main_program_name;
+ return main_program_name.get ();
}
/* The main procedure doesn't seem to be in Ada. */
{NULL, NULL}
};
-/* The "encoded" form of DECODED, according to GNAT conventions.
- The result is valid until the next call to ada_encode. */
+/* The "encoded" form of DECODED, according to GNAT conventions. The
+ result is valid until the next call to ada_encode. If
+ THROW_ERRORS, throw an error if invalid operator name is found.
+ Otherwise, return NULL in that case. */
-char *
-ada_encode (const char *decoded)
+static char *
+ada_encode_1 (const char *decoded, bool throw_errors)
{
static char *encoding_buffer = NULL;
static size_t encoding_buffer_size = 0;
&& !startswith (p, mapping->decoded); mapping += 1)
;
if (mapping->encoded == NULL)
- error (_("invalid Ada operator name: %s"), p);
+ {
+ if (throw_errors)
+ error (_("invalid Ada operator name: %s"), p);
+ else
+ return NULL;
+ }
strcpy (encoding_buffer + k, mapping->encoded);
k += strlen (mapping->encoded);
break;
return encoding_buffer;
}
+/* The "encoded" form of DECODED, according to GNAT conventions.
+ The result is valid until the next call to ada_encode. */
+
+char *
+ada_encode (const char *decoded)
+{
+ return ada_encode_1 (decoded, true);
+}
+
/* Return NAME folded to lower case, or, if surrounded by single
quotes, unfolded, but with the quotes stripped away. Result good
to next call. */
return 0;
}
-/* Returns non-zero iff SYM_NAME matches 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). If WILD, then NAME need only match a
- suffix of SYM_NAME minus the same suffixes. Also returns 0 if
- either argument is NULL. */
-
-static int
-match_name (const char *sym_name, const char *name, int wild)
-{
- if (sym_name == NULL || name == NULL)
- return 0;
- else if (wild)
- return wild_match (sym_name, name) == 0;
- else
- {
- int len_name = strlen (name);
-
- return (strncmp (sym_name, name, len_name) == 0
- && is_name_suffix (sym_name + len_name))
- || (startswith (sym_name, "_ada_")
- && strncmp (sym_name + 5, name, len_name) == 0
- && is_name_suffix (sym_name + len_name + 5));
- }
-}
\f
/* Arrays */
struct type *base_index_type = TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (type0));
struct type *index_type
= create_static_range_type (NULL, base_index_type, low, high);
- struct type *slice_type =
- create_array_type (NULL, TYPE_TARGET_TYPE (type0), index_type);
+ struct type *slice_type = create_array_type_with_stride
+ (NULL, TYPE_TARGET_TYPE (type0), index_type,
+ get_dyn_prop (DYN_PROP_BYTE_STRIDE, type0),
+ TYPE_FIELD_BITSIZE (type0, 0));
int base_low = ada_discrete_type_low_bound (TYPE_INDEX_TYPE (type0));
LONGEST base_low_pos, low_pos;
CORE_ADDR base;
struct type *base_index_type = TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (type));
struct type *index_type
= create_static_range_type (NULL, TYPE_INDEX_TYPE (type), low, high);
- struct type *slice_type =
- create_array_type (NULL, TYPE_TARGET_TYPE (type), index_type);
+ struct type *slice_type = create_array_type_with_stride
+ (NULL, TYPE_TARGET_TYPE (type), index_type,
+ get_dyn_prop (DYN_PROP_BYTE_STRIDE, type),
+ TYPE_FIELD_BITSIZE (type, 0));
LONGEST low_pos, high_pos;
if (!discrete_position (base_index_type, low, &low_pos)
}
arr_type = check_typedef (arr_type);
- index_type = TYPE_INDEX_TYPE (arr_type);
+ index_type = ada_index_type (arr_type, n, "length");
if (index_type != NULL)
{
struct type *base_type;
return type is preferred. May change (expand) *EXP. */
static void
-resolve (struct expression **expp, int void_context_p)
+resolve (expression_up *expp, int void_context_p)
{
struct type *context_type = NULL;
int pc = 0;
are as in ada_resolve, above. */
static struct value *
-resolve_subexp (struct expression **expp, int *pos, int deprocedure_p,
+resolve_subexp (expression_up *expp, int *pos, int deprocedure_p,
struct type *context_type)
{
int pc = *pos;
struct value **argvec; /* Vector of operand types (alloca'ed). */
int nargs; /* Number of operands. */
int oplen;
+ struct cleanup *old_chain = make_cleanup (null_cleanup, NULL);
argvec = NULL;
nargs = 0;
- exp = *expp;
+ exp = expp->get ();
/* Pass one: resolve operands, saving their types and updating *pos,
if needed. */
break;
case OP_LONG:
- case OP_DOUBLE:
+ case OP_FLOAT:
case OP_VAR_VALUE:
+ case OP_VAR_MSYM_VALUE:
*pos += 4;
break;
for (i = 0; i < nargs; i += 1)
argvec[i] = resolve_subexp (expp, pos, 1, NULL);
argvec[i] = NULL;
- exp = *expp;
+ exp = expp->get ();
/* Pass two: perform any resolution on principal operator. */
switch (op)
(exp->elts[pc + 2].symbol),
exp->elts[pc + 1].block, VAR_DOMAIN,
&candidates);
+ make_cleanup (xfree, candidates);
if (n_candidates > 1)
{
exp->elts[pc + 1].block = candidates[i].block;
exp->elts[pc + 2].symbol = candidates[i].symbol;
- if (innermost_block == NULL
- || contained_in (candidates[i].block, innermost_block))
- innermost_block = candidates[i].block;
+ innermost_block.update (candidates[i]);
}
if (deprocedure_p
replace_operator_with_call (expp, pc, 0, 0,
exp->elts[pc + 2].symbol,
exp->elts[pc + 1].block);
- exp = *expp;
+ exp = expp->get ();
}
break;
(exp->elts[pc + 5].symbol),
exp->elts[pc + 4].block, VAR_DOMAIN,
&candidates);
+ make_cleanup (xfree, candidates);
+
if (n_candidates == 1)
i = 0;
else
exp->elts[pc + 4].block = candidates[i].block;
exp->elts[pc + 5].symbol = candidates[i].symbol;
- if (innermost_block == NULL
- || contained_in (candidates[i].block, innermost_block))
- innermost_block = candidates[i].block;
+ innermost_block.update (candidates[i]);
}
}
break;
int n_candidates;
n_candidates =
- ada_lookup_symbol_list (ada_encode (ada_decoded_op_name (op)),
+ ada_lookup_symbol_list (ada_decoded_op_name (op),
(struct block *) NULL, VAR_DOMAIN,
&candidates);
+ make_cleanup (xfree, candidates);
+
i = ada_resolve_function (candidates, n_candidates, argvec, nargs,
ada_decoded_op_name (op), NULL);
if (i < 0)
replace_operator_with_call (expp, pc, nargs, 1,
candidates[i].symbol,
candidates[i].block);
- exp = *expp;
+ exp = expp->get ();
}
break;
case OP_TYPE:
case OP_REGISTER:
+ do_cleanups (old_chain);
return NULL;
}
*pos = pc;
- return evaluate_subexp_type (exp, pos);
+ do_cleanups (old_chain);
+ if (exp->elts[pc].opcode == OP_VAR_MSYM_VALUE)
+ return evaluate_var_msym_value (EVAL_AVOID_SIDE_EFFECTS,
+ exp->elts[pc + 1].objfile,
+ exp->elts[pc + 2].msymbol);
+ else
+ return evaluate_subexp_type (exp, pos);
}
/* Return non-zero if formal type FTYPE matches actual type ATYPE. If
arguments. Update *EXPP as needed to hold more space. */
static void
-replace_operator_with_call (struct expression **expp, int pc, int nargs,
+replace_operator_with_call (expression_up *expp, int pc, int nargs,
int oplen, struct symbol *sym,
const struct block *block)
{
struct expression *newexp = (struct expression *)
xzalloc (sizeof (struct expression)
+ EXP_ELEM_TO_BYTES ((*expp)->nelts + 7 - oplen));
- struct expression *exp = *expp;
+ struct expression *exp = expp->get ();
newexp->nelts = exp->nelts + 7 - oplen;
newexp->language_defn = exp->language_defn;
newexp->elts[pc + 4].block = block;
newexp->elts[pc + 5].symbol = sym;
- *expp = newexp;
- xfree (exp);
+ expp->reset (newexp);
}
/* Type-class predicates */
if (TYPE_CODE (formal_target) == TYPE_CODE_ARRAY
&& ada_is_array_descriptor_type (actual_target))
result = desc_data (actual);
- else if (TYPE_CODE (actual_type) != TYPE_CODE_PTR)
+ else if (TYPE_CODE (formal_type) != TYPE_CODE_PTR)
{
if (VALUE_LVAL (actual) != lval_memory)
{
\f
/* Symbol Lookup */
-/* Return nonzero if wild matching should be used when searching for
- all symbols matching LOOKUP_NAME.
+/* Return the symbol name match type that should be used used when
+ searching for all symbols matching LOOKUP_NAME.
LOOKUP_NAME is expected to be a symbol name after transformation
- for Ada lookups (see ada_name_for_lookup). */
+ for Ada lookups. */
-static int
-should_use_wild_match (const char *lookup_name)
+static symbol_name_match_type
+name_match_type_from_name (const char *lookup_name)
{
- return (strstr (lookup_name, "__") == NULL);
+ return (strstr (lookup_name, "__") == NULL
+ ? symbol_name_match_type::WILD
+ : symbol_name_match_type::FULL);
}
/* Return the result of a standard (literal, C-like) lookup of NAME in
struct bound_minimal_symbol result;
struct objfile *objfile;
struct minimal_symbol *msymbol;
- const int wild_match_p = should_use_wild_match (name);
memset (&result, 0, sizeof (result));
- /* Special case: If the user specifies a symbol name inside package
- Standard, do a non-wild matching of the symbol name without
- the "standard__" prefix. This was primarily introduced in order
- to allow the user to specifically access the standard exceptions
- using, for instance, Standard.Constraint_Error when Constraint_Error
- is ambiguous (due to the user defining its own Constraint_Error
- entity inside its program). */
- if (startswith (name, "standard__"))
- name += sizeof ("standard__") - 1;
+ symbol_name_match_type match_type = name_match_type_from_name (name);
+ lookup_name_info lookup_name (name, match_type);
+
+ symbol_name_matcher_ftype *match_name
+ = ada_get_symbol_name_matcher (lookup_name);
ALL_MSYMBOLS (objfile, msymbol)
{
- if (match_name (MSYMBOL_LINKAGE_NAME (msymbol), name, wild_match_p)
+ if (match_name (MSYMBOL_LINKAGE_NAME (msymbol), lookup_name, NULL)
&& MSYMBOL_TYPE (msymbol) != mst_solib_trampoline)
{
result.minsym = msymbol;
static void
add_symbols_from_enclosing_procs (struct obstack *obstackp,
- const char *name, domain_enum domain,
- int wild_match_p)
+ const lookup_name_info &lookup_name,
+ domain_enum domain)
{
}
Note: This function assumes that OBSTACKP has 0 (zero) element in it. */
static void
-ada_add_local_symbols (struct obstack *obstackp, const char *name,
- const struct block *block, domain_enum domain,
- int wild_match_p)
+ada_add_local_symbols (struct obstack *obstackp,
+ const lookup_name_info &lookup_name,
+ const struct block *block, domain_enum domain)
{
int block_depth = 0;
while (block != NULL)
{
block_depth += 1;
- ada_add_block_symbols (obstackp, block, name, domain, NULL,
- wild_match_p);
+ ada_add_block_symbols (obstackp, block, lookup_name, domain, NULL);
/* If we found a non-function match, assume that's the one. */
if (is_nonfunction (defns_collected (obstackp, 0),
/* 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, name, domain, wild_match_p);
+ add_symbols_from_enclosing_procs (obstackp, lookup_name, domain);
}
/* An object of this type is used as the user_data argument when
return 0;
}
-/* Helper for add_nonlocal_symbols. Find symbols in DOMAIN which are targetted
- by renamings matching NAME in BLOCK. Add these symbols to OBSTACKP. If
- WILD_MATCH_P is nonzero, perform the naming matching in "wild" mode (see
- function "wild_match" for more information). Return whether we found such
- symbols. */
+/* 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. */
static int
ada_add_block_renamings (struct obstack *obstackp,
const struct block *block,
- const char *name,
- domain_enum domain,
- int wild_match_p)
+ const lookup_name_info &lookup_name,
+ domain_enum domain)
{
struct using_direct *renaming;
int defns_mark = num_defns_collected (obstackp);
+ symbol_name_matcher_ftype *name_match
+ = ada_get_symbol_name_matcher (lookup_name);
+
for (renaming = block_using (block);
renaming != NULL;
renaming = renaming->next)
{
const char *r_name;
- int name_match;
/* Avoid infinite recursions: skip this renaming if we are actually
already traversing it.
r_name = (renaming->alias != NULL
? renaming->alias
: renaming->declaration);
- name_match
- = wild_match_p ? wild_match (r_name, name) : strcmp (r_name, name);
- if (name_match == 0)
- ada_add_all_symbols (obstackp, block, renaming->declaration, domain,
- 1, NULL);
+ if (name_match (r_name, lookup_name, NULL))
+ {
+ lookup_name_info decl_lookup_name (renaming->declaration,
+ lookup_name.match_type ());
+ ada_add_all_symbols (obstackp, block, decl_lookup_name, domain,
+ 1, NULL);
+ }
renaming->searched = 0;
}
return num_defns_collected (obstackp) != defns_mark;
return result;
}
+/* Convenience function to get at the Ada encoded lookup name for
+ LOOKUP_NAME, as a C string. */
+
+static const char *
+ada_lookup_name (const lookup_name_info &lookup_name)
+{
+ return lookup_name.ada ().lookup_name ().c_str ();
+}
+
/* Add to OBSTACKP all non-local symbols whose name and domain match
- NAME and DOMAIN respectively. The search is performed on GLOBAL_BLOCK
- symbols if GLOBAL is non-zero, or on STATIC_BLOCK symbols otherwise. */
+ 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, const char *name,
- domain_enum domain, int global,
- int is_wild_match)
+add_nonlocal_symbols (struct obstack *obstackp,
+ const lookup_name_info &lookup_name,
+ domain_enum domain, int global)
{
struct objfile *objfile;
struct compunit_symtab *cu;
memset (&data, 0, sizeof data);
data.obstackp = obstackp;
+ bool is_wild_match = lookup_name.ada ().wild_match_p ();
+
ALL_OBJFILES (objfile)
{
data.objfile = objfile;
if (is_wild_match)
- objfile->sf->qf->map_matching_symbols (objfile, name, domain, global,
+ objfile->sf->qf->map_matching_symbols (objfile, lookup_name.name ().c_str (),
+ domain, global,
aux_add_nonlocal_symbols, &data,
- wild_match, NULL);
+ symbol_name_match_type::WILD,
+ NULL);
else
- objfile->sf->qf->map_matching_symbols (objfile, name, domain, global,
+ objfile->sf->qf->map_matching_symbols (objfile, lookup_name.name ().c_str (),
+ domain, global,
aux_add_nonlocal_symbols, &data,
- full_match, compare_names);
+ symbol_name_match_type::FULL,
+ compare_names);
ALL_OBJFILE_COMPUNITS (objfile, cu)
{
const struct block *global_block
= BLOCKVECTOR_BLOCK (COMPUNIT_BLOCKVECTOR (cu), GLOBAL_BLOCK);
- if (ada_add_block_renamings (obstackp, global_block , name, domain,
- is_wild_match))
+ if (ada_add_block_renamings (obstackp, global_block, lookup_name,
+ domain))
data.found_sym = 1;
}
}
if (num_defns_collected (obstackp) == 0 && global && !is_wild_match)
{
+ const char *name = ada_lookup_name (lookup_name);
+ std::string name1 = std::string ("<_ada_") + name + '>';
+
ALL_OBJFILES (objfile)
{
- char *name1 = (char *) alloca (strlen (name) + sizeof ("_ada_"));
- strcpy (name1, "_ada_");
- strcpy (name1 + sizeof ("_ada_") - 1, name);
data.objfile = objfile;
- objfile->sf->qf->map_matching_symbols (objfile, name1, domain,
- global,
+ objfile->sf->qf->map_matching_symbols (objfile, name1.c_str (),
+ domain, global,
aux_add_nonlocal_symbols,
&data,
- full_match, compare_names);
+ symbol_name_match_type::FULL,
+ compare_names);
}
}
}
-/* Find symbols in DOMAIN matching 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.
+/* 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.
When FULL_SEARCH is non-zero, any non-function/non-enumeral
symbol match within the nest of blocks whose innermost member is BLOCK,
enclosing blocks is returned). If there are any matches in or
surrounding BLOCK, then these alone are returned.
- Names prefixed with "standard__" are handled specially: "standard__"
- is first stripped off, and only static and global symbols are searched.
+ Names prefixed with "standard__" are handled specially:
+ "standard__" is first stripped off (by the lookup_name
+ constructor), and only static and global symbols are searched.
If MADE_GLOBAL_LOOKUP_P is non-null, set it before return to whether we had
to lookup global symbols. */
static void
ada_add_all_symbols (struct obstack *obstackp,
const struct block *block,
- const char *name,
+ const lookup_name_info &lookup_name,
domain_enum domain,
int full_search,
int *made_global_lookup_p)
{
struct symbol *sym;
- const int wild_match_p = should_use_wild_match (name);
if (made_global_lookup_p)
*made_global_lookup_p = 0;
using, for instance, Standard.Constraint_Error when Constraint_Error
is ambiguous (due to the user defining its own Constraint_Error
entity inside its program). */
- if (startswith (name, "standard__"))
- {
- block = NULL;
- name = name + sizeof ("standard__") - 1;
- }
+ if (lookup_name.ada ().standard_p ())
+ block = NULL;
/* Check the non-global symbols. If we have ANY match, then we're done. */
if (block != NULL)
{
if (full_search)
- ada_add_local_symbols (obstackp, name, block, domain, wild_match_p);
+ ada_add_local_symbols (obstackp, lookup_name, block, domain);
else
{
/* In the !full_search case we're are being called by
ada_iterate_over_symbols, and we don't want to search
superblocks. */
- ada_add_block_symbols (obstackp, block, name, domain, NULL,
- wild_match_p);
+ ada_add_block_symbols (obstackp, block, lookup_name, domain, NULL);
}
if (num_defns_collected (obstackp) > 0 || !full_search)
return;
already performed this search before. If we have, then return
the same result. */
- if (lookup_cached_symbol (name, domain, &sym, &block))
+ if (lookup_cached_symbol (ada_lookup_name (lookup_name),
+ domain, &sym, &block))
{
if (sym != NULL)
- add_defn_to_vec (obstackp, sym, block);
+ add_defn_to_vec (obstackp, sym, block);
return;
}
/* Search symbols from all global blocks. */
- add_nonlocal_symbols (obstackp, name, domain, 1, wild_match_p);
+ add_nonlocal_symbols (obstackp, 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, name, domain, 0, wild_match_p);
+ add_nonlocal_symbols (obstackp, lookup_name, domain, 0);
}
-/* Find symbols in DOMAIN matching NAME, in BLOCK and, if full_search is
- non-zero, enclosing scope and in global scopes, returning the number of
+/* 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.
- Sets *RESULTS to point to a vector of (SYM,BLOCK) tuples,
+ Sets *RESULTS to point to a newly allocated vector of (SYM,BLOCK) tuples,
indicating the symbols found and the blocks and symbol tables (if
- any) in which they were found. This vector is transient---good only to
- the next call of ada_lookup_symbol_list.
+ any) in which they were found. This vector should be freed when
+ no longer useful.
When full_search is non-zero, any non-function/non-enumeral
symbol match within the nest of blocks whose innermost member is BLOCK,
is first stripped off, and only static and global symbols are searched. */
static int
-ada_lookup_symbol_list_worker (const char *name, const struct block *block,
+ada_lookup_symbol_list_worker (const lookup_name_info &lookup_name,
+ const struct block *block,
domain_enum domain,
struct block_symbol **results,
int full_search)
{
- const int wild_match_p = should_use_wild_match (name);
int syms_from_global_search;
int ndefns;
+ int results_size;
+ auto_obstack obstack;
+
+ ada_add_all_symbols (&obstack, block, lookup_name,
+ domain, full_search, &syms_from_global_search);
- obstack_free (&symbol_list_obstack, NULL);
- obstack_init (&symbol_list_obstack);
- ada_add_all_symbols (&symbol_list_obstack, block, name, domain,
- full_search, &syms_from_global_search);
+ ndefns = num_defns_collected (&obstack);
- ndefns = num_defns_collected (&symbol_list_obstack);
- *results = defns_collected (&symbol_list_obstack, 1);
+ results_size = obstack_object_size (&obstack);
+ *results = (struct block_symbol *) malloc (results_size);
+ memcpy (*results, defns_collected (&obstack, 1), results_size);
ndefns = remove_extra_symbols (*results, ndefns);
if (ndefns == 0 && full_search && syms_from_global_search)
- cache_symbol (name, domain, NULL, NULL);
+ cache_symbol (ada_lookup_name (lookup_name), domain, NULL, NULL);
if (ndefns == 1 && full_search && syms_from_global_search)
- cache_symbol (name, domain, (*results)[0].symbol, (*results)[0].block);
+ cache_symbol (ada_lookup_name (lookup_name), domain,
+ (*results)[0].symbol, (*results)[0].block);
ndefns = remove_irrelevant_renamings (*results, ndefns, block);
+
return ndefns;
}
-/* Find symbols in DOMAIN matching NAME0, in BLOCK0 and enclosing scope and
+/* Find symbols in DOMAIN matching NAME, in BLOCK and enclosing scope and
in global scopes, returning the number of matches, and setting *RESULTS
- to a vector of (SYM,BLOCK) tuples.
+ to a newly-allocated vector of (SYM,BLOCK) tuples. This newly-allocated
+ vector should be freed when no longer useful.
+
See ada_lookup_symbol_list_worker for further details. */
int
-ada_lookup_symbol_list (const char *name0, const struct block *block0,
+ada_lookup_symbol_list (const char *name, const struct block *block,
domain_enum domain, struct block_symbol **results)
{
- return ada_lookup_symbol_list_worker (name0, block0, domain, results, 1);
+ 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);
}
/* Implementation of the la_iterate_over_symbols method. */
static void
ada_iterate_over_symbols
- (const struct block *block, const char *name, domain_enum domain,
+ (const struct block *block, const lookup_name_info &name,
+ domain_enum domain,
gdb::function_view<symbol_found_callback_ftype> callback)
{
int ndefs, i;
struct block_symbol *results;
+ struct cleanup *old_chain;
ndefs = ada_lookup_symbol_list_worker (name, block, domain, &results, 0);
+ old_chain = make_cleanup (xfree, results);
+
for (i = 0; i < ndefs; ++i)
{
if (!callback (results[i].symbol))
break;
}
-}
-
-/* If NAME is the name of an entity, return a string that should
- be used to look that entity up in Ada units.
-
- NAME can have any form that the "break" or "print" commands might
- recognize. In other words, it does not have to be the "natural"
- name, or the "encoded" name. */
-std::string
-ada_name_for_lookup (const char *name)
-{
- int nlen = strlen (name);
-
- if (name[0] == '<' && name[nlen - 1] == '>')
- return std::string (name + 1, nlen - 2);
- else
- return ada_encode (ada_fold_name (name));
+ do_cleanups (old_chain);
}
/* The result is as for ada_lookup_symbol_list with FULL_SEARCH set
domain_enum domain,
struct block_symbol *info)
{
- struct block_symbol *candidates;
- int n_candidates;
+ /* Since we already have an encoded name, wrap it in '<>' to force a
+ verbatim match. Otherwise, if the name happens to not look like
+ an encoded name (because it doesn't include a "__"),
+ 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 + '>';
gdb_assert (info != NULL);
- memset (info, 0, sizeof (struct block_symbol));
-
- n_candidates = ada_lookup_symbol_list (name, block, domain, &candidates);
- if (n_candidates == 0)
- return;
-
- *info = candidates[0];
- info->symbol = fixup_symbol_section (info->symbol, NULL);
+ *info = ada_lookup_symbol (verbatim.c_str (), block, domain, NULL);
}
/* Return a symbol in DOMAIN matching NAME, in BLOCK0 and enclosing
ada_lookup_symbol (const char *name, const struct block *block0,
domain_enum domain, int *is_a_field_of_this)
{
- struct block_symbol info;
-
if (is_a_field_of_this != NULL)
*is_a_field_of_this = 0;
- ada_lookup_encoded_symbol (ada_encode (ada_fold_name (name)),
- block0, domain, &info);
+ struct block_symbol *candidates;
+ int n_candidates;
+ struct cleanup *old_chain;
+
+ n_candidates = ada_lookup_symbol_list (name, block0, domain, &candidates);
+ old_chain = make_cleanup (xfree, candidates);
+
+ if (n_candidates == 0)
+ {
+ do_cleanups (old_chain);
+ return {};
+ }
+
+ block_symbol info = candidates[0];
+ info.symbol = fixup_symbol_section (info.symbol, NULL);
+
+ do_cleanups (old_chain);
+
return info;
}
return 1;
}
-/* Return 0 iff NAME encodes a name of the form prefix.PATN. Ignores any
- informational suffixes of NAME (i.e., for which is_name_suffix is
- true). Assumes that PATN is a lower-cased Ada simple name. */
+/* Return true iff NAME encodes a name of the form prefix.PATN.
+ Ignores any informational suffixes of NAME (i.e., for which
+ is_name_suffix is true). Assumes that PATN is a lower-cased Ada
+ simple name. */
-static int
+static bool
wild_match (const char *name, const char *patn)
{
const char *p;
if (*p != *name)
break;
if (*p == '\0' && is_name_suffix (name))
- return match != name0 && !is_valid_name_for_wild_match (name0);
+ return match == name0 || is_valid_name_for_wild_match (name0);
if (name[-1] == '_')
name -= 1;
}
if (!advance_wild_match (&name, name0, *patn))
- return 1;
+ return false;
}
}
-/* Returns 0 iff symbol name SYM_NAME matches SEARCH_NAME, apart from
- informational suffix. */
+/* 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 int
+static bool
full_match (const char *sym_name, const char *search_name)
{
- return !match_name (sym_name, search_name, 0);
-}
+ 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 identifier NAME in DOMAIN to
- vector *defn_symbols, updating the list of symbols in OBSTACKP
- (if necessary). If WILD, treat as NAME with a wildcard prefix.
- OBJFILE is the section containing BLOCK. */
+/* Add symbols from BLOCK matching LOOKUP_NAME in DOMAIN to vector
+ *defn_symbols, updating the list of symbols in OBSTACKP (if
+ necessary). OBJFILE is the section containing BLOCK. */
static void
ada_add_block_symbols (struct obstack *obstackp,
- const struct block *block, const char *name,
- domain_enum domain, struct objfile *objfile,
- int wild)
+ const struct block *block,
+ const lookup_name_info &lookup_name,
+ domain_enum domain, struct objfile *objfile)
{
struct block_iterator iter;
- int name_len = strlen (name);
/* A matching argument symbol, if any. */
struct symbol *arg_sym;
/* Set true when we find a matching non-argument symbol. */
arg_sym = NULL;
found_sym = 0;
- if (wild)
- {
- for (sym = block_iter_match_first (block, name, wild_match, &iter);
- sym != NULL; sym = block_iter_match_next (name, wild_match, &iter))
- {
- if (symbol_matches_domain (SYMBOL_LANGUAGE (sym),
- SYMBOL_DOMAIN (sym), domain)
- && wild_match (SYMBOL_LINKAGE_NAME (sym), name) == 0)
- {
- if (SYMBOL_CLASS (sym) == LOC_UNRESOLVED)
- continue;
- else if (SYMBOL_IS_ARGUMENT (sym))
- arg_sym = sym;
- else
- {
- found_sym = 1;
- add_defn_to_vec (obstackp,
- fixup_symbol_section (sym, objfile),
- block);
- }
- }
- }
- }
- else
+ for (sym = block_iter_match_first (block, lookup_name, &iter);
+ sym != NULL;
+ sym = block_iter_match_next (lookup_name, &iter))
{
- for (sym = block_iter_match_first (block, name, full_match, &iter);
- sym != NULL; sym = block_iter_match_next (name, full_match, &iter))
- {
- if (symbol_matches_domain (SYMBOL_LANGUAGE (sym),
- SYMBOL_DOMAIN (sym), domain))
- {
- if (SYMBOL_CLASS (sym) != LOC_UNRESOLVED)
- {
- if (SYMBOL_IS_ARGUMENT (sym))
- arg_sym = sym;
- else
- {
- found_sym = 1;
- add_defn_to_vec (obstackp,
- fixup_symbol_section (sym, objfile),
- block);
- }
- }
- }
- }
+ if (symbol_matches_domain (SYMBOL_LANGUAGE (sym),
+ SYMBOL_DOMAIN (sym), domain))
+ {
+ if (SYMBOL_CLASS (sym) != LOC_UNRESOLVED)
+ {
+ if (SYMBOL_IS_ARGUMENT (sym))
+ arg_sym = sym;
+ else
+ {
+ found_sym = 1;
+ add_defn_to_vec (obstackp,
+ fixup_symbol_section (sym, objfile),
+ block);
+ }
+ }
+ }
}
/* Handle renamings. */
- if (ada_add_block_renamings (obstackp, block, name, domain, wild))
+ if (ada_add_block_renamings (obstackp, block, lookup_name, domain))
found_sym = 1;
if (!found_sym && arg_sym != NULL)
block);
}
- if (!wild)
+ if (!lookup_name.ada ().wild_match_p ())
{
arg_sym = NULL;
found_sym = 0;
+ 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 ();
ALL_BLOCK_SYMBOLS (block, iter, sym)
{
/* Symbol Completion */
-/* If SYM_NAME is a completion candidate for TEXT, return this symbol
- name in a form that's appropriate for the completion. The result
- does not need to be deallocated, but is only good until the next call.
-
- TEXT_LEN is equal to the length of TEXT.
- Perform a wild match if WILD_MATCH_P is set.
- ENCODED_P should be set if TEXT represents the start of a symbol name
- in its encoded form. */
+/* See symtab.h. */
-static const char *
-symbol_completion_match (const char *sym_name,
- const char *text, int text_len,
- int wild_match_p, int encoded_p)
+bool
+ada_lookup_name_info::matches
+ (const char *sym_name,
+ symbol_name_match_type match_type,
+ completion_match_result *comp_match_res) const
{
- const int verbatim_match = (text[0] == '<');
- int match = 0;
-
- if (verbatim_match)
- {
- /* Strip the leading angle bracket. */
- text = text + 1;
- text_len--;
- }
+ bool match = false;
+ const char *text = m_encoded_name.c_str ();
+ size_t text_len = m_encoded_name.size ();
/* First, test against the fully qualified name of the symbol. */
if (strncmp (sym_name, text, text_len) == 0)
- match = 1;
+ match = true;
- if (match && !encoded_p)
+ if (match && !m_encoded_p)
{
/* One needed check before declaring a positive match is to verify
that iff we are doing a verbatim match, the decoded version
of the symbol name starts with '<'. Otherwise, this symbol name
is not a suitable completion. */
const char *sym_name_copy = sym_name;
- int has_angle_bracket;
+ bool has_angle_bracket;
sym_name = ada_decode (sym_name);
has_angle_bracket = (sym_name[0] == '<');
- match = (has_angle_bracket == verbatim_match);
+ match = (has_angle_bracket == m_verbatim_p);
sym_name = sym_name_copy;
}
- if (match && !verbatim_match)
+ if (match && !m_verbatim_p)
{
/* When doing non-verbatim match, another check that needs to
be done is to verify that the potentially matching symbol name
for (tmp = sym_name; *tmp != '\0' && !isupper (*tmp); tmp++);
if (*tmp != '\0')
- match = 0;
+ match = false;
}
/* Second: Try wild matching... */
- if (!match && wild_match_p)
+ if (!match && m_wild_match_p)
{
/* Since we are doing wild matching, this means that TEXT
may represent an unqualified symbol name. We therefore must
sym_name = ada_unqualified_name (ada_decode (sym_name));
if (strncmp (sym_name, text, text_len) == 0)
- match = 1;
+ match = true;
}
- /* Finally: If we found a mach, prepare the result to return. */
+ /* Finally: If we found a match, prepare the result to return. */
if (!match)
- return NULL;
-
- if (verbatim_match)
- sym_name = add_angle_brackets (sym_name);
+ return false;
- if (!encoded_p)
- sym_name = ada_decode (sym_name);
-
- return sym_name;
-}
-
-/* A companion function to ada_collect_symbol_completion_matches().
- Check if SYM_NAME represents a symbol which name would be suitable
- to complete TEXT (TEXT_LEN is the length of TEXT), in which case it
- is added as a completion match to TRACKER.
-
- ORIG_TEXT is the string original string from the user command
- that needs to be completed. WORD is the entire command on which
- completion should be performed. These two parameters are used to
- determine which part of the symbol name should be added to the
- completion vector.
- if WILD_MATCH_P is set, then wild matching is performed.
- ENCODED_P should be set if TEXT represents a symbol name in its
- encoded formed (in which case the completion should also be
- encoded). */
-
-static void
-symbol_completion_add (completion_tracker &tracker,
- const char *sym_name,
- const char *text, int text_len,
- const char *orig_text, const char *word,
- int wild_match_p, int encoded_p)
-{
- const char *match = symbol_completion_match (sym_name, text, text_len,
- wild_match_p, encoded_p);
- char *completion;
+ if (comp_match_res != NULL)
+ {
+ std::string &match_str = comp_match_res->match.storage ();
- if (match == NULL)
- return;
+ if (!m_encoded_p)
+ match_str = ada_decode (sym_name);
+ else
+ {
+ if (m_verbatim_p)
+ match_str = add_angle_brackets (sym_name);
+ else
+ match_str = sym_name;
- /* We found a match, so add the appropriate completion to the given
- string vector. */
+ }
- if (word == orig_text)
- {
- completion = (char *) xmalloc (strlen (match) + 5);
- strcpy (completion, match);
- }
- else if (word > orig_text)
- {
- /* Return some portion of sym_name. */
- completion = (char *) xmalloc (strlen (match) + 5);
- strcpy (completion, match + (word - orig_text));
- }
- else
- {
- /* Return some of ORIG_TEXT plus sym_name. */
- completion = (char *) xmalloc (strlen (match) + (orig_text - word) + 5);
- strncpy (completion, word, orig_text - word);
- completion[orig_text - word] = '\0';
- strcat (completion, match);
+ comp_match_res->set_match (match_str.c_str ());
}
- tracker.add_completion (gdb::unique_xmalloc_ptr<char> (completion));
+ return true;
}
-/* Add the list of possible symbol names completing TEXT0 to TRACKER.
+/* Add the list of possible symbol names completing TEXT to TRACKER.
WORD is the entire command on which completion is made. */
static void
ada_collect_symbol_completion_matches (completion_tracker &tracker,
- const char *text0, const char *word,
+ complete_symbol_mode mode,
+ symbol_name_match_type name_match_type,
+ const char *text, const char *word,
enum type_code code)
{
- char *text;
- int text_len;
- int wild_match_p;
- int encoded_p;
struct symbol *sym;
struct compunit_symtab *s;
struct minimal_symbol *msymbol;
struct objfile *objfile;
const struct block *b, *surrounding_static_block = 0;
- int i;
struct block_iterator iter;
struct cleanup *old_chain = make_cleanup (null_cleanup, NULL);
gdb_assert (code == TYPE_CODE_UNDEF);
- if (text0[0] == '<')
- {
- text = xstrdup (text0);
- make_cleanup (xfree, text);
- text_len = strlen (text);
- wild_match_p = 0;
- encoded_p = 1;
- }
- else
- {
- text = xstrdup (ada_encode (text0));
- make_cleanup (xfree, text);
- text_len = strlen (text);
- for (i = 0; i < text_len; i++)
- text[i] = tolower (text[i]);
-
- encoded_p = (strstr (text0, "__") != NULL);
- /* If the name contains a ".", then the user is entering a fully
- qualified entity name, and the match must not be done in wild
- mode. Similarly, if the user wants to complete what looks like
- an encoded name, the match must not be done in wild mode. */
- wild_match_p = (strchr (text0, '.') == NULL && !encoded_p);
- }
+ lookup_name_info lookup_name (text, name_match_type, true);
/* First, look at the partial symtab symbols. */
expand_symtabs_matching (NULL,
- [&] (const char *symname)
- {
- return symbol_completion_match (symname,
- text, text_len,
- wild_match_p,
- encoded_p);
- },
+ lookup_name,
+ NULL,
NULL,
ALL_DOMAIN);
ALL_MSYMBOLS (objfile, msymbol)
{
QUIT;
- symbol_completion_add (tracker, MSYMBOL_LINKAGE_NAME (msymbol),
- text, text_len, text0, word, wild_match_p,
- encoded_p);
+
+ if (completion_skip_symbol (mode, msymbol))
+ continue;
+
+ language symbol_language = MSYMBOL_LANGUAGE (msymbol);
+
+ /* Ada minimal symbols won't have their language set to Ada. If
+ we let completion_list_add_name compare using the
+ default/C-like matcher, then when completing e.g., symbols in a
+ package named "pck", we'd match internal Ada symbols like
+ "pckS", which are invalid in an Ada expression, unless you wrap
+ them in '<' '>' to request a verbatim match.
+
+ Unfortunately, some Ada encoded names successfully demangle as
+ C++ symbols (using an old mangling scheme), such as "name__2Xn"
+ -> "Xn::name(void)" and thus some Ada minimal symbols end up
+ with the wrong language set. Paper over that issue here. */
+ if (symbol_language == language_auto
+ || symbol_language == language_cplus)
+ symbol_language = language_ada;
+
+ completion_list_add_name (tracker,
+ symbol_language,
+ MSYMBOL_LINKAGE_NAME (msymbol),
+ lookup_name, text, word);
}
/* Search upwards from currently selected frame (so that we can
ALL_BLOCK_SYMBOLS (b, iter, sym)
{
- symbol_completion_add (tracker, SYMBOL_LINKAGE_NAME (sym),
- text, text_len, text0, word,
- wild_match_p, encoded_p);
+ if (completion_skip_symbol (mode, sym))
+ continue;
+
+ completion_list_add_name (tracker,
+ SYMBOL_LANGUAGE (sym),
+ SYMBOL_LINKAGE_NAME (sym),
+ lookup_name, text, word);
}
}
b = BLOCKVECTOR_BLOCK (COMPUNIT_BLOCKVECTOR (s), GLOBAL_BLOCK);
ALL_BLOCK_SYMBOLS (b, iter, sym)
{
- symbol_completion_add (tracker, SYMBOL_LINKAGE_NAME (sym),
- text, text_len, text0, word,
- wild_match_p, encoded_p);
+ if (completion_skip_symbol (mode, sym))
+ continue;
+
+ completion_list_add_name (tracker,
+ SYMBOL_LANGUAGE (sym),
+ SYMBOL_LINKAGE_NAME (sym),
+ lookup_name, text, word);
}
}
continue;
ALL_BLOCK_SYMBOLS (b, iter, sym)
{
- symbol_completion_add (tracker, SYMBOL_LINKAGE_NAME (sym),
- text, text_len, text0, word,
- wild_match_p, encoded_p);
+ if (completion_skip_symbol (mode, sym))
+ continue;
+
+ completion_list_add_name (tracker,
+ SYMBOL_LANGUAGE (sym),
+ SYMBOL_LINKAGE_NAME (sym),
+ lookup_name, text, word);
}
}
int
ada_is_tagged_type (struct type *type, int refok)
{
- return (ada_lookup_struct_elt_type (type, "_tag", refok, 1, NULL) != NULL);
+ return (ada_lookup_struct_elt_type (type, "_tag", refok, 1) != NULL);
}
/* True iff TYPE represents the type of X'Tag */
struct type *
ada_tag_type (struct value *val)
{
- return ada_lookup_struct_elt_type (value_type (val), "_tag", 1, 0, NULL);
+ return ada_lookup_struct_elt_type (value_type (val), "_tag", 1, 0);
}
/* Return 1 if TAG follows the old scheme for Ada tags (used for Ada 95,
if (is_ada95_tag (tag))
return obj;
- ptr_type = builtin_type (target_gdbarch ())->builtin_data_ptr;
+ ptr_type = language_lookup_primitive_type
+ (language_def (language_ada), target_gdbarch(), "storage_offset");
ptr_type = lookup_pointer_type (ptr_type);
val = value_cast (ptr_type, tag);
if (!val)
if (offset_to_top == -1)
return obj;
- base_address = value_address (obj) - offset_to_top;
+ /* OFFSET_TO_TOP used to be a positive value to be subtracted
+ from the base address. This was however incompatible with
+ C++ dispatch table: C++ uses a *negative* value to *add*
+ to the base address. Ada's convention has therefore been
+ changed in GNAT 19.0w 20171023: since then, C++ and Ada
+ use the same convention. Here, we support both cases by
+ checking the sign of OFFSET_TO_TOP. */
+
+ if (offset_to_top > 0)
+ offset_to_top = -offset_to_top;
+
+ base_address = value_address (obj) + offset_to_top;
tag = value_tag_from_contents_and_address (obj_type, NULL, base_address);
/* Make sure that we have a proper tag at the new address.
{
const char *name = ada_variant_discrim_name (var_type);
- return ada_lookup_struct_elt_type (outer_type, name, 1, 1, NULL);
+ return ada_lookup_struct_elt_type (outer_type, name, 1, 1);
}
/* Assuming that TYPE is the type of a variant wrapper, and FIELD_NUM is a
number of fields if not found. A NULL value of NAME never
matches; the function just counts visible fields in this case.
+ Notice that we need to handle when a tagged record hierarchy
+ has some components with the same name, like in this scenario:
+
+ type Top_T is tagged record
+ N : Integer := 1;
+ U : Integer := 974;
+ A : Integer := 48;
+ end record;
+
+ type Middle_T is new Top.Top_T with record
+ N : Character := 'a';
+ C : Integer := 3;
+ end record;
+
+ type Bottom_T is new Middle.Middle_T with record
+ N : Float := 4.0;
+ C : Character := '5';
+ X : Integer := 6;
+ A : Character := 'J';
+ end record;
+
+ Let's say we now have a variable declared and initialized as follow:
+
+ TC : Top_A := new Bottom_T;
+
+ And then we use this variable to call this function
+
+ procedure Assign (Obj: in out Top_T; TV : Integer);
+
+ as follow:
+
+ Assign (Top_T (B), 12);
+
+ Now, we're in the debugger, and we're inside that procedure
+ then and we want to print the value of obj.c:
+
+ Usually, the tagged record or one of the parent type owns the
+ component to print and there's no issue but in this particular
+ case, what does it mean to ask for Obj.C? Since the actual
+ type for object is type Bottom_T, it could mean two things: type
+ component C from the Middle_T view, but also component C from
+ Bottom_T. So in that "undefined" case, when the component is
+ not found in the non-resolved type (which includes all the
+ components of the parent type), then resolve it and see if we
+ get better luck once expanded.
+
+ In the case of homonyms in the derived tagged type, we don't
+ guaranty anything, and pick the one that's easiest for us
+ to program.
+
Returns 1 if found, 0 otherwise. */
static int
int *index_p)
{
int i;
+ int parent_offset = -1;
type = ada_check_typedef (type);
if (t_field_name == NULL)
continue;
+ else if (ada_is_parent_field (type, i))
+ {
+ /* This is a field pointing us to the parent type of a tagged
+ type. As hinted in this function's documentation, we give
+ preference to fields in the current record first, so what
+ we do here is just record the index of this field before
+ we skip it. If it turns out we couldn't find our field
+ in the current record, then we'll get back to it and search
+ inside it whether the field might exist in the parent. */
+
+ parent_offset = i;
+ continue;
+ }
+
else if (name != NULL && field_name_match (t_field_name, name))
{
int bit_size = TYPE_FIELD_BITSIZE (type, i);
else if (index_p != NULL)
*index_p += 1;
}
+
+ /* Field not found so far. If this is a tagged type which
+ has a parent, try finding that field in the parent now. */
+
+ if (parent_offset != -1)
+ {
+ int bit_pos = TYPE_FIELD_BITPOS (type, parent_offset);
+ int fld_offset = offset + bit_pos / 8;
+
+ if (find_struct_field (name, TYPE_FIELD_TYPE (type, parent_offset),
+ fld_offset, field_type_p, byte_offset_p,
+ bit_offset_p, bit_size_p, index_p))
+ return 1;
+ }
+
return 0;
}
and search in it assuming it has (class) type TYPE.
If found, return value, else return NULL.
- Searches recursively through wrapper fields (e.g., '_parent'). */
+ Searches recursively through wrapper fields (e.g., '_parent').
+
+ In the case of homonyms in the tagged types, please refer to the
+ long explanation in find_struct_field's function documentation. */
static struct value *
ada_search_struct_field (const char *name, struct value *arg, int offset,
struct type *type)
{
int i;
+ int parent_offset = -1;
type = ada_check_typedef (type);
for (i = 0; i < TYPE_NFIELDS (type); i += 1)
if (t_field_name == NULL)
continue;
+ else if (ada_is_parent_field (type, i))
+ {
+ /* This is a field pointing us to the parent type of a tagged
+ type. As hinted in this function's documentation, we give
+ preference to fields in the current record first, so what
+ we do here is just record the index of this field before
+ we skip it. If it turns out we couldn't find our field
+ in the current record, then we'll get back to it and search
+ inside it whether the field might exist in the parent. */
+
+ parent_offset = i;
+ continue;
+ }
+
else if (field_name_match (t_field_name, name))
return ada_value_primitive_field (arg, offset, i, type);
}
}
}
+
+ /* Field not found so far. If this is a tagged type which
+ has a parent, try finding that field in the parent now. */
+
+ if (parent_offset != -1)
+ {
+ struct value *v = ada_search_struct_field (
+ name, arg, offset + TYPE_FIELD_BITPOS (type, parent_offset) / 8,
+ TYPE_FIELD_TYPE (type, parent_offset));
+
+ if (v != NULL)
+ return v;
+ }
+
return NULL;
}
else
address = value_address (ada_coerce_ref (arg));
- t1 = ada_to_fixed_type (ada_get_base_type (t1), NULL, address, NULL, 1);
+ /* Check to see if this is a tagged type. We also need to handle
+ the case where the type is a reference to a tagged type, but
+ we have to be careful to exclude pointers to tagged types.
+ The latter should be shown as usual (as a pointer), whereas
+ a reference should mostly be transparent to the user. */
+
+ if (ada_is_tagged_type (t1, 0)
+ || (TYPE_CODE (t1) == TYPE_CODE_REF
+ && ada_is_tagged_type (TYPE_TARGET_TYPE (t1), 0)))
+ {
+ /* We first try to find the searched field in the current type.
+ If not found then let's look in the fixed type. */
+
+ if (!find_struct_field (name, t1, 0,
+ &field_type, &byte_offset, &bit_offset,
+ &bit_size, NULL))
+ t1 = ada_to_fixed_type (ada_get_base_type (t1), NULL,
+ address, NULL, 1);
+ }
+ else
+ t1 = ada_to_fixed_type (ada_get_base_type (t1), NULL,
+ address, NULL, 1);
+
if (find_struct_field (name, t1, 0,
&field_type, &byte_offset, &bit_offset,
&bit_size, NULL))
Looks recursively into variant clauses and parent types.
+ In the case of homonyms in the tagged types, please refer to the
+ long explanation in find_struct_field's function documentation.
+
If NOERR is nonzero, return NULL if NAME is not suitably defined or
TYPE is not a type of the right kind. */
static struct type *
ada_lookup_struct_elt_type (struct type *type, const char *name, int refok,
- int noerr, int *dispp)
+ int noerr)
{
int i;
+ int parent_offset = -1;
if (name == NULL)
goto BadName;
{
const char *t_field_name = TYPE_FIELD_NAME (type, i);
struct type *t;
- int disp;
if (t_field_name == NULL)
continue;
- else if (field_name_match (t_field_name, name))
+ else if (ada_is_parent_field (type, i))
{
- if (dispp != NULL)
- *dispp += TYPE_FIELD_BITPOS (type, i) / 8;
- return TYPE_FIELD_TYPE (type, i);
+ /* This is a field pointing us to the parent type of a tagged
+ type. As hinted in this function's documentation, we give
+ preference to fields in the current record first, so what
+ we do here is just record the index of this field before
+ we skip it. If it turns out we couldn't find our field
+ in the current record, then we'll get back to it and search
+ inside it whether the field might exist in the parent. */
+
+ parent_offset = i;
+ continue;
}
+ else if (field_name_match (t_field_name, name))
+ return TYPE_FIELD_TYPE (type, i);
+
else if (ada_is_wrapper_field (type, i))
{
- disp = 0;
t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (type, i), name,
- 0, 1, &disp);
+ 0, 1);
if (t != NULL)
- {
- if (dispp != NULL)
- *dispp += disp + TYPE_FIELD_BITPOS (type, i) / 8;
- return t;
- }
+ return t;
}
else if (ada_is_variant_part (type, i))
generates these for unchecked variant types. Revisit
if the compiler changes this practice. */
const char *v_field_name = TYPE_FIELD_NAME (field_type, j);
- disp = 0;
+
if (v_field_name != NULL
&& field_name_match (v_field_name, name))
t = TYPE_FIELD_TYPE (field_type, j);
else
t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (field_type,
j),
- name, 0, 1, &disp);
+ name, 0, 1);
if (t != NULL)
- {
- if (dispp != NULL)
- *dispp += disp + TYPE_FIELD_BITPOS (type, i) / 8;
- return t;
- }
+ return t;
}
}
}
+ /* Field not found so far. If this is a tagged type which
+ has a parent, try finding that field in the parent now. */
+
+ if (parent_offset != -1)
+ {
+ struct type *t;
+
+ t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (type, parent_offset),
+ name, 0, 1);
+ if (t != NULL)
+ return t;
+ }
+
BadName:
if (!noerr)
{
{
const char *discrim_name = ada_variant_discrim_name (var_type);
- return (ada_lookup_struct_elt_type (outer_type, discrim_name, 0, 1, NULL)
- == NULL);
+ return (ada_lookup_struct_elt_type (outer_type, discrim_name, 0, 1) == NULL);
}
ada_is_redundant_range_encoding (struct type *range_type,
struct type *encoding_type)
{
- struct type *fixed_range_type;
const char *bounds_str;
int n;
LONGEST lo, hi;
const char *name = ada_type_name (fixed_record_type);
char *xvz_name
= (char *) alloca (strlen (name) + 7 /* "___XVZ\0" */);
- int xvz_found = 0;
+ bool xvz_found = false;
LONGEST size;
xsnprintf (xvz_name, strlen (name) + 7, "%s___XVZ", name);
- size = get_int_var_value (xvz_name, &xvz_found);
+ TRY
+ {
+ xvz_found = get_int_var_value (xvz_name, size);
+ }
+ CATCH (except, RETURN_MASK_ERROR)
+ {
+ /* We found the variable, but somehow failed to read
+ its value. Rethrow the same error, but with a little
+ bit more information, to help the user understand
+ what went wrong (Eg: the variable might have been
+ optimized out). */
+ throw_error (except.error,
+ _("unable to read value of %s (%s)"),
+ xvz_name, except.message);
+ }
+ END_CATCH
+
if (xvz_found && TYPE_LENGTH (fixed_record_type) != size)
{
fixed_record_type = copy_type (fixed_record_type);
if (type == type0 && val0 != NULL)
return val0;
- else
- return value_from_contents_and_address (type, 0, address);
+
+ if (VALUE_LVAL (val0) != lval_memory)
+ {
+ /* Our value does not live in memory; it could be a convenience
+ variable, for instance. Create a not_lval value using val0's
+ contents. */
+ return value_from_contents (type, value_contents (val0));
+ }
+
+ return value_from_contents_and_address (type, 0, address);
}
/* A value representing VAL, but with a standard (static-sized) type
}
static struct value *
-cast_to_fixed (struct type *type, struct value *arg)
+cast_from_fixed (struct type *type, struct value *arg)
{
- LONGEST val;
+ struct value *scale = ada_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_fixed (struct type *type, struct value *arg)
+{
if (type == value_type (arg))
return arg;
- else if (ada_is_fixed_point_type (value_type (arg)))
- val = ada_float_to_fixed (type,
- ada_fixed_to_float (value_type (arg),
- value_as_long (arg)));
- else
- {
- DOUBLEST argd = value_as_double (arg);
- val = ada_float_to_fixed (type, argd);
- }
+ struct value *scale = ada_scaling_factor (type);
+ if (ada_is_fixed_point_type (value_type (arg)))
+ arg = cast_from_fixed (value_type (scale), arg);
+ else
+ arg = value_cast (value_type (scale), arg);
- return value_from_longest (type, val);
-}
-
-static struct value *
-cast_from_fixed (struct type *type, struct value *arg)
-{
- DOUBLEST val = ada_fixed_to_float (value_type (arg),
- value_as_long (arg));
-
- return value_from_double (type, val);
+ arg = value_binop (arg, scale, BINOP_DIV);
+ return value_cast (type, arg);
}
/* Given two array types T1 and T2, return nonzero iff both arrays
if (ada_is_direct_array_type (value_type (arg1))
|| ada_is_direct_array_type (value_type (arg2)))
{
+ struct type *arg1_type, *arg2_type;
+
/* Automatically dereference any array reference before
we attempt to perform the comparison. */
arg1 = ada_coerce_ref (arg1);
arg2 = ada_coerce_ref (arg2);
-
+
arg1 = ada_coerce_to_simple_array (arg1);
arg2 = ada_coerce_to_simple_array (arg2);
- if (TYPE_CODE (value_type (arg1)) != TYPE_CODE_ARRAY
- || TYPE_CODE (value_type (arg2)) != TYPE_CODE_ARRAY)
+
+ arg1_type = ada_check_typedef (value_type (arg1));
+ arg2_type = ada_check_typedef (value_type (arg2));
+
+ if (TYPE_CODE (arg1_type) != TYPE_CODE_ARRAY
+ || TYPE_CODE (arg2_type) != TYPE_CODE_ARRAY)
error (_("Attempt to compare array with non-array"));
/* FIXME: The following works only for types whose
representations use all bits (no padding or undefined bits)
and do not have user-defined equality. */
- return
- TYPE_LENGTH (value_type (arg1)) == TYPE_LENGTH (value_type (arg2))
- && memcmp (value_contents (arg1), value_contents (arg2),
- TYPE_LENGTH (value_type (arg1))) == 0;
+ return (TYPE_LENGTH (arg1_type) == TYPE_LENGTH (arg2_type)
+ && memcmp (value_contents (arg1), value_contents (arg2),
+ TYPE_LENGTH (arg1_type)) == 0);
}
return value_equal (arg1, arg2);
}
{
struct value *mark = value_mark ();
struct value *elt;
+ struct type *lhs_type = check_typedef (value_type (lhs));
- if (TYPE_CODE (value_type (lhs)) == TYPE_CODE_ARRAY)
+ if (TYPE_CODE (lhs_type) == TYPE_CODE_ARRAY)
{
struct type *index_type = builtin_type (exp->gdbarch)->builtin_int;
struct value *index_val = value_from_longest (index_type, index);
if (!deprecated_value_modifiable (lhs))
error (_("Left operand of assignment is not a modifiable lvalue."));
- lhs_type = value_type (lhs);
+ lhs_type = check_typedef (value_type (lhs));
if (ada_is_direct_array_type (lhs_type))
{
lhs = ada_coerce_to_simple_array (lhs);
- lhs_type = value_type (lhs);
+ lhs_type = check_typedef (value_type (lhs));
low_index = TYPE_ARRAY_LOWER_BOUND_VALUE (lhs_type);
high_index = TYPE_ARRAY_UPPER_BOUND_VALUE (lhs_type);
}
is different. */
static struct value *
-ada_value_cast (struct type *type, struct value *arg2, enum noside noside)
+ada_value_cast (struct type *type, struct value *arg2)
{
if (type == ada_check_typedef (value_type (arg2)))
return arg2;
one element out of that array. On the other hand, fixing should
not be performed on the elements when taking a slice of an array!
- Note that one of the side-effects of miscomputing the offset and
+ Note that one of the side effects of miscomputing the offset and
size of each field is that we end up also miscomputing the size
of the containing type. This can have adverse results when computing
the value of an entity. GDB fetches the value of an entity based
on the size of its type, and thus a wrong size causes GDB to fetch
the wrong amount of memory. In the case where the computed size is
too small, GDB fetches too little data to print the value of our
- entiry. Results in this case as unpredicatble, as we usually read
+ entity. Results in this case are unpredictable, as we usually read
past the buffer containing the data =:-o. */
+/* Evaluate a subexpression of EXP, at index *POS, and return a value
+ for that subexpression cast to TO_TYPE. Advance *POS over the
+ subexpression. */
+
+static value *
+ada_evaluate_subexp_for_cast (expression *exp, int *pos,
+ enum noside noside, struct type *to_type)
+{
+ int pc = *pos;
+
+ if (exp->elts[pc].opcode == OP_VAR_MSYM_VALUE
+ || exp->elts[pc].opcode == OP_VAR_VALUE)
+ {
+ (*pos) += 4;
+
+ value *val;
+ if (exp->elts[pc].opcode == OP_VAR_MSYM_VALUE)
+ {
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return value_zero (to_type, not_lval);
+
+ val = evaluate_var_msym_value (noside,
+ exp->elts[pc + 1].objfile,
+ exp->elts[pc + 2].msymbol);
+ }
+ else
+ val = evaluate_var_value (noside,
+ exp->elts[pc + 1].block,
+ exp->elts[pc + 2].symbol);
+
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
+
+ val = ada_value_cast (to_type, val);
+
+ /* Follow the Ada language semantics that do not allow taking
+ an address of the result of a cast (view conversion in Ada). */
+ if (VALUE_LVAL (val) == lval_memory)
+ {
+ if (value_lazy (val))
+ value_fetch_lazy (val);
+ VALUE_LVAL (val) = not_lval;
+ }
+ return val;
+ }
+
+ value *val = evaluate_subexp (to_type, exp, pos, noside);
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
+ return ada_value_cast (to_type, val);
+}
+
/* Implement the evaluate_exp routine in the exp_descriptor structure
for the Ada language. */
if (noside == EVAL_NORMAL)
arg1 = unwrap_value (arg1);
- /* If evaluating an OP_DOUBLE and an EXPECT_TYPE was provided,
+ /* 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
Similarly, we need to perform the conversion from OP_LONG
ourselves. */
- if ((op == OP_DOUBLE || op == OP_LONG) && expect_type != NULL)
- arg1 = ada_value_cast (expect_type, arg1, noside);
+ if ((op == OP_FLOAT || op == OP_LONG) && expect_type != NULL)
+ arg1 = ada_value_cast (expect_type, arg1);
return arg1;
case UNOP_CAST:
(*pos) += 2;
type = exp->elts[pc + 1].type;
- arg1 = evaluate_subexp (type, exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
- arg1 = ada_value_cast (type, arg1, noside);
- return arg1;
+ return ada_evaluate_subexp_for_cast (exp, pos, noside, type);
case UNOP_QUAL:
(*pos) += 2;
case TYPE_CODE_FUNC:
if (noside == EVAL_AVOID_SIDE_EFFECTS)
{
- struct type *rtype = TYPE_TARGET_TYPE (type);
-
- if (TYPE_GNU_IFUNC (type))
- return allocate_value (TYPE_TARGET_TYPE (rtype));
- return allocate_value (rtype);
+ if (TYPE_TARGET_TYPE (type) == NULL)
+ error_call_unknown_return_type (NULL);
+ return allocate_value (TYPE_TARGET_TYPE (type));
}
- return call_function_by_hand (argvec[0], nargs, argvec + 1);
+ return call_function_by_hand (argvec[0], NULL, nargs, argvec + 1);
case TYPE_CODE_INTERNAL_FUNCTION:
if (noside == EVAL_AVOID_SIDE_EFFECTS)
/* We don't know anything about what the internal
{
type = ada_lookup_struct_elt_type (type1,
&exp->elts[pc + 2].string,
- 1, 1, NULL);
+ 1, 1);
/* If the field is not found, check if it exists in the
extension of this object's type. This means that we
else
type =
ada_lookup_struct_elt_type (type1, &exp->elts[pc + 2].string, 1,
- 0, NULL);
+ 0);
return value_zero (ada_aligned_type (type), lval_memory);
}
}
nosideret:
- return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
+ return eval_skip_value (exp);
}
\f
}
/* Assuming that TYPE is the representation of an Ada fixed-point
- type, return its delta, or -1 if the type is malformed and the
+ 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. */
-DOUBLEST
+struct value *
ada_delta (struct type *type)
{
const char *encoding = fixed_type_info (type);
- DOUBLEST num, den;
-
- /* Strictly speaking, num and den are encoded as integer. However,
- they may not fit into a long, and they will have to be converted
- to DOUBLEST anyway. So scan them as DOUBLEST. */
- if (sscanf (encoding, "_%" DOUBLEST_SCAN_FORMAT "_%" DOUBLEST_SCAN_FORMAT,
- &num, &den) < 2)
- return -1.0;
+ struct type *scale_type = ada_scaling_type (type);
+
+ long long num, den;
+
+ if (sscanf (encoding, "_%lld_%lld", &num, &den) < 2)
+ return nullptr;
else
- return num / den;
+ return value_binop (value_from_longest (scale_type, num),
+ value_from_longest (scale_type, den), BINOP_DIV);
}
/* Assuming that ada_is_fixed_point_type (TYPE), return the scaling
factor ('SMALL value) associated with the type. */
-static DOUBLEST
-scaling_factor (struct type *type)
+struct value *
+ada_scaling_factor (struct type *type)
{
const char *encoding = fixed_type_info (type);
- DOUBLEST num0, den0, num1, den1;
+ struct type *scale_type = ada_scaling_type (type);
+
+ long long num0, den0, num1, den1;
int n;
- /* Strictly speaking, num's and den's are encoded as integer. However,
- they may not fit into a long, and they will have to be converted
- to DOUBLEST anyway. So scan them as DOUBLEST. */
- n = sscanf (encoding,
- "_%" DOUBLEST_SCAN_FORMAT "_%" DOUBLEST_SCAN_FORMAT
- "_%" DOUBLEST_SCAN_FORMAT "_%" DOUBLEST_SCAN_FORMAT,
+ n = sscanf (encoding, "_%lld_%lld_%lld_%lld",
&num0, &den0, &num1, &den1);
if (n < 2)
- return 1.0;
+ return value_from_longest (scale_type, 1);
else if (n == 4)
- return num1 / den1;
+ return value_binop (value_from_longest (scale_type, num1),
+ value_from_longest (scale_type, den1), BINOP_DIV);
else
- return num0 / den0;
-}
-
-
-/* Assuming that X is the representation of a value of fixed-point
- type TYPE, return its floating-point equivalent. */
-
-DOUBLEST
-ada_fixed_to_float (struct type *type, LONGEST x)
-{
- return (DOUBLEST) x *scaling_factor (type);
-}
-
-/* The representation of a fixed-point value of type TYPE
- corresponding to the value X. */
-
-LONGEST
-ada_float_to_fixed (struct type *type, DOUBLEST x)
-{
- return (LONGEST) (x / scaling_factor (type) + 0.5);
+ return value_binop (value_from_longest (scale_type, num0),
+ value_from_longest (scale_type, den0), BINOP_DIV);
}
\f
otherwise causes an error with message ERR_MSG. */
static struct value *
-get_var_value (char *name, char *err_msg)
+get_var_value (const char *name, const char *err_msg)
{
- struct block_symbol *syms;
- int nsyms;
+ lookup_name_info lookup_name (name, symbol_name_match_type::FULL);
- nsyms = ada_lookup_symbol_list (name, get_selected_block (0), VAR_DOMAIN,
- &syms);
+ struct block_symbol *syms;
+ int nsyms = ada_lookup_symbol_list_worker (lookup_name,
+ get_selected_block (0),
+ VAR_DOMAIN, &syms, 1);
+ struct cleanup *old_chain = make_cleanup (xfree, syms);
if (nsyms != 1)
{
+ do_cleanups (old_chain);
if (err_msg == NULL)
return 0;
else
error (("%s"), err_msg);
}
- return value_of_variable (syms[0].symbol, syms[0].block);
+ struct value *result = value_of_variable (syms[0].symbol, syms[0].block);
+ do_cleanups (old_chain);
+ return result;
}
-/* Value of integer variable named NAME in the current environment. If
- no such variable found, returns 0, and sets *FLAG to 0. If
- successful, sets *FLAG to 1. */
+/* Value of integer variable named NAME in the current environment.
+ If no such variable is found, returns false. Otherwise, sets VALUE
+ to the variable's value and returns true. */
-LONGEST
-get_int_var_value (char *name, int *flag)
+bool
+get_int_var_value (const char *name, LONGEST &value)
{
struct value *var_val = get_var_value (name, 0);
if (var_val == 0)
- {
- if (flag != NULL)
- *flag = 0;
- return 0;
- }
- else
- {
- if (flag != NULL)
- *flag = 1;
- return value_as_long (var_val);
- }
+ return false;
+
+ value = value_as_long (var_val);
+ return true;
}
}
else
{
- int ok;
-
strcpy (name_buf + prefix_len, "___L");
- L = get_int_var_value (name_buf, &ok);
- if (!ok)
+ if (!get_int_var_value (name_buf, L))
{
lim_warning (_("Unknown lower bound, using 1."));
L = 1;
}
else
{
- int ok;
-
strcpy (name_buf + prefix_len, "___U");
- U = get_int_var_value (name_buf, &ok);
- if (!ok)
+ if (!get_int_var_value (name_buf, U))
{
lim_warning (_("Unknown upper bound, using %ld."), (long) L);
U = L;
type = create_static_range_type (alloc_type_copy (raw_type),
base_type, L, U);
+ /* create_static_range_type alters the resulting type's length
+ to match the size of the base_type, which is not what we want.
+ Set it back to the original range type's length. */
+ TYPE_LENGTH (type) = TYPE_LENGTH (raw_type);
TYPE_NAME (type) = name;
return type;
}
a catchpoint on failed assertions. */
const char *catch_assert_sym;
+ /* The name of the symbol to break on in order to insert
+ a catchpoint on exception handling. */
+ const char *catch_handlers_sym;
+
/* Assuming that the inferior just triggered an unhandled exception
catchpoint, this function is responsible for returning the address
in inferior memory where the name of that exception is stored.
"__gnat_debug_raise_exception", /* catch_exception_sym */
"__gnat_unhandled_exception", /* catch_exception_unhandled_sym */
"__gnat_debug_raise_assert_failure", /* catch_assert_sym */
+ "__gnat_begin_handler", /* catch_handlers_sym */
ada_unhandled_exception_name_addr
};
"__gnat_raise_nodefer_with_msg", /* catch_exception_sym */
"__gnat_unhandled_exception", /* catch_exception_unhandled_sym */
"system__assertions__raise_assert_failure", /* catch_assert_sym */
+ "__gnat_begin_handler", /* catch_handlers_sym */
ada_unhandled_exception_name_addr_from_raise
};
static int
is_known_support_routine (struct frame_info *frame)
{
- struct symtab_and_line sal;
- char *func_name;
enum language func_lang;
int i;
const char *fullname;
/* If this code does not have any debugging information (no symtab),
This cannot be any user code. */
- find_frame_sal (frame, &sal);
+ symtab_and_line sal = find_frame_sal (frame);
if (sal.symtab == NULL)
return 1;
/* Check whether the function is a GNAT-generated entity. */
- find_frame_funname (frame, &func_name, &func_lang, NULL);
+ gdb::unique_xmalloc_ptr<char> func_name
+ = find_frame_funname (frame, &func_lang, NULL);
if (func_name == NULL)
return 1;
for (i = 0; known_auxiliary_function_name_patterns[i] != NULL; i += 1)
{
re_comp (known_auxiliary_function_name_patterns[i]);
- if (re_exec (func_name))
- {
- xfree (func_name);
- return 1;
- }
+ if (re_exec (func_name.get ()))
+ return 1;
}
- xfree (func_name);
return 0;
}
int frame_level;
struct frame_info *fi;
struct ada_inferior_data *data = get_ada_inferior_data (current_inferior ());
- struct cleanup *old_chain;
/* To determine the name of this exception, we need to select
the frame corresponding to RAISE_SYM_NAME. This frame is
if (fi != NULL)
fi = get_prev_frame (fi);
- old_chain = make_cleanup (null_cleanup, NULL);
while (fi != NULL)
{
- char *func_name;
enum language func_lang;
- find_frame_funname (fi, &func_name, &func_lang, NULL);
+ gdb::unique_xmalloc_ptr<char> func_name
+ = find_frame_funname (fi, &func_lang, NULL);
if (func_name != NULL)
{
- make_cleanup (xfree, func_name);
-
- if (strcmp (func_name,
+ if (strcmp (func_name.get (),
data->exception_info->catch_exception_sym) == 0)
break; /* We found the frame we were looking for... */
fi = get_prev_frame (fi);
}
}
- do_cleanups (old_chain);
if (fi == NULL)
return 0;
case ada_catch_exception_unhandled:
return data->exception_info->unhandled_exception_name_addr ();
break;
-
+
+ case ada_catch_handlers:
+ return 0; /* The runtimes does not provide access to the exception
+ name. */
+ break;
+
case ada_catch_assert:
return 0; /* Exception name is not relevant in this case. */
break;
return 0; /* Should never be reached. */
}
+/* Assuming the inferior is stopped at an exception catchpoint,
+ return the message which was associated to the exception, if
+ available. Return NULL if the message could not be retrieved.
+
+ The caller must xfree the string after use.
+
+ Note: The exception message can be associated to an exception
+ either through the use of the Raise_Exception function, or
+ more simply (Ada 2005 and later), via:
+
+ raise Exception_Name with "exception message";
+
+ */
+
+static char *
+ada_exception_message_1 (void)
+{
+ struct value *e_msg_val;
+ char *e_msg = NULL;
+ int e_msg_len;
+ struct cleanup *cleanups;
+
+ /* For runtimes that support this feature, the exception message
+ is passed as an unbounded string argument called "message". */
+ e_msg_val = parse_and_eval ("message");
+ if (e_msg_val == NULL)
+ return NULL; /* Exception message not supported. */
+
+ e_msg_val = ada_coerce_to_simple_array (e_msg_val);
+ gdb_assert (e_msg_val != NULL);
+ e_msg_len = TYPE_LENGTH (value_type (e_msg_val));
+
+ /* If the message string is empty, then treat it as if there was
+ no exception message. */
+ if (e_msg_len <= 0)
+ return NULL;
+
+ e_msg = (char *) xmalloc (e_msg_len + 1);
+ cleanups = make_cleanup (xfree, e_msg);
+ read_memory_string (value_address (e_msg_val), e_msg, e_msg_len + 1);
+ e_msg[e_msg_len] = '\0';
+
+ discard_cleanups (cleanups);
+ return e_msg;
+}
+
+/* Same as ada_exception_message_1, except that all exceptions are
+ contained here (returning NULL instead). */
+
+static char *
+ada_exception_message (void)
+{
+ char *e_msg = NULL; /* Avoid a spurious uninitialized warning. */
+
+ TRY
+ {
+ e_msg = ada_exception_message_1 ();
+ }
+ CATCH (e, RETURN_MASK_ERROR)
+ {
+ e_msg = NULL;
+ }
+ END_CATCH
+
+ return e_msg;
+}
+
/* Same as ada_exception_name_addr_1, except that it intercepts and contains
any error that ada_exception_name_addr_1 might cause to be thrown.
When an error is intercepted, a warning with the error message is printed,
return result;
}
-static char *ada_exception_catchpoint_cond_string (const char *excep_string);
+static char *ada_exception_catchpoint_cond_string
+ (const char *excep_string,
+ enum ada_exception_catchpoint_kind ex);
/* Ada catchpoints.
catchpoint's locations, and store them for later evaluation. */
static void
-create_excep_cond_exprs (struct ada_catchpoint *c)
+create_excep_cond_exprs (struct ada_catchpoint *c,
+ enum ada_exception_catchpoint_kind ex)
{
struct cleanup *old_chain;
struct bp_location *bl;
/* Compute the condition expression in text form, from the specific
expection we want to catch. */
- cond_string = ada_exception_catchpoint_cond_string (c->excep_string);
+ cond_string = ada_exception_catchpoint_cond_string (c->excep_string, ex);
old_chain = make_cleanup (xfree, cond_string);
/* Iterate over all the catchpoint's locations, and parse an
/* Reparse the exception conditional expressions. One for each
location. */
- create_excep_cond_exprs (c);
+ create_excep_cond_exprs (c, ex);
}
/* Returns true if we should stop for this breakpoint hit. If the
{
struct ui_out *uiout = current_uiout;
struct breakpoint *b = bs->breakpoint_at;
+ char *exception_message;
annotate_catchpoint (b->number);
{
case ada_catch_exception:
case ada_catch_exception_unhandled:
+ case ada_catch_handlers:
{
const CORE_ADDR addr = ada_exception_name_addr (ex, b);
char exception_name[256];
uiout->text ("failed assertion");
break;
}
+
+ exception_message = ada_exception_message ();
+ if (exception_message != NULL)
+ {
+ struct cleanup *cleanups = make_cleanup (xfree, exception_message);
+
+ uiout->text (" (");
+ uiout->field_string ("exception-message", exception_message);
+ uiout->text (")");
+
+ do_cleanups (cleanups);
+ }
+
uiout->text (" at ");
ada_find_printable_frame (get_current_frame ());
uiout->field_string ("what", "unhandled Ada exceptions");
break;
+ case ada_catch_handlers:
+ if (c->excep_string != NULL)
+ {
+ uiout->field_fmt ("what",
+ _("`%s' Ada exception handlers"),
+ c->excep_string);
+ }
+ else
+ uiout->field_string ("what", "all Ada exceptions handlers");
+ break;
+
case ada_catch_assert:
uiout->field_string ("what", "failed Ada assertions");
break;
case ada_catch_exception_unhandled:
uiout->text (_("unhandled Ada exceptions"));
break;
-
+
+ case ada_catch_handlers:
+ if (c->excep_string != NULL)
+ {
+ std::string info
+ = string_printf (_("`%s' Ada exception handlers"),
+ c->excep_string);
+ uiout->text (info.c_str ());
+ }
+ else
+ uiout->text (_("all Ada exceptions handlers"));
+ break;
+
case ada_catch_assert:
uiout->text (_("failed Ada assertions"));
break;
fprintf_filtered (fp, "catch exception unhandled");
break;
+ case ada_catch_handlers:
+ fprintf_filtered (fp, "catch handlers");
+ break;
+
case ada_catch_assert:
fprintf_filtered (fp, "catch assert");
break;
static struct breakpoint_ops catch_assert_breakpoint_ops;
+/* Virtual table for "catch handlers" breakpoints. */
+
+static struct bp_location *
+allocate_location_catch_handlers (struct breakpoint *self)
+{
+ return allocate_location_exception (ada_catch_handlers, self);
+}
+
+static void
+re_set_catch_handlers (struct breakpoint *b)
+{
+ re_set_exception (ada_catch_handlers, b);
+}
+
+static void
+check_status_catch_handlers (bpstat bs)
+{
+ check_status_exception (ada_catch_handlers, bs);
+}
+
+static enum print_stop_action
+print_it_catch_handlers (bpstat bs)
+{
+ return print_it_exception (ada_catch_handlers, bs);
+}
+
+static void
+print_one_catch_handlers (struct breakpoint *b,
+ struct bp_location **last_loc)
+{
+ print_one_exception (ada_catch_handlers, b, last_loc);
+}
+
+static void
+print_mention_catch_handlers (struct breakpoint *b)
+{
+ print_mention_exception (ada_catch_handlers, b);
+}
+
+static void
+print_recreate_catch_handlers (struct breakpoint *b,
+ struct ui_file *fp)
+{
+ print_recreate_exception (ada_catch_handlers, b, fp);
+}
+
+static struct breakpoint_ops catch_handlers_breakpoint_ops;
+
/* Return a newly allocated copy of the first space-separated token
in ARGSP, and then adjust ARGSP to point immediately after that
token.
const char *end;
char *result;
- args = skip_spaces_const (args);
+ args = skip_spaces (args);
if (args[0] == '\0')
return NULL; /* No more arguments. */
/* Find the end of the current argument. */
- end = skip_to_space_const (args);
+ end = skip_to_space (args);
/* Adjust ARGSP to point to the start of the next argument. */
Set EX to the appropriate catchpoint type.
Set EXCEP_STRING to the name of the specific exception if
specified by the user.
+ IS_CATCH_HANDLERS_CMD: True if the arguments are for a
+ "catch handlers" command. False otherwise.
If a condition is found at the end of the arguments, the condition
expression is stored in COND_STRING (memory must be deallocated
after use). Otherwise COND_STRING is set to NULL. */
static void
catch_ada_exception_command_split (const char *args,
+ bool is_catch_handlers_cmd,
enum ada_exception_catchpoint_kind *ex,
char **excep_string,
- char **cond_string)
+ std::string &cond_string)
{
struct cleanup *old_chain = make_cleanup (null_cleanup, NULL);
char *exception_name;
/* Check to see if we have a condition. */
- args = skip_spaces_const (args);
+ args = skip_spaces (args);
if (startswith (args, "if")
&& (isspace (args[2]) || args[2] == '\0'))
{
args += 2;
- args = skip_spaces_const (args);
+ args = skip_spaces (args);
if (args[0] == '\0')
error (_("Condition missing after `if' keyword"));
discard_cleanups (old_chain);
- if (exception_name == NULL)
+ if (is_catch_handlers_cmd)
+ {
+ /* Catch handling of exceptions. */
+ *ex = ada_catch_handlers;
+ *excep_string = exception_name;
+ }
+ else if (exception_name == NULL)
{
/* Catch all exceptions. */
*ex = ada_catch_exception;
*ex = ada_catch_exception;
*excep_string = exception_name;
}
- *cond_string = cond;
+ if (cond != NULL)
+ cond_string.assign (cond);
}
/* Return the name of the symbol on which we should break in order to
case ada_catch_assert:
return (data->exception_info->catch_assert_sym);
break;
+ case ada_catch_handlers:
+ return (data->exception_info->catch_handlers_sym);
+ break;
default:
internal_error (__FILE__, __LINE__,
_("unexpected catchpoint kind (%d)"), ex);
case ada_catch_assert:
return (&catch_assert_breakpoint_ops);
break;
+ case ada_catch_handlers:
+ return (&catch_handlers_breakpoint_ops);
+ break;
default:
internal_error (__FILE__, __LINE__,
_("unexpected catchpoint kind (%d)"), ex);
being raised with the exception that the user wants to catch. This
assumes that this condition is used when the inferior just triggered
an exception catchpoint.
+ EX: the type of catchpoints used for catching Ada exceptions.
The string returned is a newly allocated string that needs to be
deallocated later. */
static char *
-ada_exception_catchpoint_cond_string (const char *excep_string)
+ada_exception_catchpoint_cond_string (const char *excep_string,
+ enum ada_exception_catchpoint_kind ex)
{
int i;
+ bool is_standard_exc = false;
+ const char *actual_exc_expr;
+ char *ref_exc_expr;
+
+ if (ex == ada_catch_handlers)
+ {
+ /* For exception handlers catchpoints, the condition string does
+ not use the same parameter as for the other exceptions. */
+ actual_exc_expr = ("long_integer (GNAT_GCC_exception_Access"
+ "(gcc_exception).all.occurrence.id)");
+ }
+ else
+ actual_exc_expr = "long_integer (e)";
/* The standard exceptions are a special case. They are defined in
runtime units that have been compiled without debugging info; if
{
if (strcmp (standard_exc [i], excep_string) == 0)
{
- return xstrprintf ("long_integer (e) = long_integer (&standard.%s)",
- excep_string);
+ is_standard_exc = true;
+ break;
}
}
- return xstrprintf ("long_integer (e) = long_integer (&%s)", excep_string);
+
+ if (is_standard_exc)
+ ref_exc_expr = xstrprintf ("long_integer (&standard.%s)", excep_string);
+ else
+ ref_exc_expr = xstrprintf ("long_integer (&%s)", excep_string);
+
+ char *result = xstrprintf ("%s = %s", actual_exc_expr, ref_exc_expr);
+ xfree (ref_exc_expr);
+ return result;
}
/* Return the symtab_and_line that should be used to insert an exception
static struct symtab_and_line
ada_exception_sal (enum ada_exception_catchpoint_kind ex, char *excep_string,
- char **addr_string, const struct breakpoint_ops **ops)
+ const char **addr_string, const struct breakpoint_ops **ops)
{
const char *sym_name;
struct symbol *sym;
create_ada_exception_catchpoint (struct gdbarch *gdbarch,
enum ada_exception_catchpoint_kind ex_kind,
char *excep_string,
- char *cond_string,
+ const std::string &cond_string,
int tempflag,
int disabled,
int from_tty)
{
- struct ada_catchpoint *c;
- char *addr_string = NULL;
+ const char *addr_string = NULL;
const struct breakpoint_ops *ops = NULL;
struct symtab_and_line sal
= ada_exception_sal (ex_kind, excep_string, &addr_string, &ops);
- c = new ada_catchpoint ();
- init_ada_exception_breakpoint (c, gdbarch, sal, addr_string,
+ std::unique_ptr<ada_catchpoint> c (new ada_catchpoint ());
+ init_ada_exception_breakpoint (c.get (), gdbarch, sal, addr_string,
ops, tempflag, disabled, from_tty);
c->excep_string = excep_string;
- create_excep_cond_exprs (c);
- if (cond_string != NULL)
- set_breakpoint_condition (c, cond_string, from_tty);
- install_breakpoint (0, c, 1);
+ create_excep_cond_exprs (c.get (), ex_kind);
+ if (!cond_string.empty ())
+ set_breakpoint_condition (c.get (), cond_string.c_str (), from_tty);
+ install_breakpoint (0, std::move (c), 1);
}
/* Implement the "catch exception" command. */
static void
-catch_ada_exception_command (char *arg_entry, int from_tty,
+catch_ada_exception_command (const char *arg_entry, int from_tty,
struct cmd_list_element *command)
{
const char *arg = arg_entry;
int tempflag;
enum ada_exception_catchpoint_kind ex_kind;
char *excep_string = NULL;
- char *cond_string = NULL;
+ std::string cond_string;
+
+ tempflag = get_cmd_context (command) == CATCH_TEMPORARY;
+
+ if (!arg)
+ arg = "";
+ catch_ada_exception_command_split (arg, false, &ex_kind, &excep_string,
+ cond_string);
+ create_ada_exception_catchpoint (gdbarch, ex_kind,
+ excep_string, cond_string,
+ tempflag, 1 /* enabled */,
+ from_tty);
+}
+
+/* Implement the "catch handlers" command. */
+
+static void
+catch_ada_handlers_command (const char *arg_entry, int from_tty,
+ struct cmd_list_element *command)
+{
+ const char *arg = arg_entry;
+ struct gdbarch *gdbarch = get_current_arch ();
+ int tempflag;
+ enum ada_exception_catchpoint_kind ex_kind;
+ char *excep_string = NULL;
+ std::string cond_string;
tempflag = get_cmd_context (command) == CATCH_TEMPORARY;
if (!arg)
arg = "";
- catch_ada_exception_command_split (arg, &ex_kind, &excep_string,
- &cond_string);
+ catch_ada_exception_command_split (arg, true, &ex_kind, &excep_string,
+ cond_string);
create_ada_exception_catchpoint (gdbarch, ex_kind,
excep_string, cond_string,
tempflag, 1 /* enabled */,
(the memory needs to be deallocated after use). */
static void
-catch_ada_assert_command_split (const char *args, char **cond_string)
+catch_ada_assert_command_split (const char *args, std::string &cond_string)
{
- args = skip_spaces_const (args);
+ args = skip_spaces (args);
/* Check whether a condition was provided. */
if (startswith (args, "if")
&& (isspace (args[2]) || args[2] == '\0'))
{
args += 2;
- args = skip_spaces_const (args);
+ args = skip_spaces (args);
if (args[0] == '\0')
error (_("condition missing after `if' keyword"));
- *cond_string = xstrdup (args);
+ cond_string.assign (args);
}
/* Otherwise, there should be no other argument at the end of
/* Implement the "catch assert" command. */
static void
-catch_assert_command (char *arg_entry, int from_tty,
+catch_assert_command (const char *arg_entry, int from_tty,
struct cmd_list_element *command)
{
const char *arg = arg_entry;
struct gdbarch *gdbarch = get_current_arch ();
int tempflag;
- char *cond_string = NULL;
+ std::string cond_string;
tempflag = get_cmd_context (command) == CATCH_TEMPORARY;
if (!arg)
arg = "";
- catch_ada_assert_command_split (arg, &cond_string);
+ catch_ada_assert_command_split (arg, cond_string);
create_ada_exception_catchpoint (gdbarch, ada_catch_assert,
NULL, cond_string,
tempflag, 1 /* enabled */,
return 1;
}
-/* A helper function for qsort, comparing two struct ada_exc_info
+/* A helper function for std::sort, comparing two struct ada_exc_info
objects.
The comparison is determined first by exception name, and then
by exception address. */
-static int
-compare_ada_exception_info (const void *a, const void *b)
+bool
+ada_exc_info::operator< (const ada_exc_info &other) const
{
- const struct ada_exc_info *exc_a = (struct ada_exc_info *) a;
- const struct ada_exc_info *exc_b = (struct ada_exc_info *) b;
int result;
- result = strcmp (exc_a->name, exc_b->name);
- if (result != 0)
- return result;
-
- if (exc_a->addr < exc_b->addr)
- return -1;
- if (exc_a->addr > exc_b->addr)
- return 1;
+ result = strcmp (name, other.name);
+ if (result < 0)
+ return true;
+ if (result == 0 && addr < other.addr)
+ return true;
+ return false;
+}
- return 0;
+bool
+ada_exc_info::operator== (const ada_exc_info &other) const
+{
+ return addr == other.addr && strcmp (name, other.name) == 0;
}
/* Sort EXCEPTIONS using compare_ada_exception_info as the comparison
All duplicates are also removed. */
static void
-sort_remove_dups_ada_exceptions_list (VEC(ada_exc_info) **exceptions,
+sort_remove_dups_ada_exceptions_list (std::vector<ada_exc_info> *exceptions,
int skip)
{
- struct ada_exc_info *to_sort
- = VEC_address (ada_exc_info, *exceptions) + skip;
- int to_sort_len
- = VEC_length (ada_exc_info, *exceptions) - skip;
- int i, j;
-
- qsort (to_sort, to_sort_len, sizeof (struct ada_exc_info),
- compare_ada_exception_info);
-
- for (i = 1, j = 1; i < to_sort_len; i++)
- if (compare_ada_exception_info (&to_sort[i], &to_sort[j - 1]) != 0)
- to_sort[j++] = to_sort[i];
- to_sort_len = j;
- VEC_truncate(ada_exc_info, *exceptions, skip + to_sort_len);
+ std::sort (exceptions->begin () + skip, exceptions->end ());
+ exceptions->erase (std::unique (exceptions->begin () + skip, exceptions->end ()),
+ exceptions->end ());
}
/* Add all exceptions defined by the Ada standard whose name match
static void
ada_add_standard_exceptions (compiled_regex *preg,
- VEC(ada_exc_info) **exceptions)
+ std::vector<ada_exc_info> *exceptions)
{
int i;
struct ada_exc_info info
= {standard_exc[i], BMSYMBOL_VALUE_ADDRESS (msymbol)};
- VEC_safe_push (ada_exc_info, *exceptions, &info);
+ exceptions->push_back (info);
}
}
}
static void
ada_add_exceptions_from_frame (compiled_regex *preg,
struct frame_info *frame,
- VEC(ada_exc_info) **exceptions)
+ std::vector<ada_exc_info> *exceptions)
{
const struct block *block = get_frame_block (frame, 0);
struct ada_exc_info info = {SYMBOL_PRINT_NAME (sym),
SYMBOL_VALUE_ADDRESS (sym)};
- VEC_safe_push (ada_exc_info, *exceptions, &info);
+ exceptions->push_back (info);
}
}
}
static void
ada_add_global_exceptions (compiled_regex *preg,
- VEC(ada_exc_info) **exceptions)
+ std::vector<ada_exc_info> *exceptions)
{
struct objfile *objfile;
struct compunit_symtab *s;
regular expression used to do the matching refers to the natural
name. So match against the decoded name. */
expand_symtabs_matching (NULL,
+ lookup_name_info::match_any (),
[&] (const char *search_name)
{
const char *decoded = ada_decode (search_name);
struct ada_exc_info info
= {SYMBOL_PRINT_NAME (sym), SYMBOL_VALUE_ADDRESS (sym)};
- VEC_safe_push (ada_exc_info, *exceptions, &info);
+ exceptions->push_back (info);
}
}
}
If not NULL, PREG is used to filter out exceptions whose names
do not match. Otherwise, all exceptions are listed. */
-static VEC(ada_exc_info) *
+static std::vector<ada_exc_info>
ada_exceptions_list_1 (compiled_regex *preg)
{
- VEC(ada_exc_info) *result = NULL;
- struct cleanup *old_chain
- = make_cleanup (VEC_cleanup (ada_exc_info), &result);
+ std::vector<ada_exc_info> result;
int prev_len;
/* First, list the known standard exceptions. These exceptions
if (has_stack_frames ())
{
- prev_len = VEC_length (ada_exc_info, result);
+ prev_len = result.size ();
ada_add_exceptions_from_frame (preg, get_selected_frame (NULL),
&result);
- if (VEC_length (ada_exc_info, result) > prev_len)
+ if (result.size () > prev_len)
sort_remove_dups_ada_exceptions_list (&result, prev_len);
}
/* Add all exceptions whose scope is global. */
- prev_len = VEC_length (ada_exc_info, result);
+ prev_len = result.size ();
ada_add_global_exceptions (preg, &result);
- if (VEC_length (ada_exc_info, result) > prev_len)
+ if (result.size () > prev_len)
sort_remove_dups_ada_exceptions_list (&result, prev_len);
- discard_cleanups (old_chain);
return result;
}
alphabetical order;
- Exceptions whose scope is global, in alphabetical order. */
-VEC(ada_exc_info) *
+std::vector<ada_exc_info>
ada_exceptions_list (const char *regexp)
{
if (regexp == NULL)
/* Implement the "info exceptions" command. */
static void
-info_exceptions_command (char *regexp, int from_tty)
+info_exceptions_command (const char *regexp, int from_tty)
{
- VEC(ada_exc_info) *exceptions;
- struct cleanup *cleanup;
struct gdbarch *gdbarch = get_current_arch ();
- int ix;
- struct ada_exc_info *info;
- exceptions = ada_exceptions_list (regexp);
- cleanup = make_cleanup (VEC_cleanup (ada_exc_info), &exceptions);
+ std::vector<ada_exc_info> exceptions = ada_exceptions_list (regexp);
if (regexp != NULL)
printf_filtered
else
printf_filtered (_("All defined Ada exceptions:\n"));
- for (ix = 0; VEC_iterate(ada_exc_info, exceptions, ix, info); ix++)
- printf_filtered ("%s: %s\n", info->name, paddress (gdbarch, info->addr));
-
- do_cleanups (cleanup);
+ for (const ada_exc_info &info : exceptions)
+ printf_filtered ("%s: %s\n", info.name, paddress (gdbarch, info.addr));
}
/* Operators */
ada_primitive_type_natural,
ada_primitive_type_positive,
ada_primitive_type_system_address,
+ ada_primitive_type_storage_offset,
nr_ada_primitive_types
};
= builtin->builtin_void;
lai->primitive_type_vector [ada_primitive_type_system_address]
- = lookup_pointer_type (arch_type (gdbarch, TYPE_CODE_VOID, 1, "void"));
+ = lookup_pointer_type (arch_type (gdbarch, TYPE_CODE_VOID, TARGET_CHAR_BIT,
+ "void"));
TYPE_NAME (lai->primitive_type_vector [ada_primitive_type_system_address])
= "system__address";
+ /* 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]);
+
+ 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;
}
ada_evaluate_subexp
};
-/* Implement the "la_get_symbol_name_cmp" language_defn method
- for Ada. */
+/* symbol_name_matcher_ftype adapter for wild_match. */
+
+static bool
+do_wild_match (const char *symbol_search_name,
+ const lookup_name_info &lookup_name,
+ completion_match_result *comp_match_res)
+{
+ return wild_match (symbol_search_name, ada_lookup_name (lookup_name));
+}
+
+/* symbol_name_matcher_ftype adapter for full_match. */
+
+static bool
+do_full_match (const char *symbol_search_name,
+ const lookup_name_info &lookup_name,
+ completion_match_result *comp_match_res)
+{
+ return full_match (symbol_search_name, ada_lookup_name (lookup_name));
+}
+
+/* Build the Ada lookup name for LOOKUP_NAME. */
+
+ada_lookup_name_info::ada_lookup_name_info (const lookup_name_info &lookup_name)
+{
+ const std::string &user_name = lookup_name.name ();
+
+ if (user_name[0] == '<')
+ {
+ if (user_name.back () == '>')
+ m_encoded_name = user_name.substr (1, user_name.size () - 2);
+ else
+ m_encoded_name = user_name.substr (1, user_name.size () - 1);
+ m_encoded_p = true;
+ m_verbatim_p = true;
+ m_wild_match_p = false;
+ m_standard_p = false;
+ }
+ else
+ {
+ m_verbatim_p = false;
+
+ m_encoded_p = user_name.find ("__") != std::string::npos;
+
+ if (!m_encoded_p)
+ {
+ const char *folded = ada_fold_name (user_name.c_str ());
+ const char *encoded = ada_encode_1 (folded, false);
+ if (encoded != NULL)
+ m_encoded_name = encoded;
+ else
+ m_encoded_name = user_name;
+ }
+ else
+ m_encoded_name = user_name;
+
+ /* Handle the 'package Standard' special case. See description
+ of m_standard_p. */
+ if (startswith (m_encoded_name.c_str (), "standard__"))
+ {
+ m_encoded_name = m_encoded_name.substr (sizeof ("standard__") - 1);
+ m_standard_p = true;
+ }
+ else
+ m_standard_p = false;
+
+ /* If the name contains a ".", then the user is entering a fully
+ qualified entity name, and the match must not be done in wild
+ mode. Similarly, if the user wants to complete what looks
+ like an encoded name, the match must not be done in wild
+ mode. Also, in the standard__ special case always do
+ non-wild matching. */
+ m_wild_match_p
+ = (lookup_name.match_type () != symbol_name_match_type::FULL
+ && !m_encoded_p
+ && !m_standard_p
+ && user_name.find ('.') == std::string::npos);
+ }
+}
+
+/* symbol_name_matcher_ftype method for Ada. This only handles
+ completion mode. */
+
+static bool
+ada_symbol_name_matches (const char *symbol_search_name,
+ const lookup_name_info &lookup_name,
+ completion_match_result *comp_match_res)
+{
+ return lookup_name.ada ().matches (symbol_search_name,
+ lookup_name.match_type (),
+ comp_match_res);
+}
+
+/* A name matcher that matches the symbol name exactly, with
+ strcmp. */
+
+static bool
+literal_symbol_name_matcher (const char *symbol_search_name,
+ const lookup_name_info &lookup_name,
+ completion_match_result *comp_match_res)
+{
+ const std::string &name = lookup_name.name ();
+
+ int cmp = (lookup_name.completion_mode ()
+ ? strncmp (symbol_search_name, name.c_str (), name.size ())
+ : strcmp (symbol_search_name, name.c_str ()));
+ if (cmp == 0)
+ {
+ if (comp_match_res != NULL)
+ comp_match_res->set_match (symbol_search_name);
+ return true;
+ }
+ else
+ return false;
+}
+
+/* Implement the "la_get_symbol_name_matcher" language_defn method for
+ Ada. */
-static symbol_name_cmp_ftype
-ada_get_symbol_name_cmp (const char *lookup_name)
+static symbol_name_matcher_ftype *
+ada_get_symbol_name_matcher (const lookup_name_info &lookup_name)
{
- if (should_use_wild_match (lookup_name))
- return wild_match;
+ if (lookup_name.match_type () == symbol_name_match_type::SEARCH_NAME)
+ return literal_symbol_name_matcher;
+
+ if (lookup_name.completion_mode ())
+ return ada_symbol_name_matches;
else
- return compare_names;
+ {
+ if (lookup_name.ada ().wild_match_p ())
+ return do_wild_match;
+ else
+ return do_full_match;
+ }
}
/* Implement the "la_read_var_value" language_defn method for Ada. */
".adb", ".ads", ".a", ".ada", ".dg", NULL
};
-const struct language_defn ada_language_defn = {
+extern const struct language_defn ada_language_defn = {
"ada", /* Language name */
"Ada",
language_ada,
ada_read_var_value, /* la_read_var_value */
NULL, /* Language specific skip_trampoline */
NULL, /* name_of_this */
+ true, /* la_store_sym_names_in_linkage_form_p */
ada_lookup_symbol_nonlocal, /* Looking up non-local symbols. */
basic_lookup_transparent_type, /* lookup_transparent_type */
ada_la_decode, /* Language specific symbol demangler */
default_pass_by_reference,
c_get_string,
c_watch_location_expression,
- ada_get_symbol_name_cmp, /* la_get_symbol_name_cmp */
+ ada_get_symbol_name_matcher, /* la_get_symbol_name_matcher */
ada_iterate_over_symbols,
+ default_search_name_hash,
&ada_varobj_ops,
NULL,
NULL,
LANG_MAGIC
};
-/* Provide a prototype to silence -Wmissing-prototypes. */
-extern initialize_file_ftype _initialize_ada_language;
-
/* Command-list for the "set/show ada" prefix command. */
static struct cmd_list_element *set_ada_list;
static struct cmd_list_element *show_ada_list;
/* Implement the "set ada" prefix command. */
static void
-set_ada_command (char *arg, int from_tty)
+set_ada_command (const char *arg, int from_tty)
{
printf_unfiltered (_(\
"\"set ada\" must be followed by the name of a setting.\n"));
/* Implement the "show ada" prefix command. */
static void
-show_ada_command (char *args, int from_tty)
+show_ada_command (const char *args, int from_tty)
{
cmd_show_list (show_ada_list, from_tty, "");
}
ops->print_one = print_one_catch_assert;
ops->print_mention = print_mention_catch_assert;
ops->print_recreate = print_recreate_catch_assert;
+
+ ops = &catch_handlers_breakpoint_ops;
+ *ops = bkpt_breakpoint_ops;
+ ops->allocate_location = allocate_location_catch_handlers;
+ ops->re_set = re_set_catch_handlers;
+ ops->check_status = check_status_catch_handlers;
+ ops->print_it = print_it_catch_handlers;
+ ops->print_one = print_one_catch_handlers;
+ ops->print_mention = print_mention_catch_handlers;
+ ops->print_recreate = print_recreate_catch_handlers;
}
/* This module's 'new_objfile' observer. */
void
_initialize_ada_language (void)
{
- add_language (&ada_language_defn);
-
initialize_ada_catchpoint_ops ();
add_prefix_cmd ("ada", no_class, set_ada_command,
NULL,
CATCH_PERMANENT,
CATCH_TEMPORARY);
+
+ add_catch_command ("handlers", _("\
+Catch Ada exceptions, when handled.\n\
+With an argument, catch only exceptions with the given name."),
+ catch_ada_handlers_command,
+ NULL,
+ CATCH_PERMANENT,
+ CATCH_TEMPORARY);
add_catch_command ("assert", _("\
Catch failed Ada assertions, when raised.\n\
With an argument, catch only exceptions with the given name."),
CATCH_TEMPORARY);
varsize_limit = 65536;
+ add_setshow_uinteger_cmd ("varsize-limit", class_support,
+ &varsize_limit, _("\
+Set the maximum number of bytes allowed in a variable-size object."), _("\
+Show the maximum number of bytes allowed in a variable-size object."), _("\
+Attempts to access an object whose size is not a compile-time constant\n\
+and exceeds this limit will cause an error."),
+ NULL, NULL, &setlist, &showlist);
add_info ("exceptions", info_exceptions_command,
_("\
DWARF attribute."),
NULL, NULL, &maint_set_ada_cmdlist, &maint_show_ada_cmdlist);
- obstack_init (&symbol_list_obstack);
-
- decoded_names_store = htab_create_alloc
- (256, htab_hash_string, (int (*)(const void *, const void *)) streq,
- NULL, xcalloc, xfree);
+ decoded_names_store = htab_create_alloc (256, htab_hash_string, streq_hash,
+ NULL, xcalloc, xfree);
/* The ada-lang observers. */
- observer_attach_new_objfile (ada_new_objfile_observer);
- observer_attach_free_objfile (ada_free_objfile_observer);
- observer_attach_inferior_exit (ada_inferior_exit);
+ gdb::observers::new_objfile.attach (ada_new_objfile_observer);
+ gdb::observers::free_objfile.attach (ada_free_objfile_observer);
+ gdb::observers::inferior_exit.attach (ada_inferior_exit);
/* Setup various context-specific data. */
ada_inferior_data