#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"
#include "block.h"
#include "infcall.h"
#include "dictionary.h"
-#include "exceptions.h"
#include "annotate.h"
#include "valprint.h"
#include "source.h"
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;
}
}
but with the bit sizes of its elements (and those of any
constituent arrays) recorded in the BITSIZE components of its
TYPE_FIELD_BITSIZE values, and with *ELT_BITS set to its total size
- in bits. */
+ in bits.
+
+ Note that, for arrays whose index type has an XA encoding where
+ a bound references a record discriminant, getting that discriminant,
+ and therefore the actual value of that bound, is not possible
+ because none of the given parameters gives us access to the record.
+ This function assumes that it is OK in the context where it is being
+ used to return an array whose bounds are still dynamic and where
+ the length is arbitrary. */
static struct type *
constrained_packed_array_type (struct type *type, long *elt_bits)
TYPE_FIELD_BITSIZE (new_type, 0) = *elt_bits;
TYPE_NAME (new_type) = ada_type_name (type);
- if (get_discrete_bounds (index_type, &low_bound, &high_bound) < 0)
+ if ((TYPE_CODE (check_typedef (index_type)) == TYPE_CODE_RANGE
+ && is_dynamic_type (check_typedef (index_type)))
+ || get_discrete_bounds (index_type, &low_bound, &high_bound) < 0)
low_bound = high_bound = 0;
if (high_bound < low_bound)
*elt_bits = TYPE_LENGTH (new_type) = 0;
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 LONGEST
ada_array_bound (struct value *arr, int n, int which)
{
- struct type *arr_type = value_type (arr);
+ struct type *arr_type;
+
+ if (TYPE_CODE (check_typedef (value_type (arr))) == TYPE_CODE_PTR)
+ arr = value_ind (arr);
+ arr_type = value_enclosing_type (arr);
if (ada_is_constrained_packed_array_type (arr_type))
return ada_array_bound (decode_constrained_packed_array (arr), n, which);
static LONGEST
ada_array_length (struct value *arr, int n)
{
- struct type *arr_type = ada_check_typedef (value_type (arr));
+ struct type *arr_type;
+
+ if (TYPE_CODE (check_typedef (value_type (arr))) == TYPE_CODE_PTR)
+ arr = value_ind (arr);
+ arr_type = value_enclosing_type (arr);
if (ada_is_constrained_packed_array_type (arr_type))
return ada_array_length (decode_constrained_packed_array (arr), n);
the symbol is local or not, we check the block where we found it
against the global and static blocks of its associated symtab. */
if (sym
- && BLOCKVECTOR_BLOCK (BLOCKVECTOR (sym->symtab), GLOBAL_BLOCK) != block
- && BLOCKVECTOR_BLOCK (BLOCKVECTOR (sym->symtab), STATIC_BLOCK) != block)
+ && BLOCKVECTOR_BLOCK (SYMTAB_BLOCKVECTOR (sym->symtab),
+ GLOBAL_BLOCK) != block
+ && BLOCKVECTOR_BLOCK (SYMTAB_BLOCKVECTOR (sym->symtab),
+ STATIC_BLOCK) != block)
return;
h = msymbol_hash (name) % HASH_SIZE;
}
/* Go through the symtabs and check the externs and statics for
- symbols which match. */
+ symbols which match.
+ Non-primary symtabs share the block vector with their primary symtabs
+ so we use ALL_PRIMARY_SYMTABS here instead of ALL_SYMTABS. */
- ALL_SYMTABS (objfile, s)
+ ALL_PRIMARY_SYMTABS (objfile, s)
{
QUIT;
- b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), GLOBAL_BLOCK);
+ b = BLOCKVECTOR_BLOCK (SYMTAB_BLOCKVECTOR (s), GLOBAL_BLOCK);
ALL_BLOCK_SYMBOLS (b, iter, sym)
{
symbol_completion_add (&completions, SYMBOL_LINKAGE_NAME (sym),
}
}
- ALL_SYMTABS (objfile, s)
+ ALL_PRIMARY_SYMTABS (objfile, s)
{
QUIT;
- b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), STATIC_BLOCK);
+ b = BLOCKVECTOR_BLOCK (SYMTAB_BLOCKVECTOR (s), STATIC_BLOCK);
/* Don't do this block twice. */
if (b == surrounding_static_block)
continue;
return (value_from_longest
(value_type (arg1),
value_as_long (arg1) + value_as_long (arg2)));
+ if (TYPE_CODE (value_type (arg2)) == TYPE_CODE_PTR)
+ return (value_from_longest
+ (value_type (arg2),
+ 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))
return (value_from_longest
(value_type (arg1),
value_as_long (arg1) - value_as_long (arg2)));
+ if (TYPE_CODE (value_type (arg2)) == TYPE_CODE_PTR)
+ return (value_from_longest
+ (value_type (arg2),
+ 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))
*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 (type), 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 "
re_comp (known_runtime_file_name_patterns[i]);
if (re_exec (lbasename (sal.symtab->filename)))
return 1;
- if (sal.symtab->objfile != NULL
- && re_exec (objfile_name (sal.symtab->objfile)))
+ if (SYMTAB_OBJFILE (sal.symtab) != NULL
+ && re_exec (objfile_name (SYMTAB_OBJFILE (sal.symtab))))
return 1;
}
ALL_PRIMARY_SYMTABS (objfile, s)
{
- const struct blockvector *bv = BLOCKVECTOR (s);
+ const struct blockvector *bv = SYMTAB_BLOCKVECTOR (s);
int i;
for (i = GLOBAL_BLOCK; i <= STATIC_BLOCK; i++)