#include "source.h"
#include "observer.h"
#include "vec.h"
+#include "stack.h"
+
+#include "psymtab.h"
+#include "value.h"
/* Define whether or not the C operator '/' truncates towards zero for
differently signed operands (truncation direction is undefined in C).
#define TRUNCATION_TOWARDS_ZERO ((-5 / 2) == -2)
#endif
-static void modify_general_field (struct type *, char *, LONGEST, int, int);
-
static struct type *desc_base_type (struct type *);
static struct type *desc_bounds_type (struct type *);
static int ada_args_match (struct symbol *, struct value **, int);
-static struct value *ensure_lval (struct value *,
- struct gdbarch *, CORE_ADDR *);
+static int full_match (const char *, const char *);
-static struct value *make_array_descriptor (struct type *, struct value *,
- struct gdbarch *, CORE_ADDR *);
+static struct value *make_array_descriptor (struct type *, struct value *);
static void ada_add_block_symbols (struct obstack *,
struct block *, const char *,
static struct ada_symbol_info *defns_collected (struct obstack *, int);
-static struct partial_symbol *ada_lookup_partial_symbol (struct partial_symtab
- *, const char *, int,
- domain_enum, int);
-
static struct value *resolve_subexp (struct expression **, int *, int,
struct type *);
static struct type *to_fixed_array_type (struct type *, struct value *, int);
-static struct type *to_fixed_range_type (char *, struct value *,
- struct type *);
+static struct type *to_fixed_range_type (struct type *, struct value *);
static struct type *to_static_fixed_type (struct type *);
static struct type *static_unwrap_type (struct type *type);
static int is_name_suffix (const char *);
-static int wild_match (const char *, int, const char *);
+static int advance_wild_match (const char **, const char *, int);
+
+static int wild_match (const char *, const char *);
static struct value *ada_coerce_ref (struct value *);
static struct value *ada_to_fixed_value_create (struct type *, CORE_ADDR,
struct value *);
-static struct value *ada_to_fixed_value (struct value *);
-
static int ada_resolve_function (struct ada_symbol_info *, int,
struct value **, int, const char *,
struct type *);
/* Space for allocating results of ada_lookup_symbol_list. */
static struct obstack symbol_list_obstack;
+ /* Inferior-specific data. */
+
+/* Per-inferior data for this module. */
+
+struct ada_inferior_data
+{
+ /* The ada__tags__type_specific_data type, which is used when decoding
+ tagged types. With older versions of GNAT, this type was directly
+ accessible through a component ("tsd") in the object tag. But this
+ is no longer the case, so we cache it for each inferior. */
+ struct type *tsd_type;
+};
+
+/* Our key to this module's inferior data. */
+static const struct inferior_data *ada_inferior_data;
+
+/* A cleanup routine for our inferior data. */
+static void
+ada_inferior_data_cleanup (struct inferior *inf, void *arg)
+{
+ struct ada_inferior_data *data;
+
+ data = inferior_data (inf, ada_inferior_data);
+ if (data != NULL)
+ xfree (data);
+}
+
+/* Return our inferior data for the given inferior (INF).
+
+ This function always returns a valid pointer to an allocated
+ ada_inferior_data structure. If INF's inferior data has not
+ been previously set, this functions creates a new one with all
+ fields set to zero, sets INF's inferior to it, and then returns
+ a pointer to that newly allocated ada_inferior_data. */
+
+static struct ada_inferior_data *
+get_ada_inferior_data (struct inferior *inf)
+{
+ struct ada_inferior_data *data;
+
+ data = inferior_data (inf, ada_inferior_data);
+ if (data == NULL)
+ {
+ data = XZALLOC (struct ada_inferior_data);
+ set_inferior_data (inf, ada_inferior_data, data);
+ }
+
+ return data;
+}
+
+/* Perform all necessary cleanups regarding our module's inferior data
+ that is required after the inferior INF just exited. */
+
+static void
+ada_inferior_exit (struct inferior *inf)
+{
+ ada_inferior_data_cleanup (inf, NULL);
+ set_inferior_data (inf, ada_inferior_data, NULL);
+}
+
/* Utilities */
/* Given DECODED_NAME a string holding a symbol name in its
field_name_match (const char *field_name, const char *target)
{
int len = strlen (target);
+
return
(strncmp (field_name, target, len) == 0
&& (field_name[len] == '\0'
else
{
const char *p = strstr (name, "___");
+
if (p == NULL)
return strlen (name);
else
is_suffix (const char *str, const char *suffix)
{
int len1, len2;
+
if (str == NULL)
return 0;
len1 = strlen (str);
/* FIXME: cagney/2004-10-10: This function is mimicking the behavior
provided by "complaint". */
-static void lim_warning (const char *format, ...) ATTR_FORMAT (printf, 1, 2);
+static void lim_warning (const char *format, ...) ATTRIBUTE_PRINTF (1, 2);
static void
lim_warning (const char *format, ...)
{
va_list args;
- va_start (args, format);
+ va_start (args, format);
warnings_issued += 1;
if (warnings_issued <= warning_limit)
vwarning (format, args);
error (_("object size is larger than varsize-limit"));
}
-
-/* Note: would have used MAX_OF_TYPE and MIN_OF_TYPE macros from
- gdbtypes.h, but some of the necessary definitions in that file
- seem to have gone missing. */
-
/* Maximum value of a SIZE-byte signed integer type. */
static LONGEST
max_of_size (int size)
{
LONGEST top_bit = (LONGEST) 1 << (size * 8 - 2);
+
return top_bit | (top_bit - 1);
}
umax_of_size (int size)
{
ULONGEST top_bit = (ULONGEST) 1 << (size * 8 - 1);
+
return top_bit | (top_bit - 1);
}
/* Language Selection */
/* If the main program is in Ada, return language_ada, otherwise return LANG
- (the main program is in Ada iif the adainit symbol is found).
-
- MAIN_PST is not used. */
+ (the main program is in Ada iif the adainit symbol is found). */
enum language
-ada_update_initial_language (enum language lang,
- struct partial_symtab *main_pst)
+ada_update_initial_language (enum language lang)
{
if (lookup_minimal_symbol ("adainit", (const char *) NULL,
(struct objfile *) NULL) != NULL)
else
{
int i;
+
for (i = 0; i <= len; i += 1)
fold_buffer[i] = tolower (name[i]);
}
if (*len > 1 && isdigit (encoded[*len - 1]))
{
int i = *len - 2;
+
while (i > 0 && isdigit (encoded[i]))
i--;
if (i >= 0 && encoded[i] == '.')
if (at_start_name && encoded[i] == 'O')
{
int k;
+
for (k = 0; ada_opname_table[k].encoded != NULL; k += 1)
{
int op_len = strlen (ada_opname_table[k].encoded);
ada_decode_symbol (const struct general_symbol_info *gsymbol)
{
char **resultp =
- (char **) &gsymbol->language_specific.cplus_specific.demangled_name;
+ (char **) &gsymbol->language_specific.mangled_lang.demangled_name;
+
if (*resultp == NULL)
{
const char *decoded = ada_decode (gsymbol->name);
+
if (gsymbol->obj_section != NULL)
{
struct objfile *objf = gsymbol->obj_section->objfile;
+
*resultp = obsavestring (decoded, strlen (decoded),
&objf->objfile_obstack);
}
{
char **slot = (char **) htab_find_slot (decoded_names_store,
decoded, INSERT);
+
if (*slot == NULL)
*slot = xstrdup (decoded);
*resultp = *slot;
either argument is NULL. */
static int
-ada_match_name (const char *sym_name, const char *name, int wild)
+match_name (const char *sym_name, const char *name, int wild)
{
if (sym_name == NULL || name == NULL)
return 0;
else if (wild)
- return wild_match (name, strlen (name), sym_name);
+ return wild_match (sym_name, name) == 0;
else
{
int len_name = strlen (name);
+
return (strncmp (sym_name, name, len_name) == 0
&& is_name_suffix (sym_name + len_name))
|| (strncmp (sym_name, "_ada_", 5) == 0
/* Arrays */
+/* Assuming that INDEX_DESC_TYPE is an ___XA structure, a structure
+ generated by the GNAT compiler to describe the index type used
+ for each dimension of an array, check whether it follows the latest
+ known encoding. If not, fix it up to conform to the latest encoding.
+ Otherwise, do nothing. This function also does nothing if
+ INDEX_DESC_TYPE is NULL.
+
+ The GNAT encoding used to describle the array index type evolved a bit.
+ Initially, the information would be provided through the name of each
+ field of the structure type only, while the type of these fields was
+ described as unspecified and irrelevant. The debugger was then expected
+ to perform a global type lookup using the name of that field in order
+ to get access to the full index type description. Because these global
+ lookups can be very expensive, the encoding was later enhanced to make
+ the global lookup unnecessary by defining the field type as being
+ the full index type description.
+
+ The purpose of this routine is to allow us to support older versions
+ of the compiler by detecting the use of the older encoding, and by
+ fixing up the INDEX_DESC_TYPE to follow the new one (at this point,
+ we essentially replace each field's meaningless type by the associated
+ index subtype). */
+
+void
+ada_fixup_array_indexes_type (struct type *index_desc_type)
+{
+ int i;
+
+ if (index_desc_type == NULL)
+ return;
+ gdb_assert (TYPE_NFIELDS (index_desc_type) > 0);
+
+ /* Check if INDEX_DESC_TYPE follows the older encoding (it is sufficient
+ to check one field only, no need to check them all). If not, return
+ now.
+
+ If our INDEX_DESC_TYPE was generated using the older encoding,
+ the field type should be a meaningless integer type whose name
+ is not equal to the field name. */
+ if (TYPE_NAME (TYPE_FIELD_TYPE (index_desc_type, 0)) != NULL
+ && strcmp (TYPE_NAME (TYPE_FIELD_TYPE (index_desc_type, 0)),
+ TYPE_FIELD_NAME (index_desc_type, 0)) == 0)
+ return;
+
+ /* Fixup each field of INDEX_DESC_TYPE. */
+ for (i = 0; i < TYPE_NFIELDS (index_desc_type); i++)
+ {
+ char *name = TYPE_FIELD_NAME (index_desc_type, i);
+ struct type *raw_type = ada_check_typedef (ada_find_any_type (name));
+
+ if (raw_type)
+ TYPE_FIELD_TYPE (index_desc_type, i) = raw_type;
+ }
+}
+
/* Names of MAX_ADA_DIMENS bounds in P_BOUNDS fields of array descriptors. */
static char *bound_name[] = {
#define MAX_ADA_DIMENS (sizeof(bound_name) / (2*sizeof(char *)))
-/* Like modify_field, but allows bitpos > wordlength. */
-
-static void
-modify_general_field (struct type *type, char *addr,
- LONGEST fieldval, int bitpos, int bitsize)
-{
- modify_field (type, addr + bitpos / 8, fieldval, bitpos % 8, bitsize);
-}
-
/* The desc_* routines return primitive portions of array descriptors
(fat pointers). */
thin_descriptor_type (struct type *type)
{
struct type *base_type = desc_base_type (type);
+
if (base_type == NULL)
return NULL;
if (is_suffix (ada_type_name (base_type), "___XVE"))
else
{
struct type *alt_type = ada_find_parallel_type (base_type, "___XVE");
+
if (alt_type == NULL)
return base_type;
else
{
struct type *type = value_type (val);
struct type *data_type = desc_data_target_type (thin_descriptor_type (type));
+
data_type = lookup_pointer_type (data_type);
if (TYPE_CODE (type) == TYPE_CODE_PTR)
desc_bounds (struct value *arr)
{
struct type *type = ada_check_typedef (value_type (arr));
+
if (is_thin_pntr (type))
{
struct type *bounds_type =
}
else if (is_thick_pntr (type))
- return value_struct_elt (&arr, NULL, "P_BOUNDS", NULL,
- _("Bad GNAT array descriptor"));
+ {
+ struct value *p_bounds = value_struct_elt (&arr, NULL, "P_BOUNDS", NULL,
+ _("Bad GNAT array descriptor"));
+ struct type *p_bounds_type = value_type (p_bounds);
+
+ if (p_bounds_type
+ && TYPE_CODE (p_bounds_type) == TYPE_CODE_PTR)
+ {
+ struct type *target_type = TYPE_TARGET_TYPE (p_bounds_type);
+
+ if (TYPE_STUB (target_type))
+ p_bounds = value_cast (lookup_pointer_type
+ (ada_check_typedef (target_type)),
+ p_bounds);
+ }
+ else
+ error (_("Bad GNAT array descriptor"));
+
+ return p_bounds;
+ }
else
return NULL;
}
if (data_type
&& TYPE_CODE (ada_check_typedef (data_type)) == TYPE_CODE_PTR)
- return TYPE_TARGET_TYPE (data_type);
+ return ada_check_typedef (TYPE_TARGET_TYPE (data_type));
}
return NULL;
desc_data (struct value *arr)
{
struct type *type = value_type (arr);
+
if (is_thin_pntr (type))
return thin_data_pntr (arr);
else if (is_thick_pntr (type))
struct type *array_type = alloc_type_copy (value_type (arr));
struct value *low = desc_one_bound (descriptor, arity, 0);
struct value *high = desc_one_bound (descriptor, arity, 1);
- 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)));
if (ada_is_array_descriptor_type (value_type (arr)))
{
struct type *arrType = ada_type_of_array (arr, 1);
+
if (arrType == NULL)
return NULL;
return value_cast (arrType, value_copy (desc_data (arr)));
if (ada_is_array_descriptor_type (value_type (arr)))
{
struct value *arrVal = ada_coerce_to_simple_array_ptr (arr);
+
if (arrVal == NULL)
error (_("Bounds unavailable for null array pointer."));
check_size (TYPE_TARGET_TYPE (value_type (arrVal)));
static struct type *
decode_constrained_packed_array_type (struct type *type)
{
- struct symbol *sym;
- struct block **blocks;
char *raw_name = ada_type_name (ada_check_typedef (type));
char *name;
char *tail;
struct type *shadow_type;
long bits;
- int i, n;
if (!raw_name)
raw_name = ada_type_name (desc_base_type (type));
if (obj != NULL)
{
CORE_ADDR new_addr;
+
set_value_component_location (v, obj);
new_addr = value_address (obj) + offset;
set_value_bitpos (v, bit_offset + value_bitpos (obj));
1;
/* Sign-extend bits for this byte. */
unsigned int signMask = sign & ~unusedMSMask;
+
accum |=
(((bytes[src] >> unusedLS) & unusedMSMask) | signMask) << accumSize;
accumSize += HOST_CHAR_BIT - unusedLS;
while (n > 0)
{
int unused_right;
+
accum = (accum << HOST_CHAR_BIT) + (unsigned char) *source;
accum_bits += HOST_CHAR_BIT;
source += 1;
low, high);
struct type *slice_type =
create_array_type (NULL, TYPE_TARGET_TYPE (type), index_type);
+
return value_at_lazy (slice_type, base);
}
create_range_type (NULL, TYPE_INDEX_TYPE (type), low, high);
struct type *slice_type =
create_array_type (NULL, TYPE_TARGET_TYPE (type), index_type);
+
return value_cast (slice_type, value_slice (array, low, high - low + 1));
}
elt_type = TYPE_TARGET_TYPE (type);
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_NAME (index_type_desc, n - 1),
- NULL, TYPE_INDEX_TYPE (elt_type));
+ index_type = to_fixed_range_type (TYPE_FIELD_TYPE (index_type_desc, n - 1),
+ NULL);
else
index_type = TYPE_INDEX_TYPE (elt_type);
create_range_type (NULL, TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (arr_type)),
low, low - 1);
struct type *elt_type = ada_array_element_type (arr_type, 1);
+
return allocate_value (create_array_type (NULL, elt_type, index_type));
}
\f
return 0;
else
{
- struct type *ftype = ada_check_typedef (TYPE_FIELD_TYPE (func_type, i));
+ struct type *ftype = ada_check_typedef (TYPE_FIELD_TYPE (func_type,
+ i));
struct type *atype = ada_check_typedef (value_type (actuals[i]));
if (!ada_type_match (ftype, atype, 1))
else
{
int k0, k1;
+
for (k0 = strlen (N0) - 1; k0 > 0 && isdigit (N0[k0]); k0 -= 1)
;
for (k1 = strlen (N1) - 1; k1 > 0 && isdigit (N1[k1]); k1 -= 1)
&& (N1[k1] == '_' || N1[k1] == '$') && N1[k1 + 1] != '\000')
{
int n0, n1;
+
n0 = k0;
while (N0[n0] == '_' && n0 > 0 && N0[n0 - 1] == '_')
n0 -= 1;
sort_choices (struct ada_symbol_info syms[], int nsyms)
{
int i;
+
for (i = 1; i < nsyms; i += 1)
{
struct ada_symbol_info sym = syms[i];
{
struct symtab_and_line sal =
find_function_start_sal (syms[i].sym, 1);
+
if (sal.symtab == NULL)
printf_unfiltered (_("[%d] %s at <no source file available>:%d\n"),
i + first_choice,
if (j < 0 || choice != choices[j])
{
int k;
+
for (k = n_chosen - 1; k > j; k -= 1)
choices[k + 1] = choices[k];
choices[j + 1] = choice;
/* Evaluation: Function Calls */
/* Return an lvalue containing the value VAL. This is the identity on
- lvalues, and otherwise has the side-effect of pushing a copy of VAL
- on the stack, using and updating *SP as the stack pointer, and
- returning an lvalue whose value_address points to the copy. */
+ lvalues, and otherwise has the side-effect of allocating memory
+ in the inferior where a copy of the value contents is copied. */
static struct value *
-ensure_lval (struct value *val, struct gdbarch *gdbarch, CORE_ADDR *sp)
+ensure_lval (struct value *val)
{
- if (! VALUE_LVAL (val))
+ if (VALUE_LVAL (val) == not_lval
+ || VALUE_LVAL (val) == lval_internalvar)
{
int len = TYPE_LENGTH (ada_check_typedef (value_type (val)));
+ const CORE_ADDR addr =
+ value_as_long (value_allocate_space_in_inferior (len));
- /* The following is taken from the structure-return code in
- call_function_by_hand. FIXME: Therefore, some refactoring seems
- indicated. */
- if (gdbarch_inner_than (gdbarch, 1, 2))
- {
- /* Stack grows downward. Align SP and value_address (val) after
- reserving sufficient space. */
- *sp -= len;
- if (gdbarch_frame_align_p (gdbarch))
- *sp = gdbarch_frame_align (gdbarch, *sp);
- set_value_address (val, *sp);
- }
- else
- {
- /* Stack grows upward. Align the frame, allocate space, and
- then again, re-align the frame. */
- if (gdbarch_frame_align_p (gdbarch))
- *sp = gdbarch_frame_align (gdbarch, *sp);
- set_value_address (val, *sp);
- *sp += len;
- if (gdbarch_frame_align_p (gdbarch))
- *sp = gdbarch_frame_align (gdbarch, *sp);
- }
+ set_value_address (val, addr);
VALUE_LVAL (val) = lval_memory;
-
- write_memory (value_address (val), value_contents_raw (val), len);
+ write_memory (addr, value_contents (val), len);
}
return val;
values not residing in memory, updating it as needed. */
struct value *
-ada_convert_actual (struct value *actual, struct type *formal_type0,
- struct gdbarch *gdbarch, CORE_ADDR *sp)
+ada_convert_actual (struct value *actual, struct type *formal_type0)
{
struct type *actual_type = ada_check_typedef (value_type (actual));
struct type *formal_type = ada_check_typedef (formal_type0);
if (ada_is_array_descriptor_type (formal_target)
&& TYPE_CODE (actual_target) == TYPE_CODE_ARRAY)
- return make_array_descriptor (formal_type, actual, gdbarch, sp);
+ return make_array_descriptor (formal_type, actual);
else if (TYPE_CODE (formal_type) == TYPE_CODE_PTR
|| TYPE_CODE (formal_type) == TYPE_CODE_REF)
{
struct value *result;
+
if (TYPE_CODE (formal_target) == TYPE_CODE_ARRAY
&& ada_is_array_descriptor_type (actual_target))
result = desc_data (actual);
if (VALUE_LVAL (actual) != lval_memory)
{
struct value *val;
+
actual_type = ada_check_typedef (value_type (actual));
val = allocate_value (actual_type);
memcpy ((char *) value_contents_raw (val),
(char *) value_contents (actual),
TYPE_LENGTH (actual_type));
- actual = ensure_lval (val, gdbarch, sp);
+ actual = ensure_lval (val);
}
result = value_addr (actual);
}
return actual;
}
+/* Convert VALUE (which must be an address) to a CORE_ADDR that is a pointer of
+ type TYPE. This is usually an inefficient no-op except on some targets
+ (such as AVR) where the representation of a pointer and an address
+ differs. */
+
+static CORE_ADDR
+value_pointer (struct value *value, struct type *type)
+{
+ struct gdbarch *gdbarch = get_type_arch (type);
+ unsigned len = TYPE_LENGTH (type);
+ gdb_byte *buf = alloca (len);
+ CORE_ADDR addr;
+
+ addr = value_address (value);
+ gdbarch_address_to_pointer (gdbarch, type, buf, addr);
+ addr = extract_unsigned_integer (buf, len, gdbarch_byte_order (gdbarch));
+ return addr;
+}
+
/* Push a descriptor of type TYPE for array value ARR on the stack at
*SP, updating *SP to reflect the new descriptor. Return either
representing a pointer to this descriptor. */
static struct value *
-make_array_descriptor (struct type *type, struct value *arr,
- struct gdbarch *gdbarch, CORE_ADDR *sp)
+make_array_descriptor (struct type *type, struct value *arr)
{
struct type *bounds_type = desc_bounds_type (type);
struct type *desc_type = desc_base_type (type);
for (i = ada_array_arity (ada_check_typedef (value_type (arr))); i > 0; i -= 1)
{
- modify_general_field (value_type (bounds),
- value_contents_writeable (bounds),
- ada_array_bound (arr, i, 0),
- desc_bound_bitpos (bounds_type, i, 0),
- desc_bound_bitsize (bounds_type, i, 0));
- modify_general_field (value_type (bounds),
- value_contents_writeable (bounds),
- ada_array_bound (arr, i, 1),
- desc_bound_bitpos (bounds_type, i, 1),
- desc_bound_bitsize (bounds_type, i, 1));
+ modify_field (value_type (bounds), value_contents_writeable (bounds),
+ ada_array_bound (arr, i, 0),
+ desc_bound_bitpos (bounds_type, i, 0),
+ desc_bound_bitsize (bounds_type, i, 0));
+ modify_field (value_type (bounds), value_contents_writeable (bounds),
+ ada_array_bound (arr, i, 1),
+ desc_bound_bitpos (bounds_type, i, 1),
+ desc_bound_bitsize (bounds_type, i, 1));
}
- bounds = ensure_lval (bounds, gdbarch, sp);
+ bounds = ensure_lval (bounds);
- modify_general_field (value_type (descriptor),
- value_contents_writeable (descriptor),
- value_address (ensure_lval (arr, gdbarch, sp)),
- fat_pntr_data_bitpos (desc_type),
- fat_pntr_data_bitsize (desc_type));
+ modify_field (value_type (descriptor),
+ value_contents_writeable (descriptor),
+ value_pointer (ensure_lval (arr),
+ TYPE_FIELD_TYPE (desc_type, 0)),
+ fat_pntr_data_bitpos (desc_type),
+ fat_pntr_data_bitsize (desc_type));
- modify_general_field (value_type (descriptor),
- value_contents_writeable (descriptor),
- value_address (bounds),
- fat_pntr_bounds_bitpos (desc_type),
- fat_pntr_bounds_bitsize (desc_type));
+ modify_field (value_type (descriptor),
+ value_contents_writeable (descriptor),
+ value_pointer (bounds,
+ TYPE_FIELD_TYPE (desc_type, 1)),
+ fat_pntr_bounds_bitpos (desc_type),
+ fat_pntr_bounds_bitsize (desc_type));
- descriptor = ensure_lval (descriptor, gdbarch, sp);
+ descriptor = ensure_lval (descriptor);
if (TYPE_CODE (type) == TYPE_CODE_PTR)
return value_addr (descriptor);
char *name0 = SYMBOL_LINKAGE_NAME (sym0);
char *name1 = SYMBOL_LINKAGE_NAME (sym1);
int len0 = strlen (name0);
+
return
TYPE_CODE (type0) == TYPE_CODE (type1)
&& (equiv_types (type0, type1)
struct block *block)
{
int i;
- size_t tmp;
struct ada_symbol_info *prevDefns = defns_collected (obstackp, 0);
/* Do not try to complete stub types, as the debugger is probably
return (struct ada_symbol_info *) obstack_base (obstackp);
}
-/* Look, in partial_symtab PST, for symbol NAME in given namespace.
- Check the global symbols if GLOBAL, the static symbols if not.
- Do wild-card match if WILD. */
-
-static struct partial_symbol *
-ada_lookup_partial_symbol (struct partial_symtab *pst, const char *name,
- int global, domain_enum namespace, int wild)
-{
- struct partial_symbol **start;
- int name_len = strlen (name);
- int length = (global ? pst->n_global_syms : pst->n_static_syms);
- int i;
-
- if (length == 0)
- {
- return (NULL);
- }
-
- start = (global ?
- pst->objfile->global_psymbols.list + pst->globals_offset :
- pst->objfile->static_psymbols.list + pst->statics_offset);
-
- if (wild)
- {
- for (i = 0; i < length; i += 1)
- {
- struct partial_symbol *psym = start[i];
-
- if (symbol_matches_domain (SYMBOL_LANGUAGE (psym),
- SYMBOL_DOMAIN (psym), namespace)
- && wild_match (name, name_len, SYMBOL_LINKAGE_NAME (psym)))
- return psym;
- }
- return NULL;
- }
- else
- {
- if (global)
- {
- int U;
- i = 0;
- U = length - 1;
- while (U - i > 4)
- {
- int M = (U + i) >> 1;
- struct partial_symbol *psym = start[M];
- if (SYMBOL_LINKAGE_NAME (psym)[0] < name[0])
- i = M + 1;
- else if (SYMBOL_LINKAGE_NAME (psym)[0] > name[0])
- U = M - 1;
- else if (strcmp (SYMBOL_LINKAGE_NAME (psym), name) < 0)
- i = M + 1;
- else
- U = M;
- }
- }
- else
- i = 0;
-
- while (i < length)
- {
- struct partial_symbol *psym = start[i];
-
- if (symbol_matches_domain (SYMBOL_LANGUAGE (psym),
- SYMBOL_DOMAIN (psym), namespace))
- {
- int cmp = strncmp (name, SYMBOL_LINKAGE_NAME (psym), name_len);
-
- if (cmp < 0)
- {
- if (global)
- break;
- }
- else if (cmp == 0
- && is_name_suffix (SYMBOL_LINKAGE_NAME (psym)
- + name_len))
- return psym;
- }
- i += 1;
- }
-
- if (global)
- {
- int U;
- i = 0;
- U = length - 1;
- while (U - i > 4)
- {
- int M = (U + i) >> 1;
- struct partial_symbol *psym = start[M];
- if (SYMBOL_LINKAGE_NAME (psym)[0] < '_')
- i = M + 1;
- else if (SYMBOL_LINKAGE_NAME (psym)[0] > '_')
- U = M - 1;
- else if (strcmp (SYMBOL_LINKAGE_NAME (psym), "_ada_") < 0)
- i = M + 1;
- else
- U = M;
- }
- }
- else
- i = 0;
-
- while (i < length)
- {
- struct partial_symbol *psym = start[i];
-
- if (symbol_matches_domain (SYMBOL_LANGUAGE (psym),
- SYMBOL_DOMAIN (psym), namespace))
- {
- int cmp;
-
- cmp = (int) '_' - (int) SYMBOL_LINKAGE_NAME (psym)[0];
- if (cmp == 0)
- {
- cmp = strncmp ("_ada_", SYMBOL_LINKAGE_NAME (psym), 5);
- if (cmp == 0)
- cmp = strncmp (name, SYMBOL_LINKAGE_NAME (psym) + 5,
- name_len);
- }
-
- if (cmp < 0)
- {
- if (global)
- break;
- }
- else if (cmp == 0
- && is_name_suffix (SYMBOL_LINKAGE_NAME (psym)
- + name_len + 5))
- return psym;
- }
- i += 1;
- }
- }
- return NULL;
-}
-
/* Return a minimal symbol matching NAME according to Ada decoding
rules. Returns NULL if there is no such minimal symbol. Names
prefixed with "standard__" are handled specially: "standard__" is
ALL_MSYMBOLS (objfile, msymbol)
{
- if (ada_match_name (SYMBOL_LINKAGE_NAME (msymbol), name, wild_match)
+ if (match_name (SYMBOL_LINKAGE_NAME (msymbol), name, wild_match)
&& MSYMBOL_TYPE (msymbol) != mst_solib_trampoline)
return msymbol;
}
is_nondebugging_type (struct type *type)
{
char *name = ada_type_name (type);
+
return (name != NULL && strcmp (name, "<variable, no debug info>") == 0);
}
{
int name_len = suffix - name;
int j;
+
is_new_style_renaming = 1;
for (j = 0; j < nsyms; j += 1)
if (i != j && syms[j].sym != NULL
&& old_renaming_is_invisible (syms[i].sym, current_function_name))
{
int j;
+
for (j = i + 1; j < nsyms; j += 1)
syms[j - 1] = syms[j];
nsyms -= 1;
add_symbols_from_enclosing_procs (obstackp, name, domain, wild_match);
}
+/* An object of this type is used as the user_data argument when
+ calling the map_matching_symbols method. */
+
+struct match_data
+{
+ struct objfile *objfile;
+ struct obstack *obstackp;
+ struct symbol *arg_sym;
+ int found_sym;
+};
+
+/* A callback for add_matching_symbols that adds SYM, found in BLOCK,
+ to a list of symbols. DATA0 is a pointer to a struct match_data *
+ containing the obstack that collects the symbol list, the file that SYM
+ must come from, a flag indicating whether a non-argument symbol has
+ been found in the current block, and the last argument symbol
+ passed in SYM within the current block (if any). When SYM is null,
+ marking the end of a block, the argument symbol is added if no
+ other has been found. */
+
+static int
+aux_add_nonlocal_symbols (struct block *block, struct symbol *sym, void *data0)
+{
+ struct match_data *data = (struct match_data *) data0;
+
+ if (sym == NULL)
+ {
+ if (!data->found_sym && data->arg_sym != NULL)
+ add_defn_to_vec (data->obstackp,
+ fixup_symbol_section (data->arg_sym, data->objfile),
+ block);
+ data->found_sym = 0;
+ data->arg_sym = NULL;
+ }
+ else
+ {
+ if (SYMBOL_CLASS (sym) == LOC_UNRESOLVED)
+ return 0;
+ else if (SYMBOL_IS_ARGUMENT (sym))
+ data->arg_sym = sym;
+ else
+ {
+ data->found_sym = 1;
+ add_defn_to_vec (data->obstackp,
+ fixup_symbol_section (sym, data->objfile),
+ block);
+ }
+ }
+ 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). */
+
+static int
+compare_names (const char *string1, const char *string2)
+{
+ while (*string1 != '\0' && *string2 != '\0')
+ {
+ if (isspace (*string1) || isspace (*string2))
+ return strcmp_iw_ordered (string1, string2);
+ if (*string1 != *string2)
+ break;
+ string1 += 1;
+ string2 += 1;
+ }
+ switch (*string1)
+ {
+ case '(':
+ return strcmp_iw_ordered (string1, string2);
+ case '_':
+ if (*string2 == '\0')
+ {
+ if (is_name_suffix (string2))
+ return 0;
+ else
+ return -1;
+ }
+ default:
+ if (*string2 == '(')
+ return strcmp_iw_ordered (string1, string2);
+ else
+ return *string1 - *string2;
+ }
+}
+
/* 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 void
-ada_add_non_local_symbols (struct obstack *obstackp, const char *name,
- domain_enum domain, int global,
- int wild_match)
+add_nonlocal_symbols (struct obstack *obstackp, const char *name,
+ domain_enum domain, int global,
+ int is_wild_match)
{
struct objfile *objfile;
- struct partial_symtab *ps;
+ struct match_data data;
- ALL_PSYMTABS (objfile, ps)
- {
- QUIT;
- if (ps->readin
- || ada_lookup_partial_symbol (ps, name, global, domain, wild_match))
- {
- struct symtab *s = PSYMTAB_TO_SYMTAB (ps);
- const int block_kind = global ? GLOBAL_BLOCK : STATIC_BLOCK;
+ data.obstackp = obstackp;
+ data.arg_sym = NULL;
- if (s == NULL || !s->primary)
- continue;
- ada_add_block_symbols (obstackp,
- BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), block_kind),
- name, domain, objfile, wild_match);
- }
- }
+ ALL_OBJFILES (objfile)
+ {
+ data.objfile = objfile;
+
+ if (is_wild_match)
+ objfile->sf->qf->map_matching_symbols (name, domain, objfile, global,
+ aux_add_nonlocal_symbols, &data,
+ wild_match, NULL);
+ else
+ objfile->sf->qf->map_matching_symbols (name, domain, objfile, global,
+ aux_add_nonlocal_symbols, &data,
+ full_match, compare_names);
+ }
+
+ if (num_defns_collected (obstackp) == 0 && global && !is_wild_match)
+ {
+ ALL_OBJFILES (objfile)
+ {
+ char *name1 = alloca (strlen (name) + sizeof ("_ada_"));
+ strcpy (name1, "_ada_");
+ strcpy (name1 + sizeof ("_ada_") - 1, name);
+ data.objfile = objfile;
+ objfile->sf->qf->map_matching_symbols (name1, domain, objfile, global,
+ aux_add_nonlocal_symbols, &data,
+ full_match, compare_names);
+ }
+ }
}
/* Find symbols in DOMAIN matching NAME0, in BLOCK0 and enclosing
/* Search symbols from all global blocks. */
- ada_add_non_local_symbols (&symbol_list_obstack, name, namespace, 1,
- wild_match);
+ add_nonlocal_symbols (&symbol_list_obstack, name, namespace, 1,
+ wild_match);
/* 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)
- ada_add_non_local_symbols (&symbol_list_obstack, name, namespace, 0,
- wild_match);
+ add_nonlocal_symbols (&symbol_list_obstack, name, namespace, 0,
+ wild_match);
done:
ndefns = num_defns_collected (&symbol_list_obstack);
static struct symbol *
ada_lookup_symbol_nonlocal (const char *name,
- const char *linkage_name,
const struct block *block,
const domain_enum domain)
{
- if (linkage_name == NULL)
- linkage_name = name;
- return ada_lookup_symbol (linkage_name, block_static_block (block), domain,
- NULL);
+ return ada_lookup_symbol (name, block_static_block (block), domain, NULL);
}
return 1;
}
-/* True if NAME represents a name of the form A1.A2....An, n>=1 and
- PATN[0..PATN_LEN-1] = Ak.Ak+1.....An for some k >= 1. Ignores
- informational suffixes of NAME (i.e., for which is_name_suffix is
- true). */
+/* Advance *NAMEP to next occurrence of TARGET0 in the string NAME0
+ that could start a simple name. Assumes that *NAMEP points into
+ the string beginning at NAME0. */
static int
-wild_match (const char *patn0, int patn_len, const char *name0)
+advance_wild_match (const char **namep, const char *name0, int target0)
{
- char* match;
- const char* start;
- start = name0;
+ const char *name = *namep;
+
while (1)
{
- match = strstr (start, patn0);
- if (match == NULL)
+ int t0, t1;
+
+ t0 = *name;
+ if (t0 == '_')
+ {
+ t1 = name[1];
+ if ((t1 >= 'a' && t1 <= 'z') || (t1 >= '0' && t1 <= '9'))
+ {
+ name += 1;
+ if (name == name0 + 5 && strncmp (name0, "_ada", 4) == 0)
+ break;
+ else
+ name += 1;
+ }
+ else if (t1 == '_' && ((name[2] >= 'a' && name[2] <= 'z')
+ || name[2] == target0))
+ {
+ name += 2;
+ break;
+ }
+ else
+ return 0;
+ }
+ else if ((t0 >= 'a' && t0 <= 'z') || (t0 >= '0' && t0 <= '9'))
+ name += 1;
+ else
return 0;
- if ((match == name0
- || match[-1] == '.'
- || (match > name0 + 1 && match[-1] == '_' && match[-2] == '_')
- || (match == name0 + 5 && strncmp ("_ada_", name0, 5) == 0))
- && is_name_suffix (match + patn_len))
- return (match == name0 || is_valid_name_for_wild_match (name0));
- start = match + 1;
}
+
+ *namep = name;
+ return 1;
}
+/* Return 0 iff NAME encodes a name of the form prefix.PATN. Ignores any
+ informational suffixes of NAME (i.e., for which is_name_suffix is
+ true). Assumes that PATN is a lower-cased Ada simple name. */
+
+static int
+wild_match (const char *name, const char *patn)
+{
+ const char *p, *n;
+ const char *name0 = name;
+
+ while (1)
+ {
+ const char *match = name;
+
+ if (*name == *patn)
+ {
+ for (name += 1, p = patn + 1; *p != '\0'; name += 1, p += 1)
+ if (*p != *name)
+ break;
+ if (*p == '\0' && is_name_suffix (name))
+ return match != name0 && !is_valid_name_for_wild_match (name0);
+
+ if (name[-1] == '_')
+ name -= 1;
+ }
+ if (!advance_wild_match (&name, name0, *patn))
+ return 1;
+ }
+}
+
+/* Returns 0 iff symbol name SYM_NAME matches SEARCH_NAME, apart from
+ informational suffix. */
+
+static int
+full_match (const char *sym_name, const char *search_name)
+{
+ return !match_name (sym_name, search_name, 0);
+}
+
+
/* Add symbols from BLOCK matching identifier NAME in DOMAIN to
vector *defn_symbols, updating the list of symbols in OBSTACKP
(if necessary). If WILD, treat as NAME with a wildcard prefix.
found_sym = 0;
if (wild)
{
- struct symbol *sym;
- ALL_BLOCK_SYMBOLS (block, iter, sym)
+ for (sym = dict_iter_match_first (BLOCK_DICT (block), name,
+ wild_match, &iter);
+ sym != NULL; sym = dict_iter_match_next (name, wild_match, &iter))
{
if (symbol_matches_domain (SYMBOL_LANGUAGE (sym),
SYMBOL_DOMAIN (sym), domain)
- && wild_match (name, name_len, SYMBOL_LINKAGE_NAME (sym)))
+ && wild_match (SYMBOL_LINKAGE_NAME (sym), name) == 0)
{
if (SYMBOL_CLASS (sym) == LOC_UNRESOLVED)
continue;
}
else
{
- ALL_BLOCK_SYMBOLS (block, iter, sym)
+ for (sym = dict_iter_match_first (BLOCK_DICT (block), name,
+ full_match, &iter);
+ sym != NULL; sym = dict_iter_match_next (name, full_match, &iter))
{
if (symbol_matches_domain (SYMBOL_LANGUAGE (sym),
SYMBOL_DOMAIN (sym), domain))
{
- int cmp = strncmp (name, SYMBOL_LINKAGE_NAME (sym), name_len);
- if (cmp == 0
- && is_name_suffix (SYMBOL_LINKAGE_NAME (sym) + name_len))
- {
- if (SYMBOL_CLASS (sym) != LOC_UNRESOLVED)
+ if (SYMBOL_CLASS (sym) != LOC_UNRESOLVED)
+ {
+ if (SYMBOL_IS_ARGUMENT (sym))
+ arg_sym = sym;
+ else
{
- if (SYMBOL_IS_ARGUMENT (sym))
- arg_sym = sym;
- else
- {
- found_sym = 1;
- add_defn_to_vec (obstackp,
- fixup_symbol_section (sym, objfile),
- block);
- }
+ found_sym = 1;
+ add_defn_to_vec (obstackp,
+ fixup_symbol_section (sym, objfile),
+ block);
}
- }
+ }
}
}
}
const char *text, int text_len,
int wild_match, int encoded)
{
- char *result;
const int verbatim_match = (text[0] == '<');
int match = 0;
return sym_name;
}
-typedef char *char_ptr;
DEF_VEC_P (char_ptr);
/* A companion function to ada_make_symbol_completion_list().
VEC_safe_push (char_ptr, *sv, completion);
}
+/* An object of this type is passed as the user_data argument to the
+ map_partial_symbol_names method. */
+struct add_partial_datum
+{
+ VEC(char_ptr) **completions;
+ char *text;
+ int text_len;
+ char *text0;
+ char *word;
+ int wild_match;
+ int encoded;
+};
+
+/* A callback for map_partial_symbol_names. */
+static void
+ada_add_partial_symbol_completions (const char *name, void *user_data)
+{
+ struct add_partial_datum *data = user_data;
+
+ symbol_completion_add (data->completions, name,
+ data->text, data->text_len, data->text0, data->word,
+ data->wild_match, data->encoded);
+}
+
/* Return a list of possible symbol names completing TEXT0. The list
is NULL terminated. WORD is the entire command on which completion
is made. */
VEC(char_ptr) *completions = VEC_alloc (char_ptr, 128);
struct symbol *sym;
struct symtab *s;
- struct partial_symtab *ps;
struct minimal_symbol *msymbol;
struct objfile *objfile;
struct block *b, *surrounding_static_block = 0;
}
/* First, look at the partial symtab symbols. */
- ALL_PSYMTABS (objfile, ps)
{
- struct partial_symbol **psym;
-
- /* If the psymtab's been read in we'll get it when we search
- through the blockvector. */
- if (ps->readin)
- continue;
-
- for (psym = objfile->global_psymbols.list + ps->globals_offset;
- psym < (objfile->global_psymbols.list + ps->globals_offset
- + ps->n_global_syms); psym++)
- {
- QUIT;
- symbol_completion_add (&completions, SYMBOL_LINKAGE_NAME (*psym),
- text, text_len, text0, word,
- wild_match, encoded);
- }
-
- for (psym = objfile->static_psymbols.list + ps->statics_offset;
- psym < (objfile->static_psymbols.list + ps->statics_offset
- + ps->n_static_syms); psym++)
- {
- QUIT;
- symbol_completion_add (&completions, SYMBOL_LINKAGE_NAME (*psym),
- text, text_len, text0, word,
- wild_match, encoded);
- }
+ struct add_partial_datum data;
+
+ data.completions = &completions;
+ data.text = text;
+ data.text_len = text_len;
+ data.text0 = text0;
+ data.word = word;
+ data.wild_match = wild_match;
+ data.encoded = encoded;
+ map_partial_symbol_names (ada_add_partial_symbol_completions, &data);
}
/* At this point scan through the misc symbol vectors and add each
else
{
const char *name = ada_type_name (TYPE_TARGET_TYPE (type));
+
return (name != NULL
&& strcmp (name, "ada__tags__dispatch_table") == 0);
}
const gdb_byte *valaddr,
CORE_ADDR address)
{
- int tag_byte_offset, dummy1, dummy2;
+ int tag_byte_offset;
struct type *tag_type;
+
if (find_struct_field ("_tag", type, 0, &tag_type, &tag_byte_offset,
NULL, NULL, NULL))
{
type_from_tag (struct value *tag)
{
const char *type_name = ada_tag_name (tag);
+
if (type_name != NULL)
return ada_find_any_type (ada_encode (type_name));
return NULL;
static char name[1024];
char *p;
struct value *val;
+
args->name = NULL;
val = ada_value_struct_elt (args->tag, "tsd", 1);
if (val == NULL)
return 0;
}
+/* Return the "ada__tags__type_specific_data" type. */
+
+static struct type *
+ada_get_tsd_type (struct inferior *inf)
+{
+ struct ada_inferior_data *data = get_ada_inferior_data (inf);
+
+ if (data->tsd_type == 0)
+ data->tsd_type = ada_find_any_type ("ada__tags__type_specific_data");
+ return data->tsd_type;
+}
+
/* Utility function for ada_tag_name_1 that tries the second
representation for the dispatch table (in which there is no
explicit 'tsd' field in the referent of the tag pointer, and instead
struct value *val, *valp;
args->name = NULL;
- info_type = ada_find_any_type ("ada__tags__type_specific_data");
+ info_type = ada_get_tsd_type (current_inferior());
if (info_type == NULL)
return 0;
info_type = lookup_pointer_type (lookup_pointer_type (info_type));
}
/* The type name of the dynamic type denoted by the 'tag value TAG, as
- * a C string. */
+ a C string. */
const char *
ada_tag_name (struct value *tag)
{
struct tag_args args;
+
if (!ada_is_tag_type (value_type (tag)))
return NULL;
args.tag = tag;
ada_is_parent_field (struct type *type, int field_num)
{
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));
ada_is_wrapper_field (struct type *type, int field_num)
{
const char *name = TYPE_FIELD_NAME (type, field_num);
+
return (name != NULL
&& (strncmp (name, "PARENT", 6) == 0
|| strcmp (name, "REP") == 0
ada_is_variant_part (struct type *type, int field_num)
{
struct type *field_type = TYPE_FIELD_TYPE (type, field_num);
+
return (TYPE_CODE (field_type) == TYPE_CODE_UNION
|| (is_dynamic_field (type, field_num)
&& (TYPE_CODE (TYPE_TARGET_TYPE (field_type))
ada_variant_discrim_type (struct type *var_type, struct type *outer_type)
{
char *name = ada_variant_discrim_name (var_type);
+
return ada_lookup_struct_elt_type (outer_type, name, 1, 1, NULL);
}
ada_is_others_clause (struct type *type, int field_num)
{
const char *name = TYPE_FIELD_NAME (type, field_num);
+
return (name != NULL && name[0] == 'O');
}
case 'S':
{
LONGEST W;
+
if (!ada_scan_number (name, p + 1, &W, &p))
return 0;
if (val == W)
case 'R':
{
LONGEST L, U;
+
if (!ada_scan_number (name, p + 1, &L, &p)
|| name[p] != 'T' || !ada_scan_number (name, p + 1, &U, &p))
return 0;
else if (name != NULL && field_name_match (t_field_name, name))
{
int bit_size = TYPE_FIELD_BITSIZE (type, i);
+
if (field_type_p != NULL)
*field_type_p = TYPE_FIELD_TYPE (type, i);
if (byte_offset_p != NULL)
num_visible_fields (struct type *type)
{
int n;
+
n = 0;
find_struct_field (NULL, type, 0, NULL, NULL, NULL, NULL, &n);
return n;
struct type *type)
{
int i;
- type = ada_check_typedef (type);
+ type = ada_check_typedef (type);
for (i = 0; i < TYPE_NFIELDS (type); i += 1)
{
char *t_field_name = TYPE_FIELD_NAME (type, i);
ada_search_struct_field (name, arg,
offset + TYPE_FIELD_BITPOS (type, i) / 8,
TYPE_FIELD_TYPE (type, i));
+
if (v != NULL)
return v;
}
{
/* PNH: Do we ever get here? See find_struct_field. */
int j;
- struct type *field_type = ada_check_typedef (TYPE_FIELD_TYPE (type, i));
+ struct type *field_type = ada_check_typedef (TYPE_FIELD_TYPE (type,
+ i));
int var_offset = offset + TYPE_FIELD_BITPOS (type, i) / 8;
for (j = 0; j < TYPE_NFIELDS (field_type); j += 1)
(name, arg,
var_offset + TYPE_FIELD_BITPOS (field_type, j) / 8,
TYPE_FIELD_TYPE (field_type, j));
+
if (v != NULL)
return v;
}
ada_index_struct_field_1 (index_p, arg,
offset + TYPE_FIELD_BITPOS (type, i) / 8,
TYPE_FIELD_TYPE (type, i));
+
if (v != NULL)
return v;
}
else if (ada_is_variant_part (type, i))
{
int j;
- struct type *field_type = ada_check_typedef (TYPE_FIELD_TYPE (type, i));
+ struct type *field_type = ada_check_typedef (TYPE_FIELD_TYPE (type,
+ i));
for (j = TYPE_NFIELDS (field_type) - 1; j >= 0; j -= 1)
{
is_unchecked_variant (struct type *var_type, struct type *outer_type)
{
char *discrim_name = ada_variant_discrim_name (var_type);
+
return (ada_lookup_struct_elt_type (outer_type, discrim_name, 0, 1, NULL)
== NULL);
}
ada_value_ind (struct value *val0)
{
struct value *val = unwrap_value (value_ind (val0));
+
return ada_to_fixed_value (val);
}
if (TYPE_CODE (value_type (val0)) == TYPE_CODE_REF)
{
struct value *val = val0;
+
val = coerce_ref (val);
val = unwrap_value (val);
return ada_to_fixed_value (val);
else
{
const int rename_len = strlen (name) + 6;
+
rename = (char *) alloca (rename_len * sizeof (char));
xsnprintf (rename, rename_len * sizeof (char), "%s___XR", name);
}
else
{
int len = strlen (ada_type_name (type));
+
if (len > 6 && strcmp (ada_type_name (type) + len - 6, "___XVE") == 0)
return type;
else
is_dynamic_field (struct type *templ_type, int field_num)
{
const char *name = TYPE_FIELD_NAME (templ_type, field_num);
+
return name != NULL
&& TYPE_CODE (TYPE_FIELD_TYPE (templ_type, field_num)) == TYPE_CODE_PTR
&& strstr (name, "___XVL") != NULL;
empty_record (struct type *template)
{
struct type *type = alloc_type_copy (template);
+
TYPE_CODE (type) = TYPE_CODE_STRUCT;
TYPE_NFIELDS (type) = 0;
TYPE_FIELDS (type) = NULL;
int nfields, bit_len;
int variant_field;
long off;
- int fld_bit_len, bit_incr;
+ int fld_bit_len;
int f;
/* Compute the number of fields in this record type that are going
if (ada_is_variant_part (type, f))
{
variant_field = f;
- fld_bit_len = bit_incr = 0;
+ fld_bit_len = 0;
}
else if (is_dynamic_field (type, f))
{
field_type = ada_get_base_type (field_type);
field_type = ada_to_fixed_type (field_type, field_valaddr,
field_address, dval, 0);
+ /* If the field size is already larger than the maximum
+ object size, then the record itself will necessarily
+ be larger than the maximum object size. We need to make
+ this check now, because the size might be so ridiculously
+ 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);
TYPE_FIELD_TYPE (rtype, f) = field_type;
TYPE_FIELD_NAME (rtype, f) = TYPE_FIELD_NAME (type, f);
- bit_incr = fld_bit_len =
+ /* The multiplication can potentially overflow. But because
+ the field length has been size-checked just above, and
+ assuming that the maximum size is a reasonable value,
+ an overflow should not happen in practice. So rather than
+ adding overflow recovery code to this already complex code,
+ we just assume that it's not going to happen. */
+ fld_bit_len =
TYPE_LENGTH (TYPE_FIELD_TYPE (rtype, f)) * TARGET_CHAR_BIT;
}
else
TYPE_FIELD_TYPE (rtype, f) = field_type;
TYPE_FIELD_NAME (rtype, f) = TYPE_FIELD_NAME (type, f);
if (TYPE_FIELD_BITSIZE (type, f) > 0)
- bit_incr = fld_bit_len =
+ fld_bit_len =
TYPE_FIELD_BITSIZE (rtype, f) = TYPE_FIELD_BITSIZE (type, f);
else
- bit_incr = fld_bit_len =
+ fld_bit_len =
TYPE_LENGTH (ada_check_typedef (field_type)) * TARGET_CHAR_BIT;
}
if (off + fld_bit_len > bit_len)
bit_len = off + fld_bit_len;
- off += bit_incr;
+ off += fld_bit_len;
TYPE_LENGTH (rtype) =
align_value (bit_len, TARGET_CHAR_BIT) / TARGET_CHAR_BIT;
}
if (branch_type == NULL)
{
int f;
+
for (f = variant_field + 1; f < nfields; f += 1)
TYPE_FIELDS (rtype)[f - 1] = TYPE_FIELDS (rtype)[f];
TYPE_NFIELDS (rtype) -= 1;
type0 = decode_constrained_packed_array_type (type0);
index_type_desc = ada_find_parallel_type (type0, "___XA");
+ ada_fixup_array_indexes_type (index_type_desc);
if (index_type_desc == NULL)
{
struct type *elt_type0 = ada_check_typedef (TYPE_TARGET_TYPE (type0));
+
/* NOTE: elt_type---the fixed version of elt_type0---should never
depend on the contents of the array in properly constructed
debugging data. */
for (i = TYPE_NFIELDS (index_type_desc) - 1; i >= 0; i -= 1)
{
struct type *range_type =
- to_fixed_range_type (TYPE_FIELD_NAME (index_type_desc, i),
- dval, TYPE_INDEX_TYPE (elt_type0));
+ to_fixed_range_type (TYPE_FIELD_TYPE (index_type_desc, i), dval);
+
result = create_array_type (alloc_type_copy (elt_type0),
result, range_type);
elt_type0 = TYPE_TARGET_TYPE (elt_type0);
struct type *static_type = to_static_fixed_type (type);
struct type *fixed_record_type =
to_fixed_record_type (type, valaddr, address, NULL);
+
/* If STATIC_TYPE is a tagged type and we know the object's address,
then we can determine its tag, and compute the object's actual
type from there. Note that we have to use the fixed record
(fixed_record_type,
valaddr,
address));
+
if (real_type != NULL)
return to_fixed_record_type (real_type, valaddr, address, NULL);
}
/* The same as ada_to_fixed_type_1, except that it preserves the type
if it is a TYPE_CODE_TYPEDEF of a type that is already fixed.
- ada_to_fixed_type_1 would return the type referenced by TYPE. */
+
+ The typedef layer needs be preserved in order to differentiate between
+ arrays and array pointers when both types are implemented using the same
+ fat pointer. In the array pointer case, the pointer is encoded as
+ a typedef of the pointer type. For instance, considering:
+
+ type String_Access is access String;
+ S1 : String_Access := null;
+
+ To the debugger, S1 is defined as a typedef of type String. But
+ to the user, it is a pointer. So if the user tries to print S1,
+ we should not dereference the array, but print the array address
+ instead.
+
+ If we didn't preserve the typedef layer, we would lose the fact that
+ the type is to be presented as a pointer (needs de-reference before
+ being printed). And we would also use the source-level type name. */
struct type *
ada_to_fixed_type (struct type *type, const gdb_byte *valaddr,
struct type *fixed_type =
ada_to_fixed_type_1 (type, valaddr, address, dval, check_tag);
+ /* If TYPE is a typedef and its target type is the same as the FIXED_TYPE,
+ then preserve the typedef layer.
+
+ Implementation note: We can only check the main-type portion of
+ the TYPE and FIXED_TYPE, because eliminating the typedef layer
+ from TYPE now returns a type that has the same instance flags
+ as TYPE. For instance, if TYPE is a "typedef const", and its
+ target type is a "struct", then the typedef elimination will return
+ a "const" version of the target type. See check_typedef for more
+ details about how the typedef layer elimination is done.
+
+ brobecker/2010-11-19: It seems to me that the only case where it is
+ useful to preserve the typedef layer is when dealing with fat pointers.
+ Perhaps, we could add a check for that and preserve the typedef layer
+ only in that situation. But this seems unecessary so far, probably
+ because we call check_typedef/ada_check_typedef pretty much everywhere.
+ */
if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF
- && TYPE_TARGET_TYPE (type) == fixed_type)
+ && (TYPE_MAIN_TYPE (TYPE_TARGET_TYPE (type))
+ == TYPE_MAIN_TYPE (fixed_type)))
return type;
return fixed_type;
else
{
struct type *raw_real_type = ada_get_base_type (type);
+
if (raw_real_type == type)
return type;
else
{
char *name = TYPE_TAG_NAME (type);
struct type *type1 = ada_find_any_type (name);
- return (type1 == NULL) ? type : type1;
+
+ if (type1 == NULL)
+ return type;
+
+ /* TYPE1 might itself be a TYPE_CODE_TYPEDEF (this can happen with
+ stubs pointing to arrays, as we don't create symbols for array
+ types, only for the typedef-to-array types). If that's the case,
+ strip the typedef layer. */
+ if (TYPE_CODE (type1) == TYPE_CODE_TYPEDEF)
+ type1 = ada_check_typedef (type1);
+
+ return type1;
}
}
struct value *val0)
{
struct type *type = ada_to_fixed_type (type0, 0, address, NULL, 1);
+
if (type == type0 && val0 != NULL)
return val0;
else
that correctly describes it. Does not necessarily create a new
value. */
-static struct value *
+struct value *
ada_to_fixed_value (struct value *val)
{
return ada_to_fixed_value_create (value_type (val),
value_address (val),
val);
}
-
-/* A value representing VAL, but with a standard (static-sized) type
- chosen to approximate the real type of VAL as well as possible, but
- without consulting any runtime values. For Ada dynamic-sized
- types, therefore, the type of the result is likely to be inaccurate. */
-
-static struct value *
-ada_to_static_fixed_value (struct value *val)
-{
- struct type *type =
- to_static_fixed_type (static_unwrap_type (value_type (val)));
- if (type == value_type (val))
- return val;
- else
- return coerce_unspec_val_to_type (val, type);
-}
\f
/* Attributes */
if (TYPE_CODE (type) == TYPE_CODE_ENUM)
{
long pos = value_as_long (arg);
+
if (pos < 0 || pos >= TYPE_NFIELDS (type))
error (_("argument to 'VAL out of range"));
return value_from_longest (type, TYPE_FIELD_BITPOS (type, pos));
if (name[0] == 'Q')
{
int v;
+
if (name[1] == 'U' || name[1] == 'W')
{
if (sscanf (name + 2, "%x", &v) != 1)
unwrap_value (struct value *val)
{
struct type *type = ada_check_typedef (value_type (val));
+
if (ada_is_aligner_type (type))
{
struct value *v = ada_value_struct_elt (val, "F", 0);
struct type *val_type = ada_check_typedef (value_type (v));
+
if (ada_type_name (val_type) == NULL)
TYPE_NAME (val_type) = ada_type_name (type);
else
{
DOUBLEST argd = value_as_double (arg);
+
val = ada_float_to_fixed (type, argd);
}
{
DOUBLEST val = ada_fixed_to_float (value_type (arg),
value_as_long (arg));
+
return value_from_double (type, val);
}
coerce_for_assign (struct type *type, struct value *val)
{
struct type *type2 = value_type (val);
+
if (type == type2)
return val;
num_component_specs (struct expression *exp, int pc)
{
int n, m, i;
+
m = exp->elts[pc + 1].longconst;
pc += 3;
n = 0;
{
struct value *mark = value_mark ();
struct value *elt;
+
if (TYPE_CODE (value_type (lhs)) == TYPE_CODE_ARRAY)
{
struct type *index_type = builtin_type (exp->gdbarch)->builtin_int;
struct value *index_val = value_from_longest (index_type, index);
+
elt = unwrap_value (ada_value_subscript (lhs, 1, &index_val));
}
else
int max_indices, num_indices;
int is_array_aggregate;
int i;
- struct value *mark = value_mark ();
*pos += 3;
if (noside != EVAL_NORMAL)
{
int i;
+
for (i = 0; i < n; i += 1)
ada_evaluate_subexp (NULL, exp, pos, noside);
return container;
{
LONGEST lower, upper;
enum exp_opcode op = exp->elts[choice_pos].opcode;
+
if (op == OP_DISCRETE_RANGE)
{
choice_pos += 1;
{
int ind;
char *name;
+
switch (op)
{
case OP_NAME:
while (lower <= upper)
{
int pos1;
+
pos1 = expr_pc;
assign_component (container, lhs, lower, exp, &pos1);
lower += 1;
for (i = 0; i < num_indices - 2; i += 2)
{
LONGEST ind;
+
for (ind = indices[i + 1] + 1; ind < indices[i + 2]; ind += 1)
{
int pos;
+
pos = expr_pc;
assign_component (container, lhs, ind, exp, &pos);
}
LONGEST* indices, int *size, int max_size)
{
int i, j;
+
for (i = 0; i < *size; i += 2) {
if (high >= indices[i] && low <= indices[i + 1])
{
int kh;
+
for (kh = i + 2; kh < *size; kh += 2)
if (high < indices[kh])
break;
int *pos, enum noside noside)
{
enum exp_opcode op;
- int tem, tem2, tem3;
+ int tem;
int pc;
struct value *arg1 = NULL, *arg2 = NULL, *arg3;
struct type *type;
case OP_STRING:
{
struct value *result;
+
*pos -= 1;
result = evaluate_subexp_standard (expect_type, exp, pos, noside);
/* The result type will have code OP_STRING, bashed there from
else if (noside == EVAL_AVOID_SIDE_EFFECTS)
{
type = static_unwrap_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
- if (ada_is_tagged_type (type, 0))
+ /* Check to see if this is a tagged type. We also need to handle
+ the case where the type is a reference to a tagged type, but
+ we have to be careful to exclude pointers to tagged types.
+ The latter should be shown as usual (as a pointer), whereas
+ a reference should mostly be transparent to the user. */
+ if (ada_is_tagged_type (type, 0)
+ || (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
evaluate_subexp (NULL_TYPE, exp, pos, noside);
LONGEST low_bound;
LONGEST high_bound;
+
low_bound_val = coerce_ref (low_bound_val);
high_bound_val = coerce_ref (high_bound_val);
low_bound = pos_atr (low_bound_val);
struct type *arr_type0 =
to_fixed_array_type (TYPE_TARGET_TYPE (value_type (array)),
NULL, 1);
+
return ada_value_slice_from_ptr (array, arr_type0,
longest_to_int (low_bound),
longest_to_int (high_bound));
case OP_ATR_LENGTH:
{
struct type *type_arg;
+
if (exp->elts[*pos].opcode == OP_TYPE)
{
evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
{
struct type *range_type;
char *name = ada_type_name (type_arg);
+
range_type = NULL;
if (name != NULL && TYPE_CODE (type_arg) != TYPE_CODE_ENUM)
- range_type = to_fixed_range_type (name, NULL, type_arg);
+ range_type = to_fixed_range_type (type_arg, NULL);
if (range_type == NULL)
range_type = type_arg;
switch (op)
case OP_ATR_MODULUS:
{
struct type *type_arg = check_typedef (exp->elts[pc + 2].type);
- evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
+ evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
if (noside == EVAL_SKIP)
goto nosideret;
/* GDB allows dereferencing GNAT array descriptors. */
{
struct type *arrType = ada_type_of_array (arg1, 0);
+
if (arrType == NULL)
error (_("Attempt to dereference null array pointer."));
return value_at_lazy (arrType, 0);
if (noside == EVAL_AVOID_SIDE_EFFECTS)
{
struct type *type1 = value_type (arg1);
+
if (ada_is_tagged_type (type1, 1))
{
type = ada_lookup_struct_elt_type (type1,
if ((code == TYPE_CODE_INT || code == TYPE_CODE_RANGE) && name != NULL)
{
const char *tail = strstr (name, "___XF_");
+
if (tail == NULL)
return NULL;
else
in NAME, the base type given in the named range type. */
static struct type *
-to_fixed_range_type (char *name, struct value *dval, struct type *orig_type)
+to_fixed_range_type (struct type *raw_type, struct value *dval)
{
- struct type *raw_type = ada_find_any_type (name);
+ char *name;
struct type *base_type;
char *subtype_info;
- /* Fall back to the original type if symbol lookup failed. */
- if (raw_type == NULL)
- raw_type = orig_type;
+ gdb_assert (raw_type != NULL);
+ gdb_assert (TYPE_NAME (raw_type) != NULL);
if (TYPE_CODE (raw_type) == TYPE_CODE_RANGE)
base_type = TYPE_TARGET_TYPE (raw_type);
else
base_type = raw_type;
+ name = TYPE_NAME (raw_type);
subtype_info = strstr (name, "___XD");
if (subtype_info == NULL)
{
LONGEST L = ada_discrete_type_low_bound (raw_type);
LONGEST U = ada_discrete_type_high_bound (raw_type);
+
if (L < INT_MIN || U > INT_MAX)
return raw_type;
else
- return create_range_type (alloc_type_copy (orig_type), raw_type,
+ 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));
}
else
{
int ok;
+
strcpy (name_buf + prefix_len, "___L");
L = get_int_var_value (name_buf, &ok);
if (!ok)
else
{
int ok;
+
strcpy (name_buf + prefix_len, "___U");
U = get_int_var_value (name_buf, &ok);
if (!ok)
}
}
- type = create_range_type (alloc_type_copy (orig_type), base_type, L, U);
+ type = create_range_type (alloc_type_copy (raw_type), base_type, L, U);
TYPE_NAME (type) = name;
return type;
}
started yet. Inform the user of these two possible causes if
applicable. */
- if (ada_update_initial_language (language_unknown, NULL) != language_ada)
+ if (ada_update_initial_language (language_unknown) != language_ada)
error (_("Unable to insert catchpoint. Is this an Ada main program?"));
/* If the symbol does not exist, then check that the program is
exception_info = NULL;
}
-/* Return the name of the function at PC, NULL if could not find it.
- This function only checks the debugging information, not the symbol
- table. */
-
-static char *
-function_name_from_pc (CORE_ADDR pc)
-{
- char *func_name;
-
- if (!find_pc_partial_function (pc, &func_name, NULL, NULL))
- return NULL;
-
- return func_name;
-}
-
/* True iff FRAME is very likely to be that of a function that is
part of the runtime system. This is all very heuristic, but is
intended to be used as advice as to what frames are uninteresting
{
struct symtab_and_line sal;
char *func_name;
+ enum language func_lang;
int i;
/* If this code does not have any debugging information (no symtab),
/* Check whether the function is a GNAT-generated entity. */
- func_name = function_name_from_pc (get_frame_address_in_block (frame));
+ find_frame_funname (frame, &func_name, &func_lang, NULL);
if (func_name == NULL)
return 1;
while (fi != NULL)
{
- const char *func_name =
- function_name_from_pc (get_frame_address_in_block (fi));
+ char *func_name;
+ enum language func_lang;
+
+ find_frame_funname (fi, &func_name, &func_lang, NULL);
if (func_name != NULL
&& strcmp (func_name, exception_info->catch_exception_sym) == 0)
break; /* We found the frame we were looking for... */
}
}
+/* Implement the PRINT_RECREATE method in the breakpoint_ops structure
+ for all exception catchpoint kinds. */
+
+static void
+print_recreate_exception (enum exception_catchpoint_kind ex,
+ struct breakpoint *b, struct ui_file *fp)
+{
+ switch (ex)
+ {
+ case ex_catch_exception:
+ fprintf_filtered (fp, "catch exception");
+ if (b->exp_string != NULL)
+ fprintf_filtered (fp, " %s", b->exp_string);
+ break;
+
+ case ex_catch_exception_unhandled:
+ fprintf_filtered (fp, "catch exception unhandled");
+ break;
+
+ case ex_catch_assert:
+ fprintf_filtered (fp, "catch assert");
+ break;
+
+ default:
+ internal_error (__FILE__, __LINE__, _("unexpected catchpoint type"));
+ }
+}
+
/* Virtual table for "catch exception" breakpoints. */
static enum print_stop_action
print_mention_exception (ex_catch_exception, b);
}
+static void
+print_recreate_catch_exception (struct breakpoint *b, struct ui_file *fp)
+{
+ print_recreate_exception (ex_catch_exception, b, fp);
+}
+
static struct breakpoint_ops catch_exception_breakpoint_ops =
{
NULL, /* insert */
NULL, /* breakpoint_hit */
print_it_catch_exception,
print_one_catch_exception,
- print_mention_catch_exception
+ print_mention_catch_exception,
+ print_recreate_catch_exception
};
/* Virtual table for "catch exception unhandled" breakpoints. */
print_mention_exception (ex_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);
+}
+
static struct breakpoint_ops catch_exception_unhandled_breakpoint_ops = {
NULL, /* insert */
NULL, /* remove */
NULL, /* breakpoint_hit */
print_it_catch_exception_unhandled,
print_one_catch_exception_unhandled,
- print_mention_catch_exception_unhandled
+ print_mention_catch_exception_unhandled,
+ print_recreate_catch_exception_unhandled
};
/* Virtual table for "catch assert" breakpoints. */
print_mention_exception (ex_catch_assert, b);
}
+static void
+print_recreate_catch_assert (struct breakpoint *b, struct ui_file *fp)
+{
+ print_recreate_exception (ex_catch_assert, b, fp);
+}
+
static struct breakpoint_ops catch_assert_breakpoint_ops = {
NULL, /* insert */
NULL, /* remove */
NULL, /* breakpoint_hit */
print_it_catch_assert,
print_one_catch_assert,
- print_mention_catch_assert
+ print_mention_catch_assert,
+ print_recreate_catch_assert
};
/* Return non-zero if B is an Ada exception catchpoint. */
OP_DEFN (OP_DISCRETE_RANGE, 1, 2, 0)
static void
-ada_operator_length (struct expression *exp, int pc, int *oplenp, int *argsp)
+ada_operator_length (const struct expression *exp, int pc, int *oplenp,
+ int *argsp)
{
switch (exp->elts[pc - 1].opcode)
{
}
}
+/* Implementation of the exp_descriptor method operator_check. */
+
+static int
+ada_operator_check (struct expression *exp, int pos,
+ int (*objfile_func) (struct objfile *objfile, void *data),
+ void *data)
+{
+ const union exp_element *const elts = exp->elts;
+ struct type *type = NULL;
+
+ switch (elts[pos].opcode)
+ {
+ case UNOP_IN_RANGE:
+ case UNOP_QUAL:
+ type = elts[pos + 1].type;
+ break;
+
+ default:
+ return operator_check_standard (exp, pos, objfile_func, data);
+ }
+
+ /* Invoke callbacks for TYPE and OBJFILE if they were set as non-NULL. */
+
+ if (type && TYPE_OBJFILE (type)
+ && (*objfile_func) (TYPE_OBJFILE (type), data))
+ return 1;
+
+ return 0;
+}
+
static char *
ada_op_name (enum exp_opcode opcode)
{
case OP_NAME:
{
int len = longest_to_int (exp->elts[pc + 1].longconst);
+
*oplenp = 4 + BYTES_TO_EXP_ELEM (len + 1);
*argsp = 0;
break;
{
char *name = &exp->elts[elt + 2].string;
int len = longest_to_int (exp->elts[elt + 1].longconst);
+
fprintf_filtered (stream, "Text: `%.*s'", len, name);
break;
}
if (nargs > 1)
{
int tem;
+
for (tem = 1; tem < nargs; tem += 1)
{
fputs_filtered ((tem == 1) ? " (" : ", ", stream);
struct language_arch_info *lai)
{
const struct builtin_type *builtin = builtin_type (gdbarch);
+
lai->primitive_type_vector
= GDBARCH_OBSTACK_CALLOC (gdbarch, nr_ada_primitive_types + 1,
struct type *);
static const struct exp_descriptor ada_exp_descriptor = {
ada_print_subexp,
ada_operator_length,
+ ada_operator_check,
ada_op_name,
ada_dump_subexp_body,
ada_evaluate_subexp
ada_printstr, /* Function to print string constant */
emit_char, /* Function to print single char (not used) */
ada_print_type, /* Print a type using appropriate syntax */
- default_print_typedef, /* Print a typedef using appropriate syntax */
+ ada_print_typedef, /* Print a typedef using appropriate syntax */
ada_val_print, /* Print a value using appropriate syntax */
ada_value_print, /* Print a top-level value */
NULL, /* Language specific skip_trampoline */
NULL, xcalloc, xfree);
observer_attach_executable_changed (ada_executable_changed_observer);
+
+ /* Setup per-inferior data. */
+ observer_attach_inferior_exit (ada_inferior_exit);
+ ada_inferior_data
+ = register_inferior_data_with_cleanup (ada_inferior_data_cleanup);
}
projects / binutils-gdb.git / blobdiff