#include "defs.h"
-#include <stdio.h>
-#include <string.h>
#include <ctype.h>
-#include <stdarg.h>
#include "demangle.h"
#include "gdb_regex.h"
#include "frame.h"
static void
maint_set_ada_cmd (char *args, int from_tty)
{
- help_list (maint_set_ada_cmdlist, "maintenance set ada ", -1, gdb_stdout);
+ help_list (maint_set_ada_cmdlist, "maintenance set ada ", all_commands,
+ gdb_stdout);
}
/* Implement the "maintenance show ada" (prefix) command. */
else
{
result = allocate_value (type);
- memcpy (value_contents_raw (result), value_contents (val),
- TYPE_LENGTH (type));
+ value_contents_copy_raw (result, 0, val, 0, TYPE_LENGTH (type));
}
set_value_component_location (result, val);
set_value_bitsize (result, value_bitsize (val));
set_value_bitpos (result, value_bitpos (val));
set_value_address (result, value_address (val));
- set_value_optimized_out (result, value_optimized_out_const (val));
return result;
}
}
LONGEST
ada_discrete_type_high_bound (struct type *type)
{
+ type = resolve_dynamic_type (type, 0);
switch (TYPE_CODE (type))
{
case TYPE_CODE_RANGE:
LONGEST
ada_discrete_type_low_bound (struct type *type)
{
+ type = resolve_dynamic_type (type, 0);
switch (TYPE_CODE (type))
{
case TYPE_CODE_RANGE:
return elt;
}
-/* Assuming ARR is a pointer to a standard GDB array of type TYPE, the
- value of the element of *ARR at the ARITY indices given in
- IND. Does not read the entire array into memory. */
+/* Assuming ARR is a pointer to a GDB array, the value of the element
+ of *ARR at the ARITY indices given in IND.
+ Does not read the entire array into memory. */
static struct value *
-ada_value_ptr_subscript (struct value *arr, struct type *type, int arity,
- struct value **ind)
+ada_value_ptr_subscript (struct value *arr, int arity, struct value **ind)
{
int k;
+ struct type *type
+ = check_typedef (value_enclosing_type (ada_value_ind (arr)));
for (k = 0; k < arity; k += 1)
{
static struct value *
ada_read_renaming_var_value (struct symbol *renaming_sym,
- struct block *block)
+ const struct block *block)
{
const char *sym_name;
struct expression *expr;
struct symtab *s;
struct minimal_symbol *msymbol;
struct objfile *objfile;
- struct block *b, *surrounding_static_block = 0;
+ const struct block *b, *surrounding_static_block = 0;
int i;
struct block_iterator iter;
struct cleanup *old_chain = make_cleanup (null_cleanup, NULL);
struct value *discrim;
LONGEST discrim_val;
- outer = value_from_contents_and_address (outer_type, outer_valaddr, 0);
+ /* Using plain value_from_contents_and_address here causes problems
+ because we will end up trying to resolve a type that is currently
+ being constructed. */
+ outer = value_from_contents_and_address_unresolved (outer_type,
+ outer_valaddr, 0);
discrim = ada_value_struct_elt (outer, discrim_name, 1);
if (discrim == NULL)
return -1;
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);
+ /* Using plain value_from_contents_and_address here
+ causes problems because we will end up trying to
+ resolve a type that is currently being
+ constructed. */
+ dval = value_from_contents_and_address_unresolved (rtype,
+ valaddr,
+ address);
rtype = value_type (dval);
}
else
if (dval0 == NULL)
{
- dval = value_from_contents_and_address (rtype, valaddr, address);
+ /* Using plain value_from_contents_and_address here causes
+ problems because we will end up trying to resolve a type
+ that is currently being constructed. */
+ dval = value_from_contents_and_address_unresolved (rtype, valaddr,
+ address);
rtype = value_type (dval);
}
else
*pos += 4;
goto nosideret;
}
- else if (SYMBOL_DOMAIN (exp->elts[pc + 2].symbol) == UNDEF_DOMAIN)
+
+ if (SYMBOL_DOMAIN (exp->elts[pc + 2].symbol) == UNDEF_DOMAIN)
/* Only encountered when an unresolved symbol occurs in a
context other than a function call, in which case, it is
invalid. */
error (_("Unexpected unresolved symbol, %s, during evaluation"),
SYMBOL_PRINT_NAME (exp->elts[pc + 2].symbol));
- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
+
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
{
type = static_unwrap_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
/* Check to see if this is a tagged type. We also need to handle
if (ada_is_tagged_type (type, 0)
|| (TYPE_CODE (type) == TYPE_CODE_REF
&& ada_is_tagged_type (TYPE_TARGET_TYPE (type), 0)))
- {
- /* Tagged types are a little special in the fact that the real
- type is dynamic and can only be determined by inspecting the
- 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);
-
- if (TYPE_CODE (type) != TYPE_CODE_REF)
- {
- struct type *actual_type;
-
- actual_type = type_from_tag (ada_value_tag (arg1));
- if (actual_type == NULL)
- /* If, for some reason, we were unable to determine
- the actual type from the tag, then use the static
- approximation that we just computed as a fallback.
- This can happen if the debugging information is
- incomplete, for instance. */
- actual_type = type;
- return value_zero (actual_type, not_lval);
- }
- else
- {
- /* In the case of a ref, ada_coerce_ref takes care
- of determining the actual type. But the evaluation
- should return a ref as it should be valid to ask
- for its address; so rebuild a ref after coerce. */
- arg1 = ada_coerce_ref (arg1);
- return value_ref (arg1);
- }
- }
+ {
+ /* 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);
+
+ if (TYPE_CODE (type) != TYPE_CODE_REF)
+ {
+ struct type *actual_type;
+
+ actual_type = type_from_tag (ada_value_tag (arg1));
+ if (actual_type == NULL)
+ /* If, for some reason, we were unable to determine
+ the actual type from the tag, then use the static
+ approximation that we just computed as a fallback.
+ This can happen if the debugging information is
+ incomplete, for instance. */
+ actual_type = type;
+ return value_zero (actual_type, not_lval);
+ }
+ else
+ {
+ /* In the case of a ref, ada_coerce_ref takes care
+ of determining the actual type. But the evaluation
+ should return a ref as it should be valid to ask
+ for its address; so rebuild a ref after coerce. */
+ arg1 = ada_coerce_ref (arg1);
+ return value_ref (arg1);
+ }
+ }
- *pos += 4;
- return value_zero
- (to_static_fixed_type
- (static_unwrap_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol))),
- not_lval);
- }
- else
- {
- arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
- return ada_to_fixed_value (arg1);
+ /* Records and unions for which GNAT encodings have been
+ generated need to be statically fixed as well.
+ Otherwise, non-static fixing produces a type where
+ all dynamic properties are removed, which prevents "ptype"
+ from being able to completely describe the type.
+ For instance, a case statement in a variant record would be
+ replaced by the relevant components based on the actual
+ value of the discriminants. */
+ if ((TYPE_CODE (type) == TYPE_CODE_STRUCT
+ && dynamic_template_type (type) != NULL)
+ || (TYPE_CODE (type) == TYPE_CODE_UNION
+ && ada_find_parallel_type (type, "___XVU") != NULL))
+ {
+ *pos += 4;
+ return value_zero (to_static_fixed_type (type), not_lval);
+ }
}
+ arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
+ return ada_to_fixed_value (arg1);
+
case OP_FUNCALL:
(*pos) += 2;
(ada_coerce_to_simple_array (argvec[0]),
nargs, argvec + 1));
case TYPE_CODE_PTR: /* Pointer to array */
- type = to_fixed_array_type (TYPE_TARGET_TYPE (type), NULL, 1);
if (noside == EVAL_AVOID_SIDE_EFFECTS)
{
+ type = to_fixed_array_type (TYPE_TARGET_TYPE (type), NULL, 1);
type = ada_array_element_type (type, nargs);
if (type == NULL)
error (_("element type of array unknown"));
return value_zero (ada_aligned_type (type), lval_memory);
}
return
- unwrap_value (ada_value_ptr_subscript (argvec[0], type,
- nargs, argvec + 1));
+ unwrap_value (ada_value_ptr_subscript (argvec[0],
+ nargs, argvec + 1));
default:
error (_("Attempt to index or call something other than an "
variants of the runtime, we use a sniffer that will determine
the runtime variant used by the program being debugged. */
-/* Ada's standard exceptions. */
+/* Ada's standard exceptions.
+
+ The Ada 83 standard also defined Numeric_Error. But there so many
+ situations where it was unclear from the Ada 83 Reference Manual
+ (RM) whether Constraint_Error or Numeric_Error should be raised,
+ that the ARG (Ada Rapporteur Group) eventually issued a Binding
+ Interpretation saying that anytime the RM says that Numeric_Error
+ should be raised, the implementation may raise Constraint_Error.
+ Ada 95 went one step further and pretty much removed Numeric_Error
+ from the list of standard exceptions (it made it a renaming of
+ Constraint_Error, to help preserve compatibility when compiling
+ an Ada83 compiler). As such, we do not include Numeric_Error from
+ this list of standard exceptions. */
static char *standard_exc[] = {
"constraint_error",
ada_add_exceptions_from_frame (regex_t *preg, struct frame_info *frame,
VEC(ada_exc_info) **exceptions)
{
- struct block *block = get_frame_block (frame, 0);
+ const struct block *block = get_frame_block (frame, 0);
while (block != 0)
{
ALL_PRIMARY_SYMTABS (objfile, s)
{
- struct blockvector *bv = BLOCKVECTOR (s);
+ const struct blockvector *bv = BLOCKVECTOR (s);
int i;
for (i = GLOBAL_BLOCK; i <= STATIC_BLOCK; i++)
static struct value *
ada_read_var_value (struct symbol *var, struct frame_info *frame)
{
- struct block *frame_block = NULL;
+ const struct block *frame_block = NULL;
struct symbol *renaming_sym = NULL;
/* The only case where default_read_var_value is not sufficient
{
printf_unfiltered (_(\
"\"set ada\" must be followed by the name of a setting.\n"));
- help_list (set_ada_list, "set ada ", -1, gdb_stdout);
+ help_list (set_ada_list, "set ada ", all_commands, gdb_stdout);
}
/* Implement the "show ada" prefix command. */
projects / deliverable / binutils-gdb.git / blobdiff