#include "value.h"
/* Define whether or not the C operator '/' truncates towards zero for
- differently signed operands (truncation direction is undefined in C).
+ differently signed operands (truncation direction is undefined in C).
Copied from valarith.c. */
#ifndef TRUNCATION_TOWARDS_ZERO
#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 int full_match (const char *, const char *);
+
static struct value *make_array_descriptor (struct type *, struct value *);
static void ada_add_block_symbols (struct obstack *,
struct value **, int, const char *,
struct type *);
-static struct value *ada_coerce_to_simple_array (struct value *);
-
static int ada_is_direct_array_type (struct type *);
static void ada_language_arch_info (struct gdbarch *,
struct type *);
static struct value *assign_aggregate (struct value *, struct value *,
- struct expression *, int *, enum noside);
+ struct expression *,
+ int *, enum noside);
static void aggregate_assign_from_choices (struct value *, struct value *,
struct expression *,
/* Utilities */
+/* If TYPE is a TYPE_CODE_TYPEDEF type, return the target type after
+ all typedef layers have been peeled. Otherwise, return TYPE.
+
+ Normally, we really expect a typedef type to only have 1 typedef layer.
+ In other words, we really expect the target type of a typedef type to be
+ a non-typedef type. This is particularly true for Ada units, because
+ the language does not have a typedef vs not-typedef distinction.
+ In that respect, the Ada compiler has been trying to eliminate as many
+ typedef definitions in the debugging information, since they generally
+ do not bring any extra information (we still use typedef under certain
+ circumstances related mostly to the GNAT encoding).
+
+ Unfortunately, we have seen situations where the debugging information
+ generated by the compiler leads to such multiple typedef layers. For
+ instance, consider the following example with stabs:
+
+ .stabs "pck__float_array___XUP:Tt(0,46)=s16P_ARRAY:(0,47)=[...]"[...]
+ .stabs "pck__float_array___XUP:t(0,36)=(0,46)",128,0,6,0
+
+ This is an error in the debugging information which causes type
+ pck__float_array___XUP to be defined twice, and the second time,
+ it is defined as a typedef of a typedef.
+
+ This is on the fringe of legality as far as debugging information is
+ concerned, and certainly unexpected. But it is easy to handle these
+ situations correctly, so we can afford to be lenient in this case. */
+
+static struct type *
+ada_typedef_target_type (struct type *type)
+{
+ while (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)
+ type = TYPE_TARGET_TYPE (type);
+ return type;
+}
+
/* Given DECODED_NAME a string holding a symbol name in its
decoded form (ie using the Ada dotted notation), returns
its unqualified name. */
error (_("object size is larger than varsize-limit"));
}
-/* Maximum value of a SIZE-byte signed integer type. */
+/* Maximum value of a SIZE-byte signed integer type. */
static LONGEST
max_of_size (int size)
{
return top_bit | (top_bit - 1);
}
-/* Minimum value of a SIZE-byte signed integer type. */
+/* Minimum value of a SIZE-byte signed integer type. */
static LONGEST
min_of_size (int size)
{
return -max_of_size (size) - 1;
}
-/* Maximum value of a SIZE-byte unsigned integer type. */
+/* Maximum value of a SIZE-byte unsigned integer type. */
static ULONGEST
umax_of_size (int size)
{
return top_bit | (top_bit - 1);
}
-/* Maximum value of integral type T, as a signed quantity. */
+/* Maximum value of integral type T, as a signed quantity. */
static LONGEST
max_of_type (struct type *t)
{
return max_of_size (TYPE_LENGTH (t));
}
-/* Minimum value of integral type T, as a signed quantity. */
+/* Minimum value of integral type T, as a signed quantity. */
static LONGEST
min_of_type (struct type *t)
{
/* Protected entry subprograms are broken into two
separate subprograms: The first one is unprotected, and has
a 'N' suffix; the second is the protected version, and has
- the 'P' suffix. The second calls the first one after handling
+ the 'P' suffix. The second calls the first one after handling
the protection. Since the P subprograms are internally generated,
we leave these names undecoded, giving the user a clue that this
entity is internal. */
/* Remove _E{DIGITS}+[sb] */
/* Just as for protected object subprograms, there are 2 categories
- of subprograms created by the compiler for each entry. The first
+ of subprograms created by the compiler for each entry. The first
one implements the actual entry code, and has a suffix following
the convention above; the second one implements the barrier and
uses the same convention as above, except that the 'E' is replaced
previously computed. Tries to save the decoded name in the same
obstack as GSYMBOL, if possible, and otherwise on the heap (so that,
in any case, the decoded symbol has a lifetime at least that of
- GSYMBOL).
+ GSYMBOL).
The GSYMBOL parameter is "mutable" in the C++ sense: logically
const, but nevertheless modified to a semantically equivalent form
- when a decoded name is cached in it.
-*/
+ when a decoded name is cached in it. */
char *
ada_decode_symbol (const struct general_symbol_info *gsymbol)
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;
#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). */
if (type == NULL)
return NULL;
type = ada_check_typedef (type);
+ if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)
+ type = ada_typedef_target_type (type);
+
if (type != NULL
&& (TYPE_CODE (type) == TYPE_CODE_PTR
|| TYPE_CODE (type) == TYPE_CODE_REF))
}
/* Non-zero iff TYPE represents any kind of array in Ada, or a pointer
- * to one. */
+ * to one. */
static int
ada_is_array_type (struct type *type)
Otherwise, returns a standard GDB array describing ARR (which may
be ARR itself if it already is in the proper form). */
-static struct value *
+struct value *
ada_coerce_to_simple_array (struct value *arr)
{
if (ada_is_array_descriptor_type (value_type (arr)))
static long
decode_packed_array_bitsize (struct type *type)
{
- char *raw_name = ada_type_name (ada_check_typedef (type));
+ char *raw_name;
char *tail;
long bits;
+ /* Access to arrays implemented as fat pointers are encoded as a typedef
+ of the fat pointer type. We need the name of the fat pointer type
+ to do the decoding, so strip the typedef layer. */
+ if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)
+ type = ada_typedef_target_type (type);
+
+ raw_name = ada_type_name (ada_check_typedef (type));
if (!raw_name)
raw_name = ada_type_name (desc_base_type (type));
return 0;
tail = strstr (raw_name, "___XP");
+ gdb_assert (tail != NULL);
if (sscanf (tail + sizeof ("___XP") - 1, "%ld", &bits) != 1)
{
if (TYPE_CODE (shadow_type) != TYPE_CODE_ARRAY)
{
- lim_warning (_("could not understand bounds information on packed array"));
+ lim_warning (_("could not understand bounds "
+ "information on packed array"));
return NULL;
}
if (TYPE_CODE (elt_type) != TYPE_CODE_ARRAY
|| TYPE_FIELD_BITSIZE (elt_type, 0) == 0)
error
- (_("attempt to do packed indexing of something other than a packed array"));
+ (_("attempt to do packed indexing of "
+ "something other than a packed array"));
else
{
struct type *range_type = TYPE_INDEX_TYPE (elt_type);
idx = pos_atr (ind[i]);
if (idx < lowerbound || idx > upperbound)
- lim_warning (_("packed array index %ld out of bounds"), (long) idx);
+ lim_warning (_("packed array index %ld out of bounds"),
+ (long) idx);
bits = TYPE_FIELD_BITSIZE (elt_type, 0);
elt_total_bit_offset += (idx - lowerbound) * bits;
elt_type = ada_check_typedef (TYPE_TARGET_TYPE (elt_type));
/* Create a new value of type TYPE from the contents of OBJ starting
at byte OFFSET, and bit offset BIT_OFFSET within that byte,
proceeding for BIT_SIZE bits. If OBJ is an lval in memory, then
- assigning through the result will set the field fetched from.
+ assigning through the result will set the field fetched from.
VALADDR is ignored unless OBJ is NULL, in which case,
VALADDR+OFFSET must address the start of storage containing the
packed value. The value returned in this case is never an lval.
/* Given that ARRAY_PTR is a pointer or reference to an array of type TYPE (the
actual type of ARRAY_PTR is ignored), returns the Ada slice of HIGH-LOW+1
elements starting at index LOW. The lower bound of this array is LOW, as
- per Ada rules. */
+ per Ada rules. */
static struct value *
ada_value_slice_from_ptr (struct value *array_ptr, struct type *type,
int low, int high)
sets *LEN to the length of the renamed entity's name,
*RENAMED_ENTITY to that name (not null-terminated), and *RENAMING_EXPR to
the string describing the subcomponent selected from the renamed
- entity. Returns ADA_NOT_RENAMING if SYM does not encode a renaming
+ entity. Returns ADA_NOT_RENAMING if SYM does not encode a renaming
(in which case, the values of *RENAMED_ENTITY, *LEN, and *RENAMING_EXPR
are undefined). Otherwise, returns a value indicating the category
of entity renamed: an object (ADA_OBJECT_RENAMING), exception
struct value *bounds = allocate_value (bounds_type);
int i;
- for (i = ada_array_arity (ada_check_typedef (value_type (arr))); i > 0; i -= 1)
+ 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);
- modify_general_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_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);
}
\f
/* Dummy definitions for an experimental caching module that is not
- * used in the public sources. */
+ * used in the public sources. */
static int
lookup_cached_symbol (const char *name, domain_enum namespace,
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;
}
xget_renaming_scope (struct type *renaming_type)
{
/* The renaming types adhere to the following convention:
- <scope>__<rename>___<XR extension>.
+ <scope>__<rename>___<XR extension>.
So, to extract the scope, we search for the "___XR" extension,
and then backtrack until we find the first "__". */
/* If there is both a renaming foo___XR... encoded as a variable and
a simple variable foo in the same block, discard the latter.
- First, zero out such symbols, then compress. */
+ First, zero out such symbols, then compress. */
is_new_style_renaming = 0;
for (i = 0; i < nsyms; i += 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;
+ 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;
+}
- ada_add_block_symbols (data->obstackp,
- BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), block_kind),
- data->name, data->domain, objfile, data->wild_match);
+/* 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 a symbol in DOMAIN matching NAME, in BLOCK0 and enclosing
scope and in global scopes, or NULL if none. NAME is folded and
encoded first. Otherwise, the result is as for ada_lookup_symbol_list,
- choosing the first symbol if there are multiple choices.
+ choosing the first symbol if there are multiple choices.
*IS_A_FIELD_OF_THIS is set to 0 and *SYMTAB is set to the symbol
table in which the symbol was found (in both cases, these
assignments occur only if the pointers are non-null). */
#if 0
/* FIXME: brobecker/2005-09-23: Protected Object subprograms end
- with a N at the end. Unfortunately, the compiler uses the same
- convention for other internal types it creates. So treating
+ with a N at the end. Unfortunately, the compiler uses the same
+ convention for other internal types it creates. So treating
all entity names that end with an "N" as a name suffix causes
- some regressions. For instance, consider the case of an enumerated
- type. To support the 'Image attribute, it creates an array whose
+ some regressions. For instance, consider the case of an enumerated
+ type. To support the 'Image attribute, it creates an array whose
name ends with N.
Having a single character like this as a suffix carrying some
- information is a bit risky. Perhaps we should change the encoding
+ information is a bit risky. Perhaps we should change the encoding
to be something like "_N" instead. In the meantime, do not do
the following check. */
/* Protected Object Subprograms */
}
}
+/* 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.
+ (if necessary). If WILD, treat as NAME with a wildcard prefix.
OBJFILE is the section containing BLOCK.
SYMTAB is recorded with each symbol added. */
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)
}
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);
}
- }
+ }
}
}
}
}
/* True iff TYPE has a tag field. If REFOK, then TYPE may also be a
- pointer or reference type whose ultimate target has a tag field. */
+ pointer or reference type whose ultimate target has a tag field. */
int
ada_is_tagged_type (struct type *type, int refok)
/* The value of the tag on the object of type TYPE whose contents are
saved at VALADDR, if it is non-null, or is at memory address
- ADDRESS. */
+ ADDRESS. */
static struct value *
value_tag_from_contents_and_address (struct type *type,
static int ada_tag_name_2 (struct tag_args *);
/* Wrapper function used by ada_tag_name. Given a struct tag_args*
- value ARGS, sets ARGS->name to the tag name of ARGS->tag.
+ value ARGS, sets ARGS->name to the tag name of ARGS->tag.
The value stored in ARGS->name is valid until the next call to
ada_tag_name_1. */
/* Utility function for ada_tag_name_1 that tries the second
representation for the dispatch table (in which there is no
explicit 'tsd' field in the referent of the tag pointer, and instead
- the tsd pointer is stored just before the dispatch table. */
+ the tsd pointer is stored just before the dispatch table. */
static int
ada_tag_name_2 (struct tag_args *args)
}
}
-/* FIXME: Lots of redundancy below. Try to consolidate. */
+/* FIXME: Lots of redundancy below. Try to consolidate. */
/* Given a value ARG1 (offset by OFFSET bytes) of a struct or union type
ARG_TYPE, extract and return the value of one of its (non-static)
number of fields if not found. A NULL value of NAME never
matches; the function just counts visible fields in this case.
- Returns 1 if found, 0 otherwise. */
+ Returns 1 if found, 0 otherwise. */
static int
find_struct_field (char *name, struct type *type, int offset,
return 0;
}
-/* Number of user-visible fields in record type TYPE. */
+/* Number of user-visible fields in record type TYPE. */
static int
num_visible_fields (struct type *type)
else if (ada_is_wrapper_field (type, i))
{
- struct value *v = /* Do not let indent join lines here. */
+ struct value *v = /* Do not let indent join lines here. */
ada_search_struct_field (name, arg,
offset + TYPE_FIELD_BITPOS (type, i) / 8,
TYPE_FIELD_TYPE (type, i));
else if (ada_is_variant_part (type, i))
{
- /* PNH: Do we ever get here? See find_struct_field. */
+ /* PNH: Do we ever get here? See find_struct_field. */
int j;
struct type *field_type = ada_check_typedef (TYPE_FIELD_TYPE (type,
i));
for (j = 0; j < TYPE_NFIELDS (field_type); j += 1)
{
- struct value *v = ada_search_struct_field /* Force line break. */
+ struct value *v = ada_search_struct_field /* Force line
+ break. */
(name, arg,
var_offset + TYPE_FIELD_BITPOS (field_type, j) / 8,
TYPE_FIELD_TYPE (field_type, j));
/* Return field #INDEX in ARG, where the index is that returned by
* find_struct_field through its INDEX_P argument. Adjust the address
* of ARG by OFFSET bytes, and search in it assuming it has (class) type TYPE.
- * If found, return value, else return NULL. */
+ * If found, return value, else return NULL. */
static struct value *
ada_index_struct_field (int index, struct value *arg, int offset,
/* Auxiliary function for ada_index_struct_field. Like
* ada_index_struct_field, but takes index from *INDEX_P and modifies
- * *INDEX_P. */
+ * *INDEX_P. */
static struct value *
ada_index_struct_field_1 (int *index_p, struct value *arg, int offset,
continue;
else if (ada_is_wrapper_field (type, i))
{
- struct value *v = /* Do not let indent join lines here. */
+ struct value *v = /* Do not let indent join lines here. */
ada_index_struct_field_1 (index_p, arg,
offset + TYPE_FIELD_BITPOS (type, i) / 8,
TYPE_FIELD_TYPE (type, i));
else if (ada_is_variant_part (type, i))
{
/* PNH: Do we ever get here? See ada_search_struct_field,
- find_struct_field. */
+ find_struct_field. */
error (_("Cannot assign this kind of variant record"));
}
else if (*index_p == 0)
if (no_err)
return NULL;
else
- error (_("Attempt to extract a component of a value that is not a record."));
+ error (_("Attempt to extract a component of "
+ "a value that is not a record."));
}
/* Given a type TYPE, look up the type of the component of type named NAME.
Matches any field whose name has NAME as a prefix, possibly
followed by "___".
- TYPE can be either a struct or union. If REFOK, TYPE may also
+ TYPE can be either a struct or union. If REFOK, TYPE may also
be a (pointer or reference)+ to a struct or union, and the
ultimate target type will be searched.
/* FIXME pnh 2008/01/26: We check for a field that is
NOT wrapped in a struct, since the compiler sometimes
generates these for unchecked variant types. Revisit
- if the compiler changes this practice. */
+ if the compiler changes this practice. */
char *v_field_name = TYPE_FIELD_NAME (field_type, j);
disp = 0;
if (v_field_name != NULL
&& field_name_match (v_field_name, name))
t = ada_check_typedef (TYPE_FIELD_TYPE (field_type, j));
else
- t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (field_type, j),
+ t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (field_type,
+ j),
name, 0, 1, &disp);
if (t != NULL)
/* Assuming that VAR_TYPE is the type of a variant part of a record (a union),
within a value of type OUTER_TYPE, return true iff VAR_TYPE
represents an unchecked union (that is, the variant part of a
- record that is named in an Unchecked_Union pragma). */
+ record that is named in an Unchecked_Union pragma). */
static int
is_unchecked_variant (struct type *var_type, struct type *outer_type)
if (sym != NULL)
return sym;
- /* Not right yet. FIXME pnh 7/20/2007. */
+ /* Not right yet. FIXME pnh 7/20/2007. */
sym = ada_find_any_symbol (name);
if (sym != NULL && strstr (SYMBOL_LINKAGE_NAME (sym), "___XR") != NULL)
return sym;
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))
{
/* rtype's length is computed based on the run-time
value of discriminants. If the discriminants are not
initialized, the type size may be completely bogus and
- GDB may fail to allocate a value for it. So check the
+ GDB may fail to allocate a value for it. So check the
size first before creating the value. */
check_size (rtype);
dval = value_from_contents_and_address (rtype, valaddr, address);
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
{
struct type *field_type = TYPE_FIELD_TYPE (type, f);
+ /* If our field is a typedef type (most likely a typedef of
+ a fat pointer, encoding an array access), then we need to
+ look at its target type to determine its characteristics.
+ In particular, we would miscompute the field size if we took
+ the size of the typedef (zero), instead of the size of
+ the target type. */
+ if (TYPE_CODE (field_type) == TYPE_CODE_TYPEDEF)
+ field_type = ada_typedef_target_type (field_type);
+
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;
}
should contain the alignment of that record, which should be a strictly
positive value. If null or negative, then something is wrong, most
probably in the debug info. In that case, we don't round up the size
- of the resulting type. If this record is not part of another structure,
+ of the resulting type. If this record is not part of another structure,
the current RTYPE length might be good enough for our purposes. */
if (TYPE_LENGTH (type) <= 0)
{
a record value. That is, this routine selects the appropriate
branch of the union at ADDR according to the discriminant value
indicated in the union's type name. Returns VAR_TYPE0 itself if
- it represents a variant subject to a pragma Unchecked_Union. */
+ it represents a variant subject to a pragma Unchecked_Union. */
static struct type *
to_fixed_variant_branch_type (struct type *var_type0, const gdb_byte *valaddr,
/* 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
+ type from there. Note that we have to use the fixed record
type (the parent part of the record may have dynamic fields
and the way the location of _tag is expressed may depend on
them). */
when using this type to create new types targeting it.
Indeed, the associated creation routines often check
whether the target type is a stub and will try to replace
- it, thus using a type with the wrong size. This, in turn,
+ it, thus using a type with the wrong size. This, in turn,
might cause the new type to have the wrong size too.
Consider the case of an array, for instance, where the size
of the array is computed from the number of elements in
/* 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 (ada_typedef_target_type (type))
+ == TYPE_MAIN_TYPE (fixed_type)))
return type;
return fixed_type;
if (type == NULL)
return NULL;
+ /* If our type is a typedef type of a fat pointer, then we're done.
+ We don't want to strip the TYPE_CODE_TYPDEF layer, because this is
+ what allows us to distinguish between fat pointers that represent
+ array types, and fat pointers that represent array access types
+ (in both cases, the compiler implements them as fat pointers). */
+ if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF
+ && is_thick_pntr (ada_typedef_target_type (type)))
+ return type;
+
CHECK_TYPEDEF (type);
if (type == NULL || TYPE_CODE (type) != TYPE_CODE_ENUM
|| !TYPE_STUB (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). This is why
- we process TYPE1 with ada_check_typedef before returning
- the result. */
- return ada_check_typedef (type1);
+ 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;
}
}
/* Total number of component associations in the aggregate starting at
index PC in EXP. Assumes that index PC is the start of an
- OP_AGGREGATE. */
+ OP_AGGREGATE. */
static int
num_component_specs (struct expression *exp, int pc)
aggregate. NOSIDE is as for evaluate_subexp. CONTAINER is an
lvalue containing LHS (possibly LHS itself). Does not modify
the inferior's memory, nor does it modify the contents of
- LHS (unless == CONTAINER). Returns the modified CONTAINER. */
+ LHS (unless == CONTAINER). Returns the modified CONTAINER. */
static struct value *
assign_aggregate (struct value *container,
the positions are relative to lower bound LOW, where HIGH is the
upper bound. Record the position in INDICES[0 .. MAX_INDICES-1]
updating *NUM_INDICES as needed. CONTAINER is as for
- assign_aggregate. */
+ assign_aggregate. */
static void
aggregate_assign_positional (struct value *container,
struct value *lhs, struct expression *exp,
construct at *POS, updating *POS past the construct, given that
the allowable indices are LOW..HIGH. Record the indices assigned
to in INDICES[0 .. MAX_INDICES-1], updating *NUM_INDICES as
- needed. CONTAINER is as for assign_aggregate. */
+ needed. CONTAINER is as for assign_aggregate. */
static void
aggregate_assign_from_choices (struct value *container,
struct value *lhs, struct expression *exp,
EXP at *POS into the components of LHS indexed from LOW .. HIGH that
have not been previously assigned. The index intervals already assigned
are in INDICES[0 .. NUM_INDICES-1]. Updates *POS to after the
- OP_OTHERS clause. CONTAINER is as for assign_aggregate*/
+ OP_OTHERS clause. CONTAINER is as for assign_aggregate. */
static void
aggregate_assign_others (struct value *container,
struct value *lhs, struct expression *exp,
if ((ada_is_fixed_point_type (value_type (arg1))
|| ada_is_fixed_point_type (value_type (arg2)))
&& value_type (arg1) != value_type (arg2))
- error (_("Operands of fixed-point subtraction must have the same type"));
+ error (_("Operands of fixed-point subtraction "
+ "must have the same type"));
/* Do the substraction, and cast the result to the type of the first
argument. We cannot cast the result to a reference type, so if
ARG1 is a reference type, find its underlying type. */
argvec[0] = value_addr (argvec[0]);
type = ada_check_typedef (value_type (argvec[0]));
+
+ /* Ada allows us to implicitly dereference arrays when subscripting
+ them. So, if this is an typedef (encoding use for array access
+ types encoded as fat pointers), strip it now. */
+ if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)
+ type = ada_typedef_target_type (type);
+
if (TYPE_CODE (type) == TYPE_CODE_PTR)
{
switch (TYPE_CODE (ada_check_typedef (TYPE_TARGET_TYPE (type))))
else
error (_("Attempt to take contents of a non-pointer value."));
}
- arg1 = ada_coerce_ref (arg1); /* FIXME: What is this for?? */
+ arg1 = ada_coerce_ref (arg1); /* FIXME: What is this for?? */
type = ada_check_typedef (value_type (arg1));
if (TYPE_CODE (type) == TYPE_CODE_INT)
/* In this case, we assume that the field COULD exist
in some extension of the type. Return an object of
"type" void, which will match any formal
- (see ada_type_match). */
+ (see ada_type_match). */
return value_zero (builtin_type (exp->gdbarch)->builtin_void,
lval_memory);
}
case OP_AGGREGATE:
error (_("Aggregates only allowed on the right of an assignment"));
default:
- internal_error (__FILE__, __LINE__, _("aggregate apparently mangled"));
+ internal_error (__FILE__, __LINE__,
+ _("aggregate apparently mangled"));
}
ada_forward_operator_length (exp, pc, &oplen, &nargs);
return raw_type;
if (bounds_str[n] == '_')
n += 2;
- else if (bounds_str[n] == '.') /* FIXME? SGI Workshop kludge. */
+ else if (bounds_str[n] == '.') /* FIXME? SGI Workshop kludge. */
n += 1;
subtype_info += 1;
}
/* At this point, we know that we are debugging an Ada program and
that the inferior has been started, but we still are not able to
- find the run-time symbols. That can mean that we are in
+ find the run-time symbols. That can mean that we are in
configurable run time mode, or that a-except as been optimized
out by the linker... In any case, at this point it is not worth
supporting this feature. */
NULL, /* insert */
NULL, /* remove */
NULL, /* breakpoint_hit */
+ NULL, /* resources_needed */
print_it_catch_exception,
print_one_catch_exception,
print_mention_catch_exception,
NULL, /* insert */
NULL, /* remove */
NULL, /* breakpoint_hit */
+ NULL, /* resources_needed */
print_it_catch_exception_unhandled,
print_one_catch_exception_unhandled,
print_mention_catch_exception_unhandled,
NULL, /* insert */
NULL, /* remove */
NULL, /* breakpoint_hit */
+ NULL, /* resources_needed */
print_it_catch_assert,
print_one_catch_assert,
print_mention_catch_assert,
{
int i;
- /* The standard exceptions are a special case. They are defined in
+ /* The standard exceptions are a special case. They are defined in
runtime units that have been compiled without debugging info; if
EXP_STRING is the not-fully-qualified name of a standard
exception (e.g. "constraint_error") then, during the evaluation
of the condition expression, the symbol lookup on this name would
- *not* return this standard exception. The catchpoint condition
+ *not* return this standard exception. The catchpoint condition
may then be set only on user-defined exceptions which have the
same not-fully-qualified name (e.g. my_package.constraint_error).
To avoid this unexcepted behavior, these standard exceptions are
- systematically prefixed by "standard". This means that "catch
+ systematically prefixed by "standard". This means that "catch
exception constraint_error" is rewritten into "catch exception
standard.constraint_error".
ada_lookup_symbol_nonlocal, /* Looking up non-local symbols. */
basic_lookup_transparent_type, /* lookup_transparent_type */
ada_la_decode, /* Language specific symbol demangler */
- NULL, /* Language specific class_name_from_physname */
+ NULL, /* Language specific
+ class_name_from_physname */
ada_op_print_tab, /* expression operators for printing */
0, /* c-style arrays */
1, /* String lower bound */
projects / deliverable / binutils-gdb.git / blobdiff