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 *);
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);
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);
{
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_binop (idx, value_from_longest (value_type (idx), lwb),
BINOP_SUB);
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;
}
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;
}
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);
- char *raw_name = SYMBOL_LINKAGE_NAME (msymbol);
- char *name1;
- const char *suffix;
- QUIT;
- suffix = strrchr (raw_name, '.');
- if (suffix == NULL)
- suffix = strrchr (raw_name, '$');
- if (suffix != NULL && is_digits_suffix (suffix + 1))
- {
- name1 = alloca (suffix - raw_name + 1);
- strncpy (name1, raw_name, suffix - raw_name);
- name1[suffix - raw_name] = '\0';
- }
- else
- name1 = raw_name;
-
- bv = BLOCKVECTOR (s);
- block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK);
- ada_add_block_symbols (&symbol_list_obstack, block,
- name1, namespace, objfile, 0);
-
- if (num_defns_collected (&symbol_list_obstack) == ndefns0)
- {
- block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK);
- ada_add_block_symbols (&symbol_list_obstack, block,
- name1, namespace, objfile, 0);
- }
- }
- }
- }
- }
- }
-
- 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);
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 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);
}
type = value_type (arg1);
while (TYPE_CODE (type) == TYPE_CODE_REF)
type = TYPE_TARGET_TYPE (type);
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
return value_cast (type, value_binop (arg1, arg2, BINOP_ADD));
case BINOP_SUB:
type = value_type (arg1);
while (TYPE_CODE (type) == TYPE_CODE_REF)
type = TYPE_TARGET_TYPE (type);
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
return value_cast (type, value_binop (arg1, arg2, BINOP_SUB));
case BINOP_MUL:
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;
type = language_bool_type (exp->language_defn, exp->gdbarch);
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:
case TYPE_CODE_RANGE:
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,
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 (type,
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 (type,
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);
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
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 */
projects / deliverable / binutils-gdb.git / blobdiff