static int is_name_suffix (const char *);
+static int is_digits_suffix (const char *str);
+
static int wild_match (const char *, int, const char *);
static struct value *ada_coerce_ref (struct value *);
static LONGEST pos_atr (struct value *);
-static struct value *value_pos_atr (struct value *);
+static struct value *value_pos_atr (struct type *, struct value *);
static struct value *value_val_atr (struct type *, struct value *);
}
/* The largest value in the domain of TYPE, a discrete type, as an integer. */
-static struct value *
+static LONGEST
discrete_type_high_bound (struct type *type)
{
switch (TYPE_CODE (type))
{
case TYPE_CODE_RANGE:
- return value_from_longest (TYPE_TARGET_TYPE (type),
- TYPE_HIGH_BOUND (type));
+ return TYPE_HIGH_BOUND (type);
case TYPE_CODE_ENUM:
- return
- value_from_longest (type,
- TYPE_FIELD_BITPOS (type,
- TYPE_NFIELDS (type) - 1));
+ return TYPE_FIELD_BITPOS (type, TYPE_NFIELDS (type) - 1);
+ case TYPE_CODE_BOOL:
+ return 1;
+ case TYPE_CODE_CHAR:
case TYPE_CODE_INT:
- return value_from_longest (type, max_of_type (type));
+ return max_of_type (type);
default:
error (_("Unexpected type in discrete_type_high_bound."));
}
}
/* The largest value in the domain of TYPE, a discrete type, as an integer. */
-static struct value *
+static LONGEST
discrete_type_low_bound (struct type *type)
{
switch (TYPE_CODE (type))
{
case TYPE_CODE_RANGE:
- return value_from_longest (TYPE_TARGET_TYPE (type),
- TYPE_LOW_BOUND (type));
+ return TYPE_LOW_BOUND (type);
case TYPE_CODE_ENUM:
- return value_from_longest (type, TYPE_FIELD_BITPOS (type, 0));
+ return TYPE_FIELD_BITPOS (type, 0);
+ case TYPE_CODE_BOOL:
+ return 0;
+ case TYPE_CODE_CHAR:
case TYPE_CODE_INT:
- return value_from_longest (type, min_of_type (type));
+ return min_of_type (type);
default:
error (_("Unexpected type in discrete_type_low_bound."));
}
if (*resultp == NULL)
{
const char *decoded = ada_decode (gsymbol->name);
- if (gsymbol->bfd_section != NULL)
+ if (gsymbol->obj_section != NULL)
{
- bfd *obfd = gsymbol->bfd_section->owner;
- if (obfd != NULL)
- {
- struct objfile *objf;
- ALL_OBJFILES (objf)
- {
- if (obfd == objf->obfd)
- {
- *resultp = obsavestring (decoded, strlen (decoded),
- &objf->objfile_obstack);
- break;
- }
- }
- }
+ struct objfile *objf = gsymbol->obj_section->objfile;
+ *resultp = obsavestring (decoded, strlen (decoded),
+ &objf->objfile_obstack);
}
/* Sometimes, we can't find a corresponding objfile, in which
case, we put the result on the heap. Since we only decode
ada_coerce_to_simple_array_type (struct type *type)
{
struct value *mark = value_mark ();
- struct value *dummy = value_from_longest (builtin_type_long, 0);
+ struct value *dummy = value_from_longest (builtin_type_int32, 0);
struct type *result;
deprecated_set_value_type (dummy, type);
result = ada_type_of_array (dummy, 0);
(*elt_bits + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT;
}
- TYPE_FLAGS (new_type) |= TYPE_FLAG_FIXED_INSTANCE;
+ TYPE_FIXED_INSTANCE (new_type) = 1;
return new_type;
}
lowerbound = upperbound = 0;
}
- idx = value_as_long (value_pos_atr (ind[i]));
+ idx = pos_atr (ind[i]);
if (idx < lowerbound || idx > upperbound)
lim_warning (_("packed array index %ld out of bounds"), (long) idx);
bits = TYPE_FIELD_BITSIZE (elt_type, 0);
{
int len = (value_bitpos (toval)
+ bits + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT;
+ int from_size;
char *buffer = (char *) alloca (len);
struct value *val;
CORE_ADDR to_addr = VALUE_ADDRESS (toval) + value_offset (toval);
fromval = value_cast (type, fromval);
read_memory (to_addr, buffer, len);
+ from_size = value_bitsize (fromval);
+ if (from_size == 0)
+ from_size = TYPE_LENGTH (value_type (fromval)) * TARGET_CHAR_BIT;
if (gdbarch_bits_big_endian (current_gdbarch))
move_bits (buffer, value_bitpos (toval),
- value_contents (fromval),
- TYPE_LENGTH (value_type (fromval)) * TARGET_CHAR_BIT -
- bits, bits);
+ value_contents (fromval), from_size - bits, bits);
else
move_bits (buffer, value_bitpos (toval), value_contents (fromval),
0, bits);
{
if (TYPE_CODE (elt_type) != TYPE_CODE_ARRAY)
error (_("too many subscripts (%d expected)"), k);
- elt = value_subscript (elt, value_pos_atr (ind[k]));
+ elt = value_subscript (elt, value_pos_atr (builtin_type_int32, ind[k]));
}
return elt;
}
arr = value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
value_copy (arr));
get_discrete_bounds (TYPE_INDEX_TYPE (type), &lwb, &upb);
- idx = value_pos_atr (ind[k]);
+ idx = value_pos_atr (builtin_type_int32, ind[k]);
if (lwb != 0)
- idx = value_sub (idx, value_from_longest (builtin_type_int, lwb));
- arr = value_add (arr, idx);
+ idx = value_binop (idx, value_from_longest (value_type (idx), lwb),
+ BINOP_SUB);
+
+ arr = value_ptradd (arr, idx);
type = TYPE_TARGET_TYPE (type);
}
has a target type of TYPE_CODE_UNDEF. We compensate here, but
perhaps stabsread.c would make more sense. */
if (result_type == NULL || TYPE_CODE (result_type) == TYPE_CODE_UNDEF)
- result_type = builtin_type_int;
+ result_type = builtin_type_int32;
return result_type;
}
if (arr_type == NULL || !ada_is_simple_array_type (arr_type))
{
if (typep != NULL)
- *typep = builtin_type_int;
+ *typep = builtin_type_int32;
return (LONGEST) - which;
}
}
else
return
- value_from_longest (builtin_type_int,
+ value_from_longest (builtin_type_int32,
value_as_long (desc_one_bound (desc_bounds (arr),
n, 1))
- value_as_long (desc_one_bound (desc_bounds (arr),
case LOC_REGISTER:
case LOC_ARG:
case LOC_REF_ARG:
- case LOC_REGPARM:
case LOC_REGPARM_ADDR:
case LOC_LOCAL:
- case LOC_BASEREG:
- case LOC_BASEREG_ARG:
case LOC_COMPUTED:
- case LOC_COMPUTED_ARG:
goto FoundNonType;
default:
break;
case LOC_REGISTER:
case LOC_ARG:
case LOC_REF_ARG:
- case LOC_REGPARM:
case LOC_REGPARM_ADDR:
case LOC_LOCAL:
case LOC_TYPEDEF:
- case LOC_BASEREG:
- case LOC_BASEREG_ARG:
case LOC_COMPUTED:
- case LOC_COMPUTED_ARG:
for (j = FIRST_LOCAL_BLOCK;
j < BLOCKVECTOR_NBLOCKS (BLOCKVECTOR (s)); j += 1)
{
i = 0;
while (i < nsyms)
{
- if (SYMBOL_LINKAGE_NAME (syms[i].sym) != NULL
+ int remove = 0;
+
+ /* If two symbols have the same name and one of them is a stub type,
+ the get rid of the stub. */
+
+ if (TYPE_STUB (SYMBOL_TYPE (syms[i].sym))
+ && SYMBOL_LINKAGE_NAME (syms[i].sym) != NULL)
+ {
+ for (j = 0; j < nsyms; j++)
+ {
+ if (j != i
+ && !TYPE_STUB (SYMBOL_TYPE (syms[j].sym))
+ && SYMBOL_LINKAGE_NAME (syms[j].sym) != NULL
+ && strcmp (SYMBOL_LINKAGE_NAME (syms[i].sym),
+ SYMBOL_LINKAGE_NAME (syms[j].sym)) == 0)
+ remove = 1;
+ }
+ }
+
+ /* Two symbols with the same name, same class and same address
+ should be identical. */
+
+ else if (SYMBOL_LINKAGE_NAME (syms[i].sym) != NULL
&& SYMBOL_CLASS (syms[i].sym) == LOC_STATIC
&& is_nondebugging_type (SYMBOL_TYPE (syms[i].sym)))
{
&& SYMBOL_CLASS (syms[i].sym) == SYMBOL_CLASS (syms[j].sym)
&& SYMBOL_VALUE_ADDRESS (syms[i].sym)
== SYMBOL_VALUE_ADDRESS (syms[j].sym))
- {
- int k;
- for (k = i + 1; k < nsyms; k += 1)
- syms[k - 1] = syms[k];
- nsyms -= 1;
- goto NextSymbol;
- }
+ remove = 1;
}
}
+
+ if (remove)
+ {
+ for (j = i + 1; j < nsyms; j += 1)
+ syms[j - 1] = syms[j];
+ nsyms -= 1;
+ }
+
i += 1;
- NextSymbol:
- ;
}
return nsyms;
}
if (current_block == NULL)
return nsyms;
- current_function = block_function (current_block);
+ current_function = block_linkage_function (current_block);
if (current_function == NULL)
return nsyms;
return nsyms;
}
+/* Add to OBSTACKP all symbols from BLOCK (and its super-blocks)
+ whose name and domain match NAME and DOMAIN respectively.
+ If no match was found, then extend the search to "enclosing"
+ routines (in other words, if we're inside a nested function,
+ search the symbols defined inside the enclosing functions).
+
+ Note: This function assumes that OBSTACKP has 0 (zero) element in it. */
+
+static void
+ada_add_local_symbols (struct obstack *obstackp, const char *name,
+ struct block *block, domain_enum domain,
+ int wild_match)
+{
+ int block_depth = 0;
+
+ while (block != NULL)
+ {
+ block_depth += 1;
+ ada_add_block_symbols (obstackp, block, name, domain, NULL, wild_match);
+
+ /* If we found a non-function match, assume that's the one. */
+ if (is_nonfunction (defns_collected (obstackp, 0),
+ num_defns_collected (obstackp)))
+ return;
+
+ block = BLOCK_SUPERBLOCK (block);
+ }
+
+ /* If no luck so far, try to find NAME as a local symbol in some lexically
+ enclosing subprogram. */
+ if (num_defns_collected (obstackp) == 0 && block_depth > 2)
+ add_symbols_from_enclosing_procs (obstackp, name, domain, wild_match);
+}
+
+/* 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)
+{
+ struct objfile *objfile;
+ struct partial_symtab *ps;
+
+ 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;
+
+ if (s == NULL || !s->primary)
+ continue;
+ ada_add_block_symbols (obstackp,
+ BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), block_kind),
+ name, domain, objfile, wild_match);
+ }
+ }
+}
+
/* Find symbols in DOMAIN matching NAME0, in BLOCK0 and enclosing
scope and in global scopes, returning the number of matches. Sets
*RESULTS to point to a vector of (SYM,BLOCK) tuples,
struct ada_symbol_info **results)
{
struct symbol *sym;
- struct symtab *s;
- struct partial_symtab *ps;
- struct blockvector *bv;
- struct objfile *objfile;
struct block *block;
const char *name;
- struct minimal_symbol *msymbol;
int wild_match;
int cacheIfUnique;
- int block_depth;
int ndefns;
obstack_free (&symbol_list_obstack, NULL);
block = (struct block *) block0; /* FIXME: No cast ought to be
needed, but adding const will
have a cascade effect. */
+
+ /* Special case: If the user specifies a symbol name inside package
+ Standard, do a non-wild matching of the symbol name without
+ the "standard__" prefix. This was primarily introduced in order
+ to allow the user to specifically access the standard exceptions
+ using, for instance, Standard.Constraint_Error when Constraint_Error
+ is ambiguous (due to the user defining its own Constraint_Error
+ entity inside its program). */
if (strncmp (name0, "standard__", sizeof ("standard__") - 1) == 0)
{
wild_match = 0;
name = name0 + sizeof ("standard__") - 1;
}
- block_depth = 0;
- while (block != NULL)
- {
- block_depth += 1;
- ada_add_block_symbols (&symbol_list_obstack, block, name,
- namespace, NULL, wild_match);
-
- /* If we found a non-function match, assume that's the one. */
- if (is_nonfunction (defns_collected (&symbol_list_obstack, 0),
- num_defns_collected (&symbol_list_obstack)))
- goto done;
-
- block = BLOCK_SUPERBLOCK (block);
- }
-
- /* If no luck so far, try to find NAME as a local symbol in some lexically
- enclosing subprogram. */
- if (num_defns_collected (&symbol_list_obstack) == 0 && block_depth > 2)
- add_symbols_from_enclosing_procs (&symbol_list_obstack,
- name, namespace, wild_match);
-
- /* If we found ANY matches among non-global symbols, we're done. */
+ /* Check the non-global symbols. If we have ANY match, then we're done. */
+ ada_add_local_symbols (&symbol_list_obstack, name, block, namespace,
+ wild_match);
if (num_defns_collected (&symbol_list_obstack) > 0)
goto done;
+ /* No non-global symbols found. Check our cache to see if we have
+ already performed this search before. If we have, then return
+ the same result. */
+
cacheIfUnique = 1;
if (lookup_cached_symbol (name0, namespace, &sym, &block))
{
goto done;
}
- /* Now add symbols from all global blocks: symbol tables, minimal symbol
- tables, and psymtab's. */
-
- ALL_PRIMARY_SYMTABS (objfile, s)
- {
- QUIT;
- bv = BLOCKVECTOR (s);
- block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK);
- ada_add_block_symbols (&symbol_list_obstack, block, name, namespace,
- objfile, wild_match);
- }
-
- if (namespace == VAR_DOMAIN)
- {
- ALL_MSYMBOLS (objfile, msymbol)
- {
- if (ada_match_name (SYMBOL_LINKAGE_NAME (msymbol), name, wild_match))
- {
- switch (MSYMBOL_TYPE (msymbol))
- {
- case mst_solib_trampoline:
- break;
- default:
- s = find_pc_symtab (SYMBOL_VALUE_ADDRESS (msymbol));
- if (s != NULL)
- {
- int ndefns0 = num_defns_collected (&symbol_list_obstack);
- QUIT;
- bv = BLOCKVECTOR (s);
- block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK);
- ada_add_block_symbols (&symbol_list_obstack, block,
- SYMBOL_LINKAGE_NAME (msymbol),
- namespace, objfile, wild_match);
-
- if (num_defns_collected (&symbol_list_obstack) == ndefns0)
- {
- block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK);
- ada_add_block_symbols (&symbol_list_obstack, block,
- SYMBOL_LINKAGE_NAME (msymbol),
- namespace, objfile,
- wild_match);
- }
- }
- }
- }
- }
- }
-
- ALL_PSYMTABS (objfile, ps)
- {
- QUIT;
- if (!ps->readin
- && ada_lookup_partial_symbol (ps, name, 1, namespace, wild_match))
- {
- s = PSYMTAB_TO_SYMTAB (ps);
- if (!s->primary)
- continue;
- bv = BLOCKVECTOR (s);
- block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK);
- ada_add_block_symbols (&symbol_list_obstack, block, name,
- namespace, objfile, wild_match);
- }
- }
+ /* Search symbols from all global blocks. */
+
+ ada_add_non_local_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).
- Do the symtabs first, then check the psymtabs. */
+ (not strictly correct, but perhaps better than an error). */
if (num_defns_collected (&symbol_list_obstack) == 0)
- {
-
- ALL_PRIMARY_SYMTABS (objfile, s)
- {
- QUIT;
- bv = BLOCKVECTOR (s);
- block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK);
- ada_add_block_symbols (&symbol_list_obstack, block, name, namespace,
- objfile, wild_match);
- }
-
- ALL_PSYMTABS (objfile, ps)
- {
- QUIT;
- if (!ps->readin
- && ada_lookup_partial_symbol (ps, name, 0, namespace, wild_match))
- {
- s = PSYMTAB_TO_SYMTAB (ps);
- bv = BLOCKVECTOR (s);
- if (!s->primary)
- continue;
- block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK);
- ada_add_block_symbols (&symbol_list_obstack, block, name,
- namespace, objfile, wild_match);
- }
- }
- }
+ ada_add_non_local_symbols (&symbol_list_obstack, name, namespace, 0,
+ wild_match);
done:
ndefns = num_defns_collected (&symbol_list_obstack);
/* True iff STR is a possible encoded suffix of a normal Ada name
that is to be ignored for matching purposes. Suffixes of parallel
names (e.g., XVE) are not included here. Currently, the possible suffixes
- are given by either of the regular expression:
+ are given by any of the regular expressions:
[.$][0-9]+ [nested subprogram suffix, on platforms such as GNU/Linux]
___[0-9]+ [nested subprogram suffix, on platforms such as HP/UX]
return 0;
}
-/* Return nonzero if the given string starts with a dot ('.')
- followed by zero or more digits.
-
- Note: brobecker/2003-11-10: A forward declaration has not been
- added at the begining of this file yet, because this function
- is only used to work around a problem found during wild matching
- when trying to match minimal symbol names against symbol names
- obtained from dwarf-2 data. This function is therefore currently
- only used in wild_match() and is likely to be deleted when the
- problem in dwarf-2 is fixed. */
+/* Return nonzero if the given string contains only digits.
+ The empty string also matches. */
static int
-is_dot_digits_suffix (const char *str)
+is_digits_suffix (const char *str)
{
- if (str[0] != '.')
- return 0;
-
- str++;
while (isdigit (str[0]))
str++;
return (str[0] == '\0');
const char *decoded_name = ada_decode (name0);
int i;
+ /* If the decoded name starts with an angle bracket, it means that
+ NAME0 does not follow the GNAT encoding format. It should then
+ not be allowed as a possible wild match. */
+ if (decoded_name[0] == '<')
+ return 0;
+
for (i=0; decoded_name[i] != '\0'; i++)
if (isalpha (decoded_name[i]) && !islower (decoded_name[i]))
return 0;
static int
wild_match (const char *patn0, int patn_len, const char *name0)
{
- int name_len;
- char *name;
- char *name_start;
- char *patn;
-
- /* FIXME: brobecker/2003-11-10: For some reason, the symbol name
- stored in the symbol table for nested function names is sometimes
- different from the name of the associated entity stored in
- the dwarf-2 data: This is the case for nested subprograms, where
- the minimal symbol name contains a trailing ".[:digit:]+" suffix,
- while the symbol name from the dwarf-2 data does not.
-
- Although the DWARF-2 standard documents that entity names stored
- in the dwarf-2 data should be identical to the name as seen in
- the source code, GNAT takes a different approach as we already use
- a special encoding mechanism to convey the information so that
- a C debugger can still use the information generated to debug
- Ada programs. A corollary is that the symbol names in the dwarf-2
- data should match the names found in the symbol table. I therefore
- consider this issue as a compiler defect.
-
- Until the compiler is properly fixed, we work-around the problem
- by ignoring such suffixes during the match. We do so by making
- a copy of PATN0 and NAME0, and then by stripping such a suffix
- if present. We then perform the match on the resulting strings. */
- {
- char *dot;
- name_len = strlen (name0);
-
- name = name_start = (char *) alloca ((name_len + 1) * sizeof (char));
- strcpy (name, name0);
- dot = strrchr (name, '.');
- if (dot != NULL && is_dot_digits_suffix (dot))
- *dot = '\0';
-
- patn = (char *) alloca ((patn_len + 1) * sizeof (char));
- strncpy (patn, patn0, patn_len);
- patn[patn_len] = '\0';
- dot = strrchr (patn, '.');
- if (dot != NULL && is_dot_digits_suffix (dot))
- {
- *dot = '\0';
- patn_len = dot - patn;
- }
- }
-
- /* Now perform the wild match. */
-
- name_len = strlen (name);
- if (name_len >= patn_len + 5 && strncmp (name, "_ada_", 5) == 0
- && strncmp (patn, name + 5, patn_len) == 0
- && is_name_suffix (name + patn_len + 5))
- return 1;
-
- while (name_len >= patn_len)
+ char* match;
+ const char* start;
+ start = name0;
+ while (1)
{
- if (strncmp (patn, name, patn_len) == 0
- && is_name_suffix (name + patn_len))
- return (name == name_start || is_valid_name_for_wild_match (name0));
- do
- {
- name += 1;
- name_len -= 1;
- }
- while (name_len > 0
- && name[0] != '.' && (name[0] != '_' || name[1] != '_'));
- if (name_len <= 0)
- return 0;
- if (name[0] == '_')
- {
- if (!islower (name[2]))
- return 0;
- name += 2;
- name_len -= 2;
- }
- else
- {
- if (!islower (name[1]))
- return 0;
- name += 1;
- name_len -= 1;
- }
+ match = strstr (start, patn0);
+ if (match == NULL)
+ 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;
}
-
- return 0;
}
SYMBOL_DOMAIN (sym), domain)
&& wild_match (name, name_len, SYMBOL_LINKAGE_NAME (sym)))
{
- switch (SYMBOL_CLASS (sym))
- {
- case LOC_ARG:
- case LOC_REF_ARG:
- case LOC_REGPARM:
- case LOC_REGPARM_ADDR:
- case LOC_BASEREG_ARG:
- case LOC_COMPUTED_ARG:
- arg_sym = sym;
- break;
- case LOC_UNRESOLVED:
- continue;
- default:
+ if (SYMBOL_CLASS (sym) == LOC_UNRESOLVED)
+ continue;
+ else if (SYMBOL_IS_ARGUMENT (sym))
+ arg_sym = sym;
+ else
+ {
found_sym = 1;
add_defn_to_vec (obstackp,
fixup_symbol_section (sym, objfile),
block);
- break;
}
}
}
if (cmp == 0
&& is_name_suffix (SYMBOL_LINKAGE_NAME (sym) + name_len))
{
- switch (SYMBOL_CLASS (sym))
- {
- case LOC_ARG:
- case LOC_REF_ARG:
- case LOC_REGPARM:
- case LOC_REGPARM_ADDR:
- case LOC_BASEREG_ARG:
- case LOC_COMPUTED_ARG:
- arg_sym = sym;
- break;
- case LOC_UNRESOLVED:
- break;
- default:
- found_sym = 1;
- add_defn_to_vec (obstackp,
- fixup_symbol_section (sym, objfile),
- block);
- break;
- }
+ if (SYMBOL_CLASS (sym) != LOC_UNRESOLVED)
+ {
+ if (SYMBOL_IS_ARGUMENT (sym))
+ arg_sym = sym;
+ else
+ {
+ found_sym = 1;
+ add_defn_to_vec (obstackp,
+ fixup_symbol_section (sym, objfile),
+ block);
+ }
+ }
}
}
}
if (cmp == 0
&& is_name_suffix (SYMBOL_LINKAGE_NAME (sym) + name_len + 5))
{
- switch (SYMBOL_CLASS (sym))
- {
- case LOC_ARG:
- case LOC_REF_ARG:
- case LOC_REGPARM:
- case LOC_REGPARM_ADDR:
- case LOC_BASEREG_ARG:
- case LOC_COMPUTED_ARG:
- arg_sym = sym;
- break;
- case LOC_UNRESOLVED:
- break;
- default:
- found_sym = 1;
- add_defn_to_vec (obstackp,
- fixup_symbol_section (sym, objfile),
- block);
- break;
- }
+ if (SYMBOL_CLASS (sym) != LOC_UNRESOLVED)
+ {
+ if (SYMBOL_IS_ARGUMENT (sym))
+ arg_sym = sym;
+ else
+ {
+ found_sym = 1;
+ add_defn_to_vec (obstackp,
+ fixup_symbol_section (sym, objfile),
+ block);
+ }
+ }
}
}
}
valp = value_cast (info_type, args->tag);
if (valp == NULL)
return 0;
- val = value_ind (value_add (valp, value_from_longest (builtin_type_int, -1)));
+ val = value_ind (value_ptradd (valp,
+ value_from_longest (builtin_type_int8, -1)));
if (val == NULL)
return 0;
val = ada_value_struct_elt (val, "expanded_name", 1);
for (i = 0; i < TYPE_NFIELDS (type); i += 1)
if (ada_is_parent_field (type, i))
- return ada_check_typedef (TYPE_FIELD_TYPE (type, i));
+ {
+ struct type *parent_type = TYPE_FIELD_TYPE (type, i);
+
+ /* If the _parent field is a pointer, then dereference it. */
+ if (TYPE_CODE (parent_type) == TYPE_CODE_PTR)
+ parent_type = TYPE_TARGET_TYPE (parent_type);
+ /* If there is a parallel XVS type, get the actual base type. */
+ parent_type = ada_get_base_type (parent_type);
+
+ return ada_check_typedef (parent_type);
+ }
return NULL;
}
struct type *type =
ada_lookup_struct_elt_type (outer_type, name, 1, 1, NULL);
if (type == NULL)
- return builtin_type_int;
+ return builtin_type_int32;
else
return type;
}
static struct symbol *
find_old_style_renaming_symbol (const char *name, struct block *block)
{
- const struct symbol *function_sym = block_function (block);
+ const struct symbol *function_sym = block_linkage_function (block);
char *rename;
if (function_sym != NULL)
TYPE_FIELDS (type) = NULL;
TYPE_NAME (type) = "<empty>";
TYPE_TAG_NAME (type) = NULL;
- TYPE_FLAGS (type) = 0;
TYPE_LENGTH (type) = 0;
return type;
}
memset (TYPE_FIELDS (rtype), 0, sizeof (struct field) * nfields);
TYPE_NAME (rtype) = ada_type_name (type);
TYPE_TAG_NAME (rtype) = NULL;
- TYPE_FLAGS (rtype) |= TYPE_FLAG_FIXED_INSTANCE;
+ TYPE_FIXED_INSTANCE (rtype) = 1;
off = 0;
bit_len = 0;
sizeof (struct field) * nfields);
TYPE_NAME (type) = ada_type_name (type0);
TYPE_TAG_NAME (type) = NULL;
- TYPE_FLAGS (type) |= TYPE_FLAG_FIXED_INSTANCE;
+ TYPE_FIXED_INSTANCE (type) = 1;
TYPE_LENGTH (type) = 0;
}
TYPE_FIELD_TYPE (type, f) = new_type;
}
/* Given an object of type TYPE whose contents are at VALADDR and
- whose address in memory is ADDRESS, returns a revision of TYPE --
- a non-dynamic-sized record with a variant part -- in which
- the variant part is replaced with the appropriate branch. Looks
+ whose address in memory is ADDRESS, returns a revision of TYPE,
+ which should be a non-dynamic-sized record, in which the variant
+ part, if any, is replaced with the appropriate branch. Looks
for discriminant values in DVAL0, which can be NULL if the record
contains the necessary discriminant values. */
sizeof (struct field) * nfields);
TYPE_NAME (rtype) = ada_type_name (type);
TYPE_TAG_NAME (rtype) = NULL;
- TYPE_FLAGS (rtype) |= TYPE_FLAG_FIXED_INSTANCE;
+ TYPE_FIXED_INSTANCE (rtype) = 1;
TYPE_LENGTH (rtype) = TYPE_LENGTH (type);
branch_type = to_fixed_variant_branch_type
{
struct type *templ_type;
- if (TYPE_FLAGS (type0) & TYPE_FLAG_FIXED_INSTANCE)
+ if (TYPE_FIXED_INSTANCE (type0))
return type0;
templ_type = dynamic_template_type (type0);
}
else
{
- TYPE_FLAGS (type0) |= TYPE_FLAG_FIXED_INSTANCE;
+ TYPE_FIXED_INSTANCE (type0) = 1;
return type0;
}
struct type *result;
if (ada_is_packed_array_type (type0) /* revisit? */
- || (TYPE_FLAGS (type0) & TYPE_FLAG_FIXED_INSTANCE))
+ || TYPE_FIXED_INSTANCE (type0))
return type0;
index_type_desc = ada_find_parallel_type (type0, "___XA");
error (_("array type with dynamic size is larger than varsize-limit"));
}
- TYPE_FLAGS (result) |= TYPE_FLAG_FIXED_INSTANCE;
+ TYPE_FIXED_INSTANCE (result) = 1;
return result;
}
if (type0 == NULL)
return NULL;
- if (TYPE_FLAGS (type0) & TYPE_FLAG_FIXED_INSTANCE)
+ if (TYPE_FIXED_INSTANCE (type0))
return type0;
type0 = ada_check_typedef (type0);
static LONGEST
pos_atr (struct value *arg)
{
- struct type *type = value_type (arg);
+ struct value *val = coerce_ref (arg);
+ struct type *type = value_type (val);
if (!discrete_type_p (type))
error (_("'POS only defined on discrete types"));
if (TYPE_CODE (type) == TYPE_CODE_ENUM)
{
int i;
- LONGEST v = value_as_long (arg);
+ LONGEST v = value_as_long (val);
for (i = 0; i < TYPE_NFIELDS (type); i += 1)
{
error (_("enumeration value is invalid: can't find 'POS"));
}
else
- return value_as_long (arg);
+ return value_as_long (val);
}
static struct value *
-value_pos_atr (struct value *arg)
+value_pos_atr (struct type *type, struct value *arg)
{
- return value_from_longest (builtin_type_int, pos_atr (arg));
+ return value_from_longest (type, pos_atr (arg));
}
/* Evaluate the TYPE'VAL attribute applied to ARG. */
value_as_long (arg)));
else
{
- DOUBLEST argd =
- value_as_double (value_cast (builtin_type_double, value_copy (arg)));
+ DOUBLEST argd = value_as_double (arg);
val = ada_float_to_fixed (type, argd);
}
}
static struct value *
-cast_from_fixed_to_double (struct value *arg)
+cast_from_fixed (struct type *type, struct value *arg)
{
DOUBLEST val = ada_fixed_to_float (value_type (arg),
value_as_long (arg));
- return value_from_double (builtin_type_double, val);
+ return value_from_double (type, val);
}
/* Coerce VAL as necessary for assignment to an lval of type TYPE, and
struct value *elt;
if (TYPE_CODE (value_type (lhs)) == TYPE_CODE_ARRAY)
{
- struct value *index_val = value_from_longest (builtin_type_int, index);
+ struct value *index_val = value_from_longest (builtin_type_int32, index);
elt = unwrap_value (ada_value_subscript (lhs, 1, &index_val));
}
else
return (cast_to_fixed (type, arg2));
if (ada_is_fixed_point_type (value_type (arg2)))
- return value_cast (type, cast_from_fixed_to_double (arg2));
+ return cast_from_fixed (type, arg2);
return value_cast (type, arg2);
}
arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
+ if (TYPE_CODE (value_type (arg1)) == TYPE_CODE_PTR)
+ return (value_from_longest
+ (value_type (arg1),
+ value_as_long (arg1) + value_as_long (arg2)));
if ((ada_is_fixed_point_type (value_type (arg1))
|| ada_is_fixed_point_type (value_type (arg2)))
&& value_type (arg1) != value_type (arg2))
type = value_type (arg1);
while (TYPE_CODE (type) == TYPE_CODE_REF)
type = TYPE_TARGET_TYPE (type);
- return value_cast (type, value_add (arg1, arg2));
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ return value_cast (type, value_binop (arg1, arg2, BINOP_ADD));
case BINOP_SUB:
arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
+ if (TYPE_CODE (value_type (arg1)) == TYPE_CODE_PTR)
+ return (value_from_longest
+ (value_type (arg1),
+ value_as_long (arg1) - value_as_long (arg2)));
if ((ada_is_fixed_point_type (value_type (arg1))
|| ada_is_fixed_point_type (value_type (arg2)))
&& value_type (arg1) != value_type (arg2))
type = value_type (arg1);
while (TYPE_CODE (type) == TYPE_CODE_REF)
type = TYPE_TARGET_TYPE (type);
- return value_cast (type, value_sub (arg1, arg2));
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ return value_cast (type, value_binop (arg1, arg2, BINOP_SUB));
case BINOP_MUL:
case BINOP_DIV:
return value_zero (value_type (arg1), not_lval);
else
{
+ type = builtin_type (exp->gdbarch)->builtin_double;
if (ada_is_fixed_point_type (value_type (arg1)))
- arg1 = cast_from_fixed_to_double (arg1);
+ arg1 = cast_from_fixed (type, arg1);
if (ada_is_fixed_point_type (value_type (arg2)))
- arg2 = cast_from_fixed_to_double (arg2);
+ arg2 = cast_from_fixed (type, arg2);
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
return ada_value_binop (arg1, arg2, op);
}
&& (op == BINOP_DIV || op == BINOP_REM || op == BINOP_MOD))
return value_zero (value_type (arg1), not_lval);
else
- return ada_value_binop (arg1, arg2, op);
+ {
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ return ada_value_binop (arg1, arg2, op);
+ }
case BINOP_EQUAL:
case BINOP_NOTEQUAL:
if (noside == EVAL_AVOID_SIDE_EFFECTS)
tem = 0;
else
- tem = ada_value_equal (arg1, arg2);
+ {
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ tem = ada_value_equal (arg1, arg2);
+ }
if (op == BINOP_NOTEQUAL)
tem = !tem;
- return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
+ type = language_bool_type (exp->language_defn, exp->gdbarch);
+ return value_from_longest (type, (LONGEST) tem);
case UNOP_NEG:
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
else if (ada_is_fixed_point_type (value_type (arg1)))
return value_cast (value_type (arg1), value_neg (arg1));
else
- return value_neg (arg1);
+ {
+ unop_promote (exp->language_defn, exp->gdbarch, &arg1);
+ return value_neg (arg1);
+ }
case BINOP_LOGICAL_AND:
case BINOP_LOGICAL_OR:
*pos -= 1;
val = evaluate_subexp_standard (expect_type, exp, pos, noside);
- return value_cast (LA_BOOL_TYPE, val);
+ type = language_bool_type (exp->language_defn, exp->gdbarch);
+ return value_cast (type, val);
}
case BINOP_BITWISE_AND:
case OP_VAR_VALUE:
*pos -= 1;
- /* Tagged types are a little special in the fact that the real type
- is dynamic and can only be determined by inspecting the object
- value. So even if we're support to do an EVAL_AVOID_SIDE_EFFECTS
- evaluation, we force an EVAL_NORMAL evaluation for tagged types. */
- if (noside == EVAL_AVOID_SIDE_EFFECTS
- && ada_is_tagged_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol), 1))
- noside = EVAL_NORMAL;
-
if (noside == EVAL_SKIP)
{
*pos += 4;
SYMBOL_PRINT_NAME (exp->elts[pc + 2].symbol));
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))
+ {
+ /* Tagged types are a little special in the fact that the real
+ type is dynamic and can only be determined by inspecting the
+ object's tag. This means that we need to get the object's
+ value first (EVAL_NORMAL) and then extract the actual object
+ type from its tag.
+
+ Note that we cannot skip the final step where we extract
+ the object type from its tag, because the EVAL_NORMAL phase
+ results in dynamic components being resolved into fixed ones.
+ This can cause problems when trying to print the type
+ description of tagged types whose parent has a dynamic size:
+ We use the type name of the "_parent" component in order
+ to print the name of the ancestor type in the type description.
+ If that component had a dynamic size, the resolution into
+ a fixed type would result in the loss of that type name,
+ thus preventing us from printing the name of the ancestor
+ type in the type description. */
+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_NORMAL);
+ return value_zero (type_from_tag (ada_value_tag (arg1)), not_lval);
+ }
+
*pos += 4;
return value_zero
(to_static_fixed_type
default:
lim_warning (_("Membership test incompletely implemented; "
"always returns true"));
- return value_from_longest (builtin_type_int, (LONGEST) 1);
+ type = language_bool_type (exp->language_defn, exp->gdbarch);
+ return value_from_longest (type, (LONGEST) 1);
case TYPE_CODE_RANGE:
- arg2 = value_from_longest (builtin_type_int, TYPE_LOW_BOUND (type));
- arg3 = value_from_longest (builtin_type_int,
- TYPE_HIGH_BOUND (type));
- return
- value_from_longest (builtin_type_int,
+ arg2 = value_from_longest (type, TYPE_LOW_BOUND (type));
+ arg3 = value_from_longest (type, TYPE_HIGH_BOUND (type));
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg3);
+ type = language_bool_type (exp->language_defn, exp->gdbarch);
+ return
+ value_from_longest (type,
(value_less (arg1, arg3)
|| value_equal (arg1, arg3))
&& (value_less (arg2, arg1)
goto nosideret;
if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (builtin_type_int, not_lval);
+ {
+ type = language_bool_type (exp->language_defn, exp->gdbarch);
+ return value_zero (type, not_lval);
+ }
tem = longest_to_int (exp->elts[pc + 1].longconst);
arg3 = ada_array_bound (arg2, tem, 1);
arg2 = ada_array_bound (arg2, tem, 0);
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg3);
+ type = language_bool_type (exp->language_defn, exp->gdbarch);
return
- value_from_longest (builtin_type_int,
+ value_from_longest (type,
(value_less (arg1, arg3)
|| value_equal (arg1, arg3))
&& (value_less (arg2, arg1)
if (noside == EVAL_SKIP)
goto nosideret;
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg3);
+ type = language_bool_type (exp->language_defn, exp->gdbarch);
return
- value_from_longest (builtin_type_int,
+ value_from_longest (type,
(value_less (arg1, arg3)
|| value_equal (arg1, arg3))
&& (value_less (arg2, arg1)
default:
error (_("unexpected attribute encountered"));
case OP_ATR_FIRST:
- return discrete_type_low_bound (range_type);
+ return value_from_longest
+ (range_type, discrete_type_low_bound (range_type));
case OP_ATR_LAST:
- return discrete_type_high_bound (range_type);
+ return value_from_longest
+ (range_type, discrete_type_high_bound (range_type));
case OP_ATR_LENGTH:
error (_("the 'length attribute applies only to array types"));
}
else if (noside == EVAL_AVOID_SIDE_EFFECTS)
return value_zero (value_type (arg1), not_lval);
else
- return value_binop (arg1, arg2,
- op == OP_ATR_MIN ? BINOP_MIN : BINOP_MAX);
+ {
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ return value_binop (arg1, arg2,
+ op == OP_ATR_MIN ? BINOP_MIN : BINOP_MAX);
+ }
case OP_ATR_MODULUS:
{
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (builtin_type_int, not_lval);
+ type = builtin_type (exp->gdbarch)->builtin_int;
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return value_zero (type, not_lval);
else
- return value_pos_atr (arg1);
+ return value_pos_atr (type, arg1);
case OP_ATR_SIZE:
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
else if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (builtin_type_int, not_lval);
+ return value_zero (builtin_type_int32, not_lval);
else
- return value_from_longest (builtin_type_int,
+ return value_from_longest (builtin_type_int32,
TARGET_CHAR_BIT
* TYPE_LENGTH (value_type (arg1)));
else if (noside == EVAL_AVOID_SIDE_EFFECTS)
return value_zero (value_type (arg1), not_lval);
else
- return value_binop (arg1, arg2, op);
+ {
+ /* For integer exponentiation operations,
+ only promote the first argument. */
+ if (is_integral_type (value_type (arg2)))
+ unop_promote (exp->language_defn, exp->gdbarch, &arg1);
+ else
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+
+ return value_binop (arg1, arg2, op);
+ }
case UNOP_PLUS:
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
+ unop_promote (exp->language_defn, exp->gdbarch, &arg1);
if (value_less (arg1, value_zero (value_type (arg1), not_lval)))
return value_neg (arg1);
else
}
else if (TYPE_CODE (type) == TYPE_CODE_INT)
/* GDB allows dereferencing an int. */
- return value_zero (builtin_type_int, lval_memory);
+ return value_zero (builtin_type (exp->gdbarch)->builtin_int,
+ lval_memory);
else
error (_("Attempt to take contents of a non-pointer value."));
}
if (ada_is_array_descriptor_type (type))
/* GDB allows dereferencing GNAT array descriptors. */
return ada_coerce_to_simple_array (arg1);
+ else if (TYPE_CODE (type) == TYPE_CODE_INT)
+ /* GDB allows dereferencing an int. */
+ return value_at_lazy (builtin_type (exp->gdbarch)->builtin_int,
+ (CORE_ADDR) value_as_address (arg1));
else
return ada_value_ind (arg1);
}
nosideret:
- return value_from_longest (builtin_type_long, (LONGEST) 1);
+ return value_from_longest (builtin_type_int8, (LONGEST) 1);
}
\f
char *subtype_info;
if (raw_type == NULL)
- base_type = builtin_type_int;
+ base_type = builtin_type_int32;
else if (TYPE_CODE (raw_type) == TYPE_CODE_RANGE)
base_type = TYPE_TARGET_TYPE (raw_type);
else
subtype_info = strstr (name, "___XD");
if (subtype_info == NULL)
- return raw_type;
+ {
+ LONGEST L = discrete_type_low_bound (raw_type);
+ LONGEST U = discrete_type_high_bound (raw_type);
+ if (L < INT_MIN || U > INT_MAX)
+ return raw_type;
+ else
+ return create_range_type (alloc_type (objfile), raw_type,
+ discrete_type_low_bound (raw_type),
+ discrete_type_high_bound (raw_type));
+ }
else
{
static char *name_buf = NULL;
struct type *subranged_type = base_type (type);
return (subranged_type != NULL && TYPE_CODE (type) == TYPE_CODE_RANGE
- && TYPE_CODE (subranged_type) != TYPE_CODE_ENUM
+ && TYPE_CODE (subranged_type) == TYPE_CODE_INT
&& TYPE_UNSIGNED (subranged_type));
}
each time a new executable is loaded by GDB. */
static void
-ada_executable_changed_observer (void *unused)
+ada_executable_changed_observer (void)
{
/* If the executable changed, then it is possible that the Ada runtime
is different. So we need to invalidate the exception support info
(struct objfile *) NULL));
TYPE_NAME (lai->primitive_type_vector [ada_primitive_type_system_address])
= "system__address";
+
+ lai->bool_type_symbol = "boolean";
+ lai->bool_type_default = builtin->builtin_bool;
}
\f
/* Language vector */
case_sensitive_on, /* Yes, Ada is case-insensitive, but
that's not quite what this means. */
array_row_major,
+ macro_expansion_no,
&ada_exp_descriptor,
parse,
ada_error,
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_val_print, /* Print a value using appropriate syntax */
ada_value_print, /* Print a top-level value */
NULL, /* Language specific skip_trampoline */