gdb/gdb-vla-intel-04of23.patch

615 lines
20 KiB
Diff
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

Subject: [PATCH 04/23] vla: make dynamic fortran arrays functional.
Message-Id: <1401861266-6240-5-git-send-email-keven.boell@intel.com>
This patch enables GDB to print the value of a dynamic
array (VLA) if allocated/associated in fortran. If not the
allocation status will be printed to the command line.
(gdb) p vla_not_allocated
$1 = <not allocated>
(gdb) p vla_allocated
$1 = (1, 2, 3)
(gdb) p vla_not_associated
$1 = <not associated>
(gdb) p vla_associated
$1 = (3, 2, 1)
The patch covers various locations where the allocation/
association status makes sense to print.
2014-05-28 Keven Boell <keven.boell@intel.com>
Sanimir Agovic <sanimir.agovic@intel.com>
* dwarf2loc.c (dwarf2_address_data_valid): New
function.
* dwarf2loc.h (dwarf2_address_data_valid): New
function.
* f-typeprint.c (f_print_type): Print allocation/
association status.
(f_type_print_varspec_suffix): Print allocation/
association status for &-operator usages.
* gdbtypes.c (create_array_type_with_stride): Add
query for valid data location.
(is_dynamic_type): Extend dynamic type detection
with allocated/associated. Add type detection for
fields.
(resolve_dynamic_range): Copy type before resolving
it as dynamic attributes need to be preserved.
(resolve_dynamic_array): Copy type before resolving
it as dynamic attributes need to be preserved. Add
resolving of allocated/associated attributes.
(resolve_dynamic_type): Add call to nested
type resolving.
(copy_type_recursive): Add allocated/associated
attributes to be copied.
(copy_type): Copy allocated/associated/data_location
as well as the fields structure if available.
(resolve_dynamic_compound): New function.
* valarith.c (value_subscripted_rvalue): Print allocated/
associated status when indexing a VLA.
* valprint.c (valprint_check_validity): Print allocated/
associated status.
(val_print_not_allocated): New function.
(val_print_not_associated): New function.
* valprint.h (val_print_not_allocated): New function.
(val_print_not_associated): New function.
* value.c (set_value_component_location): Adjust the value
address for single value prints.
Change-Id: Idfb44c8a6b38008f8e2c84cb0fdb13729ec160f4
Signed-off-by: Keven Boell <keven.boell@intel.com>
---
gdb/dwarf2loc.c | 14 +++++
gdb/dwarf2loc.h | 6 ++
gdb/f-typeprint.c | 62 +++++++++++++-------
gdb/gdbtypes.c | 165 +++++++++++++++++++++++++++++++++++++++++++++++++++--
gdb/valarith.c | 9 ++-
gdb/valprint.c | 40 +++++++++++++
gdb/valprint.h | 4 ++
gdb/value.c | 20 +++++++
8 files changed, 292 insertions(+), 28 deletions(-)
Index: gdb-7.7.90.20140613/gdb/dwarf2loc.c
===================================================================
--- gdb-7.7.90.20140613.orig/gdb/dwarf2loc.c 2014-06-14 15:12:43.797996885 +0200
+++ gdb-7.7.90.20140613/gdb/dwarf2loc.c 2014-06-14 15:12:45.485998049 +0200
@@ -2569,6 +2569,20 @@ dwarf2_evaluate_property (const struct d
return 0;
}
+/* See dwarf2loc.h. */
+
+int
+dwarf2_address_data_valid (const struct type *type)
+{
+ if (TYPE_NOT_ASSOCIATED (type))
+ return 0;
+
+ if (TYPE_NOT_ALLOCATED (type))
+ return 0;
+
+ return 1;
+}
+
/* Helper functions and baton for dwarf2_loc_desc_needs_frame. */
Index: gdb-7.7.90.20140613/gdb/dwarf2loc.h
===================================================================
--- gdb-7.7.90.20140613.orig/gdb/dwarf2loc.h 2014-06-14 15:12:43.797996885 +0200
+++ gdb-7.7.90.20140613/gdb/dwarf2loc.h 2014-06-14 15:12:45.486998064 +0200
@@ -102,6 +102,12 @@ int dwarf2_evaluate_property (const stru
CORE_ADDR dwarf2_read_addr_index (struct dwarf2_per_cu_data *per_cu,
unsigned int addr_index);
+/* Checks if a dwarf location definition is valid.
+ Returns 1 if valid; 0 otherwise. */
+
+extern int dwarf2_address_data_valid (const struct type *type);
+
+
/* The symbol location baton types used by the DWARF-2 reader (i.e.
SYMBOL_LOCATION_BATON for a LOC_COMPUTED symbol). "struct
dwarf2_locexpr_baton" is for a symbol with a single location
Index: gdb-7.7.90.20140613/gdb/f-typeprint.c
===================================================================
--- gdb-7.7.90.20140613.orig/gdb/f-typeprint.c 2014-06-14 15:12:43.798996886 +0200
+++ gdb-7.7.90.20140613/gdb/f-typeprint.c 2014-06-14 15:12:45.486998064 +0200
@@ -30,6 +30,7 @@
#include "gdbcore.h"
#include "target.h"
#include "f-lang.h"
+#include "valprint.h"
#include <string.h>
#include <errno.h>
@@ -56,6 +57,17 @@ f_print_type (struct type *type, const c
enum type_code code;
int demangled_args;
+ if (TYPE_NOT_ASSOCIATED (type))
+ {
+ val_print_not_associated (stream);
+ return;
+ }
+ if (TYPE_NOT_ALLOCATED (type))
+ {
+ val_print_not_allocated (stream);
+ return;
+ }
+
f_type_print_base (type, stream, show, level);
code = TYPE_CODE (type);
if ((varstring != NULL && *varstring != '\0')
@@ -170,28 +182,36 @@ f_type_print_varspec_suffix (struct type
if (arrayprint_recurse_level == 1)
fprintf_filtered (stream, "(");
- if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
- f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
- arrayprint_recurse_level);
-
- lower_bound = f77_get_lowerbound (type);
- if (lower_bound != 1) /* Not the default. */
- fprintf_filtered (stream, "%d:", lower_bound);
-
- /* Make sure that, if we have an assumed size array, we
- print out a warning and print the upperbound as '*'. */
-
- if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
- fprintf_filtered (stream, "*");
+ if (TYPE_NOT_ASSOCIATED (type))
+ val_print_not_associated (stream);
+ else if (TYPE_NOT_ALLOCATED (type))
+ val_print_not_allocated (stream);
else
- {
- upper_bound = f77_get_upperbound (type);
- fprintf_filtered (stream, "%d", upper_bound);
- }
-
- if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
- f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
- arrayprint_recurse_level);
+ {
+
+ if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
+ f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
+ arrayprint_recurse_level);
+
+ lower_bound = f77_get_lowerbound (type);
+ if (lower_bound != 1) /* Not the default. */
+ fprintf_filtered (stream, "%d:", lower_bound);
+
+ /* Make sure that, if we have an assumed size array, we
+ print out a warning and print the upperbound as '*'. */
+
+ if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
+ fprintf_filtered (stream, "*");
+ else
+ {
+ upper_bound = f77_get_upperbound (type);
+ fprintf_filtered (stream, "%d", upper_bound);
+ }
+
+ if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
+ f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
+ arrayprint_recurse_level);
+ }
if (arrayprint_recurse_level == 1)
fprintf_filtered (stream, ")");
else
Index: gdb-7.7.90.20140613/gdb/gdbtypes.c
===================================================================
--- gdb-7.7.90.20140613.orig/gdb/gdbtypes.c 2014-06-14 15:12:43.801996888 +0200
+++ gdb-7.7.90.20140613/gdb/gdbtypes.c 2014-06-14 15:14:34.837102369 +0200
@@ -1003,7 +1003,8 @@ create_array_type_with_stride (struct ty
TYPE_CODE (result_type) = TYPE_CODE_ARRAY;
TYPE_TARGET_TYPE (result_type) = element_type;
- if (has_static_range (TYPE_RANGE_DATA (range_type)))
+ if (has_static_range (TYPE_RANGE_DATA (range_type))
+ && dwarf2_address_data_valid (result_type))
{
LONGEST low_bound, high_bound;
@@ -1616,11 +1617,30 @@ stub_noname_complaint (void)
int
is_dynamic_type (struct type *type)
{
+ int index;
+
+ if (!type)
+ return 0;
+
type = check_typedef (type);
if (TYPE_CODE (type) == TYPE_CODE_REF)
type = check_typedef (TYPE_TARGET_TYPE (type));
+ if (TYPE_ASSOCIATED_PROP (type))
+ return 1;
+
+ if (TYPE_ALLOCATED_PROP (type))
+ return 1;
+
+ /* Scan field types in the Fortran case for nested dynamic types.
+ This will be done only for Fortran as in the C++ case an endless recursion
+ can occur in the area of classes. */
+ if (current_language->la_language == language_fortran)
+ for (index = 0; index < TYPE_NFIELDS (type); index++)
+ if (is_dynamic_type (TYPE_FIELD_TYPE (type, index)))
+ return 1;
+
switch (TYPE_CODE (type))
{
case TYPE_CODE_RANGE:
@@ -1669,6 +1689,7 @@ resolve_dynamic_range (struct type *dyn_
const struct dynamic_prop *prop;
const struct dwarf2_locexpr_baton *baton;
struct dynamic_prop low_bound, high_bound;
+ struct type *range_copy = copy_type (dyn_range_type);
gdb_assert (TYPE_CODE (dyn_range_type) == TYPE_CODE_RANGE);
@@ -1700,8 +1721,8 @@ resolve_dynamic_range (struct type *dyn_
high_bound.data.const_val = 0;
}
- static_range_type = create_range_type (copy_type (dyn_range_type),
- TYPE_TARGET_TYPE (dyn_range_type),
+ static_range_type = create_range_type (range_copy,
+ TYPE_TARGET_TYPE (range_copy),
&low_bound, &high_bound);
TYPE_RANGE_DATA (static_range_type)->flag_bound_evaluated = 1;
return static_range_type;
@@ -1718,6 +1739,8 @@ resolve_dynamic_array (struct type *type
struct type *elt_type;
struct type *range_type;
struct type *ary_dim;
+ struct dynamic_prop *prop;
+ struct type *copy = copy_type (type);
gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY);
@@ -1725,18 +1748,93 @@ resolve_dynamic_array (struct type *type
range_type = check_typedef (TYPE_INDEX_TYPE (elt_type));
range_type = resolve_dynamic_range (range_type, addr);
+ prop = TYPE_ALLOCATED_PROP (type);
+ if (dwarf2_evaluate_property (prop, addr, &value))
+ {
+ TYPE_ALLOCATED_PROP (copy)->kind = PROP_CONST;
+ TYPE_ALLOCATED_PROP (copy)->data.const_val = value;
+ }
+
+ prop = TYPE_ASSOCIATED_PROP (type);
+ if (dwarf2_evaluate_property (prop, addr, &value))
+ {
+ TYPE_ASSOCIATED_PROP (copy)->kind = PROP_CONST;
+ TYPE_ASSOCIATED_PROP (copy)->data.const_val = value;
+ }
+
ary_dim = check_typedef (TYPE_TARGET_TYPE (elt_type));
if (ary_dim != NULL && TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY)
- elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (type), addr);
+ elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (copy), addr);
else
elt_type = TYPE_TARGET_TYPE (type);
- return create_array_type (copy_type (type),
+ return create_array_type (copy,
elt_type,
range_type);
}
+/* Resolves dynamic compound types, e.g. STRUCTS's to static ones.
+ ADDRESS is needed to resolve the compound type data location. */
+
+static struct type *
+resolve_dynamic_compound (struct type *type, CORE_ADDR addr)
+{
+ struct type *cur_type, *prev_type, *copy;
+ int index, depth = 0;
+
+ cur_type = type;
+ prev_type = cur_type;
+ while (cur_type)
+ {
+ switch (TYPE_CODE (cur_type))
+ {
+ case TYPE_CODE_STRUCT:
+ {
+ copy = copy_type (cur_type);
+ for (index = 0; index < TYPE_NFIELDS (copy); index++)
+ {
+ struct type *index_type = TYPE_FIELD_TYPE (copy, index);
+
+ if (index_type == NULL)
+ continue;
+
+ if (TYPE_CODE (index_type) == TYPE_CODE_ARRAY
+ || TYPE_CODE (index_type) == TYPE_CODE_STRUCT)
+ {
+ if (TYPE_CODE (index_type) != TYPE_CODE_RANGE)
+ addr +=
+ (TYPE_FIELD_BITPOS (copy, index) / 8);
+
+ TYPE_FIELD_TYPE (copy, index) =
+ resolve_dynamic_type (TYPE_FIELD_TYPE (copy, index),
+ addr);
+ }
+ }
+
+ /* If a struct type will be resolved as the first type, we need
+ to assign it back the resolved_type. In the other case it can
+ be that we have a struct, which is nested in another type.
+ Therefore we need to preserve the previous type, to assign the
+ new resolved type as the previous' target type. */
+ if (depth == 0)
+ type = copy;
+ else
+ TYPE_TARGET_TYPE (prev_type) = copy;
+ }
+ break;
+ }
+
+ /* Store the previous type, in order to assign resolved types back to
+ the right target type. */
+ prev_type = cur_type;
+ cur_type = TYPE_TARGET_TYPE (cur_type);
+ depth++;
+ };
+
+ return type;
+}
+
/* Resolve dynamic bounds of members of the union TYPE to static
bounds. */
@@ -1836,7 +1934,7 @@ resolve_dynamic_type (struct type *type,
struct type *real_type = check_typedef (type);
struct type *resolved_type = type;
const struct dynamic_prop *prop;
- CORE_ADDR value;
+ CORE_ADDR value, adjusted_address = addr;
if (!is_dynamic_type (real_type))
return type;
@@ -1882,12 +1980,15 @@ resolve_dynamic_type (struct type *type,
prop = TYPE_DATA_LOCATION (type);
if (dwarf2_evaluate_property (prop, addr, &value))
{
+ adjusted_address = value;
TYPE_DATA_LOCATION_ADDR (type) = value;
TYPE_DATA_LOCATION_KIND (type) = PROP_CONST;
}
else
TYPE_DATA_LOCATION (type) = NULL;
+ resolved_type = resolve_dynamic_compound (type, adjusted_address);
+
return resolved_type;
}
@@ -4104,6 +4205,20 @@ copy_type_recursive (struct objfile *obj
*TYPE_DATA_LOCATION (new_type) = *TYPE_DATA_LOCATION (type);
}
+ /* Copy allocated information. */
+ if (TYPE_ALLOCATED_PROP (type) != NULL)
+ {
+ TYPE_ALLOCATED_PROP (new_type) = xmalloc (sizeof (struct dynamic_prop));
+ *TYPE_ALLOCATED_PROP (new_type) = *TYPE_ALLOCATED_PROP (type);
+ }
+
+ /* Copy associated information. */
+ if (TYPE_ASSOCIATED_PROP (type) != NULL)
+ {
+ TYPE_ASSOCIATED_PROP (new_type) = xmalloc (sizeof (struct dynamic_prop));
+ *TYPE_ASSOCIATED_PROP (new_type) = *TYPE_ASSOCIATED_PROP (type);
+ }
+
/* Copy pointers to other types. */
if (TYPE_TARGET_TYPE (type))
TYPE_TARGET_TYPE (new_type) =
@@ -4150,6 +4265,44 @@ copy_type (const struct type *type)
memcpy (TYPE_MAIN_TYPE (new_type), TYPE_MAIN_TYPE (type),
sizeof (struct main_type));
+ if (TYPE_ALLOCATED_PROP (type))
+ {
+ TYPE_ALLOCATED_PROP (new_type)
+ = OBSTACK_ZALLOC (&TYPE_OWNER (type).objfile->objfile_obstack,
+ struct dynamic_prop);
+ memcpy (TYPE_ALLOCATED_PROP (new_type), TYPE_ALLOCATED_PROP (type),
+ sizeof (struct dynamic_prop));
+ }
+
+ if (TYPE_ASSOCIATED_PROP (type))
+ {
+ TYPE_ASSOCIATED_PROP (new_type)
+ = OBSTACK_ZALLOC (&TYPE_OWNER (type).objfile->objfile_obstack,
+ struct dynamic_prop);
+ memcpy (TYPE_ASSOCIATED_PROP (new_type), TYPE_ASSOCIATED_PROP (type),
+ sizeof (struct dynamic_prop));
+ }
+
+ if (TYPE_DATA_LOCATION (type))
+ {
+ TYPE_DATA_LOCATION (new_type)
+ = OBSTACK_ZALLOC (&TYPE_OWNER (type).objfile->objfile_obstack,
+ struct dynamic_prop);
+ memcpy (TYPE_DATA_LOCATION (new_type), TYPE_DATA_LOCATION (type),
+ sizeof (struct dynamic_prop));
+ }
+
+ if (TYPE_NFIELDS (type))
+ {
+ int nfields = TYPE_NFIELDS (type);
+
+ TYPE_FIELDS (new_type)
+ = OBSTACK_CALLOC (&TYPE_OWNER (type).objfile->objfile_obstack,
+ nfields, struct field);
+ memcpy (TYPE_FIELDS (new_type), TYPE_FIELDS (type),
+ nfields * sizeof (struct field));
+ }
+
return new_type;
}
Index: gdb-7.7.90.20140613/gdb/valarith.c
===================================================================
--- gdb-7.7.90.20140613.orig/gdb/valarith.c 2014-06-14 15:12:43.801996888 +0200
+++ gdb-7.7.90.20140613/gdb/valarith.c 2014-06-14 15:12:45.488998075 +0200
@@ -200,7 +200,14 @@ value_subscripted_rvalue (struct value *
if (index < lowerbound || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type)
&& elt_offs >= TYPE_LENGTH (array_type)))
- error (_("no such vector element"));
+ {
+ if (TYPE_NOT_ASSOCIATED (array_type))
+ error (_("no such vector element because not associated"));
+ else if (TYPE_NOT_ALLOCATED (array_type))
+ error (_("no such vector element because not allocated"));
+ else
+ error (_("no such vector element"));
+ }
if (VALUE_LVAL (array) == lval_memory && value_lazy (array))
v = allocate_value_lazy (elt_type);
Index: gdb-7.7.90.20140613/gdb/valprint.c
===================================================================
--- gdb-7.7.90.20140613.orig/gdb/valprint.c 2014-06-14 15:12:43.802996888 +0200
+++ gdb-7.7.90.20140613/gdb/valprint.c 2014-06-14 15:12:45.488998075 +0200
@@ -307,6 +307,18 @@ valprint_check_validity (struct ui_file
{
CHECK_TYPEDEF (type);
+ if (TYPE_NOT_ASSOCIATED (type))
+ {
+ val_print_not_associated (stream);
+ return 0;
+ }
+
+ if (TYPE_NOT_ALLOCATED (type))
+ {
+ val_print_not_allocated (stream);
+ return 0;
+ }
+
if (TYPE_CODE (type) != TYPE_CODE_UNION
&& TYPE_CODE (type) != TYPE_CODE_STRUCT
&& TYPE_CODE (type) != TYPE_CODE_ARRAY)
@@ -362,6 +374,18 @@ val_print_invalid_address (struct ui_fil
fprintf_filtered (stream, _("<invalid address>"));
}
+void
+val_print_not_allocated (struct ui_file *stream)
+{
+ fprintf_filtered (stream, _("<not allocated>"));
+}
+
+void
+val_print_not_associated (struct ui_file *stream)
+{
+ fprintf_filtered (stream, _("<not associated>"));
+}
+
/* A generic val_print that is suitable for use by language
implementations of the la_val_print method. This function can
handle most type codes, though not all, notably exception
@@ -803,12 +827,16 @@ static int
value_check_printable (struct value *val, struct ui_file *stream,
const struct value_print_options *options)
{
+ const struct type *type;
+
if (val == 0)
{
fprintf_filtered (stream, _("<address of value unknown>"));
return 0;
}
+ type = value_type (val);
+
if (value_entirely_optimized_out (val))
{
if (options->summary && !val_print_scalar_type_p (value_type (val)))
@@ -834,6 +862,18 @@ value_check_printable (struct value *val
return 0;
}
+ if (TYPE_NOT_ASSOCIATED (type))
+ {
+ val_print_not_associated (stream);
+ return 0;
+ }
+
+ if (TYPE_NOT_ALLOCATED (type))
+ {
+ val_print_not_allocated (stream);
+ return 0;
+ }
+
return 1;
}
Index: gdb-7.7.90.20140613/gdb/valprint.h
===================================================================
--- gdb-7.7.90.20140613.orig/gdb/valprint.h 2014-06-14 15:12:43.803996889 +0200
+++ gdb-7.7.90.20140613/gdb/valprint.h 2014-06-14 15:12:45.489998073 +0200
@@ -217,4 +217,8 @@ extern void output_command_const (const
extern int val_print_scalar_type_p (struct type *type);
+extern void val_print_not_allocated (struct ui_file *stream);
+
+extern void val_print_not_associated (struct ui_file *stream);
+
#endif
Index: gdb-7.7.90.20140613/gdb/value.c
===================================================================
--- gdb-7.7.90.20140613.orig/gdb/value.c 2014-06-14 15:12:43.804996890 +0200
+++ gdb-7.7.90.20140613/gdb/value.c 2014-06-14 15:12:45.490998069 +0200
@@ -43,6 +43,7 @@
#include "tracepoint.h"
#include "cp-abi.h"
#include "user-regs.h"
+#include "dwarf2loc.h"
/* Prototypes for exported functions. */
@@ -1646,6 +1647,25 @@ set_value_component_location (struct val
if (funcs->copy_closure)
component->location.computed.closure = funcs->copy_closure (whole);
}
+
+ /* For dynamic types compute the address of the component value location in
+ sub range types based on the location of the sub range type, if not being
+ an internal GDB variable or parts of it. */
+ if (VALUE_LVAL (component) != lval_internalvar
+ && VALUE_LVAL (component) != lval_internalvar_component)
+ {
+ CORE_ADDR addr;
+ struct type *type = value_type (whole);
+
+ addr = value_raw_address (component);
+
+ if (TYPE_DATA_LOCATION (type)
+ && TYPE_DATA_LOCATION_KIND (type) == PROP_CONST)
+ {
+ addr = TYPE_DATA_LOCATION_ADDR (type);
+ set_value_address (component, addr);
+ }
+ }
}