/* Ada language support routines for GDB, the GNU debugger.
- Copyright (C) 1992-2013 Free Software Foundation, Inc.
+ Copyright (C) 1992-2015 Free Software Foundation, Inc.
This file is part of GDB.
#include "defs.h"
-#include <stdio.h>
-#include "gdb_string.h"
#include <ctype.h>
-#include <stdarg.h>
#include "demangle.h"
#include "gdb_regex.h"
#include "frame.h"
#include "expression.h"
#include "parser-defs.h"
#include "language.h"
+#include "varobj.h"
#include "c-lang.h"
#include "inferior.h"
#include "symfile.h"
#include "gdb_obstack.h"
#include "ada-lang.h"
#include "completer.h"
-#include "gdb_stat.h"
-#ifdef UI_OUT
+#include <sys/stat.h>
#include "ui-out.h"
-#endif
#include "block.h"
#include "infcall.h"
#include "dictionary.h"
-#include "exceptions.h"
#include "annotate.h"
#include "valprint.h"
#include "source.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
static struct value *make_array_descriptor (struct type *, struct value *);
static void ada_add_block_symbols (struct obstack *,
- struct block *, const char *,
+ const struct block *, const char *,
domain_enum, struct objfile *, int);
static int is_nonfunction (struct ada_symbol_info *, int);
static void add_defn_to_vec (struct obstack *, struct symbol *,
- struct block *);
+ const struct block *);
static int num_defns_collected (struct obstack *);
static void ada_language_arch_info (struct gdbarch *,
struct language_arch_info *);
-static void check_size (const struct type *);
-
static struct value *ada_index_struct_field (int, struct value *, int,
struct type *);
static struct type *ada_find_any_type (const char *name);
\f
+/* The result of a symbol lookup to be stored in our symbol cache. */
+
+struct cache_entry
+{
+ /* The name used to perform the lookup. */
+ const char *name;
+ /* The namespace used during the lookup. */
+ domain_enum domain;
+ /* The symbol returned by the lookup, or NULL if no matching symbol
+ was found. */
+ struct symbol *sym;
+ /* The block where the symbol was found, or NULL if no matching
+ symbol was found. */
+ const struct block *block;
+ /* A pointer to the next entry with the same hash. */
+ struct cache_entry *next;
+};
+
+/* The Ada symbol cache, used to store the result of Ada-mode symbol
+ lookups in the course of executing the user's commands.
+
+ The cache is implemented using a simple, fixed-sized hash.
+ The size is fixed on the grounds that there are not likely to be
+ all that many symbols looked up during any given session, regardless
+ of the size of the symbol table. If we decide to go to a resizable
+ table, let's just use the stuff from libiberty instead. */
+
+#define HASH_SIZE 1009
+
+struct ada_symbol_cache
+{
+ /* An obstack used to store the entries in our cache. */
+ struct obstack cache_space;
+
+ /* The root of the hash table used to implement our symbol cache. */
+ struct cache_entry *root[HASH_SIZE];
+};
+
+static void ada_free_symbol_cache (struct ada_symbol_cache *sym_cache);
/* Maximum-sized dynamic type. */
static unsigned int varsize_limit;
/* 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;
+static struct cmd_list_element *maint_show_ada_cmdlist;
+
+/* Implement the "maintenance set ada" (prefix) command. */
+
+static void
+maint_set_ada_cmd (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)
+{
+ cmd_show_list (maint_show_ada_cmdlist, from_tty, "");
+}
+
+/* The "maintenance ada set/show ignore-descriptive-type" value. */
+
+static int ada_ignore_descriptive_types_p = 0;
+
/* Inferior-specific data. */
/* Per-inferior data for this module. */
data = inferior_data (inf, ada_inferior_data);
if (data == NULL)
{
- data = XZALLOC (struct ada_inferior_data);
+ data = XCNEW (struct ada_inferior_data);
set_inferior_data (inf, ada_inferior_data, data);
}
set_inferior_data (inf, ada_inferior_data, NULL);
}
+
+ /* program-space-specific data. */
+
+/* This module's per-program-space data. */
+struct ada_pspace_data
+{
+ /* The Ada symbol cache. */
+ struct ada_symbol_cache *sym_cache;
+};
+
+/* Key to our per-program-space data. */
+static const struct program_space_data *ada_pspace_data_handle;
+
+/* Return this module's data for the given program space (PSPACE).
+ If not is found, add a zero'ed one now.
+
+ This function always returns a valid object. */
+
+static struct ada_pspace_data *
+get_ada_pspace_data (struct program_space *pspace)
+{
+ struct ada_pspace_data *data;
+
+ data = program_space_data (pspace, ada_pspace_data_handle);
+ if (data == NULL)
+ {
+ data = XCNEW (struct ada_pspace_data);
+ set_program_space_data (pspace, ada_pspace_data_handle, data);
+ }
+
+ return data;
+}
+
+/* The cleanup callback for this module's per-program-space data. */
+
+static void
+ada_pspace_data_cleanup (struct program_space *pspace, void *data)
+{
+ struct ada_pspace_data *pspace_data = data;
+
+ if (pspace_data->sym_cache != NULL)
+ ada_free_symbol_cache (pspace_data->sym_cache);
+ xfree (pspace_data);
+}
+
/* Utilities */
/* If TYPE is a TYPE_CODE_TYPEDEF type, return the target type after
static const char *
ada_unqualified_name (const char *decoded_name)
{
- const char *result = strrchr (decoded_name, '.');
+ const char *result;
+
+ /* If the decoded name starts with '<', it means that the encoded
+ name does not follow standard naming conventions, and thus that
+ it is not your typical Ada symbol name. Trying to unqualify it
+ is therefore pointless and possibly erroneous. */
+ if (decoded_name[0] == '<')
+ return decoded_name;
+ result = strrchr (decoded_name, '.');
if (result != NULL)
result++; /* Skip the dot... */
else
return
(strncmp (field_name, target, len) == 0
&& (field_name[len] == '\0'
- || (strncmp (field_name + len, "___", 3) == 0
+ || (startswith (field_name + len, "___")
&& strcmp (field_name + strlen (field_name) - 6,
"___XVN") != 0)));
}
/* Make sure that the object size is not unreasonable before
trying to allocate some memory for it. */
- check_size (type);
+ ada_ensure_varsize_limit (type);
if (value_lazy (val)
|| TYPE_LENGTH (type) > TYPE_LENGTH (value_type (val)))
else
{
result = allocate_value (type);
- memcpy (value_contents_raw (result), value_contents (val),
- TYPE_LENGTH (type));
+ value_contents_copy_raw (result, 0, val, 0, TYPE_LENGTH (type));
}
set_value_component_location (result, val);
set_value_bitsize (result, value_bitsize (val));
set_value_bitpos (result, value_bitpos (val));
set_value_address (result, value_address (val));
- set_value_optimized_out (result, value_optimized_out_const (val));
return result;
}
}
i.e. if it would be a bad idea to allocate a value of this type in
GDB. */
-static void
-check_size (const struct type *type)
+void
+ada_ensure_varsize_limit (const struct type *type)
{
if (TYPE_LENGTH (type) > varsize_limit)
error (_("object size is larger than varsize-limit"));
LONGEST
ada_discrete_type_high_bound (struct type *type)
{
+ type = resolve_dynamic_type (type, NULL, 0);
switch (TYPE_CODE (type))
{
case TYPE_CODE_RANGE:
LONGEST
ada_discrete_type_low_bound (struct type *type)
{
+ type = resolve_dynamic_type (type, NULL, 0);
switch (TYPE_CODE (type))
{
case TYPE_CODE_RANGE:
ada_update_initial_language (enum language lang)
{
if (lookup_minimal_symbol ("adainit", (const char *) NULL,
- (struct objfile *) NULL) != NULL)
+ (struct objfile *) NULL).minsym != NULL)
return language_ada;
return lang;
char *
ada_main_name (void)
{
- struct minimal_symbol *msym;
+ struct bound_minimal_symbol msym;
static char *main_program_name = NULL;
/* For Ada, the name of the main procedure is stored in a specific
in Ada. */
msym = lookup_minimal_symbol (ADA_MAIN_PROGRAM_SYMBOL_NAME, NULL, NULL);
- if (msym != NULL)
+ if (msym.minsym != NULL)
{
CORE_ADDR main_program_name_addr;
int err_code;
- main_program_name_addr = SYMBOL_VALUE_ADDRESS (msym);
+ main_program_name_addr = BMSYMBOL_VALUE_ADDRESS (msym);
if (main_program_name_addr == 0)
error (_("Invalid address for Ada main program name."));
for (mapping = ada_opname_table;
mapping->encoded != NULL
- && strncmp (mapping->decoded, p,
- strlen (mapping->decoded)) != 0; mapping += 1)
+ && !startswith (p, mapping->decoded); mapping += 1)
;
if (mapping->encoded == NULL)
error (_("invalid Ada operator name: %s"), p);
*len = i;
else if (i >= 0 && encoded[i] == '$')
*len = i;
- else if (i >= 2 && strncmp (encoded + i - 2, "___", 3) == 0)
+ else if (i >= 2 && startswith (encoded + i - 2, "___"))
*len = i - 2;
- else if (i >= 1 && strncmp (encoded + i - 1, "__", 2) == 0)
+ else if (i >= 1 && startswith (encoded + i - 1, "__"))
*len = i - 1;
}
}
/* The name of the Ada main procedure starts with "_ada_".
This prefix is not part of the decoded name, so skip this part
if we see this prefix. */
- if (strncmp (encoded, "_ada_", 5) == 0)
+ if (startswith (encoded, "_ada_"))
encoded += 5;
/* If the name starts with '_', then it is not a properly encoded
is for the body of a task, but that information does not actually
appear in the decoded name. */
- if (len0 > 3 && strncmp (encoded + len0 - 3, "TKB", 3) == 0)
+ if (len0 > 3 && startswith (encoded + len0 - 3, "TKB"))
len0 -= 3;
/* Remove any trailing TB suffix. The TB suffix is slightly different
from the TKB suffix because it is used for non-anonymous task
bodies. */
- if (len0 > 2 && strncmp (encoded + len0 - 2, "TB", 2) == 0)
+ if (len0 > 2 && startswith (encoded + len0 - 2, "TB"))
len0 -= 2;
/* Remove trailing "B" suffixes. */
/* FIXME: brobecker/2006-04-19: Not sure what this are used for... */
- if (len0 > 1 && strncmp (encoded + len0 - 1, "B", 1) == 0)
+ if (len0 > 1 && startswith (encoded + len0 - 1, "B"))
len0 -= 1;
/* Make decoded big enough for possible expansion by operator name. */
/* Replace "TK__" with "__", which will eventually be translated
into "." (just below). */
- if (i < len0 - 4 && strncmp (encoded + i, "TK__", 4) == 0)
+ if (i < len0 - 4 && startswith (encoded + i, "TK__"))
i += 2;
/* Replace "__B_{DIGITS}+__" sequences by "__", which will eventually
return (strncmp (sym_name, name, len_name) == 0
&& is_name_suffix (sym_name + len_name))
- || (strncmp (sym_name, "_ada_", 5) == 0
+ || (startswith (sym_name, "_ada_")
&& strncmp (sym_name + 5, name, len_name) == 0
&& is_name_suffix (sym_name + len_name + 5));
}
struct value *high = desc_one_bound (descriptor, arity, 1);
arity -= 1;
- create_range_type (range_type, value_type (low),
- longest_to_int (value_as_long (low)),
- longest_to_int (value_as_long (high)));
+ create_static_range_type (range_type, value_type (low),
+ longest_to_int (value_as_long (low)),
+ longest_to_int (value_as_long (high)));
elt_type = create_array_type (array_type, elt_type, range_type);
if (ada_is_unconstrained_packed_array_type (value_type (arr)))
if (arrVal == NULL)
error (_("Bounds unavailable for null array pointer."));
- check_size (TYPE_TARGET_TYPE (value_type (arrVal)));
+ ada_ensure_varsize_limit (TYPE_TARGET_TYPE (value_type (arrVal)));
return value_ind (arrVal);
}
else if (ada_is_constrained_packed_array_type (value_type (arr)))
but with the bit sizes of its elements (and those of any
constituent arrays) recorded in the BITSIZE components of its
TYPE_FIELD_BITSIZE values, and with *ELT_BITS set to its total size
- in bits. */
+ in bits.
+
+ Note that, for arrays whose index type has an XA encoding where
+ a bound references a record discriminant, getting that discriminant,
+ and therefore the actual value of that bound, is not possible
+ because none of the given parameters gives us access to the record.
+ This function assumes that it is OK in the context where it is being
+ used to return an array whose bounds are still dynamic and where
+ the length is arbitrary. */
static struct type *
constrained_packed_array_type (struct type *type, long *elt_bits)
TYPE_FIELD_BITSIZE (new_type, 0) = *elt_bits;
TYPE_NAME (new_type) = ada_type_name (type);
- if (get_discrete_bounds (index_type, &low_bound, &high_bound) < 0)
+ if ((TYPE_CODE (check_typedef (index_type)) == TYPE_CODE_RANGE
+ && is_dynamic_type (check_typedef (index_type)))
+ || 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;
lim_warning (_("could not find bounds information on packed array"));
return NULL;
}
- CHECK_TYPEDEF (shadow_type);
+ shadow_type = check_typedef (shadow_type);
if (TYPE_CODE (shadow_type) != TYPE_CODE_ARRAY)
{
{
struct type *type;
- arr = ada_coerce_ref (arr);
-
- /* If our value is a pointer, then dererence it. Make sure that
- this operation does not cause the target type to be fixed, as
- this would indirectly cause this array to be decoded. The rest
- of the routine assumes that the array hasn't been decoded yet,
- so we use the basic "value_ind" routine to perform the dereferencing,
- as opposed to using "ada_value_ind". */
+ /* If our value is a pointer, then dereference it. Likewise if
+ the value is a reference. Make sure that this operation does not
+ cause the target type to be fixed, as this would indirectly cause
+ this array to be decoded. The rest of the routine assumes that
+ the array hasn't been decoded yet, so we use the basic "coerce_ref"
+ and "value_ind" routines to perform the dereferencing, as opposed
+ to using "ada_coerce_ref" or "ada_value_ind". */
+ arr = coerce_ref (arr);
if (TYPE_CODE (ada_check_typedef (value_type (arr))) == TYPE_CODE_PTR)
arr = value_ind (arr);
}
else if (VALUE_LVAL (obj) == lval_memory && value_lazy (obj))
{
- v = value_at (type, value_address (obj));
+ v = value_at (type, value_address (obj) + offset);
+ type = value_type (v);
+ if (TYPE_LENGTH (type) * HOST_CHAR_BIT < bit_size)
+ {
+ /* This can happen in the case of an array of dynamic objects,
+ where the size of each element changes from element to element.
+ In that case, we're initially given the array stride, but
+ after resolving the element type, we find that its size is
+ less than this stride. In that case, adjust bit_size to
+ match TYPE's length, and recompute LEN accordingly. */
+ bit_size = TYPE_LENGTH (type) * HOST_CHAR_BIT;
+ len = TYPE_LENGTH (type) + (bit_offset + HOST_CHAR_BIT - 1) / 8;
+ }
bytes = (unsigned char *) alloca (len);
- read_memory (value_address (v) + offset, bytes, len);
+ read_memory (value_address (v), bytes, len);
}
else
{
accum |= sign << accumSize;
unpacked[targ] = accum & ~(~0L << HOST_CHAR_BIT);
accumSize -= HOST_CHAR_BIT;
+ if (accumSize < 0)
+ accumSize = 0;
accum >>= HOST_CHAR_BIT;
ntarg -= 1;
targ += delta;
}
+ if (is_dynamic_type (value_type (v)))
+ v = value_from_contents_and_address (value_type (v), value_contents (v),
+ 0);
return v;
}
}
-/* Given that COMPONENT is a memory lvalue that is part of the lvalue
- * CONTAINER, assign the contents of VAL to COMPONENTS's place in
- * CONTAINER. Modifies the VALUE_CONTENTS of CONTAINER only, not
- * COMPONENT, and not the inferior's memory. The current contents
- * of COMPONENT are ignored. */
+/* Given that COMPONENT is a memory lvalue that is part of the lvalue
+ CONTAINER, assign the contents of VAL to COMPONENTS's place in
+ CONTAINER. Modifies the VALUE_CONTENTS of CONTAINER only, not
+ COMPONENT, and not the inferior's memory. The current contents
+ of COMPONENT are ignored.
+
+ Although not part of the initial design, this function also works
+ when CONTAINER and COMPONENT are not_lval's: it works as if CONTAINER
+ had a null address, and COMPONENT had an address which is equal to
+ its offset inside CONTAINER. */
+
static void
value_assign_to_component (struct value *container, struct value *component,
struct value *val)
{
LONGEST offset_in_container =
(LONGEST) (value_address (component) - value_address (container));
- int bit_offset_in_container =
+ int bit_offset_in_container =
value_bitpos (component) - value_bitpos (container);
int bits;
-
+
val = value_cast (value_type (component), val);
if (value_bitsize (component) == 0)
bits = value_bitsize (component);
if (gdbarch_bits_big_endian (get_type_arch (value_type (container))))
- move_bits (value_contents_writeable (container) + offset_in_container,
+ move_bits (value_contents_writeable (container) + offset_in_container,
value_bitpos (container) + bit_offset_in_container,
value_contents (val),
TYPE_LENGTH (value_type (component)) * TARGET_CHAR_BIT - bits,
bits, 1);
else
- move_bits (value_contents_writeable (container) + offset_in_container,
+ move_bits (value_contents_writeable (container) + offset_in_container,
value_bitpos (container) + bit_offset_in_container,
value_contents (val), 0, bits, 0);
-}
-
+}
+
/* The value of the element of array ARR at the ARITY indices given in IND.
ARR may be either a simple array, GNAT array descriptor, or pointer
thereto. */
return elt;
}
-/* Assuming ARR is a pointer to a standard GDB array of type TYPE, the
- value of the element of *ARR at the ARITY indices given in
- IND. Does not read the entire array into memory. */
+/* Assuming ARR is a pointer to a GDB array, the value of the element
+ of *ARR at the ARITY indices given in IND.
+ Does not read the entire array into memory. */
static struct value *
-ada_value_ptr_subscript (struct value *arr, struct type *type, int arity,
- struct value **ind)
+ada_value_ptr_subscript (struct value *arr, int arity, struct value **ind)
{
int k;
+ struct type *type
+ = check_typedef (value_enclosing_type (ada_value_ind (arr)));
for (k = 0; k < arity; k += 1)
{
LONGEST lwb, upb;
+ struct value *lwb_value;
if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
error (_("too many subscripts (%d expected)"), k);
arr = value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
value_copy (arr));
get_discrete_bounds (TYPE_INDEX_TYPE (type), &lwb, &upb);
- arr = value_ptradd (arr, pos_atr (ind[k]) - lwb);
+ lwb_value = value_from_longest (value_type(ind[k]), lwb);
+ arr = value_ptradd (arr, pos_atr (ind[k]) - pos_atr (lwb_value));
type = TYPE_TARGET_TYPE (type);
}
}
/* Given that ARRAY_PTR is a pointer or reference to an array of type TYPE (the
- actual type of ARRAY_PTR is ignored), returns the Ada slice of HIGH-LOW+1
- elements starting at index LOW. The lower bound of this array is LOW, as
- per Ada rules. */
+ actual type of ARRAY_PTR is ignored), returns the Ada slice of
+ HIGH'Pos-LOW'Pos+1 elements starting at index LOW. The lower bound of
+ this array is LOW, as per Ada rules. */
static struct value *
ada_value_slice_from_ptr (struct value *array_ptr, struct type *type,
int low, int high)
{
struct type *type0 = ada_check_typedef (type);
- CORE_ADDR base = value_as_address (array_ptr)
- + ((low - ada_discrete_type_low_bound (TYPE_INDEX_TYPE (type0)))
- * TYPE_LENGTH (TYPE_TARGET_TYPE (type0)));
- struct type *index_type =
- create_range_type (NULL, TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (type0)),
- low, high);
+ 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);
+ int base_low = ada_discrete_type_low_bound (TYPE_INDEX_TYPE (type0));
+ LONGEST base_low_pos, low_pos;
+ CORE_ADDR base;
+
+ if (!discrete_position (base_index_type, low, &low_pos)
+ || !discrete_position (base_index_type, base_low, &base_low_pos))
+ {
+ warning (_("unable to get positions in slice, use bounds instead"));
+ low_pos = low;
+ base_low_pos = base_low;
+ }
+ base = value_as_address (array_ptr)
+ + ((low_pos - base_low_pos)
+ * TYPE_LENGTH (TYPE_TARGET_TYPE (type0)));
return value_at_lazy (slice_type, base);
}
ada_value_slice (struct value *array, int low, int high)
{
struct type *type = ada_check_typedef (value_type (array));
- struct type *index_type =
- create_range_type (NULL, TYPE_INDEX_TYPE (type), low, high);
+ 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);
+ LONGEST low_pos, high_pos;
+
+ if (!discrete_position (base_index_type, low, &low_pos)
+ || !discrete_position (base_index_type, high, &high_pos))
+ {
+ warning (_("unable to get positions in slice, use bounds instead"));
+ low_pos = low;
+ high_pos = high;
+ }
- return value_cast (slice_type, value_slice (array, low, high - low + 1));
+ return value_cast (slice_type,
+ value_slice (array, low, high_pos - low_pos + 1));
}
/* If type is a record type in the form of a standard GNAT array
by run-time quantities other than discriminants. */
static LONGEST
-ada_array_bound_from_type (struct type * arr_type, int n, int which)
+ada_array_bound_from_type (struct type *arr_type, int n, int which)
{
- struct type *type, *elt_type, *index_type_desc, *index_type;
+ struct type *type, *index_type_desc, *index_type;
int i;
gdb_assert (which == 0 || which == 1);
else
type = arr_type;
- elt_type = type;
- for (i = n; i > 1; i--)
- elt_type = TYPE_TARGET_TYPE (type);
+ if (TYPE_FIXED_INSTANCE (type))
+ {
+ /* The array has already been fixed, so we do not need to
+ check the parallel ___XA type again. That encoding has
+ already been applied, so ignore it now. */
+ index_type_desc = NULL;
+ }
+ else
+ {
+ index_type_desc = ada_find_parallel_type (type, "___XA");
+ ada_fixup_array_indexes_type (index_type_desc);
+ }
- index_type_desc = ada_find_parallel_type (type, "___XA");
- ada_fixup_array_indexes_type (index_type_desc);
if (index_type_desc != NULL)
index_type = to_fixed_range_type (TYPE_FIELD_TYPE (index_type_desc, n - 1),
NULL);
else
- index_type = TYPE_INDEX_TYPE (elt_type);
+ {
+ struct type *elt_type = check_typedef (type);
+
+ for (i = 1; i < n; i++)
+ elt_type = check_typedef (TYPE_TARGET_TYPE (elt_type));
+
+ index_type = TYPE_INDEX_TYPE (elt_type);
+ }
return
(LONGEST) (which == 0
static LONGEST
ada_array_bound (struct value *arr, int n, int which)
{
- struct type *arr_type = value_type (arr);
+ struct type *arr_type;
+
+ if (TYPE_CODE (check_typedef (value_type (arr))) == TYPE_CODE_PTR)
+ arr = value_ind (arr);
+ arr_type = value_enclosing_type (arr);
if (ada_is_constrained_packed_array_type (arr_type))
return ada_array_bound (decode_constrained_packed_array (arr), n, which);
static LONGEST
ada_array_length (struct value *arr, int n)
{
- struct type *arr_type = ada_check_typedef (value_type (arr));
+ struct type *arr_type, *index_type;
+ int low, high;
+
+ if (TYPE_CODE (check_typedef (value_type (arr))) == TYPE_CODE_PTR)
+ arr = value_ind (arr);
+ arr_type = value_enclosing_type (arr);
if (ada_is_constrained_packed_array_type (arr_type))
return ada_array_length (decode_constrained_packed_array (arr), n);
if (ada_is_simple_array_type (arr_type))
- return (ada_array_bound_from_type (arr_type, n, 1)
- - ada_array_bound_from_type (arr_type, n, 0) + 1);
+ {
+ low = ada_array_bound_from_type (arr_type, n, 0);
+ high = ada_array_bound_from_type (arr_type, n, 1);
+ }
else
- return (value_as_long (desc_one_bound (desc_bounds (arr), n, 1))
- - value_as_long (desc_one_bound (desc_bounds (arr), n, 0)) + 1);
+ {
+ low = value_as_long (desc_one_bound (desc_bounds (arr), n, 0));
+ high = value_as_long (desc_one_bound (desc_bounds (arr), n, 1));
+ }
+
+ arr_type = check_typedef (arr_type);
+ index_type = TYPE_INDEX_TYPE (arr_type);
+ if (index_type != NULL)
+ {
+ struct type *base_type;
+ if (TYPE_CODE (index_type) == TYPE_CODE_RANGE)
+ base_type = TYPE_TARGET_TYPE (index_type);
+ else
+ base_type = index_type;
+
+ low = pos_atr (value_from_longest (base_type, low));
+ high = pos_atr (value_from_longest (base_type, high));
+ }
+ return high - low + 1;
}
/* An empty array whose type is that of ARR_TYPE (an array type),
empty_array (struct type *arr_type, int low)
{
struct type *arr_type0 = ada_check_typedef (arr_type);
- struct type *index_type =
- create_range_type (NULL, TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (arr_type0)),
- low, low - 1);
+ struct type *index_type
+ = create_static_range_type
+ (NULL, TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (arr_type0)), low, low - 1);
struct type *elt_type = ada_array_element_type (arr_type0, 1);
return allocate_value (create_array_type (NULL, elt_type, index_type));
(SYMBOL_CLASS (syms[i].sym) == LOC_CONST
&& SYMBOL_TYPE (syms[i].sym) != NULL
&& TYPE_CODE (SYMBOL_TYPE (syms[i].sym)) == TYPE_CODE_ENUM);
- struct symtab *symtab = SYMBOL_SYMTAB (syms[i].sym);
+ struct symtab *symtab = NULL;
+
+ if (SYMBOL_OBJFILE_OWNED (syms[i].sym))
+ symtab = symbol_symtab (syms[i].sym);
if (SYMBOL_LINE (syms[i].sym) != 0 && symtab != NULL)
printf_unfiltered (_("[%d] %s at %s:%d\n"),
static struct value *
ada_read_renaming_var_value (struct symbol *renaming_sym,
- struct block *block)
+ const struct block *block)
{
const char *sym_name;
struct expression *expr;
}
else if (TYPE_CODE (actual_type) == TYPE_CODE_PTR)
return ada_value_ind (actual);
+ else if (ada_is_aligner_type (formal_type))
+ {
+ /* We need to turn this parameter into an aligner type
+ as well. */
+ struct value *aligner = allocate_value (formal_type);
+ struct value *component = ada_value_struct_elt (aligner, "F", 0);
+
+ value_assign_to_component (aligner, component, actual);
+ return aligner;
+ }
return actual;
}
return descriptor;
}
\f
-/* Dummy definitions for an experimental caching module that is not
- * used in the public sources. */
+ /* Symbol Cache Module */
+
+/* Performance measurements made as of 2010-01-15 indicate that
+ this cache does bring some noticeable improvements. Depending
+ on the type of entity being printed, the cache can make it as much
+ as an order of magnitude faster than without it.
+
+ The descriptive type DWARF extension has significantly reduced
+ the need for this cache, at least when DWARF is being used. However,
+ even in this case, some expensive name-based symbol searches are still
+ sometimes necessary - to find an XVZ variable, mostly. */
+
+/* Initialize the contents of SYM_CACHE. */
+
+static void
+ada_init_symbol_cache (struct ada_symbol_cache *sym_cache)
+{
+ obstack_init (&sym_cache->cache_space);
+ memset (sym_cache->root, '\000', sizeof (sym_cache->root));
+}
+
+/* Free the memory used by SYM_CACHE. */
+
+static void
+ada_free_symbol_cache (struct ada_symbol_cache *sym_cache)
+{
+ obstack_free (&sym_cache->cache_space, NULL);
+ xfree (sym_cache);
+}
+
+/* Return the symbol cache associated to the given program space PSPACE.
+ If not allocated for this PSPACE yet, allocate and initialize one. */
+
+static struct ada_symbol_cache *
+ada_get_symbol_cache (struct program_space *pspace)
+{
+ struct ada_pspace_data *pspace_data = get_ada_pspace_data (pspace);
+
+ if (pspace_data->sym_cache == NULL)
+ {
+ pspace_data->sym_cache = XCNEW (struct ada_symbol_cache);
+ ada_init_symbol_cache (pspace_data->sym_cache);
+ }
+
+ return pspace_data->sym_cache;
+}
+
+/* Clear all entries from the symbol cache. */
+
+static void
+ada_clear_symbol_cache (void)
+{
+ struct ada_symbol_cache *sym_cache
+ = ada_get_symbol_cache (current_program_space);
+
+ obstack_free (&sym_cache->cache_space, NULL);
+ ada_init_symbol_cache (sym_cache);
+}
+
+/* Search our cache for an entry matching NAME and DOMAIN.
+ Return it if found, or NULL otherwise. */
+
+static struct cache_entry **
+find_entry (const char *name, domain_enum domain)
+{
+ struct ada_symbol_cache *sym_cache
+ = ada_get_symbol_cache (current_program_space);
+ int h = msymbol_hash (name) % HASH_SIZE;
+ struct cache_entry **e;
+
+ for (e = &sym_cache->root[h]; *e != NULL; e = &(*e)->next)
+ {
+ if (domain == (*e)->domain && strcmp (name, (*e)->name) == 0)
+ return e;
+ }
+ return NULL;
+}
+
+/* Search the symbol cache for an entry matching NAME and DOMAIN.
+ Return 1 if found, 0 otherwise.
+
+ If an entry was found and SYM is not NULL, set *SYM to the entry's
+ SYM. Same principle for BLOCK if not NULL. */
static int
-lookup_cached_symbol (const char *name, domain_enum namespace,
- struct symbol **sym, struct block **block)
+lookup_cached_symbol (const char *name, domain_enum domain,
+ struct symbol **sym, const struct block **block)
{
- return 0;
+ struct cache_entry **e = find_entry (name, domain);
+
+ if (e == NULL)
+ return 0;
+ if (sym != NULL)
+ *sym = (*e)->sym;
+ if (block != NULL)
+ *block = (*e)->block;
+ return 1;
}
+/* Assuming that (SYM, BLOCK) is the result of the lookup of NAME
+ in domain DOMAIN, save this result in our symbol cache. */
+
static void
-cache_symbol (const char *name, domain_enum namespace, struct symbol *sym,
+cache_symbol (const char *name, domain_enum domain, struct symbol *sym,
const struct block *block)
{
+ struct ada_symbol_cache *sym_cache
+ = ada_get_symbol_cache (current_program_space);
+ int h;
+ char *copy;
+ struct cache_entry *e;
+
+ /* Symbols for builtin types don't have a block.
+ For now don't cache such symbols. */
+ if (sym != NULL && !SYMBOL_OBJFILE_OWNED (sym))
+ return;
+
+ /* If the symbol is a local symbol, then do not cache it, as a search
+ for that symbol depends on the context. To determine whether
+ the symbol is local or not, we check the block where we found it
+ against the global and static blocks of its associated symtab. */
+ if (sym
+ && BLOCKVECTOR_BLOCK (SYMTAB_BLOCKVECTOR (symbol_symtab (sym)),
+ GLOBAL_BLOCK) != block
+ && BLOCKVECTOR_BLOCK (SYMTAB_BLOCKVECTOR (symbol_symtab (sym)),
+ STATIC_BLOCK) != block)
+ return;
+
+ h = msymbol_hash (name) % HASH_SIZE;
+ e = (struct cache_entry *) obstack_alloc (&sym_cache->cache_space,
+ sizeof (*e));
+ e->next = sym_cache->root[h];
+ sym_cache->root[h] = e;
+ e->name = copy = obstack_alloc (&sym_cache->cache_space, strlen (name) + 1);
+ strcpy (copy, name);
+ e->sym = sym;
+ e->domain = domain;
+ e->block = block;
}
\f
/* Symbol Lookup */
TYPE_CODE (type0) == TYPE_CODE (type1)
&& (equiv_types (type0, type1)
|| (len0 < strlen (name1) && strncmp (name0, name1, len0) == 0
- && strncmp (name1 + len0, "___XV", 5) == 0));
+ && startswith (name1 + len0, "___XV")));
}
case LOC_CONST:
return SYMBOL_VALUE (sym0) == SYMBOL_VALUE (sym1)
static void
add_defn_to_vec (struct obstack *obstackp,
struct symbol *sym,
- struct block *block)
+ const struct block *block)
{
int i;
struct ada_symbol_info *prevDefns = defns_collected (obstackp, 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 (strncmp (name, "standard__", sizeof ("standard__") - 1) == 0)
+ if (startswith (name, "standard__"))
name += sizeof ("standard__") - 1;
ALL_MSYMBOLS (objfile, msymbol)
{
- if (match_name (SYMBOL_LINKAGE_NAME (msymbol), name, wild_match_p)
+ if (match_name (MSYMBOL_LINKAGE_NAME (msymbol), name, wild_match_p)
&& MSYMBOL_TYPE (msymbol) != mst_solib_trampoline)
{
result.minsym = msymbol;
static void
add_symbols_from_enclosing_procs (struct obstack *obstackp,
- const char *name, domain_enum namespace,
+ const char *name, domain_enum domain,
int wild_match_p)
{
}
a library-level function. Strip this prefix before doing the
comparison, as the encoding for the renaming does not contain
this prefix. */
- if (strncmp (function_name, "_ada_", 5) == 0)
+ if (startswith (function_name, "_ada_"))
function_name += 5;
{
- int is_invisible = strncmp (function_name, scope, strlen (scope)) != 0;
+ int is_invisible = !startswith (function_name, scope);
do_cleanups (old_chain);
return is_invisible;
static void
ada_add_local_symbols (struct obstack *obstackp, const char *name,
- struct block *block, domain_enum domain,
+ const struct block *block, domain_enum domain,
int wild_match_p)
{
int block_depth = 0;
return 0;
}
-/* Compare STRING1 to STRING2, with results as for strcmp.
- Compatible with strcmp_iw in that strcmp_iw (STRING1, STRING2) <= 0
- implies compare_names (STRING1, STRING2) (they may differ as to
- what symbols compare equal). */
+/* Implements compare_names, but only applying the comparision using
+ the given CASING. */
static int
-compare_names (const char *string1, const char *string2)
+compare_names_with_case (const char *string1, const char *string2,
+ enum case_sensitivity casing)
{
while (*string1 != '\0' && *string2 != '\0')
{
+ char c1, c2;
+
if (isspace (*string1) || isspace (*string2))
return strcmp_iw_ordered (string1, string2);
- if (*string1 != *string2)
+
+ if (casing == case_sensitive_off)
+ {
+ c1 = tolower (*string1);
+ c2 = tolower (*string2);
+ }
+ else
+ {
+ c1 = *string1;
+ c2 = *string2;
+ }
+ if (c1 != c2)
break;
+
string1 += 1;
string2 += 1;
}
+
switch (*string1)
{
case '(':
if (*string2 == '(')
return strcmp_iw_ordered (string1, string2);
else
- return *string1 - *string2;
+ {
+ if (casing == case_sensitive_off)
+ return tolower (*string1) - tolower (*string2);
+ else
+ return *string1 - *string2;
+ }
}
}
+/* Compare STRING1 to STRING2, with results as for strcmp.
+ Compatible with strcmp_iw_ordered in that...
+
+ strcmp_iw_ordered (STRING1, STRING2) <= 0
+
+ ... implies...
+
+ compare_names (STRING1, STRING2) <= 0
+
+ (they may differ as to what symbols compare equal). */
+
+static int
+compare_names (const char *string1, const char *string2)
+{
+ int result;
+
+ /* Similar to what strcmp_iw_ordered does, we need to perform
+ a case-insensitive comparison first, and only resort to
+ a second, case-sensitive, comparison if the first one was
+ not sufficient to differentiate the two strings. */
+
+ result = compare_names_with_case (string1, string2, case_sensitive_off);
+ if (result == 0)
+ result = compare_names_with_case (string1, string2, case_sensitive_on);
+
+ return result;
+}
+
/* 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. */
static int
ada_lookup_symbol_list_worker (const char *name0, const struct block *block0,
- domain_enum namespace,
+ domain_enum domain,
struct ada_symbol_info **results,
int full_search)
{
struct symbol *sym;
- struct block *block;
+ const struct block *block;
const char *name;
const int wild_match_p = should_use_wild_match (name0);
- int cacheIfUnique;
+ int syms_from_global_search = 0;
int ndefns;
obstack_free (&symbol_list_obstack, NULL);
obstack_init (&symbol_list_obstack);
- cacheIfUnique = 0;
-
/* Search specified block and its superiors. */
name = name0;
- block = (struct block *) block0; /* FIXME: No cast ought to be
- needed, but adding const will
- have a cascade effect. */
+ block = block0;
/* Special case: If the user specifies a symbol name inside package
Standard, do a non-wild matching of the symbol name without
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 (strncmp (name0, "standard__", sizeof ("standard__") - 1) == 0)
+ if (startswith (name0, "standard__"))
{
block = NULL;
name = name0 + sizeof ("standard__") - 1;
if (full_search)
{
ada_add_local_symbols (&symbol_list_obstack, name, block,
- namespace, wild_match_p);
+ domain, wild_match_p);
}
else
{
ada_iterate_over_symbols, and we don't want to search
superblocks. */
ada_add_block_symbols (&symbol_list_obstack, block, name,
- namespace, NULL, wild_match_p);
+ domain, NULL, wild_match_p);
}
if (num_defns_collected (&symbol_list_obstack) > 0 || !full_search)
goto done;
already performed this search before. If we have, then return
the same result. */
- cacheIfUnique = 1;
- if (lookup_cached_symbol (name0, namespace, &sym, &block))
+ if (lookup_cached_symbol (name0, domain, &sym, &block))
{
if (sym != NULL)
add_defn_to_vec (&symbol_list_obstack, sym, block);
goto done;
}
+ syms_from_global_search = 1;
+
/* Search symbols from all global blocks. */
- add_nonlocal_symbols (&symbol_list_obstack, name, namespace, 1,
+ add_nonlocal_symbols (&symbol_list_obstack, name, domain, 1,
wild_match_p);
/* 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 (&symbol_list_obstack) == 0)
- add_nonlocal_symbols (&symbol_list_obstack, name, namespace, 0,
+ add_nonlocal_symbols (&symbol_list_obstack, name, domain, 0,
wild_match_p);
done:
ndefns = remove_extra_symbols (*results, ndefns);
- if (ndefns == 0 && full_search)
- cache_symbol (name0, namespace, NULL, NULL);
+ if (ndefns == 0 && full_search && syms_from_global_search)
+ cache_symbol (name0, domain, NULL, NULL);
- if (ndefns == 1 && full_search && cacheIfUnique)
- cache_symbol (name0, namespace, (*results)[0].sym, (*results)[0].block);
+ if (ndefns == 1 && full_search && syms_from_global_search)
+ cache_symbol (name0, domain, (*results)[0].sym, (*results)[0].block);
ndefns = remove_irrelevant_renamings (*results, ndefns, block0);
void
ada_lookup_encoded_symbol (const char *name, const struct block *block,
- domain_enum namespace,
+ domain_enum domain,
struct ada_symbol_info *info)
{
struct ada_symbol_info *candidates;
gdb_assert (info != NULL);
memset (info, 0, sizeof (struct ada_symbol_info));
- n_candidates = ada_lookup_symbol_list (name, block, namespace, &candidates);
+ n_candidates = ada_lookup_symbol_list (name, block, domain, &candidates);
if (n_candidates == 0)
return;
struct symbol *
ada_lookup_symbol (const char *name, const struct block *block0,
- domain_enum namespace, int *is_a_field_of_this)
+ domain_enum domain, int *is_a_field_of_this)
{
struct ada_symbol_info info;
*is_a_field_of_this = 0;
ada_lookup_encoded_symbol (ada_encode (ada_fold_name (name)),
- block0, namespace, &info);
+ block0, domain, &info);
return info.sym;
}
static struct symbol *
-ada_lookup_symbol_nonlocal (const char *name,
+ada_lookup_symbol_nonlocal (const struct language_defn *langdef,
+ const char *name,
const struct block *block,
const domain_enum domain)
{
- return ada_lookup_symbol (name, block_static_block (block), domain, NULL);
+ struct symbol *sym;
+
+ sym = ada_lookup_symbol (name, block_static_block (block), domain, NULL);
+ if (sym != NULL)
+ return sym;
+
+ /* If we haven't found a match at this point, try the primitive
+ types. In other languages, this search is performed before
+ searching for global symbols in order to short-circuit that
+ global-symbol search if it happens that the name corresponds
+ to a primitive type. But we cannot do the same in Ada, because
+ it is perfectly legitimate for a program to declare a type which
+ has the same name as a standard type. If looking up a type in
+ that situation, we have traditionally ignored the primitive type
+ in favor of user-defined types. This is why, unlike most other
+ languages, we search the primitive types this late and only after
+ having searched the global symbols without success. */
+
+ if (domain == VAR_DOMAIN)
+ {
+ struct gdbarch *gdbarch;
+
+ if (block == NULL)
+ gdbarch = target_gdbarch ();
+ else
+ gdbarch = block_gdbarch (block);
+ sym = language_lookup_primitive_type_as_symbol (langdef, gdbarch, name);
+ if (sym != NULL)
+ return sym;
+ }
+
+ return NULL;
}
if ((t1 >= 'a' && t1 <= 'z') || (t1 >= '0' && t1 <= '9'))
{
name += 1;
- if (name == name0 + 5 && strncmp (name0, "_ada", 4) == 0)
+ if (name == name0 + 5 && startswith (name0, "_ada"))
break;
else
name += 1;
static void
ada_add_block_symbols (struct obstack *obstackp,
- struct block *block, const char *name,
+ const struct block *block, const char *name,
domain_enum domain, struct objfile *objfile,
int wild)
{
cmp = (int) '_' - (int) SYMBOL_LINKAGE_NAME (sym)[0];
if (cmp == 0)
{
- cmp = strncmp ("_ada_", SYMBOL_LINKAGE_NAME (sym), 5);
+ cmp = !startswith (SYMBOL_LINKAGE_NAME (sym), "_ada_");
if (cmp == 0)
cmp = strncmp (name, SYMBOL_LINKAGE_NAME (sym) + 5,
name_len);
}
/* An object of this type is passed as the user_data argument to the
- expand_partial_symbol_names method. */
+ expand_symtabs_matching method. */
struct add_partial_datum
{
VEC(char_ptr) **completions;
int encoded;
};
-/* A callback for expand_partial_symbol_names. */
+/* A callback for expand_symtabs_matching. */
+
static int
-ada_expand_partial_symbol_name (const char *name, void *user_data)
+ada_complete_symbol_matcher (const char *name, void *user_data)
{
struct add_partial_datum *data = user_data;
int encoded_p;
VEC(char_ptr) *completions = VEC_alloc (char_ptr, 128);
struct symbol *sym;
- struct symtab *s;
+ struct compunit_symtab *s;
struct minimal_symbol *msymbol;
struct objfile *objfile;
- struct block *b, *surrounding_static_block = 0;
+ const struct block *b, *surrounding_static_block = 0;
int i;
struct block_iterator iter;
struct cleanup *old_chain = make_cleanup (null_cleanup, NULL);
data.word = word;
data.wild_match = wild_match_p;
data.encoded = encoded_p;
- expand_partial_symbol_names (ada_expand_partial_symbol_name, &data);
+ expand_symtabs_matching (NULL, ada_complete_symbol_matcher, NULL,
+ ALL_DOMAIN, &data);
}
/* At this point scan through the misc symbol vectors and add each
ALL_MSYMBOLS (objfile, msymbol)
{
QUIT;
- symbol_completion_add (&completions, SYMBOL_LINKAGE_NAME (msymbol),
+ symbol_completion_add (&completions, MSYMBOL_LINKAGE_NAME (msymbol),
text, text_len, text0, word, wild_match_p,
encoded_p);
}
/* Go through the symtabs and check the externs and statics for
symbols which match. */
- ALL_SYMTABS (objfile, s)
+ ALL_COMPUNITS (objfile, s)
{
QUIT;
- b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), GLOBAL_BLOCK);
+ b = BLOCKVECTOR_BLOCK (COMPUNIT_BLOCKVECTOR (s), GLOBAL_BLOCK);
ALL_BLOCK_SYMBOLS (b, iter, sym)
{
symbol_completion_add (&completions, SYMBOL_LINKAGE_NAME (sym),
}
}
- ALL_SYMTABS (objfile, s)
+ ALL_COMPUNITS (objfile, s)
{
QUIT;
- b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), STATIC_BLOCK);
+ b = BLOCKVECTOR_BLOCK (COMPUNIT_BLOCKVECTOR (s), STATIC_BLOCK);
/* Don't do this block twice. */
if (b == surrounding_static_block)
continue;
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)
+ if (name[0] == '_' && !startswith (name, "_parent"))
return 1;
}
int
ada_is_tag_type (struct type *type)
{
+ type = ada_check_typedef (type);
+
if (type == NULL || TYPE_CODE (type) != TYPE_CODE_PTR)
return 0;
else
struct value *
ada_tag_value_at_base_address (struct value *obj)
{
- volatile struct gdb_exception e;
struct value *val;
LONGEST offset_to_top = 0;
struct type *ptr_type, *obj_type;
see ada_tag_name for more details. We do not print the error
message for the same reason. */
- TRY_CATCH (e, RETURN_MASK_ERROR)
+ TRY
{
offset_to_top = value_as_long (value_ind (value_ptradd (val, -2)));
}
- if (e.reason < 0)
- return obj;
+ CATCH (e, RETURN_MASK_ERROR)
+ {
+ return obj;
+ }
+ END_CATCH
/* If offset is null, nothing to do. */
const char *
ada_tag_name (struct value *tag)
{
- volatile struct gdb_exception e;
char *name = NULL;
if (!ada_is_tag_type (value_type (tag)))
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)
+ TRY
{
struct value *tsd = ada_get_tsd_from_tag (tag);
if (tsd != NULL)
name = ada_tag_name_from_tsd (tsd);
}
+ CATCH (e, RETURN_MASK_ERROR)
+ {
+ }
+ END_CATCH
return name;
}
const char *name = TYPE_FIELD_NAME (ada_check_typedef (type), field_num);
return (name != NULL
- && (strncmp (name, "PARENT", 6) == 0
- || strncmp (name, "_parent", 7) == 0));
+ && (startswith (name, "PARENT")
+ || startswith (name, "_parent")));
}
/* True iff field number FIELD_NUM of structure type TYPE is a
const char *name = TYPE_FIELD_NAME (type, field_num);
return (name != NULL
- && (strncmp (name, "PARENT", 6) == 0
+ && (startswith (name, "PARENT")
|| strcmp (name, "REP") == 0
- || strncmp (name, "_parent", 7) == 0
+ || startswith (name, "_parent")
|| name[0] == 'S' || name[0] == 'R' || name[0] == 'O'));
}
for (discrim_end = name + strlen (name) - 6; discrim_end != name;
discrim_end -= 1)
{
- if (strncmp (discrim_end, "___XVN", 6) == 0)
+ if (startswith (discrim_end, "___XVN"))
break;
}
if (discrim_end == name)
if (discrim_start == name + 1)
return "";
if ((discrim_start > name + 3
- && strncmp (discrim_start - 3, "___", 3) == 0)
+ && startswith (discrim_start - 3, "___"))
|| discrim_start[-1] == '.')
break;
}
{
if (dispp != NULL)
*dispp += TYPE_FIELD_BITPOS (type, i) / 8;
- return ada_check_typedef (TYPE_FIELD_TYPE (type, i));
+ return TYPE_FIELD_TYPE (type, i);
}
else if (ada_is_wrapper_field (type, i))
disp = 0;
if (v_field_name != NULL
&& field_name_match (v_field_name, name))
- t = ada_check_typedef (TYPE_FIELD_TYPE (field_type, j));
+ t = TYPE_FIELD_TYPE (field_type, j);
else
t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (field_type,
j),
struct value *discrim;
LONGEST discrim_val;
- outer = value_from_contents_and_address (outer_type, outer_valaddr, 0);
+ /* Using plain value_from_contents_and_address here causes problems
+ because we will end up trying to resolve a type that is currently
+ being constructed. */
+ outer = value_from_contents_and_address_unresolved (outer_type,
+ outer_valaddr, 0);
discrim = ada_value_struct_elt (outer, discrim_name, 1);
if (discrim == NULL)
return -1;
else
align_offset = len - 1;
- if (align_offset < 7 || strncmp ("___XV", name + align_offset - 6, 5) != 0)
+ if (align_offset < 7 || !startswith (name + align_offset - 6, "___XV"))
return TARGET_CHAR_BIT;
return atoi (name + align_offset) * TARGET_CHAR_BIT;
static struct type *
find_parallel_type_by_descriptive_type (struct type *type, const char *name)
{
- struct type *result;
+ struct type *result, *tmp;
+
+ if (ada_ignore_descriptive_types_p)
+ return NULL;
/* If there no descriptive-type info, then there is no parallel type
to be found. */
/* Otherwise, look at the next item on the list, if any. */
if (HAVE_GNAT_AUX_INFO (result))
- result = TYPE_DESCRIPTIVE_TYPE (result);
+ tmp = TYPE_DESCRIPTIVE_TYPE (result);
+ else
+ tmp = NULL;
+
+ /* If not found either, try after having resolved the typedef. */
+ if (tmp != NULL)
+ result = tmp;
else
- result = NULL;
+ {
+ result = check_typedef (result);
+ if (HAVE_GNAT_AUX_INFO (result))
+ result = TYPE_DESCRIPTIVE_TYPE (result);
+ else
+ result = NULL;
+ }
}
/* If we didn't find a match, see whether this is a packed array. With
ada_find_parallel_type (struct type *type, const char *suffix)
{
char *name;
- const char *typename = ada_type_name (type);
+ const char *type_name = ada_type_name (type);
int len;
- if (typename == NULL)
+ if (type_name == NULL)
return NULL;
- len = strlen (typename);
+ len = strlen (type_name);
name = (char *) alloca (len + strlen (suffix) + 1);
- strcpy (name, typename);
+ strcpy (name, type_name);
strcpy (name + len, suffix);
return ada_find_parallel_type_with_name (type, name);
/* A record type with no fields. */
static struct type *
-empty_record (struct type *template)
+empty_record (struct type *templ)
{
- struct type *type = alloc_type_copy (template);
+ struct type *type = alloc_type_copy (templ);
TYPE_CODE (type) = TYPE_CODE_STRUCT;
TYPE_NFIELDS (type) = 0;
initialized, the type size may be completely bogus and
GDB may fail to allocate a value for it. So check the
size first before creating the value. */
- check_size (rtype);
- dval = value_from_contents_and_address (rtype, valaddr, address);
+ ada_ensure_varsize_limit (rtype);
+ /* Using plain value_from_contents_and_address here
+ causes problems because we will end up trying to
+ resolve a type that is currently being
+ constructed. */
+ dval = value_from_contents_and_address_unresolved (rtype,
+ valaddr,
+ address);
+ rtype = value_type (dval);
}
else
dval = dval0;
large (due to an uninitialized variable in the inferior)
that it would cause an overflow when adding it to the
record size. */
- check_size (field_type);
+ ada_ensure_varsize_limit (field_type);
TYPE_FIELD_TYPE (rtype, f) = field_type;
TYPE_FIELD_NAME (rtype, f) = TYPE_FIELD_NAME (type, f);
off = TYPE_FIELD_BITPOS (rtype, variant_field);
if (dval0 == NULL)
- dval = value_from_contents_and_address (rtype, valaddr, address);
+ {
+ /* Using plain value_from_contents_and_address here causes
+ problems because we will end up trying to resolve a type
+ that is currently being constructed. */
+ dval = value_from_contents_and_address_unresolved (rtype, valaddr,
+ address);
+ rtype = value_type (dval);
+ }
else
dval = dval0;
int nfields;
int f;
+ /* No need no do anything if the input type is already fixed. */
+ if (TYPE_FIXED_INSTANCE (type0))
+ return type0;
+
+ /* Likewise if we already have computed the static approximation. */
if (TYPE_TARGET_TYPE (type0) != NULL)
return TYPE_TARGET_TYPE (type0);
- nfields = TYPE_NFIELDS (type0);
+ /* Don't clone TYPE0 until we are sure we are going to need a copy. */
type = type0;
+ nfields = TYPE_NFIELDS (type0);
+
+ /* Whether or not we cloned TYPE0, cache the result so that we don't do
+ recompute all over next time. */
+ TYPE_TARGET_TYPE (type0) = type;
for (f = 0; f < nfields; f += 1)
{
- struct type *field_type = ada_check_typedef (TYPE_FIELD_TYPE (type0, f));
+ struct type *field_type = TYPE_FIELD_TYPE (type0, f);
struct type *new_type;
if (is_dynamic_field (type0, f))
- new_type = to_static_fixed_type (TYPE_TARGET_TYPE (field_type));
+ {
+ field_type = ada_check_typedef (field_type);
+ new_type = to_static_fixed_type (TYPE_TARGET_TYPE (field_type));
+ }
else
new_type = static_unwrap_type (field_type);
- if (type == type0 && new_type != field_type)
- {
- TYPE_TARGET_TYPE (type0) = type = alloc_type_copy (type0);
- TYPE_CODE (type) = TYPE_CODE (type0);
- INIT_CPLUS_SPECIFIC (type);
- TYPE_NFIELDS (type) = nfields;
- TYPE_FIELDS (type) = (struct field *)
- TYPE_ALLOC (type, nfields * sizeof (struct field));
- memcpy (TYPE_FIELDS (type), TYPE_FIELDS (type0),
- sizeof (struct field) * nfields);
- TYPE_NAME (type) = ada_type_name (type0);
- TYPE_TAG_NAME (type) = NULL;
- TYPE_FIXED_INSTANCE (type) = 1;
- TYPE_LENGTH (type) = 0;
- }
- TYPE_FIELD_TYPE (type, f) = new_type;
- TYPE_FIELD_NAME (type, f) = TYPE_FIELD_NAME (type0, f);
+
+ if (new_type != field_type)
+ {
+ /* Clone TYPE0 only the first time we get a new field type. */
+ if (type == type0)
+ {
+ TYPE_TARGET_TYPE (type0) = type = alloc_type_copy (type0);
+ TYPE_CODE (type) = TYPE_CODE (type0);
+ INIT_CPLUS_SPECIFIC (type);
+ TYPE_NFIELDS (type) = nfields;
+ TYPE_FIELDS (type) = (struct field *)
+ TYPE_ALLOC (type, nfields * sizeof (struct field));
+ memcpy (TYPE_FIELDS (type), TYPE_FIELDS (type0),
+ sizeof (struct field) * nfields);
+ TYPE_NAME (type) = ada_type_name (type0);
+ TYPE_TAG_NAME (type) = NULL;
+ TYPE_FIXED_INSTANCE (type) = 1;
+ TYPE_LENGTH (type) = 0;
+ }
+ TYPE_FIELD_TYPE (type, f) = new_type;
+ TYPE_FIELD_NAME (type, f) = TYPE_FIELD_NAME (type0, f);
+ }
}
+
return type;
}
return type;
if (dval0 == NULL)
- dval = value_from_contents_and_address (type, valaddr, address);
+ {
+ dval = value_from_contents_and_address (type, valaddr, address);
+ type = value_type (dval);
+ }
else
dval = dval0;
return TYPE_FIELD_TYPE (var_type, which);
}
-/* Assuming that TYPE0 is an array type describing the type of a value
- at ADDR, and that DVAL describes a record containing any
- discriminants used in TYPE0, returns a type for the value that
- contains no dynamic components (that is, no components whose sizes
- are determined by run-time quantities). Unless IGNORE_TOO_BIG is
- true, gives an error message if the resulting type's size is over
- varsize_limit. */
+/* Assuming RANGE_TYPE is a TYPE_CODE_RANGE, return nonzero if
+ ENCODING_TYPE, a type following the GNAT conventions for discrete
+ type encodings, only carries redundant information. */
-static struct type *
-to_fixed_array_type (struct type *type0, struct value *dval,
- int ignore_too_big)
+static int
+ada_is_redundant_range_encoding (struct type *range_type,
+ struct type *encoding_type)
{
- struct type *index_type_desc;
- struct type *result;
- int constrained_packed_array_p;
-
- type0 = ada_check_typedef (type0);
- if (TYPE_FIXED_INSTANCE (type0))
- return type0;
+ struct type *fixed_range_type;
+ char *bounds_str;
+ int n;
+ LONGEST lo, hi;
- constrained_packed_array_p = ada_is_constrained_packed_array_type (type0);
- if (constrained_packed_array_p)
- type0 = decode_constrained_packed_array_type (type0);
+ gdb_assert (TYPE_CODE (range_type) == TYPE_CODE_RANGE);
- index_type_desc = ada_find_parallel_type (type0, "___XA");
- ada_fixup_array_indexes_type (index_type_desc);
- if (index_type_desc == NULL)
+ if (TYPE_CODE (get_base_type (range_type))
+ != TYPE_CODE (get_base_type (encoding_type)))
+ {
+ /* The compiler probably used a simple base type to describe
+ the range type instead of the range's actual base type,
+ expecting us to get the real base type from the encoding
+ anyway. In this situation, the encoding cannot be ignored
+ as redundant. */
+ return 0;
+ }
+
+ if (is_dynamic_type (range_type))
+ return 0;
+
+ if (TYPE_NAME (encoding_type) == NULL)
+ return 0;
+
+ bounds_str = strstr (TYPE_NAME (encoding_type), "___XDLU_");
+ if (bounds_str == NULL)
+ return 0;
+
+ n = 8; /* Skip "___XDLU_". */
+ if (!ada_scan_number (bounds_str, n, &lo, &n))
+ return 0;
+ if (TYPE_LOW_BOUND (range_type) != lo)
+ return 0;
+
+ n += 2; /* Skip the "__" separator between the two bounds. */
+ if (!ada_scan_number (bounds_str, n, &hi, &n))
+ return 0;
+ if (TYPE_HIGH_BOUND (range_type) != hi)
+ return 0;
+
+ return 1;
+}
+
+/* Given the array type ARRAY_TYPE, return nonzero if DESC_TYPE,
+ a type following the GNAT encoding for describing array type
+ indices, only carries redundant information. */
+
+static int
+ada_is_redundant_index_type_desc (struct type *array_type,
+ struct type *desc_type)
+{
+ struct type *this_layer = check_typedef (array_type);
+ int i;
+
+ for (i = 0; i < TYPE_NFIELDS (desc_type); i++)
+ {
+ if (!ada_is_redundant_range_encoding (TYPE_INDEX_TYPE (this_layer),
+ TYPE_FIELD_TYPE (desc_type, i)))
+ return 0;
+ this_layer = check_typedef (TYPE_TARGET_TYPE (this_layer));
+ }
+
+ return 1;
+}
+
+/* Assuming that TYPE0 is an array type describing the type of a value
+ at ADDR, and that DVAL describes a record containing any
+ discriminants used in TYPE0, returns a type for the value that
+ contains no dynamic components (that is, no components whose sizes
+ are determined by run-time quantities). Unless IGNORE_TOO_BIG is
+ true, gives an error message if the resulting type's size is over
+ varsize_limit. */
+
+static struct type *
+to_fixed_array_type (struct type *type0, struct value *dval,
+ int ignore_too_big)
+{
+ struct type *index_type_desc;
+ struct type *result;
+ int constrained_packed_array_p;
+ static const char *xa_suffix = "___XA";
+
+ type0 = ada_check_typedef (type0);
+ if (TYPE_FIXED_INSTANCE (type0))
+ return type0;
+
+ constrained_packed_array_p = ada_is_constrained_packed_array_type (type0);
+ if (constrained_packed_array_p)
+ type0 = decode_constrained_packed_array_type (type0);
+
+ index_type_desc = ada_find_parallel_type (type0, xa_suffix);
+
+ /* As mentioned in exp_dbug.ads, for non bit-packed arrays an
+ encoding suffixed with 'P' may still be generated. If so,
+ it should be used to find the XA type. */
+
+ if (index_type_desc == NULL)
+ {
+ const char *type_name = ada_type_name (type0);
+
+ if (type_name != NULL)
+ {
+ const int len = strlen (type_name);
+ char *name = (char *) alloca (len + strlen (xa_suffix));
+
+ if (type_name[len - 1] == 'P')
+ {
+ strcpy (name, type_name);
+ strcpy (name + len - 1, xa_suffix);
+ index_type_desc = ada_find_parallel_type_with_name (type0, name);
+ }
+ }
+ }
+
+ ada_fixup_array_indexes_type (index_type_desc);
+ if (index_type_desc != NULL
+ && ada_is_redundant_index_type_desc (type0, index_type_desc))
+ {
+ /* Ignore this ___XA parallel type, as it does not bring any
+ useful information. This allows us to avoid creating fixed
+ versions of the array's index types, which would be identical
+ to the original ones. This, in turn, can also help avoid
+ the creation of fixed versions of the array itself. */
+ index_type_desc = NULL;
+ }
+
+ if (index_type_desc == NULL)
{
struct type *elt_type0 = ada_check_typedef (TYPE_TARGET_TYPE (type0));
value_from_contents_and_address (fixed_record_type,
valaddr,
address);
+ fixed_record_type = value_type (obj);
if (real_type != NULL)
return to_fixed_record_type
(real_type, NULL,
&& is_thick_pntr (ada_typedef_target_type (type)))
return type;
- CHECK_TYPEDEF (type);
+ type = check_typedef (type);
if (type == NULL || TYPE_CODE (type) != TYPE_CODE_ENUM
|| !TYPE_STUB (type)
|| TYPE_TAG_NAME (type) == NULL)
{
struct value *val = coerce_ref (arg);
struct type *type = value_type (val);
+ LONGEST result;
if (!discrete_type_p (type))
error (_("'POS only defined on discrete types"));
- if (TYPE_CODE (type) == TYPE_CODE_ENUM)
- {
- int i;
- LONGEST v = value_as_long (val);
+ if (!discrete_position (type, value_as_long (val), &result))
+ error (_("enumeration value is invalid: can't find 'POS"));
- for (i = 0; i < TYPE_NFIELDS (type); i += 1)
- {
- if (v == TYPE_FIELD_ENUMVAL (type, i))
- return i;
- }
- error (_("enumeration value is invalid: can't find 'POS"));
- }
- else
- return value_as_long (val);
+ return result;
}
static struct value *
enum exp_opcode op;
int tem;
int pc;
+ int preeval_pos;
struct value *arg1 = NULL, *arg2 = NULL, *arg3;
struct type *type;
int nargs, oplen;
return (value_from_longest
(value_type (arg1),
value_as_long (arg1) + value_as_long (arg2)));
+ if (TYPE_CODE (value_type (arg2)) == TYPE_CODE_PTR)
+ return (value_from_longest
+ (value_type (arg2),
+ value_as_long (arg1) + value_as_long (arg2)));
if ((ada_is_fixed_point_type (value_type (arg1))
|| ada_is_fixed_point_type (value_type (arg2)))
&& value_type (arg1) != value_type (arg2))
return (value_from_longest
(value_type (arg1),
value_as_long (arg1) - value_as_long (arg2)));
+ if (TYPE_CODE (value_type (arg2)) == TYPE_CODE_PTR)
+ return (value_from_longest
+ (value_type (arg2),
+ value_as_long (arg1) - value_as_long (arg2)));
if ((ada_is_fixed_point_type (value_type (arg1))
|| ada_is_fixed_point_type (value_type (arg2)))
&& value_type (arg1) != value_type (arg2))
*pos += 4;
goto nosideret;
}
- else if (SYMBOL_DOMAIN (exp->elts[pc + 2].symbol) == UNDEF_DOMAIN)
+
+ if (SYMBOL_DOMAIN (exp->elts[pc + 2].symbol) == UNDEF_DOMAIN)
/* Only encountered when an unresolved symbol occurs in a
context other than a function call, in which case, it is
invalid. */
error (_("Unexpected unresolved symbol, %s, during evaluation"),
SYMBOL_PRINT_NAME (exp->elts[pc + 2].symbol));
- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
+
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
{
type = static_unwrap_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
/* Check to see if this is a tagged type. We also need to handle
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 (type, 0)
- || (TYPE_CODE(type) == TYPE_CODE_REF
+ || (TYPE_CODE (type) == TYPE_CODE_REF
&& ada_is_tagged_type (TYPE_TARGET_TYPE (type), 0)))
- {
- /* Tagged types are a little special in the fact that the real
- type is dynamic and can only be determined by inspecting the
- object's tag. This means that we need to get the object's
- value first (EVAL_NORMAL) and then extract the actual object
- type from its tag.
-
- Note that we cannot skip the final step where we extract
- the object type from its tag, because the EVAL_NORMAL phase
- results in dynamic components being resolved into fixed ones.
- This can cause problems when trying to print the type
- description of tagged types whose parent has a dynamic size:
- We use the type name of the "_parent" component in order
- to print the name of the ancestor type in the type description.
- If that component had a dynamic size, the resolution into
- a fixed type would result in the loss of that type name,
- thus preventing us from printing the name of the ancestor
- type in the type description. */
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_NORMAL);
-
- if (TYPE_CODE (type) != TYPE_CODE_REF)
- {
- struct type *actual_type;
-
- actual_type = type_from_tag (ada_value_tag (arg1));
- if (actual_type == NULL)
- /* If, for some reason, we were unable to determine
- the actual type from the tag, then use the static
- approximation that we just computed as a fallback.
- This can happen if the debugging information is
- incomplete, for instance. */
- actual_type = type;
- return value_zero (actual_type, not_lval);
- }
- else
- {
- /* In the case of a ref, ada_coerce_ref takes care
- of determining the actual type. But the evaluation
- should return a ref as it should be valid to ask
- for its address; so rebuild a ref after coerce. */
- arg1 = ada_coerce_ref (arg1);
- return value_ref (arg1);
- }
- }
+ {
+ /* Tagged types are a little special in the fact that the real
+ type is dynamic and can only be determined by inspecting the
+ object's tag. This means that we need to get the object's
+ value first (EVAL_NORMAL) and then extract the actual object
+ type from its tag.
+
+ Note that we cannot skip the final step where we extract
+ the object type from its tag, because the EVAL_NORMAL phase
+ results in dynamic components being resolved into fixed ones.
+ This can cause problems when trying to print the type
+ description of tagged types whose parent has a dynamic size:
+ We use the type name of the "_parent" component in order
+ to print the name of the ancestor type in the type description.
+ If that component had a dynamic size, the resolution into
+ a fixed type would result in the loss of that type name,
+ thus preventing us from printing the name of the ancestor
+ type in the type description. */
+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_NORMAL);
+
+ if (TYPE_CODE (type) != TYPE_CODE_REF)
+ {
+ struct type *actual_type;
+
+ actual_type = type_from_tag (ada_value_tag (arg1));
+ if (actual_type == NULL)
+ /* If, for some reason, we were unable to determine
+ the actual type from the tag, then use the static
+ approximation that we just computed as a fallback.
+ This can happen if the debugging information is
+ incomplete, for instance. */
+ actual_type = type;
+ return value_zero (actual_type, not_lval);
+ }
+ else
+ {
+ /* In the case of a ref, ada_coerce_ref takes care
+ of determining the actual type. But the evaluation
+ should return a ref as it should be valid to ask
+ for its address; so rebuild a ref after coerce. */
+ arg1 = ada_coerce_ref (arg1);
+ return value_ref (arg1);
+ }
+ }
- *pos += 4;
- return value_zero
- (to_static_fixed_type
- (static_unwrap_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol))),
- not_lval);
- }
- else
- {
- arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
- return ada_to_fixed_value (arg1);
+ /* Records and unions for which GNAT encodings have been
+ generated need to be statically fixed as well.
+ Otherwise, non-static fixing produces a type where
+ all dynamic properties are removed, which prevents "ptype"
+ from being able to completely describe the type.
+ For instance, a case statement in a variant record would be
+ replaced by the relevant components based on the actual
+ value of the discriminants. */
+ if ((TYPE_CODE (type) == TYPE_CODE_STRUCT
+ && dynamic_template_type (type) != NULL)
+ || (TYPE_CODE (type) == TYPE_CODE_UNION
+ && ada_find_parallel_type (type, "___XVU") != NULL))
+ {
+ *pos += 4;
+ return value_zero (to_static_fixed_type (type), not_lval);
+ }
}
+ arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
+ return ada_to_fixed_value (arg1);
+
case OP_FUNCALL:
(*pos) += 2;
(ada_coerce_to_simple_array (argvec[0]),
nargs, argvec + 1));
case TYPE_CODE_PTR: /* Pointer to array */
- type = to_fixed_array_type (TYPE_TARGET_TYPE (type), NULL, 1);
if (noside == EVAL_AVOID_SIDE_EFFECTS)
{
+ type = to_fixed_array_type (TYPE_TARGET_TYPE (type), NULL, 1);
type = ada_array_element_type (type, nargs);
if (type == NULL)
error (_("element type of array unknown"));
return value_zero (ada_aligned_type (type), lval_memory);
}
return
- unwrap_value (ada_value_ptr_subscript (argvec[0], type,
- nargs, argvec + 1));
+ unwrap_value (ada_value_ptr_subscript (argvec[0],
+ nargs, argvec + 1));
default:
error (_("Attempt to index or call something other than an "
low_bound_val = coerce_ref (low_bound_val);
high_bound_val = coerce_ref (high_bound_val);
- low_bound = pos_atr (low_bound_val);
- high_bound = pos_atr (high_bound_val);
+ low_bound = value_as_long (low_bound_val);
+ high_bound = value_as_long (high_bound_val);
if (noside == EVAL_SKIP)
goto nosideret;
if (ada_is_constrained_packed_array_type (value_type (arg1)))
arg1 = ada_coerce_to_simple_array (arg1);
- type = ada_index_type (value_type (arg1), tem,
- ada_attribute_name (op));
- if (type == NULL)
+ if (op == OP_ATR_LENGTH)
type = builtin_type (exp->gdbarch)->builtin_int;
+ else
+ {
+ type = ada_index_type (value_type (arg1), tem,
+ ada_attribute_name (op));
+ if (type == NULL)
+ type = builtin_type (exp->gdbarch)->builtin_int;
+ }
if (noside == EVAL_AVOID_SIDE_EFFECTS)
return allocate_value (type);
if (ada_is_constrained_packed_array_type (type_arg))
type_arg = decode_constrained_packed_array_type (type_arg);
- type = ada_index_type (type_arg, tem, ada_attribute_name (op));
- if (type == NULL)
+ if (op == OP_ATR_LENGTH)
type = builtin_type (exp->gdbarch)->builtin_int;
+ else
+ {
+ type = ada_index_type (type_arg, tem, ada_attribute_name (op));
+ if (type == NULL)
+ type = builtin_type (exp->gdbarch)->builtin_int;
+ }
if (noside == EVAL_AVOID_SIDE_EFFECTS)
return allocate_value (type);
return arg1;
case UNOP_IND:
+ preeval_pos = *pos;
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
/* In C you can dereference an array to get the 1st elt. */
|| TYPE_CODE (type) == TYPE_CODE_ARRAY)
{
- type = to_static_fixed_type
- (ada_aligned_type
- (ada_check_typedef (TYPE_TARGET_TYPE (type))));
- check_size (type);
+ /* As mentioned in the OP_VAR_VALUE case, tagged types can
+ only be determined by inspecting the object's tag.
+ This means that we need to evaluate completely the
+ expression in order to get its type. */
+
+ if ((TYPE_CODE (type) == TYPE_CODE_REF
+ || TYPE_CODE (type) == TYPE_CODE_PTR)
+ && ada_is_tagged_type (TYPE_TARGET_TYPE (type), 0))
+ {
+ arg1 = evaluate_subexp (NULL_TYPE, exp, &preeval_pos,
+ EVAL_NORMAL);
+ type = value_type (ada_value_ind (arg1));
+ }
+ else
+ {
+ type = to_static_fixed_type
+ (ada_aligned_type
+ (ada_check_typedef (TYPE_TARGET_TYPE (type))));
+ }
+ ada_ensure_varsize_limit (type);
return value_zero (type, lval_memory);
}
else if (TYPE_CODE (type) == TYPE_CODE_INT)
case STRUCTOP_STRUCT:
tem = longest_to_int (exp->elts[pc + 1].longconst);
(*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
+ preeval_pos = *pos;
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
type = ada_lookup_struct_elt_type (type1,
&exp->elts[pc + 2].string,
1, 1, NULL);
+
+ /* If the field is not found, check if it exists in the
+ extension of this object's type. This means that we
+ need to evaluate completely the expression. */
+
if (type == NULL)
- /* In this case, we assume that the field COULD exist
- in some extension of the type. Return an object of
- "type" void, which will match any formal
- (see ada_type_match). */
- return value_zero (builtin_type (exp->gdbarch)->builtin_void,
- lval_memory);
+ {
+ arg1 = evaluate_subexp (NULL_TYPE, exp, &preeval_pos,
+ EVAL_NORMAL);
+ arg1 = ada_value_struct_elt (arg1,
+ &exp->elts[pc + 2].string,
+ 0);
+ arg1 = unwrap_value (arg1);
+ type = value_type (ada_to_fixed_value (arg1));
+ }
}
else
type =
if (L < INT_MIN || U > INT_MAX)
return raw_type;
else
- return create_range_type (alloc_type_copy (raw_type), raw_type,
- ada_discrete_type_low_bound (raw_type),
- ada_discrete_type_high_bound (raw_type));
+ return create_static_range_type (alloc_type_copy (raw_type), raw_type,
+ L, U);
}
else
{
}
}
- type = create_range_type (alloc_type_copy (raw_type), base_type, L, U);
+ type = create_static_range_type (alloc_type_copy (raw_type),
+ base_type, L, U);
TYPE_NAME (type) = name;
return type;
}
variants of the runtime, we use a sniffer that will determine
the runtime variant used by the program being debugged. */
-/* The different types of catchpoints that we introduced for catching
- Ada exceptions. */
-
-enum exception_catchpoint_kind
-{
- ex_catch_exception,
- ex_catch_exception_unhandled,
- ex_catch_assert
-};
+/* Ada's standard exceptions.
-/* Ada's standard exceptions. */
+ The Ada 83 standard also defined Numeric_Error. But there so many
+ situations where it was unclear from the Ada 83 Reference Manual
+ (RM) whether Constraint_Error or Numeric_Error should be raised,
+ that the ARG (Ada Rapporteur Group) eventually issued a Binding
+ Interpretation saying that anytime the RM says that Numeric_Error
+ should be raised, the implementation may raise Constraint_Error.
+ Ada 95 went one step further and pretty much removed Numeric_Error
+ from the list of standard exceptions (it made it a renaming of
+ Constraint_Error, to help preserve compatibility when compiling
+ an Ada83 compiler). As such, we do not include Numeric_Error from
+ this list of standard exceptions. */
static char *standard_exc[] = {
"constraint_error",
the name of the exception being raised (this name is printed in
the catchpoint message, and is also used when trying to catch
a specific exception). We do not handle this case for now. */
- struct minimal_symbol *msym
+ struct bound_minimal_symbol msym
= lookup_minimal_symbol (einfo->catch_exception_sym, NULL, NULL);
- if (msym && MSYMBOL_TYPE (msym) != mst_solib_trampoline)
+ if (msym.minsym && MSYMBOL_TYPE (msym.minsym) != mst_solib_trampoline)
error (_("Your Ada runtime appears to be missing some debugging "
"information.\nCannot insert Ada exception catchpoint "
"in this configuration."));
re_comp (known_runtime_file_name_patterns[i]);
if (re_exec (lbasename (sal.symtab->filename)))
return 1;
- if (sal.symtab->objfile != NULL
- && re_exec (objfile_name (sal.symtab->objfile)))
+ if (SYMTAB_OBJFILE (sal.symtab) != NULL
+ && re_exec (objfile_name (SYMTAB_OBJFILE (sal.symtab))))
return 1;
}
Return zero if the address could not be computed, or if not relevant. */
static CORE_ADDR
-ada_exception_name_addr_1 (enum exception_catchpoint_kind ex,
+ada_exception_name_addr_1 (enum ada_exception_catchpoint_kind ex,
struct breakpoint *b)
{
struct ada_inferior_data *data = get_ada_inferior_data (current_inferior ());
switch (ex)
{
- case ex_catch_exception:
+ case ada_catch_exception:
return (parse_and_eval_address ("e.full_name"));
break;
- case ex_catch_exception_unhandled:
+ case ada_catch_exception_unhandled:
return data->exception_info->unhandled_exception_name_addr ();
break;
- case ex_catch_assert:
+ case ada_catch_assert:
return 0; /* Exception name is not relevant in this case. */
break;
and zero is returned. */
static CORE_ADDR
-ada_exception_name_addr (enum exception_catchpoint_kind ex,
+ada_exception_name_addr (enum ada_exception_catchpoint_kind ex,
struct breakpoint *b)
{
- volatile struct gdb_exception e;
CORE_ADDR result = 0;
- TRY_CATCH (e, RETURN_MASK_ERROR)
+ TRY
{
result = ada_exception_name_addr_1 (ex, b);
}
- if (e.reason < 0)
+ CATCH (e, RETURN_MASK_ERROR)
{
warning (_("failed to get exception name: %s"), e.message);
return 0;
}
+ END_CATCH
return result;
}
if (!bl->shlib_disabled)
{
- volatile struct gdb_exception e;
const char *s;
s = cond_string;
- TRY_CATCH (e, RETURN_MASK_ERROR)
+ TRY
{
exp = parse_exp_1 (&s, bl->address,
block_for_pc (bl->address), 0);
}
- if (e.reason < 0)
- warning (_("failed to reevaluate internal exception condition "
- "for catchpoint %d: %s"),
- c->base.number, e.message);
+ CATCH (e, RETURN_MASK_ERROR)
+ {
+ warning (_("failed to reevaluate internal exception condition "
+ "for catchpoint %d: %s"),
+ c->base.number, e.message);
+ /* There is a bug in GCC on sparc-solaris when building with
+ optimization which causes EXP to change unexpectedly
+ (http://gcc.gnu.org/bugzilla/show_bug.cgi?id=56982).
+ The problem should be fixed starting with GCC 4.9.
+ In the meantime, work around it by forcing EXP back
+ to NULL. */
+ exp = NULL;
+ }
+ END_CATCH
}
ada_loc->excep_cond_expr = exp;
exception catchpoint kinds. */
static void
-dtor_exception (enum exception_catchpoint_kind ex, struct breakpoint *b)
+dtor_exception (enum ada_exception_catchpoint_kind ex, struct breakpoint *b)
{
struct ada_catchpoint *c = (struct ada_catchpoint *) b;
structure for all exception catchpoint kinds. */
static struct bp_location *
-allocate_location_exception (enum exception_catchpoint_kind ex,
+allocate_location_exception (enum ada_exception_catchpoint_kind ex,
struct breakpoint *self)
{
struct ada_catchpoint_location *loc;
exception catchpoint kinds. */
static void
-re_set_exception (enum exception_catchpoint_kind ex, struct breakpoint *b)
+re_set_exception (enum ada_exception_catchpoint_kind ex, struct breakpoint *b)
{
struct ada_catchpoint *c = (struct ada_catchpoint *) b;
struct ada_catchpoint *c = (struct ada_catchpoint *) bl->owner;
const struct ada_catchpoint_location *ada_loc
= (const struct ada_catchpoint_location *) bl;
- volatile struct gdb_exception ex;
int stop;
/* With no specific exception, should always stop. */
}
stop = 1;
- TRY_CATCH (ex, RETURN_MASK_ALL)
+ TRY
{
struct value *mark;
stop = value_true (evaluate_expression (ada_loc->excep_cond_expr));
value_free_to_mark (mark);
}
- if (ex.reason < 0)
- exception_fprintf (gdb_stderr, ex,
- _("Error in testing exception condition:\n"));
+ CATCH (ex, RETURN_MASK_ALL)
+ {
+ exception_fprintf (gdb_stderr, ex,
+ _("Error in testing exception condition:\n"));
+ }
+ END_CATCH
+
return stop;
}
for all exception catchpoint kinds. */
static void
-check_status_exception (enum exception_catchpoint_kind ex, bpstat bs)
+check_status_exception (enum ada_exception_catchpoint_kind ex, bpstat bs)
{
bs->stop = should_stop_exception (bs->bp_location_at);
}
for all exception catchpoint kinds. */
static enum print_stop_action
-print_it_exception (enum exception_catchpoint_kind ex, bpstat bs)
+print_it_exception (enum ada_exception_catchpoint_kind ex, bpstat bs)
{
struct ui_out *uiout = current_uiout;
struct breakpoint *b = bs->breakpoint_at;
switch (ex)
{
- case ex_catch_exception:
- case ex_catch_exception_unhandled:
+ case ada_catch_exception:
+ case ada_catch_exception_unhandled:
{
const CORE_ADDR addr = ada_exception_name_addr (ex, b);
char exception_name[256];
it clearer to the user which kind of catchpoint just got
hit. We used ui_out_text to make sure that this extra
info does not pollute the exception name in the MI case. */
- if (ex == ex_catch_exception_unhandled)
+ if (ex == ada_catch_exception_unhandled)
ui_out_text (uiout, "unhandled ");
ui_out_field_string (uiout, "exception-name", exception_name);
}
break;
- case ex_catch_assert:
+ case ada_catch_assert:
/* In this case, the name of the exception is not really
important. Just print "failed assertion" to make it clearer
that his program just hit an assertion-failure catchpoint.
for all exception catchpoint kinds. */
static void
-print_one_exception (enum exception_catchpoint_kind ex,
+print_one_exception (enum ada_exception_catchpoint_kind ex,
struct breakpoint *b, struct bp_location **last_loc)
{
struct ui_out *uiout = current_uiout;
*last_loc = b->loc;
switch (ex)
{
- case ex_catch_exception:
+ case ada_catch_exception:
if (c->excep_string != NULL)
{
char *msg = xstrprintf (_("`%s' Ada exception"), c->excep_string);
break;
- case ex_catch_exception_unhandled:
+ case ada_catch_exception_unhandled:
ui_out_field_string (uiout, "what", "unhandled Ada exceptions");
break;
- case ex_catch_assert:
+ case ada_catch_assert:
ui_out_field_string (uiout, "what", "failed Ada assertions");
break;
for all exception catchpoint kinds. */
static void
-print_mention_exception (enum exception_catchpoint_kind ex,
+print_mention_exception (enum ada_exception_catchpoint_kind ex,
struct breakpoint *b)
{
struct ada_catchpoint *c = (struct ada_catchpoint *) b;
switch (ex)
{
- case ex_catch_exception:
+ case ada_catch_exception:
if (c->excep_string != NULL)
{
char *info = xstrprintf (_("`%s' Ada exception"), c->excep_string);
ui_out_text (uiout, _("all Ada exceptions"));
break;
- case ex_catch_exception_unhandled:
+ case ada_catch_exception_unhandled:
ui_out_text (uiout, _("unhandled Ada exceptions"));
break;
- case ex_catch_assert:
+ case ada_catch_assert:
ui_out_text (uiout, _("failed Ada assertions"));
break;
for all exception catchpoint kinds. */
static void
-print_recreate_exception (enum exception_catchpoint_kind ex,
+print_recreate_exception (enum ada_exception_catchpoint_kind ex,
struct breakpoint *b, struct ui_file *fp)
{
struct ada_catchpoint *c = (struct ada_catchpoint *) b;
switch (ex)
{
- case ex_catch_exception:
+ case ada_catch_exception:
fprintf_filtered (fp, "catch exception");
if (c->excep_string != NULL)
fprintf_filtered (fp, " %s", c->excep_string);
break;
- case ex_catch_exception_unhandled:
+ case ada_catch_exception_unhandled:
fprintf_filtered (fp, "catch exception unhandled");
break;
- case ex_catch_assert:
+ case ada_catch_assert:
fprintf_filtered (fp, "catch assert");
break;
static void
dtor_catch_exception (struct breakpoint *b)
{
- dtor_exception (ex_catch_exception, b);
+ dtor_exception (ada_catch_exception, b);
}
static struct bp_location *
allocate_location_catch_exception (struct breakpoint *self)
{
- return allocate_location_exception (ex_catch_exception, self);
+ return allocate_location_exception (ada_catch_exception, self);
}
static void
re_set_catch_exception (struct breakpoint *b)
{
- re_set_exception (ex_catch_exception, b);
+ re_set_exception (ada_catch_exception, b);
}
static void
check_status_catch_exception (bpstat bs)
{
- check_status_exception (ex_catch_exception, bs);
+ check_status_exception (ada_catch_exception, bs);
}
static enum print_stop_action
print_it_catch_exception (bpstat bs)
{
- return print_it_exception (ex_catch_exception, bs);
+ return print_it_exception (ada_catch_exception, bs);
}
static void
print_one_catch_exception (struct breakpoint *b, struct bp_location **last_loc)
{
- print_one_exception (ex_catch_exception, b, last_loc);
+ print_one_exception (ada_catch_exception, b, last_loc);
}
static void
print_mention_catch_exception (struct breakpoint *b)
{
- print_mention_exception (ex_catch_exception, b);
+ print_mention_exception (ada_catch_exception, b);
}
static void
print_recreate_catch_exception (struct breakpoint *b, struct ui_file *fp)
{
- print_recreate_exception (ex_catch_exception, b, fp);
+ print_recreate_exception (ada_catch_exception, b, fp);
}
static struct breakpoint_ops catch_exception_breakpoint_ops;
static void
dtor_catch_exception_unhandled (struct breakpoint *b)
{
- dtor_exception (ex_catch_exception_unhandled, b);
+ dtor_exception (ada_catch_exception_unhandled, b);
}
static struct bp_location *
allocate_location_catch_exception_unhandled (struct breakpoint *self)
{
- return allocate_location_exception (ex_catch_exception_unhandled, self);
+ return allocate_location_exception (ada_catch_exception_unhandled, self);
}
static void
re_set_catch_exception_unhandled (struct breakpoint *b)
{
- re_set_exception (ex_catch_exception_unhandled, b);
+ re_set_exception (ada_catch_exception_unhandled, b);
}
static void
check_status_catch_exception_unhandled (bpstat bs)
{
- check_status_exception (ex_catch_exception_unhandled, bs);
+ check_status_exception (ada_catch_exception_unhandled, bs);
}
static enum print_stop_action
print_it_catch_exception_unhandled (bpstat bs)
{
- return print_it_exception (ex_catch_exception_unhandled, bs);
+ return print_it_exception (ada_catch_exception_unhandled, bs);
}
static void
print_one_catch_exception_unhandled (struct breakpoint *b,
struct bp_location **last_loc)
{
- print_one_exception (ex_catch_exception_unhandled, b, last_loc);
+ print_one_exception (ada_catch_exception_unhandled, b, last_loc);
}
static void
print_mention_catch_exception_unhandled (struct breakpoint *b)
{
- print_mention_exception (ex_catch_exception_unhandled, b);
+ print_mention_exception (ada_catch_exception_unhandled, b);
}
static void
print_recreate_catch_exception_unhandled (struct breakpoint *b,
struct ui_file *fp)
{
- print_recreate_exception (ex_catch_exception_unhandled, b, fp);
+ print_recreate_exception (ada_catch_exception_unhandled, b, fp);
}
static struct breakpoint_ops catch_exception_unhandled_breakpoint_ops;
static void
dtor_catch_assert (struct breakpoint *b)
{
- dtor_exception (ex_catch_assert, b);
+ dtor_exception (ada_catch_assert, b);
}
static struct bp_location *
allocate_location_catch_assert (struct breakpoint *self)
{
- return allocate_location_exception (ex_catch_assert, self);
+ return allocate_location_exception (ada_catch_assert, self);
}
static void
re_set_catch_assert (struct breakpoint *b)
{
- re_set_exception (ex_catch_assert, b);
+ re_set_exception (ada_catch_assert, b);
}
static void
check_status_catch_assert (bpstat bs)
{
- check_status_exception (ex_catch_assert, bs);
+ check_status_exception (ada_catch_assert, bs);
}
static enum print_stop_action
print_it_catch_assert (bpstat bs)
{
- return print_it_exception (ex_catch_assert, bs);
+ return print_it_exception (ada_catch_assert, bs);
}
static void
print_one_catch_assert (struct breakpoint *b, struct bp_location **last_loc)
{
- print_one_exception (ex_catch_assert, b, last_loc);
+ print_one_exception (ada_catch_assert, b, last_loc);
}
static void
print_mention_catch_assert (struct breakpoint *b)
{
- print_mention_exception (ex_catch_assert, b);
+ print_mention_exception (ada_catch_assert, b);
}
static void
print_recreate_catch_assert (struct breakpoint *b, struct ui_file *fp)
{
- print_recreate_exception (ex_catch_assert, b, fp);
+ print_recreate_exception (ada_catch_assert, b, fp);
}
static struct breakpoint_ops catch_assert_breakpoint_ops;
static void
catch_ada_exception_command_split (char *args,
- enum exception_catchpoint_kind *ex,
+ enum ada_exception_catchpoint_kind *ex,
char **excep_string,
char **cond_string)
{
/* Check to see if we have a condition. */
args = skip_spaces (args);
- if (strncmp (args, "if", 2) == 0
+ if (startswith (args, "if")
&& (isspace (args[2]) || args[2] == '\0'))
{
args += 2;
if (exception_name == NULL)
{
/* Catch all exceptions. */
- *ex = ex_catch_exception;
+ *ex = ada_catch_exception;
*excep_string = NULL;
}
else if (strcmp (exception_name, "unhandled") == 0)
{
/* Catch unhandled exceptions. */
- *ex = ex_catch_exception_unhandled;
+ *ex = ada_catch_exception_unhandled;
*excep_string = NULL;
}
else
{
/* Catch a specific exception. */
- *ex = ex_catch_exception;
+ *ex = ada_catch_exception;
*excep_string = exception_name;
}
*cond_string = cond;
implement a catchpoint of the EX kind. */
static const char *
-ada_exception_sym_name (enum exception_catchpoint_kind ex)
+ada_exception_sym_name (enum ada_exception_catchpoint_kind ex)
{
struct ada_inferior_data *data = get_ada_inferior_data (current_inferior ());
switch (ex)
{
- case ex_catch_exception:
+ case ada_catch_exception:
return (data->exception_info->catch_exception_sym);
break;
- case ex_catch_exception_unhandled:
+ case ada_catch_exception_unhandled:
return (data->exception_info->catch_exception_unhandled_sym);
break;
- case ex_catch_assert:
+ case ada_catch_assert:
return (data->exception_info->catch_assert_sym);
break;
default:
of the EX kind. */
static const struct breakpoint_ops *
-ada_exception_breakpoint_ops (enum exception_catchpoint_kind ex)
+ada_exception_breakpoint_ops (enum ada_exception_catchpoint_kind ex)
{
switch (ex)
{
- case ex_catch_exception:
+ case ada_catch_exception:
return (&catch_exception_breakpoint_ops);
break;
- case ex_catch_exception_unhandled:
+ case ada_catch_exception_unhandled:
return (&catch_exception_unhandled_breakpoint_ops);
break;
- case ex_catch_assert:
+ case ada_catch_assert:
return (&catch_assert_breakpoint_ops);
break;
default:
type of catchpoint we need to create. */
static struct symtab_and_line
-ada_exception_sal (enum exception_catchpoint_kind ex, char *excep_string,
+ada_exception_sal (enum ada_exception_catchpoint_kind ex, char *excep_string,
char **addr_string, const struct breakpoint_ops **ops)
{
const char *sym_name;
return find_function_start_sal (sym, 1);
}
-/* Parse the arguments (ARGS) of the "catch exception" command.
-
- If the user asked the catchpoint to catch only a specific
- exception, then save the exception name in ADDR_STRING.
+/* Create an Ada exception catchpoint.
- 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.
+ EX_KIND is the kind of exception catchpoint to be created.
- See ada_exception_sal for a description of all the remaining
- function arguments of this function. */
+ If EXCEPT_STRING is NULL, this catchpoint is expected to trigger
+ for all exceptions. Otherwise, EXCEPT_STRING indicates the name
+ of the exception to which this catchpoint applies. When not NULL,
+ the string must be allocated on the heap, and its deallocation
+ is no longer the responsibility of the caller.
-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;
+ COND_STRING, if not NULL, is the catchpoint condition. This string
+ must be allocated on the heap, and its deallocation is no longer
+ the responsibility of the caller.
- catch_ada_exception_command_split (args, &ex, excep_string, cond_string);
- return ada_exception_sal (ex, *excep_string, addr_string, ops);
-}
+ TEMPFLAG, if nonzero, means that the underlying breakpoint
+ should be temporary.
-/* Create an Ada exception catchpoint. */
+ FROM_TTY is the usual argument passed to all commands implementations. */
-static void
+void
create_ada_exception_catchpoint (struct gdbarch *gdbarch,
- struct symtab_and_line sal,
- char *addr_string,
+ enum ada_exception_catchpoint_kind ex_kind,
char *excep_string,
char *cond_string,
- const struct breakpoint_ops *ops,
int tempflag,
+ int disabled,
int from_tty)
{
struct ada_catchpoint *c;
+ 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 = XNEW (struct ada_catchpoint);
init_ada_exception_breakpoint (&c->base, gdbarch, sal, addr_string,
- ops, tempflag, from_tty);
+ ops, tempflag, disabled, from_tty);
c->excep_string = excep_string;
create_excep_cond_exprs (c);
if (cond_string != NULL)
{
struct gdbarch *gdbarch = get_current_arch ();
int tempflag;
- struct symtab_and_line sal;
- char *addr_string = NULL;
+ enum ada_exception_catchpoint_kind ex_kind;
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,
- &cond_string, &ops);
- create_ada_exception_catchpoint (gdbarch, sal, addr_string,
- excep_string, cond_string, ops,
- tempflag, from_tty);
+ catch_ada_exception_command_split (arg, &ex_kind, &excep_string,
+ &cond_string);
+ create_ada_exception_catchpoint (gdbarch, ex_kind,
+ excep_string, cond_string,
+ tempflag, 1 /* enabled */,
+ 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.
+/* Split the arguments specified in a "catch assert" command.
- Set ADDR_STRING to the name of the function where the real
- breakpoint that implements the catchpoint is set.
+ ARGS contains the command's arguments (or the empty string if
+ no arguments were passed).
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. */
+ (the memory needs to be deallocated after use). */
-static struct symtab_and_line
-ada_decode_assert_location (char *args, char **addr_string,
- char **cond_string,
- const struct breakpoint_ops **ops)
+static void
+catch_ada_assert_command_split (char *args, char **cond_string)
{
args = skip_spaces (args);
/* Check whether a condition was provided. */
- if (strncmp (args, "if", 2) == 0
+ if (startswith (args, "if")
&& (isspace (args[2]) || args[2] == '\0'))
{
args += 2;
the command. */
else if (args[0] != '\0')
error (_("Junk at end of arguments."));
-
- return ada_exception_sal (ex_catch_assert, NULL, addr_string, ops);
}
/* Implement the "catch assert" command. */
{
struct gdbarch *gdbarch = get_current_arch ();
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, &cond_string, &ops);
- create_ada_exception_catchpoint (gdbarch, sal, addr_string,
- NULL, cond_string, ops, tempflag,
+ catch_ada_assert_command_split (arg, &cond_string);
+ create_ada_exception_catchpoint (gdbarch, ada_catch_assert,
+ NULL, cond_string,
+ tempflag, 1 /* enabled */,
from_tty);
}
+
+/* Return non-zero if the symbol SYM is an Ada exception object. */
+
+static int
+ada_is_exception_sym (struct symbol *sym)
+{
+ const char *type_name = type_name_no_tag (SYMBOL_TYPE (sym));
+
+ return (SYMBOL_CLASS (sym) != LOC_TYPEDEF
+ && SYMBOL_CLASS (sym) != LOC_BLOCK
+ && SYMBOL_CLASS (sym) != LOC_CONST
+ && SYMBOL_CLASS (sym) != LOC_UNRESOLVED
+ && type_name != NULL && strcmp (type_name, "exception") == 0);
+}
+
+/* Given a global symbol SYM, return non-zero iff SYM is a non-standard
+ Ada exception object. This matches all exceptions except the ones
+ defined by the Ada language. */
+
+static int
+ada_is_non_standard_exception_sym (struct symbol *sym)
+{
+ int i;
+
+ if (!ada_is_exception_sym (sym))
+ return 0;
+
+ for (i = 0; i < ARRAY_SIZE (standard_exc); i++)
+ if (strcmp (SYMBOL_LINKAGE_NAME (sym), standard_exc[i]) == 0)
+ return 0; /* A standard exception. */
+
+ /* Numeric_Error is also a standard exception, so exclude it.
+ See the STANDARD_EXC description for more details as to why
+ this exception is not listed in that array. */
+ if (strcmp (SYMBOL_LINKAGE_NAME (sym), "numeric_error") == 0)
+ return 0;
+
+ return 1;
+}
+
+/* A helper function for qsort, 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)
+{
+ 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;
+
+ return 0;
+}
+
+/* Sort EXCEPTIONS using compare_ada_exception_info as the comparison
+ routine, but keeping the first SKIP elements untouched.
+
+ All duplicates are also removed. */
+
+static void
+sort_remove_dups_ada_exceptions_list (VEC(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);
+}
+
+/* A function intended as the "name_matcher" callback in the struct
+ quick_symbol_functions' expand_symtabs_matching method.
+
+ SEARCH_NAME is the symbol's search name.
+
+ If USER_DATA is not NULL, it is a pointer to a regext_t object
+ used to match the symbol (by natural name). Otherwise, when USER_DATA
+ is null, no filtering is performed, and all symbols are a positive
+ match. */
+
+static int
+ada_exc_search_name_matches (const char *search_name, void *user_data)
+{
+ regex_t *preg = user_data;
+
+ if (preg == NULL)
+ return 1;
+
+ /* In Ada, the symbol "search name" is a linkage name, whereas
+ the regular expression used to do the matching refers to
+ the natural name. So match against the decoded name. */
+ return (regexec (preg, ada_decode (search_name), 0, NULL, 0) == 0);
+}
+
+/* Add all exceptions defined by the Ada standard whose name match
+ a regular expression.
+
+ If PREG is not NULL, then this regexp_t object is used to
+ perform the symbol name matching. Otherwise, no name-based
+ filtering is performed.
+
+ EXCEPTIONS is a vector of exceptions to which matching exceptions
+ gets pushed. */
+
+static void
+ada_add_standard_exceptions (regex_t *preg, VEC(ada_exc_info) **exceptions)
+{
+ int i;
+
+ for (i = 0; i < ARRAY_SIZE (standard_exc); i++)
+ {
+ if (preg == NULL
+ || regexec (preg, standard_exc[i], 0, NULL, 0) == 0)
+ {
+ struct bound_minimal_symbol msymbol
+ = ada_lookup_simple_minsym (standard_exc[i]);
+
+ if (msymbol.minsym != NULL)
+ {
+ struct ada_exc_info info
+ = {standard_exc[i], BMSYMBOL_VALUE_ADDRESS (msymbol)};
+
+ VEC_safe_push (ada_exc_info, *exceptions, &info);
+ }
+ }
+ }
+}
+
+/* Add all Ada exceptions defined locally and accessible from the given
+ FRAME.
+
+ If PREG is not NULL, then this regexp_t object is used to
+ perform the symbol name matching. Otherwise, no name-based
+ filtering is performed.
+
+ EXCEPTIONS is a vector of exceptions to which matching exceptions
+ gets pushed. */
+
+static void
+ada_add_exceptions_from_frame (regex_t *preg, struct frame_info *frame,
+ VEC(ada_exc_info) **exceptions)
+{
+ const struct block *block = get_frame_block (frame, 0);
+
+ while (block != 0)
+ {
+ struct block_iterator iter;
+ struct symbol *sym;
+
+ ALL_BLOCK_SYMBOLS (block, iter, sym)
+ {
+ switch (SYMBOL_CLASS (sym))
+ {
+ case LOC_TYPEDEF:
+ case LOC_BLOCK:
+ case LOC_CONST:
+ break;
+ default:
+ if (ada_is_exception_sym (sym))
+ {
+ struct ada_exc_info info = {SYMBOL_PRINT_NAME (sym),
+ SYMBOL_VALUE_ADDRESS (sym)};
+
+ VEC_safe_push (ada_exc_info, *exceptions, &info);
+ }
+ }
+ }
+ if (BLOCK_FUNCTION (block) != NULL)
+ break;
+ block = BLOCK_SUPERBLOCK (block);
+ }
+}
+
+/* Add all exceptions defined globally whose name name match
+ a regular expression, excluding standard exceptions.
+
+ The reason we exclude standard exceptions is that they need
+ to be handled separately: Standard exceptions are defined inside
+ a runtime unit which is normally not compiled with debugging info,
+ and thus usually do not show up in our symbol search. However,
+ if the unit was in fact built with debugging info, we need to
+ exclude them because they would duplicate the entry we found
+ during the special loop that specifically searches for those
+ standard exceptions.
+
+ If PREG is not NULL, then this regexp_t object is used to
+ perform the symbol name matching. Otherwise, no name-based
+ filtering is performed.
+
+ EXCEPTIONS is a vector of exceptions to which matching exceptions
+ gets pushed. */
+
+static void
+ada_add_global_exceptions (regex_t *preg, VEC(ada_exc_info) **exceptions)
+{
+ struct objfile *objfile;
+ struct compunit_symtab *s;
+
+ expand_symtabs_matching (NULL, ada_exc_search_name_matches, NULL,
+ VARIABLES_DOMAIN, preg);
+
+ ALL_COMPUNITS (objfile, s)
+ {
+ const struct blockvector *bv = COMPUNIT_BLOCKVECTOR (s);
+ int i;
+
+ for (i = GLOBAL_BLOCK; i <= STATIC_BLOCK; i++)
+ {
+ struct block *b = BLOCKVECTOR_BLOCK (bv, i);
+ struct block_iterator iter;
+ struct symbol *sym;
+
+ ALL_BLOCK_SYMBOLS (b, iter, sym)
+ if (ada_is_non_standard_exception_sym (sym)
+ && (preg == NULL
+ || regexec (preg, SYMBOL_NATURAL_NAME (sym),
+ 0, NULL, 0) == 0))
+ {
+ struct ada_exc_info info
+ = {SYMBOL_PRINT_NAME (sym), SYMBOL_VALUE_ADDRESS (sym)};
+
+ VEC_safe_push (ada_exc_info, *exceptions, &info);
+ }
+ }
+ }
+}
+
+/* Implements ada_exceptions_list with the regular expression passed
+ as a regex_t, rather than a string.
+
+ 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) *
+ada_exceptions_list_1 (regex_t *preg)
+{
+ VEC(ada_exc_info) *result = NULL;
+ struct cleanup *old_chain
+ = make_cleanup (VEC_cleanup (ada_exc_info), &result);
+ int prev_len;
+
+ /* First, list the known standard exceptions. These exceptions
+ need to be handled separately, as they are usually defined in
+ runtime units that have been compiled without debugging info. */
+
+ ada_add_standard_exceptions (preg, &result);
+
+ /* Next, find all exceptions whose scope is local and accessible
+ from the currently selected frame. */
+
+ if (has_stack_frames ())
+ {
+ prev_len = VEC_length (ada_exc_info, result);
+ ada_add_exceptions_from_frame (preg, get_selected_frame (NULL),
+ &result);
+ if (VEC_length (ada_exc_info, result) > 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);
+ ada_add_global_exceptions (preg, &result);
+ if (VEC_length (ada_exc_info, result) > prev_len)
+ sort_remove_dups_ada_exceptions_list (&result, prev_len);
+
+ discard_cleanups (old_chain);
+ return result;
+}
+
+/* Return a vector of ada_exc_info.
+
+ If REGEXP is NULL, all exceptions are included in the result.
+ Otherwise, it should contain a valid regular expression,
+ and only the exceptions whose names match that regular expression
+ are included in the result.
+
+ The exceptions are sorted in the following order:
+ - Standard exceptions (defined by the Ada language), in
+ alphabetical order;
+ - Exceptions only visible from the current frame, in
+ alphabetical order;
+ - Exceptions whose scope is global, in alphabetical order. */
+
+VEC(ada_exc_info) *
+ada_exceptions_list (const char *regexp)
+{
+ VEC(ada_exc_info) *result = NULL;
+ struct cleanup *old_chain = NULL;
+ regex_t reg;
+
+ if (regexp != NULL)
+ old_chain = compile_rx_or_error (®, regexp,
+ _("invalid regular expression"));
+
+ result = ada_exceptions_list_1 (regexp != NULL ? ® : NULL);
+
+ if (old_chain != NULL)
+ do_cleanups (old_chain);
+ return result;
+}
+
+/* Implement the "info exceptions" command. */
+
+static void
+info_exceptions_command (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);
+
+ if (regexp != NULL)
+ printf_filtered
+ (_("All Ada exceptions matching regular expression \"%s\":\n"), regexp);
+ 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);
+}
+
/* Operators */
/* Information about operators given special treatment in functions
below. */
}
static int
-parse (void)
+parse (struct parser_state *ps)
{
warnings_issued = 0;
- return ada_parse ();
+ return ada_parse (ps);
}
static const struct exp_descriptor ada_exp_descriptor = {
static struct value *
ada_read_var_value (struct symbol *var, struct frame_info *frame)
{
- struct block *frame_block = NULL;
+ const struct block *frame_block = NULL;
struct symbol *renaming_sym = NULL;
/* The only case where default_read_var_value is not sufficient
const struct language_defn ada_language_defn = {
"ada", /* Language name */
+ "Ada",
language_ada,
range_check_off,
case_sensitive_on, /* Yes, Ada is case-insensitive, but
c_get_string,
ada_get_symbol_name_cmp, /* la_get_symbol_name_cmp */
ada_iterate_over_symbols,
+ &ada_varobj_ops,
+ NULL,
+ NULL,
LANG_MAGIC
};
{
printf_unfiltered (_(\
"\"set ada\" must be followed by the name of a setting.\n"));
- help_list (set_ada_list, "set ada ", -1, gdb_stdout);
+ help_list (set_ada_list, "set ada ", all_commands, gdb_stdout);
}
/* Implement the "show ada" prefix command. */
ops->print_recreate = print_recreate_catch_assert;
}
+/* This module's 'new_objfile' observer. */
+
+static void
+ada_new_objfile_observer (struct objfile *objfile)
+{
+ ada_clear_symbol_cache ();
+}
+
+/* This module's 'free_objfile' observer. */
+
+static void
+ada_free_objfile_observer (struct objfile *objfile)
+{
+ ada_clear_symbol_cache ();
+}
+
void
_initialize_ada_language (void)
{
varsize_limit = 65536;
+ add_info ("exceptions", info_exceptions_command,
+ _("\
+List all Ada exception names.\n\
+If a regular expression is passed as an argument, only those matching\n\
+the regular expression are listed."));
+
+ add_prefix_cmd ("ada", class_maintenance, maint_set_ada_cmd,
+ _("Set Ada maintenance-related variables."),
+ &maint_set_ada_cmdlist, "maintenance set ada ",
+ 0/*allow-unknown*/, &maintenance_set_cmdlist);
+
+ add_prefix_cmd ("ada", class_maintenance, maint_show_ada_cmd,
+ _("Show Ada maintenance-related variables"),
+ &maint_show_ada_cmdlist, "maintenance show ada ",
+ 0/*allow-unknown*/, &maintenance_show_cmdlist);
+
+ add_setshow_boolean_cmd
+ ("ignore-descriptive-types", class_maintenance,
+ &ada_ignore_descriptive_types_p,
+ _("Set whether descriptive types generated by GNAT should be ignored."),
+ _("Show whether descriptive types generated by GNAT should be ignored."),
+ _("\
+When enabled, the debugger will stop using the DW_AT_GNAT_descriptive_type\n\
+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);
- /* Setup per-inferior data. */
+ /* 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);
+
+ /* Setup various context-specific data. */
ada_inferior_data
= register_inferior_data_with_cleanup (NULL, ada_inferior_data_cleanup);
+ ada_pspace_data_handle
+ = register_program_space_data_with_cleanup (NULL, ada_pspace_data_cleanup);
}