/* Ada language support routines for GDB, the GNU debugger.
- Copyright (C) 1992, 1993, 1994, 1997, 1998, 1999, 2000, 2003, 2004,
- 2005, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+ Copyright (C) 1992-1994, 1997-2000, 2003-2005, 2007-2012 Free
+ Software Foundation, Inc.
This file is part of GDB.
#include "observer.h"
#include "vec.h"
#include "stack.h"
+#include "gdb_vecs.h"
#include "psymtab.h"
#include "value.h"
#include "mi/mi-common.h"
#include "arch-utils.h"
#include "exceptions.h"
+#include "cli/cli-utils.h"
/* Define whether or not the C operator '/' truncates towards zero for
differently signed operands (truncation direction is undefined in C).
static struct value *ada_value_primitive_field (struct value *, int, int,
struct type *);
-static int find_struct_field (char *, struct type *, int,
+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,
static void ada_forward_operator_length (struct expression *, int, int *,
int *);
+
+static struct type *ada_find_any_type (const char *name);
\f
}
return type;
}
+
+/* Return a decoded version of the given VALUE. This means returning
+ a value whose type is obtained by applying all the GNAT-specific
+ encondings, making the resulting type a static but standard description
+ of the initial type. */
+
+struct value *
+ada_get_decoded_value (struct value *value)
+{
+ struct type *type = ada_check_typedef (value_type (value));
+
+ if (ada_is_array_descriptor_type (type)
+ || (ada_is_constrained_packed_array_type (type)
+ && TYPE_CODE (type) != TYPE_CODE_PTR))
+ {
+ if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF) /* array access type. */
+ value = ada_coerce_to_simple_array_ptr (value);
+ else
+ value = ada_coerce_to_simple_array (value);
+ }
+ else
+ value = ada_to_fixed_value (value);
+
+ return value;
+}
+
+/* Same as ada_get_decoded_value, but with the given TYPE.
+ Because there is no associated actual value for this type,
+ the resulting type might be a best-effort approximation in
+ the case of dynamic types. */
+
+struct type *
+ada_get_decoded_type (struct type *type)
+{
+ type = to_static_fixed_type (type);
+ if (ada_is_constrained_packed_array_type (type))
+ type = ada_coerce_to_simple_array_type (type);
+ return type;
+}
+
\f
/* Language Selection */
/* Fixup each field of INDEX_DESC_TYPE. */
for (i = 0; i < TYPE_NFIELDS (index_desc_type); i++)
{
- char *name = TYPE_FIELD_NAME (index_desc_type, i);
+ const char *name = TYPE_FIELD_NAME (index_desc_type, i);
struct type *raw_type = ada_check_typedef (ada_find_any_type (name));
if (raw_type)
static long
decode_packed_array_bitsize (struct type *type)
{
- char *raw_name;
- char *tail;
+ const char *raw_name;
+ const char *tail;
long bits;
/* Access to arrays implemented as fat pointers are encoded as a typedef
{
struct type *new_elt_type;
struct type *new_type;
+ struct type *index_type_desc;
+ struct type *index_type;
LONGEST low_bound, high_bound;
type = ada_check_typedef (type);
if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
return type;
+ index_type_desc = ada_find_parallel_type (type, "___XA");
+ if (index_type_desc)
+ index_type = to_fixed_range_type (TYPE_FIELD_TYPE (index_type_desc, 0),
+ NULL);
+ else
+ index_type = TYPE_INDEX_TYPE (type);
+
new_type = alloc_type_copy (type);
new_elt_type =
constrained_packed_array_type (ada_check_typedef (TYPE_TARGET_TYPE (type)),
elt_bits);
- create_array_type (new_type, new_elt_type, TYPE_INDEX_TYPE (type));
+ create_array_type (new_type, new_elt_type, index_type);
TYPE_FIELD_BITSIZE (new_type, 0) = *elt_bits;
TYPE_NAME (new_type) = ada_type_name (type);
- if (get_discrete_bounds (TYPE_INDEX_TYPE (type),
- &low_bound, &high_bound) < 0)
+ if (get_discrete_bounds (index_type, &low_bound, &high_bound) < 0)
low_bound = high_bound = 0;
if (high_bound < low_bound)
*elt_bits = TYPE_LENGTH (new_type) = 0;
static struct type *
decode_constrained_packed_array_type (struct type *type)
{
- char *raw_name = ada_type_name (ada_check_typedef (type));
+ const char *raw_name = ada_type_name (ada_check_typedef (type));
char *name;
- char *tail;
+ const char *tail;
struct type *shadow_type;
long bits;
ada_lookup_symbol_list (SYMBOL_LINKAGE_NAME
(exp->elts[pc + 2].symbol),
exp->elts[pc + 1].block, VAR_DOMAIN,
- &candidates);
+ &candidates, 1);
if (n_candidates > 1)
{
ada_lookup_symbol_list (SYMBOL_LINKAGE_NAME
(exp->elts[pc + 5].symbol),
exp->elts[pc + 4].block, VAR_DOMAIN,
- &candidates);
+ &candidates, 1);
if (n_candidates == 1)
i = 0;
else
n_candidates =
ada_lookup_symbol_list (ada_encode (ada_decoded_op_name (op)),
(struct block *) NULL, VAR_DOMAIN,
- &candidates);
+ &candidates, 1);
i = ada_resolve_function (candidates, n_candidates, argvec, nargs,
ada_decoded_op_name (op), NULL);
if (i < 0)
such symbols by their trailing number (__N or $N). */
static int
-encoded_ordered_before (char *N0, char *N1)
+encoded_ordered_before (const char *N0, const char *N1)
{
if (N1 == NULL)
return 0;
char *args2;
int choice, j;
- while (isspace (*args))
- args += 1;
+ args = skip_spaces (args);
if (*args == '\0' && n_chosen == 0)
error_no_arg (_("one or more choice numbers"));
else if (*args == '\0')
{
struct type *type0 = SYMBOL_TYPE (sym0);
struct type *type1 = SYMBOL_TYPE (sym1);
- char *name0 = SYMBOL_LINKAGE_NAME (sym0);
- char *name1 = SYMBOL_LINKAGE_NAME (sym1);
+ const char *name0 = SYMBOL_LINKAGE_NAME (sym0);
+ const char *name1 = SYMBOL_LINKAGE_NAME (sym1);
int len0 = strlen (name0);
return
static int
is_nondebugging_type (struct type *type)
{
- char *name = ada_type_name (type);
+ const char *name = ada_type_name (type);
return (name != NULL && strcmp (name, "<variable, no debug info>") == 0);
}
suffix). */
for (i = 0; i < TYPE_NFIELDS (type1); i++)
{
- char *name_1 = TYPE_FIELD_NAME (type1, i);
- char *name_2 = TYPE_FIELD_NAME (type2, i);
+ const char *name_1 = TYPE_FIELD_NAME (type1, i);
+ const char *name_2 = TYPE_FIELD_NAME (type2, i);
int len_1 = strlen (name_1);
int len_2 = strlen (name_2);
not visible from FUNCTION_NAME. */
static int
-old_renaming_is_invisible (const struct symbol *sym, char *function_name)
+old_renaming_is_invisible (const struct symbol *sym, const char *function_name)
{
char *scope;
int nsyms, const struct block *current_block)
{
struct symbol *current_function;
- char *current_function_name;
+ const char *current_function_name;
int i;
int is_new_style_renaming;
the next call of ada_lookup_symbol_list. Any non-function/non-enumeral
symbol match within the nest of blocks whose innermost member is BLOCK0,
is the one match returned (no other matches in that or
- enclosing blocks is returned). If there are any matches in or
- surrounding BLOCK0, then these alone are returned. Otherwise, the
- search extends to global and file-scope (static) symbol tables.
+ enclosing blocks is returned). If there are any matches in or
+ surrounding BLOCK0, then these alone are returned. Otherwise, if
+ FULL_SEARCH is non-zero, then the search extends to global and
+ file-scope (static) symbol tables.
Names prefixed with "standard__" are handled specially: "standard__"
is first stripped off, and only static and global symbols are searched. */
int
ada_lookup_symbol_list (const char *name0, const struct block *block0,
- domain_enum namespace,
- struct ada_symbol_info **results)
+ domain_enum namespace,
+ struct ada_symbol_info **results,
+ int full_search)
{
struct symbol *sym;
struct block *block;
ada_add_local_symbols (&symbol_list_obstack, name, block, namespace,
wild_match);
- if (num_defns_collected (&symbol_list_obstack) > 0)
+ if (num_defns_collected (&symbol_list_obstack) > 0 || !full_search)
goto done;
/* No non-global symbols found. Check our cache to see if we have
ndefns = remove_extra_symbols (*results, ndefns);
- if (ndefns == 0)
+ if (ndefns == 0 && full_search)
cache_symbol (name0, namespace, NULL, NULL);
- if (ndefns == 1 && cacheIfUnique)
+ if (ndefns == 1 && full_search && cacheIfUnique)
cache_symbol (name0, namespace, (*results)[0].sym, (*results)[0].block);
ndefns = remove_irrelevant_renamings (*results, ndefns, block0);
static void
ada_iterate_over_symbols (const struct block *block,
const char *name, domain_enum domain,
- int (*callback) (struct symbol *, void *),
+ symbol_found_callback_ftype *callback,
void *data)
{
int ndefs, i;
struct ada_symbol_info *results;
- ndefs = ada_lookup_symbol_list (name, block, domain, &results);
+ ndefs = ada_lookup_symbol_list (name, block, domain, &results, 0);
for (i = 0; i < ndefs; ++i)
{
if (! (*callback) (results[i].sym, data))
struct ada_symbol_info *candidates;
int n_candidates;
- n_candidates = ada_lookup_symbol_list (name, block0, namespace, &candidates);
+ n_candidates = ada_lookup_symbol_list (name, block0, namespace, &candidates,
+ 1);
if (n_candidates == 0)
return NULL;
return sym_name;
}
-DEF_VEC_P (char_ptr);
-
/* A companion function to ada_make_symbol_completion_list().
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
/* A callback for expand_partial_symbol_names. */
static int
-ada_expand_partial_symbol_name (const struct language_defn *language,
- const char *name, void *user_data)
+ada_expand_partial_symbol_name (const char *name, void *user_data)
{
struct add_partial_datum *data = user_data;
static int
ada_is_dispatch_table_ptr_type (struct type *type)
{
- char *name;
+ const char *name;
if (TYPE_CODE (type) != TYPE_CODE_PTR)
return 0;
{
if (field_num < 0 || field_num > TYPE_NFIELDS (type))
return 1;
-
+
/* Check the name of that field. */
{
const char *name = TYPE_FIELD_NAME (type, field_num);
if (name == NULL)
return 1;
- /* A field named "_parent" is internally generated by GNAT for
- tagged types, and should not be printed either. */
+ /* Normally, fields whose name start with an underscore ("_")
+ are fields that have been internally generated by the compiler,
+ and thus should not be printed. The "_parent" field is special,
+ however: This is a field internally generated by the compiler
+ for tagged types, and it contains the components inherited from
+ the parent type. This field should not be printed as is, but
+ should not be ignored either. */
if (name[0] == '_' && strncmp (name, "_parent", 7) != 0)
return 1;
}
return NULL;
}
-struct tag_args
+/* Return the "ada__tags__type_specific_data" type. */
+
+static struct type *
+ada_get_tsd_type (struct inferior *inf)
{
- struct value *tag;
- char *name;
-};
+ struct ada_inferior_data *data = get_ada_inferior_data (inf);
+ if (data->tsd_type == 0)
+ data->tsd_type = ada_find_any_type ("ada__tags__type_specific_data");
+ return data->tsd_type;
+}
-static int ada_tag_name_1 (void *);
-static int ada_tag_name_2 (struct tag_args *);
+/* Return the TSD (type-specific data) associated to the given TAG.
+ TAG is assumed to be the tag of a tagged-type entity.
-/* Wrapper function used by ada_tag_name. Given a struct tag_args*
- value ARGS, sets ARGS->name to the tag name of ARGS->tag.
- The value stored in ARGS->name is valid until the next call to
- ada_tag_name_1. */
+ May return NULL if we are unable to get the TSD. */
-static int
-ada_tag_name_1 (void *args0)
+static struct value *
+ada_get_tsd_from_tag (struct value *tag)
{
- struct tag_args *args = (struct tag_args *) args0;
- static char name[1024];
- char *p;
struct value *val;
+ struct type *type;
- args->name = NULL;
- val = ada_value_struct_elt (args->tag, "tsd", 1);
- if (val == NULL)
- return ada_tag_name_2 (args);
- val = ada_value_struct_elt (val, "expanded_name", 1);
- if (val == NULL)
- return 0;
- read_memory_string (value_as_address (val), name, sizeof (name) - 1);
- for (p = name; *p != '\0'; p += 1)
- if (isalpha (*p))
- *p = tolower (*p);
- args->name = name;
- return 0;
-}
+ /* First option: The TSD is simply stored as a field of our TAG.
+ Only older versions of GNAT would use this format, but we have
+ to test it first, because there are no visible markers for
+ the current approach except the absence of that field. */
-/* Return the "ada__tags__type_specific_data" type. */
+ val = ada_value_struct_elt (tag, "tsd", 1);
+ if (val)
+ return val;
-static struct type *
-ada_get_tsd_type (struct inferior *inf)
-{
- struct ada_inferior_data *data = get_ada_inferior_data (inf);
+ /* Try the second representation for the dispatch table (in which
+ there is no explicit 'tsd' field in the referent of the tag pointer,
+ and instead the tsd pointer is stored just before the dispatch
+ table. */
- if (data->tsd_type == 0)
- data->tsd_type = ada_find_any_type ("ada__tags__type_specific_data");
- return data->tsd_type;
+ type = ada_get_tsd_type (current_inferior());
+ if (type == NULL)
+ return NULL;
+ type = lookup_pointer_type (lookup_pointer_type (type));
+ val = value_cast (type, tag);
+ if (val == NULL)
+ return NULL;
+ return value_ind (value_ptradd (val, -1));
}
-/* Utility function for ada_tag_name_1 that tries the second
- representation for the dispatch table (in which there is no
- explicit 'tsd' field in the referent of the tag pointer, and instead
- the tsd pointer is stored just before the dispatch table. */
-
-static int
-ada_tag_name_2 (struct tag_args *args)
+/* Given the TSD of a tag (type-specific data), return a string
+ containing the name of the associated type.
+
+ The returned value is good until the next call. May return NULL
+ if we are unable to determine the tag name. */
+
+static char *
+ada_tag_name_from_tsd (struct value *tsd)
{
- struct type *info_type;
static char name[1024];
char *p;
- struct value *val, *valp;
+ struct value *val;
- args->name = NULL;
- info_type = ada_get_tsd_type (current_inferior());
- if (info_type == NULL)
- return 0;
- info_type = lookup_pointer_type (lookup_pointer_type (info_type));
- valp = value_cast (info_type, args->tag);
- if (valp == NULL)
- return 0;
- val = value_ind (value_ptradd (valp, -1));
+ val = ada_value_struct_elt (tsd, "expanded_name", 1);
if (val == NULL)
- return 0;
- val = ada_value_struct_elt (val, "expanded_name", 1);
- if (val == NULL)
- return 0;
+ return NULL;
read_memory_string (value_as_address (val), name, sizeof (name) - 1);
for (p = name; *p != '\0'; p += 1)
if (isalpha (*p))
*p = tolower (*p);
- args->name = name;
- return 0;
+ return name;
}
/* The type name of the dynamic type denoted by the 'tag value TAG, as
- a C string. */
+ a C string.
+
+ Return NULL if the TAG is not an Ada tag, or if we were unable to
+ determine the name of that tag. The result is good until the next
+ call. */
const char *
ada_tag_name (struct value *tag)
{
- struct tag_args args;
+ volatile struct gdb_exception e;
+ char *name = NULL;
if (!ada_is_tag_type (value_type (tag)))
return NULL;
- args.tag = tag;
- args.name = NULL;
- catch_errors (ada_tag_name_1, &args, NULL, RETURN_MASK_ALL);
- return args.name;
+
+ /* It is perfectly possible that an exception be raised while trying
+ to determine the TAG's name, even under normal circumstances:
+ The associated variable may be uninitialized or corrupted, for
+ instance. We do not let any exception propagate past this point.
+ instead we return NULL.
+
+ We also do not print the error message either (which often is very
+ low-level (Eg: "Cannot read memory at 0x[...]"), but instead let
+ the caller print a more meaningful message if necessary. */
+ TRY_CATCH (e, RETURN_MASK_ERROR)
+ {
+ struct value *tsd = ada_get_tsd_from_tag (tag);
+
+ if (tsd != NULL)
+ name = ada_tag_name_from_tsd (tsd);
+ }
+
+ return name;
}
/* The parent type of TYPE, or NULL if none. */
Returns 1 if found, 0 otherwise. */
static int
-find_struct_field (char *name, struct type *type, int offset,
+find_struct_field (const char *name, struct type *type, int offset,
struct type **field_type_p,
int *byte_offset_p, int *bit_offset_p, int *bit_size_p,
int *index_p)
{
int bit_pos = TYPE_FIELD_BITPOS (type, i);
int fld_offset = offset + bit_pos / 8;
- char *t_field_name = TYPE_FIELD_NAME (type, i);
+ const char *t_field_name = TYPE_FIELD_NAME (type, i);
if (t_field_name == NULL)
continue;
type = ada_check_typedef (type);
for (i = 0; i < TYPE_NFIELDS (type); i += 1)
{
- char *t_field_name = TYPE_FIELD_NAME (type, i);
+ const char *t_field_name = TYPE_FIELD_NAME (type, i);
if (t_field_name == NULL)
continue;
for (i = 0; i < TYPE_NFIELDS (type); i += 1)
{
- char *t_field_name = TYPE_FIELD_NAME (type, i);
+ const char *t_field_name = TYPE_FIELD_NAME (type, i);
struct type *t;
int disp;
NOT wrapped in a struct, since the compiler sometimes
generates these for unchecked variant types. Revisit
if the compiler changes this practice. */
- char *v_field_name = TYPE_FIELD_NAME (field_type, j);
+ 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))
struct value *
ada_value_ind (struct value *val0)
{
- struct value *val = unwrap_value (value_ind (val0));
+ struct value *val = value_ind (val0);
return ada_to_fixed_value (val);
}
struct value *val = val0;
val = coerce_ref (val);
- val = unwrap_value (val);
return ada_to_fixed_value (val);
}
else
return atoi (name + align_offset) * TARGET_CHAR_BIT;
}
-/* Find a symbol named NAME. Ignores ambiguity. */
+/* Find a typedef or tag symbol named NAME. Ignores ambiguity. */
-struct symbol *
-ada_find_any_symbol (const char *name)
+static struct symbol *
+ada_find_any_type_symbol (const char *name)
{
struct symbol *sym;
solely for types defined by debug info, it will not search the GDB
primitive types. */
-struct type *
+static struct type *
ada_find_any_type (const char *name)
{
- struct symbol *sym = ada_find_any_symbol (name);
+ struct symbol *sym = ada_find_any_type_symbol (name);
if (sym != NULL)
return SYMBOL_TYPE (sym);
return NULL;
}
-/* Given NAME and an associated BLOCK, search all symbols for
- NAME suffixed with "___XR", which is the ``renaming'' symbol
- associated to NAME. Return this symbol if found, return
- NULL otherwise. */
+/* Given NAME_SYM and an associated BLOCK, find a "renaming" symbol
+ associated with NAME_SYM's name. NAME_SYM may itself be a renaming
+ symbol, in which case it is returned. Otherwise, this looks for
+ symbols whose name is that of NAME_SYM suffixed with "___XR".
+ Return symbol if found, and NULL otherwise. */
struct symbol *
-ada_find_renaming_symbol (const char *name, struct block *block)
+ada_find_renaming_symbol (struct symbol *name_sym, struct block *block)
{
+ const char *name = SYMBOL_LINKAGE_NAME (name_sym);
struct symbol *sym;
+ if (strstr (name, "___XR") != NULL)
+ return name_sym;
+
sym = find_old_style_renaming_symbol (name, block);
if (sym != NULL)
return sym;
/* Not right yet. FIXME pnh 7/20/2007. */
- sym = ada_find_any_symbol (name);
+ sym = ada_find_any_type_symbol (name);
if (sym != NULL && strstr (SYMBOL_LINKAGE_NAME (sym), "___XR") != NULL)
return sym;
else
qualified. This means we need to prepend the function name
as well as adding the ``___XR'' suffix to build the name of
the associated renaming symbol. */
- char *function_name = SYMBOL_LINKAGE_NAME (function_sym);
+ const char *function_name = SYMBOL_LINKAGE_NAME (function_sym);
/* Function names sometimes contain suffixes used
for instance to qualify nested subprograms. When building
the XR type name, we need to make sure that this suffix is
xsnprintf (rename, rename_len * sizeof (char), "%s___XR", name);
}
- return ada_find_any_symbol (rename);
+ return ada_find_any_type_symbol (rename);
}
/* Because of GNAT encoding conventions, several GDB symbols may match a
/* The name of TYPE, which is either its TYPE_NAME, or, if that is
null, its TYPE_TAG_NAME. Null if TYPE is null. */
-char *
+const char *
ada_type_name (struct type *type)
{
if (type == NULL)
result = TYPE_DESCRIPTIVE_TYPE (type);
while (result != NULL)
{
- char *result_name = ada_type_name (result);
+ const char *result_name = ada_type_name (result);
if (result_name == NULL)
{
struct type *
ada_find_parallel_type (struct type *type, const char *suffix)
{
- char *name, *typename = ada_type_name (type);
+ char *name;
+ const char *typename = ada_type_name (type);
int len;
if (typename == NULL)
error (_("array type with dynamic size is larger than varsize-limit"));
}
+ /* We want to preserve the type name. This can be useful when
+ trying to get the type name of a value that has already been
+ printed (for instance, if the user did "print VAR; whatis $". */
+ TYPE_NAME (result) = TYPE_NAME (type0);
+
if (constrained_packed_array_p)
{
/* So far, the resulting type has been created as if the original
If there is, then it provides the actual size of our type. */
else if (ada_type_name (fixed_record_type) != NULL)
{
- char *name = ada_type_name (fixed_record_type);
+ const char *name = ada_type_name (fixed_record_type);
char *xvz_name = alloca (strlen (name) + 7 /* "___XVZ\0" */);
int xvz_found = 0;
LONGEST size;
return type;
else
{
- char *name = TYPE_TAG_NAME (type);
+ const char *name = TYPE_TAG_NAME (type);
struct type *type1 = ada_find_any_type (name);
if (type1 == NULL)
struct value *
ada_to_fixed_value (struct value *val)
{
- return ada_to_fixed_value_create (value_type (val),
- value_address (val),
- val);
+ val = unwrap_value (val);
+ val = ada_to_fixed_value_create (value_type (val),
+ value_address (val),
+ val);
+ return val;
}
\f
else
{
elt = ada_index_struct_field (index, lhs, 0, value_type (lhs));
- elt = ada_to_fixed_value (unwrap_value (elt));
+ elt = ada_to_fixed_value (elt);
}
if (exp->elts[*pos].opcode == OP_AGGREGATE)
else
{
int ind;
- char *name;
+ const char *name;
switch (op)
{
else
{
arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
- arg1 = unwrap_value (arg1);
return ada_to_fixed_value (arg1);
}
else if (discrete_type_p (type_arg))
{
struct type *range_type;
- char *name = ada_type_name (type_arg);
+ const char *name = ada_type_name (type_arg);
range_type = NULL;
if (name != NULL && TYPE_CODE (type_arg) != TYPE_CODE_ENUM)
int nsyms;
nsyms = ada_lookup_symbol_list (name, get_selected_block (0), VAR_DOMAIN,
- &syms);
+ &syms, 1);
if (nsyms != 1)
{
static struct type *
to_fixed_range_type (struct type *raw_type, struct value *dval)
{
- char *name;
+ const char *name;
struct type *base_type;
char *subtype_info;
&& TYPE_UNSIGNED (subranged_type));
}
-/* Try to determine the lower and upper bounds of the given modular type
- using the type name only. Return non-zero and set L and U as the lower
- and upper bounds (respectively) if successful. */
-
-int
-ada_modulus_from_name (struct type *type, ULONGEST *modulus)
-{
- char *name = ada_type_name (type);
- char *suffix;
- int k;
- LONGEST U;
-
- if (name == NULL)
- return 0;
-
- /* Discrete type bounds are encoded using an __XD suffix. In our case,
- we are looking for static bounds, which means an __XDLU suffix.
- Moreover, we know that the lower bound of modular types is always
- zero, so the actual suffix should start with "__XDLU_0__", and
- then be followed by the upper bound value. */
- suffix = strstr (name, "__XDLU_0__");
- if (suffix == NULL)
- return 0;
- k = 10;
- if (!ada_scan_number (suffix, k, &U, NULL))
- return 0;
-
- *modulus = (ULONGEST) U + 1;
- return 1;
-}
-
/* Assuming ada_is_modular_type (TYPE), the modulus of TYPE. */
ULONGEST
is_known_support_routine (struct frame_info *frame)
{
struct symtab_and_line sal;
- char *func_name;
+ const char *func_name;
enum language func_lang;
int i;
while (fi != NULL)
{
- char *func_name;
+ const char *func_name;
enum language func_lang;
find_frame_funname (fi, &func_name, &func_lang, NULL);
ada_exception_name_addr (enum exception_catchpoint_kind ex,
struct breakpoint *b)
{
- struct gdb_exception e;
+ volatile struct gdb_exception e;
CORE_ADDR result = 0;
TRY_CATCH (e, RETURN_MASK_ERROR)
char *end;
char *result;
- /* Skip any leading white space. */
-
- while (isspace (*args))
- args++;
-
+ args = skip_spaces (args);
if (args[0] == '\0')
return NULL; /* No more arguments. */
/* Find the end of the current argument. */
- end = args;
- while (*end != '\0' && !isspace (*end))
- end++;
+ end = skip_to_space (args);
/* Adjust ARGSP to point to the start of the next argument. */
/* Split the arguments specified in a "catch exception" command.
Set EX to the appropriate catchpoint type.
Set EXCEP_STRING to the name of the specific exception if
- specified by the user. */
+ specified by the user.
+ 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 (char *args,
enum exception_catchpoint_kind *ex,
- char **excep_string)
+ char **excep_string,
+ char **cond_string)
{
struct cleanup *old_chain = make_cleanup (null_cleanup, NULL);
char *exception_name;
+ char *cond = NULL;
exception_name = ada_get_next_arg (&args);
+ if (exception_name != NULL && strcmp (exception_name, "if") == 0)
+ {
+ /* This is not an exception name; this is the start of a condition
+ expression for a catchpoint on all exceptions. So, "un-get"
+ this token, and set exception_name to NULL. */
+ xfree (exception_name);
+ exception_name = NULL;
+ args -= 2;
+ }
make_cleanup (xfree, exception_name);
+ /* Check to see if we have a condition. */
+
+ args = skip_spaces (args);
+ if (strncmp (args, "if", 2) == 0
+ && (isspace (args[2]) || args[2] == '\0'))
+ {
+ args += 2;
+ args = skip_spaces (args);
+
+ if (args[0] == '\0')
+ error (_("Condition missing after `if' keyword"));
+ cond = xstrdup (args);
+ make_cleanup (xfree, cond);
+
+ args += strlen (args);
+ }
+
/* Check that we do not have any more arguments. Anything else
is unexpected. */
- while (isspace (*args))
- args++;
-
if (args[0] != '\0')
error (_("Junk at end of expression"));
*ex = ex_catch_exception;
*excep_string = exception_name;
}
+ *cond_string = cond;
}
/* Return the name of the symbol on which we should break in order to
If the user asked the catchpoint to catch only a specific
exception, then save the exception name in ADDR_STRING.
+ If the user provided a condition, then set COND_STRING to
+ that condition expression (the memory must be deallocated
+ after use). Otherwise, set COND_STRING to NULL.
+
See ada_exception_sal for a description of all the remaining
function arguments of this function. */
static struct symtab_and_line
ada_decode_exception_location (char *args, char **addr_string,
char **excep_string,
+ char **cond_string,
const struct breakpoint_ops **ops)
{
enum exception_catchpoint_kind ex;
- catch_ada_exception_command_split (args, &ex, excep_string);
+ catch_ada_exception_command_split (args, &ex, excep_string, cond_string);
return ada_exception_sal (ex, *excep_string, addr_string, ops);
}
struct symtab_and_line sal,
char *addr_string,
char *excep_string,
+ char *cond_string,
const struct breakpoint_ops *ops,
int tempflag,
int from_tty)
ops, tempflag, from_tty);
c->excep_string = excep_string;
create_excep_cond_exprs (c);
+ if (cond_string != NULL)
+ set_breakpoint_condition (&c->base, cond_string, from_tty);
install_breakpoint (0, &c->base, 1);
}
struct symtab_and_line sal;
char *addr_string = NULL;
char *excep_string = NULL;
+ char *cond_string = NULL;
const struct breakpoint_ops *ops = NULL;
tempflag = get_cmd_context (command) == CATCH_TEMPORARY;
if (!arg)
arg = "";
- sal = ada_decode_exception_location (arg, &addr_string, &excep_string, &ops);
+ sal = ada_decode_exception_location (arg, &addr_string, &excep_string,
+ &cond_string, &ops);
create_ada_exception_catchpoint (gdbarch, sal, addr_string,
- excep_string, ops, tempflag, from_tty);
+ excep_string, cond_string, ops,
+ tempflag, from_tty);
}
+/* Assuming that ARGS contains the arguments of a "catch assert"
+ command, parse those arguments and return a symtab_and_line object
+ for a failed assertion catchpoint.
+
+ Set ADDR_STRING to the name of the function where the real
+ breakpoint that implements the catchpoint is set.
+
+ If ARGS contains a condition, set COND_STRING to that condition
+ (the memory needs to be deallocated after use). Otherwise, set
+ COND_STRING to NULL. */
+
static struct symtab_and_line
ada_decode_assert_location (char *args, char **addr_string,
+ char **cond_string,
const struct breakpoint_ops **ops)
{
- /* Check that no argument where provided at the end of the command. */
+ args = skip_spaces (args);
- if (args != NULL)
+ /* Check whether a condition was provided. */
+ if (strncmp (args, "if", 2) == 0
+ && (isspace (args[2]) || args[2] == '\0'))
{
- while (isspace (*args))
- args++;
- if (*args != '\0')
- error (_("Junk at end of arguments."));
+ args += 2;
+ args = skip_spaces (args);
+ if (args[0] == '\0')
+ error (_("condition missing after `if' keyword"));
+ *cond_string = xstrdup (args);
}
+ /* Otherwise, there should be no other argument at the end of
+ the command. */
+ else if (args[0] != '\0')
+ error (_("Junk at end of arguments."));
+
return ada_exception_sal (ex_catch_assert, NULL, addr_string, ops);
}
int tempflag;
struct symtab_and_line sal;
char *addr_string = NULL;
+ char *cond_string = NULL;
const struct breakpoint_ops *ops = NULL;
tempflag = get_cmd_context (command) == CATCH_TEMPORARY;
if (!arg)
arg = "";
- sal = ada_decode_assert_location (arg, &addr_string, &ops);
+ sal = ada_decode_assert_location (arg, &addr_string, &cond_string, &ops);
create_ada_exception_catchpoint (gdbarch, sal, addr_string,
- NULL, ops, tempflag, from_tty);
+ NULL, cond_string, ops, tempflag,
+ from_tty);
}
/* Operators */
/* Information about operators given special treatment in functions
ada_evaluate_subexp
};
+/* Implement the "la_get_symbol_name_cmp" language_defn method
+ for Ada. */
+
+static symbol_name_cmp_ftype
+ada_get_symbol_name_cmp (const char *lookup_name)
+{
+ if (should_use_wild_match (lookup_name))
+ return wild_match;
+ else
+ return compare_names;
+}
+
const struct language_defn ada_language_defn = {
"ada", /* Language name */
language_ada,
ada_print_array_index,
default_pass_by_reference,
c_get_string,
- compare_names,
+ ada_get_symbol_name_cmp, /* la_get_symbol_name_cmp */
ada_iterate_over_symbols,
LANG_MAGIC
};