#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 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 *);
/* 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);
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);
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);
}
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);
}
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_pointer (ensure_lval (arr, gdbarch, sp),
- TYPE_FIELD_TYPE (desc_type, 0)),
- 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_pointer (bounds,
- TYPE_FIELD_TYPE (desc_type, 1)),
- 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
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;
}
/* An object of this type is used as the user_data argument when
- calling the map_ada_symtabs method. */
+ calling the map_matching_symbols method. */
-struct ada_psym_data
+struct match_data
{
+ struct objfile *objfile;
struct obstack *obstackp;
- const char *name;
- domain_enum domain;
- int global;
- int wild_match;
+ struct symbol *arg_sym;
+ int found_sym;
};
-/* Callback function for map_ada_symtabs. */
+/* 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 void
-ada_add_psyms (struct objfile *objfile, struct symtab *s, void *user_data)
+static int
+aux_add_nonlocal_symbols (struct block *block, struct symbol *sym, void *data0)
{
- struct ada_psym_data *data = user_data;
- const int block_kind = data->global ? GLOBAL_BLOCK : STATIC_BLOCK;
- ada_add_block_symbols (data->obstackp,
- BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), block_kind),
- data->name, data->domain, objfile, data->wild_match);
+ 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
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 is_wild_match)
+add_nonlocal_symbols (struct obstack *obstackp, const char *name,
+ domain_enum domain, int global,
+ int is_wild_match)
{
struct objfile *objfile;
- struct ada_psym_data data;
+ struct match_data data;
data.obstackp = obstackp;
- data.name = name;
- data.domain = domain;
- data.global = global;
- data.wild_match = is_wild_match;
+ data.arg_sym = NULL;
ALL_OBJFILES (objfile)
- {
- if (objfile->sf)
- objfile->sf->qf->map_ada_symtabs (objfile, wild_match, is_name_suffix,
- ada_add_psyms, name,
- global, domain,
- is_wild_match, &data);
- }
+ {
+ 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);
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;
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);
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
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
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;
}
/* Check whether the function is a GNAT-generated entity. */
- find_frame_funname (frame, &func_name, &func_lang);
+ find_frame_funname (frame, &func_name, &func_lang, NULL);
if (func_name == NULL)
return 1;
char *func_name;
enum language func_lang;
- find_frame_funname (fi, &func_name, &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... */
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)
{
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 *);
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