rpms
/
gdb
2
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
gdb/gdb-6.8-bz377541-vla.patch

3060 lines
107 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.

Based on:
http://people.redhat.com/jkratoch/vla/
fortran-dynamic-arrays-HEAD-j.patch
--- ./gdb/c-typeprint.c 2008-11-06 20:50:14.000000000 +0100
+++ ./gdb/c-typeprint.c 2008-11-06 20:51:03.000000000 +0100
@@ -541,7 +541,12 @@ c_type_print_varspec_suffix (struct type
fprintf_filtered (stream, ")");
fprintf_filtered (stream, "[");
- if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0
+ if (TYPE_ARRAY_BOUND_IS_DWARF_BLOCK (type, 1))
+ {
+ /* No _() - printed sources should not be locale dependent. */
+ fprintf_filtered (stream, "variable");
+ }
+ else if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0
&& !TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
fprintf_filtered (stream, "%d",
(TYPE_LENGTH (type)
--- ./gdb/dwarf2expr.c 2008-11-06 20:50:14.000000000 +0100
+++ ./gdb/dwarf2expr.c 2008-11-06 20:51:03.000000000 +0100
@@ -750,6 +750,13 @@ execute_stack_op (struct dwarf_expr_cont
ctx->initialized = 0;
goto no_push;
+ case DW_OP_push_object_address:
+ if (ctx->get_object_address == NULL)
+ error (_("DWARF-2 expression error: DW_OP_push_object_address must "
+ "have a value to push."));
+ result = (ctx->get_object_address) (ctx->baton);
+ break;
+
default:
error (_("Unhandled dwarf expression opcode 0x%x"), op);
}
--- ./gdb/dwarf2expr.h 2008-11-06 20:50:14.000000000 +0100
+++ ./gdb/dwarf2expr.h 2008-11-06 20:51:03.000000000 +0100
@@ -61,10 +61,10 @@ struct dwarf_expr_context
The result must be live until the current expression evaluation
is complete. */
unsigned char *(*get_subr) (void *baton, off_t offset, size_t *length);
+#endif
/* Return the `object address' for DW_OP_push_object_address. */
CORE_ADDR (*get_object_address) (void *baton);
-#endif
/* The current depth of dwarf expression recursion, via DW_OP_call*,
DW_OP_fbreg, DW_OP_push_object_address, etc., and the maximum
--- ./gdb/dwarf2loc.c 2008-11-06 20:50:14.000000000 +0100
+++ ./gdb/dwarf2loc.c 2008-11-06 20:51:35.000000000 +0100
@@ -106,6 +106,9 @@ struct dwarf_expr_baton
{
struct frame_info *frame;
struct objfile *objfile;
+ /* From DW_TAG_variable's DW_AT_location (not DW_TAG_type's
+ DW_AT_data_location) for DW_OP_push_object_address. */
+ CORE_ADDR object_address;
};
/* Helper functions for dwarf2_evaluate_loc_desc. */
@@ -164,22 +167,32 @@ dwarf_expr_frame_base (void *baton, gdb_
*start = find_location_expression (symbaton, length,
get_frame_address_in_block (frame));
}
- else
+ else if (SYMBOL_OPS (framefunc) == &dwarf2_locexpr_funcs)
{
struct dwarf2_locexpr_baton *symbaton;
+
symbaton = SYMBOL_LOCATION_BATON (framefunc);
- if (symbaton != NULL)
- {
- *length = symbaton->size;
- *start = symbaton->data;
- }
- else
- *start = NULL;
+ gdb_assert (symbaton != NULL);
+ *start = symbaton->data;
+ *length = symbaton->size;
}
+ else if (SYMBOL_OPS (framefunc) == &dwarf2_missing_funcs)
+ {
+ struct dwarf2_locexpr_baton *symbaton;
+
+ symbaton = SYMBOL_LOCATION_BATON (framefunc);
+ gdb_assert (symbaton == NULL);
+ *start = NULL;
+ *length = 0; /* unused */
+ }
+ else
+ internal_error (__FILE__, __LINE__,
+ _("Unsupported SYMBOL_OPS %p for \"%s\""),
+ SYMBOL_OPS (framefunc), SYMBOL_PRINT_NAME (framefunc));
if (*start == NULL)
error (_("Could not find the frame base for \"%s\"."),
- SYMBOL_NATURAL_NAME (framefunc));
+ SYMBOL_PRINT_NAME (framefunc));
}
/* Using the objfile specified in BATON, find the address for the
@@ -192,6 +205,117 @@ dwarf_expr_tls_address (void *baton, COR
return target_translate_tls_address (debaton->objfile, offset);
}
+static CORE_ADDR
+dwarf_expr_object_address (void *baton)
+{
+ struct dwarf_expr_baton *debaton = baton;
+
+ /* The message is suppressed in DWARF_BLOCK_EXEC. */
+ if (debaton->object_address == 0)
+ error (_("Cannot resolve DW_OP_push_object_address for a missing object"));
+
+ return debaton->object_address;
+}
+
+/* Address of the variable we are currently referring to. It is set from
+ DW_TAG_variable's DW_AT_location (not DW_TAG_type's DW_AT_data_location) for
+ DW_OP_push_object_address. */
+
+static CORE_ADDR object_address;
+
+/* Callers use object_address_set while their callers use the result set so we
+ cannot run the cleanup at the local block of our direct caller. Still we
+ should reset OBJECT_ADDRESS at least for the next GDB command. */
+
+static void
+object_address_cleanup (void *prev_save_voidp)
+{
+ CORE_ADDR *prev_save = prev_save_voidp;
+
+ object_address = *prev_save;
+ xfree (prev_save);
+}
+
+/* Set the base address - DW_AT_location - of a variable. It is being later
+ used to derive other object addresses by DW_OP_push_object_address.
+
+ It would be useful to sanity check ADDRESS - such as for some objects with
+ unset VALUE_ADDRESS - but some valid addresses may be zero (such as first
+ objects in relocatable .o files). */
+
+void
+object_address_set (CORE_ADDR address)
+{
+ CORE_ADDR *prev_save;
+
+ prev_save = xmalloc (sizeof *prev_save);
+ *prev_save = object_address;
+ make_cleanup (object_address_cleanup, prev_save);
+
+ object_address = address;
+}
+
+/* Evaluate DWARF expression at DATA ... DATA + SIZE with its result readable
+ by dwarf_expr_fetch (RETVAL, 0). FRAME parameter can be NULL to call
+ get_selected_frame to find it. Returned dwarf_expr_context freeing is
+ pushed on the cleanup chain. */
+
+static struct dwarf_expr_context *
+dwarf_expr_prep_ctx (struct frame_info *frame, gdb_byte *data,
+ unsigned short size, struct objfile *objfile)
+{
+ struct dwarf_expr_context *ctx;
+ struct dwarf_expr_baton baton;
+
+ if (!frame)
+ frame = get_selected_frame (NULL);
+
+ baton.frame = frame;
+ baton.objfile = objfile;
+ baton.object_address = object_address;
+
+ ctx = new_dwarf_expr_context ();
+ ctx->baton = &baton;
+ ctx->read_reg = dwarf_expr_read_reg;
+ ctx->read_mem = dwarf_expr_read_mem;
+ ctx->get_frame_base = dwarf_expr_frame_base;
+ ctx->get_tls_address = dwarf_expr_tls_address;
+ ctx->get_object_address = dwarf_expr_object_address;
+
+ make_cleanup ((make_cleanup_ftype *) free_dwarf_expr_context, ctx);
+
+ dwarf_expr_eval (ctx, data, size);
+
+ /* It was used only during dwarf_expr_eval. */
+ ctx->baton = NULL;
+
+ return ctx;
+}
+
+/* Evaluate DWARF expression at DLBATON expecting it produces exactly one
+ CORE_ADDR result on the DWARF stack stack. */
+
+CORE_ADDR
+dwarf_locexpr_baton_eval (struct dwarf2_locexpr_baton *dlbaton)
+{
+ struct dwarf_expr_context *ctx;
+ CORE_ADDR retval;
+ struct cleanup *back_to = make_cleanup (null_cleanup, 0);
+
+ ctx = dwarf_expr_prep_ctx (NULL, dlbaton->data, dlbaton->size,
+ dlbaton->objfile);
+ if (ctx->num_pieces > 0)
+ error (_("DW_OP_*piece is unsupported for DW_FORM_block"));
+ else if (ctx->in_reg)
+ error (_("Register result is unsupported for DW_FORM_block"));
+
+ retval = dwarf_expr_fetch (ctx, 0);
+
+ do_cleanups (back_to);
+
+ return retval;
+}
+
/* Evaluate a location description, starting at DATA and with length
SIZE, to find the current location of variable VAR in the context
of FRAME. */
@@ -202,8 +326,8 @@ dwarf2_evaluate_loc_desc (struct symbol
{
struct gdbarch *arch = get_frame_arch (frame);
struct value *retval;
- struct dwarf_expr_baton baton;
struct dwarf_expr_context *ctx;
+ struct cleanup *back_to = make_cleanup (null_cleanup, 0);
if (size == 0)
{
@@ -213,17 +337,8 @@ dwarf2_evaluate_loc_desc (struct symbol
return retval;
}
- baton.frame = frame;
- baton.objfile = objfile;
+ ctx = dwarf_expr_prep_ctx (frame, data, size, objfile);
- ctx = new_dwarf_expr_context ();
- ctx->baton = &baton;
- ctx->read_reg = dwarf_expr_read_reg;
- ctx->read_mem = dwarf_expr_read_mem;
- ctx->get_frame_base = dwarf_expr_frame_base;
- ctx->get_tls_address = dwarf_expr_tls_address;
-
- dwarf_expr_eval (ctx, data, size);
if (ctx->num_pieces > 0)
{
int i;
@@ -261,6 +376,10 @@ dwarf2_evaluate_loc_desc (struct symbol
{
CORE_ADDR address = dwarf_expr_fetch (ctx, 0);
+ /* object_address_set called here is required in ALLOCATE_VALUE's
+ CHECK_TYPEDEF for the object's possible DW_OP_push_object_address. */
+ object_address_set (address);
+
retval = allocate_value (SYMBOL_TYPE (var));
VALUE_LVAL (retval) = lval_memory;
set_value_lazy (retval, 1);
@@ -269,7 +388,7 @@ dwarf2_evaluate_loc_desc (struct symbol
set_value_initialized (retval, ctx->initialized);
- free_dwarf_expr_context (ctx);
+ do_cleanups (back_to);
return retval;
}
@@ -578,7 +697,7 @@ static int
loclist_describe_location (struct symbol *symbol, struct ui_file *stream)
{
/* FIXME: Could print the entire list of locations. */
- fprintf_filtered (stream, "a variable with multiple locations");
+ fprintf_filtered (stream, _("a variable with multiple locations"));
return 1;
}
@@ -594,16 +713,56 @@ loclist_tracepoint_var_ref (struct symbo
data = find_location_expression (dlbaton, &size, ax->scope);
if (data == NULL)
- error (_("Variable \"%s\" is not available."), SYMBOL_NATURAL_NAME (symbol));
+ error (_("Variable \"%s\" is not available."), SYMBOL_PRINT_NAME (symbol));
dwarf2_tracepoint_var_ref (symbol, ax, value, data, size);
}
-/* The set of location functions used with the DWARF-2 expression
- evaluator and location lists. */
+/* The set of location functions used with the DWARF-2 location lists. */
const struct symbol_ops dwarf2_loclist_funcs = {
loclist_read_variable,
loclist_read_needs_frame,
loclist_describe_location,
loclist_tracepoint_var_ref
};
+
+static struct value *
+missing_read_variable (struct symbol *symbol, struct frame_info *frame)
+{
+ struct dwarf2_loclist_baton *dlbaton = SYMBOL_LOCATION_BATON (symbol);
+
+ gdb_assert (dlbaton == NULL);
+ error (_("Unable to resolve variable \"%s\""), SYMBOL_PRINT_NAME (symbol));
+}
+
+static int
+missing_read_needs_frame (struct symbol *symbol)
+{
+ return 0;
+}
+
+static int
+missing_describe_location (struct symbol *symbol, struct ui_file *stream)
+{
+ fprintf_filtered (stream, _("a variable we are unable to resolve"));
+ return 1;
+}
+
+static void
+missing_tracepoint_var_ref (struct symbol *symbol, struct agent_expr *ax,
+ struct axs_value *value)
+{
+ struct dwarf2_loclist_baton *dlbaton = SYMBOL_LOCATION_BATON (symbol);
+
+ gdb_assert (dlbaton == NULL);
+ error (_("Unable to resolve variable \"%s\""), SYMBOL_PRINT_NAME (symbol));
+}
+
+/* The set of location functions used with the DWARF-2 evaluator when we are
+ unable to resolve the symbols. */
+const struct symbol_ops dwarf2_missing_funcs = {
+ missing_read_variable,
+ missing_read_needs_frame,
+ missing_describe_location,
+ missing_tracepoint_var_ref
+};
--- ./gdb/dwarf2loc.h 2008-11-06 20:50:14.000000000 +0100
+++ ./gdb/dwarf2loc.h 2008-11-06 20:52:23.000000000 +0100
@@ -65,5 +65,11 @@ struct dwarf2_loclist_baton
extern const struct symbol_ops dwarf2_locexpr_funcs;
extern const struct symbol_ops dwarf2_loclist_funcs;
+extern const struct symbol_ops dwarf2_missing_funcs;
+
+extern void object_address_set (CORE_ADDR address);
+
+extern CORE_ADDR dwarf_locexpr_baton_eval
+ (struct dwarf2_locexpr_baton *dlbaton);
#endif /* dwarf2loc.h */
--- ./gdb/dwarf2read.c 2008-11-06 20:50:14.000000000 +0100
+++ ./gdb/dwarf2read.c 2008-11-06 20:51:35.000000000 +0100
@@ -1005,7 +1005,14 @@ static void store_in_ref_table (unsigned
static unsigned int dwarf2_get_ref_die_offset (struct attribute *,
struct dwarf2_cu *);
-static int dwarf2_get_attr_constant_value (struct attribute *, int);
+enum dwarf2_get_attr_constant_value
+ {
+ dwarf2_attr_unknown,
+ dwarf2_attr_const,
+ dwarf2_attr_block
+ };
+static enum dwarf2_get_attr_constant_value dwarf2_get_attr_constant_value
+ (struct attribute *attr, int *val_return);
static struct die_info *follow_die_ref (struct die_info *,
struct attribute *,
@@ -1060,6 +1067,9 @@ static void age_cached_comp_units (void)
static void free_one_cached_comp_unit (void *);
+static void fetch_die_type_attrs (struct die_info *die, struct type *type,
+ struct dwarf2_cu *cu);
+
static void set_die_type (struct die_info *, struct type *,
struct dwarf2_cu *);
@@ -1083,6 +1093,9 @@ static void dwarf2_clear_marks (struct d
static void read_set_type (struct die_info *, struct dwarf2_cu *);
+static struct dwarf2_locexpr_baton *dwarf2_attr_to_locexpr_baton
+ (struct attribute *attr, struct dwarf2_cu *cu);
+
/* Try to locate the sections we need for DWARF 2 debugging
information and return true if we have enough to do something. */
@@ -4402,6 +4415,26 @@ process_enumeration_scope (struct die_in
new_symbol (die, die->type, cu);
}
+/* Create a new array dimension referencing its target type TYPE.
+
+ Multidimensional arrays are internally represented as a stack of
+ singledimensional arrays being referenced by their TYPE_TARGET_TYPE. */
+
+static struct type *
+create_single_array_dimension (struct type *type, struct type *range_type,
+ struct die_info *die, struct dwarf2_cu *cu)
+{
+ type = create_array_type (NULL, type, range_type);
+
+ /* These generic type attributes need to be fetched by
+ evaluate_subexp_standard <multi_f77_subscript>'s call of
+ value_subscripted_rvalue only for the innermost array type. */
+
+ fetch_die_type_attrs (die, type, cu);
+
+ return type;
+}
+
/* Extract all information from a DW_TAG_array_type DIE and put it in
the DIE's type field. For now, this only handles one dimensional
arrays. */
@@ -4415,7 +4448,7 @@ read_array_type (struct die_info *die, s
struct type *element_type, *range_type, *index_type;
struct type **range_types = NULL;
struct attribute *attr;
- int ndim = 0;
+ int ndim = 0, i;
struct cleanup *back_to;
char *name;
@@ -4470,16 +4503,11 @@ read_array_type (struct die_info *die, s
type = element_type;
if (read_array_order (die, cu) == DW_ORD_col_major)
- {
- int i = 0;
- while (i < ndim)
- type = create_array_type (NULL, type, range_types[i++]);
- }
- else
- {
- while (ndim-- > 0)
- type = create_array_type (NULL, type, range_types[ndim]);
- }
+ for (i = 0; i < ndim; i++)
+ type = create_single_array_dimension (type, range_types[i], die, cu);
+ else /* (read_array_order (die, cu) == DW_ORD_row_major) */
+ for (i = ndim - 1; i >= 0; i--)
+ type = create_single_array_dimension (type, range_types[i], die, cu);
/* Understand Dwarf2 support for vector types (like they occur on
the PowerPC w/ AltiVec). Gcc just adds another attribute to the
@@ -4841,34 +4869,98 @@ read_tag_string_type (struct die_info *d
struct objfile *objfile = cu->objfile;
struct type *type, *range_type, *index_type, *char_type;
struct attribute *attr;
- unsigned int length;
+ int length;
if (die->type)
{
return;
}
+ index_type = builtin_type_int32;
+ range_type = create_range_type_nfields (NULL, index_type, 2);
+ TYPE_FLAGS (range_type) |= TYPE_FLAG_UNSIGNED;
+
+ /* C/C++ should probably have the low bound 0 but C/C++ does not use
+ DW_TAG_string_type. */
+ TYPE_LOW_BOUND (range_type) = 1;
+
attr = dwarf2_attr (die, DW_AT_string_length, cu);
- if (attr)
+ switch (dwarf2_get_attr_constant_value (attr, &length))
{
- length = DW_UNSND (attr);
- }
- else
- {
- /* check for the DW_AT_byte_size attribute */
+ case dwarf2_attr_const:
+ /* We currently do not support a constant address where the location
+ should be read from - DWARF2_ATTR_BLOCK is expected instead. See
+ DWARF for the DW_AT_STRING_LENGTH vs. DW_AT_BYTE_SIZE difference. */
+ /* PASSTHRU */
+ case dwarf2_attr_unknown:
attr = dwarf2_attr (die, DW_AT_byte_size, cu);
- if (attr)
- {
- length = DW_UNSND (attr);
- }
- else
- {
- length = 1;
- }
+ switch (dwarf2_get_attr_constant_value (attr, &length))
+ {
+ case dwarf2_attr_unknown:
+ length = 1;
+ /* PASSTHRU */
+ case dwarf2_attr_const:
+ TYPE_HIGH_BOUND (range_type) = length;
+ break;
+ case dwarf2_attr_block:
+ TYPE_RANGE_BOUND_SET_DWARF_BLOCK (range_type, 1);
+ TYPE_FIELD_DWARF_BLOCK (range_type, 1) =
+ dwarf2_attr_to_locexpr_baton (attr, cu);
+ TYPE_FLAGS (range_type) |= TYPE_FLAG_DYNAMIC;
+ break;
+ }
+ break;
+ case dwarf2_attr_block:
+ /* Security check for a size overflow. */
+ if (DW_BLOCK (attr)->size + 2 < DW_BLOCK (attr)->size)
+ {
+ TYPE_HIGH_BOUND (range_type) = 1;
+ break;
+ }
+ /* Extend the DWARF block by a new DW_OP_deref/DW_OP_deref_size
+ instruction as DW_AT_string_length specifies the length location, not
+ its value. */
+ {
+ struct dwarf2_locexpr_baton *length_baton;
+ struct attribute *size_attr;
+
+ length_baton = obstack_alloc (&cu->comp_unit_obstack,
+ sizeof (*length_baton));
+ length_baton->objfile = cu->objfile;
+ length_baton->data = obstack_alloc (&cu->comp_unit_obstack,
+ DW_BLOCK (attr)->size + 2);
+ memcpy (length_baton->data, DW_BLOCK (attr)->data,
+ DW_BLOCK (attr)->size);
+
+ /* DW_AT_BYTE_SIZE existing together with DW_AT_STRING_LENGTH specifies
+ the size of an integer to fetch. */
+
+ size_attr = dwarf2_attr (die, DW_AT_byte_size, cu);
+ if (size_attr)
+ {
+ length_baton->size = DW_BLOCK (attr)->size + 2;
+ length_baton->data[DW_BLOCK (attr)->size] = DW_OP_deref_size;
+ length_baton->data[DW_BLOCK (attr)->size + 1]
+ = DW_UNSND (size_attr);
+ if (length_baton->data[DW_BLOCK (attr)->size + 1]
+ != DW_UNSND (size_attr))
+ complaint (&symfile_complaints,
+ _("DW_AT_string_length's DW_AT_byte_size integer "
+ "exceeds the byte size storage"));
+ }
+ else
+ {
+ length_baton->size = DW_BLOCK (attr)->size + 1;
+ length_baton->data[DW_BLOCK (attr)->size] = DW_OP_deref;
+ }
+
+ TYPE_RANGE_BOUND_SET_DWARF_BLOCK (range_type, 1);
+ TYPE_FIELD_DWARF_BLOCK (range_type, 1) = length_baton;
+ TYPE_FLAGS (range_type) |= TYPE_FLAG_DYNAMIC;
+ }
+ break;
}
- index_type = builtin_type_int32;
- range_type = create_range_type (NULL, index_type, 1, length);
type = create_string_type (NULL, range_type);
set_die_type (die, type, cu);
@@ -4961,7 +5053,6 @@ static void
read_typedef (struct die_info *die, struct dwarf2_cu *cu)
{
struct objfile *objfile = cu->objfile;
- struct attribute *attr;
char *name = NULL;
if (!die->type)
@@ -5067,9 +5158,9 @@ read_subrange_type (struct die_info *die
{
struct type *base_type;
struct type *range_type;
- struct attribute *attr;
- int low = 0;
- int high = -1;
+ struct attribute *attr, *byte_stride_attr;
+ int low, high, byte_stride_int;
+ enum dwarf2_get_attr_constant_value high_type, byte_stride_type;
char *name;
/* If we have already decoded this die, then nothing more to do. */
@@ -5086,42 +5177,87 @@ read_subrange_type (struct die_info *die
0, NULL, cu->objfile);
}
- if (cu->language == language_fortran)
- {
- /* FORTRAN implies a lower bound of 1, if not given. */
- low = 1;
- }
+ /* DW_AT_bit_stride is currently unsupported as we count in bytes. */
+ byte_stride_attr = dwarf2_attr (die, DW_AT_byte_stride, cu);
+ byte_stride_type = dwarf2_get_attr_constant_value (byte_stride_attr,
+ &byte_stride_int);
+
+ range_type = create_range_type_nfields
+ (NULL, base_type, byte_stride_type == dwarf2_attr_unknown ? 2 : 3);
- /* FIXME: For variable sized arrays either of these could be
- a variable rather than a constant value. We'll allow it,
- but we don't know how to handle it. */
attr = dwarf2_attr (die, DW_AT_lower_bound, cu);
- if (attr)
- low = dwarf2_get_attr_constant_value (attr, 0);
+ switch (dwarf2_get_attr_constant_value (attr, &low))
+ {
+ case dwarf2_attr_unknown:
+ if (cu->language == language_fortran)
+ {
+ /* FORTRAN implies a lower bound of 1, if not given. */
+ low = 1;
+ }
+ else
+ {
+ /* According to DWARF we should assume the value 0 only for
+ LANGUAGE_C and LANGUAGE_CPLUS. */
+ low = 0;
+ }
+ /* PASSTHRU */
+ case dwarf2_attr_const:
+ TYPE_LOW_BOUND (range_type) = low;
+ if (low >= 0)
+ TYPE_FLAGS (range_type) |= TYPE_FLAG_UNSIGNED;
+ break;
+ case dwarf2_attr_block:
+ TYPE_RANGE_BOUND_SET_DWARF_BLOCK (range_type, 0);
+ TYPE_FIELD_DWARF_BLOCK (range_type, 0) = dwarf2_attr_to_locexpr_baton
+ (attr, cu);
+ TYPE_FLAGS (range_type) |= TYPE_FLAG_DYNAMIC;
+ /* For setting a default if DW_AT_UPPER_BOUND would be missing. */
+ low = 0;
+ break;
+ }
attr = dwarf2_attr (die, DW_AT_upper_bound, cu);
- if (attr)
- {
- if (attr->form == DW_FORM_block1)
- {
- /* GCC encodes arrays with unspecified or dynamic length
- with a DW_FORM_block1 attribute.
- FIXME: GDB does not yet know how to handle dynamic
- arrays properly, treat them as arrays with unspecified
- length for now.
-
- FIXME: jimb/2003-09-22: GDB does not really know
- how to handle arrays of unspecified length
- either; we just represent them as zero-length
- arrays. Choose an appropriate upper bound given
- the lower bound we've computed above. */
- high = low - 1;
- }
- else
- high = dwarf2_get_attr_constant_value (attr, 1);
+ high_type = dwarf2_get_attr_constant_value (attr, &high);
+ if (high_type == dwarf2_attr_unknown)
+ {
+ attr = dwarf2_attr (die, DW_AT_count, cu);
+ high_type = dwarf2_get_attr_constant_value (attr, &high);
+ TYPE_FLAGS (range_type) |= TYPE_FLAG_RANGE_HIGH_BOUND_IS_COUNT;
+ /* Pass it now as the regular DW_AT_upper_bound. */
+ }
+ switch (high_type)
+ {
+ case dwarf2_attr_unknown:
+ TYPE_RANGE_UPPER_BOUND_IS_UNDEFINED (range_type) = 1;
+ high = low - 1;
+ /* PASSTHRU */
+ case dwarf2_attr_const:
+ TYPE_HIGH_BOUND (range_type) = high;
+ break;
+ case dwarf2_attr_block:
+ TYPE_RANGE_BOUND_SET_DWARF_BLOCK (range_type, 1);
+ TYPE_FIELD_DWARF_BLOCK (range_type, 1) = dwarf2_attr_to_locexpr_baton
+ (attr, cu);
+ TYPE_FLAGS (range_type) |= TYPE_FLAG_DYNAMIC;
+ break;
}
- range_type = create_range_type (NULL, base_type, low, high);
+ switch (byte_stride_type)
+ {
+ case dwarf2_attr_unknown:
+ break;
+ case dwarf2_attr_const:
+ if (byte_stride_int == 0)
+ warning (_("Found DW_AT_byte_stride with unsupported value 0"));
+ SET_TYPE_BYTE_STRIDE (range_type, byte_stride_int);
+ break;
+ case dwarf2_attr_block:
+ TYPE_RANGE_BOUND_SET_DWARF_BLOCK (range_type, 2);
+ TYPE_FIELD_DWARF_BLOCK (range_type, 2) = dwarf2_attr_to_locexpr_baton
+ (byte_stride_attr, cu);
+ TYPE_FLAGS (range_type) |= TYPE_FLAG_DYNAMIC;
+ break;
+ }
name = dwarf2_name (die, cu);
if (name)
@@ -7256,10 +7392,12 @@ var_decode_location (struct attribute *a
(i.e. when the value of a register or memory location is
referenced, or a thread-local block, etc.). Then again, it might
not be worthwhile. I'm assuming that it isn't unless performance
- or memory numbers show me otherwise. */
+ or memory numbers show me otherwise.
+
+ SYMBOL_CLASS may get overriden by dwarf2_symbol_mark_computed. */
- dwarf2_symbol_mark_computed (attr, sym, cu);
SYMBOL_CLASS (sym) = LOC_COMPUTED;
+ dwarf2_symbol_mark_computed (attr, sym, cu);
}
/* Given a pointer to a DWARF information entry, figure out if we need
@@ -9120,26 +9258,35 @@ dwarf2_get_ref_die_offset (struct attrib
return result;
}
-/* Return the constant value held by the given attribute. Return -1
- if the value held by the attribute is not constant. */
+/* (*val_return) is filled only if returning dwarf2_attr_const. */
-static int
-dwarf2_get_attr_constant_value (struct attribute *attr, int default_value)
+static enum dwarf2_get_attr_constant_value
+dwarf2_get_attr_constant_value (struct attribute *attr, int *val_return)
{
+ if (attr == NULL)
+ return dwarf2_attr_unknown;
if (attr->form == DW_FORM_sdata)
- return DW_SND (attr);
- else if (attr->form == DW_FORM_udata
- || attr->form == DW_FORM_data1
- || attr->form == DW_FORM_data2
- || attr->form == DW_FORM_data4
- || attr->form == DW_FORM_data8)
- return DW_UNSND (attr);
- else
{
- complaint (&symfile_complaints, _("Attribute value is not a constant (%s)"),
- dwarf_form_name (attr->form));
- return default_value;
+ *val_return = DW_SND (attr);
+ return dwarf2_attr_const;
+ }
+ if (attr->form == DW_FORM_udata
+ || attr->form == DW_FORM_data1
+ || attr->form == DW_FORM_data2
+ || attr->form == DW_FORM_data4
+ || attr->form == DW_FORM_data8)
+ {
+ *val_return = DW_UNSND (attr);
+ return dwarf2_attr_const;
}
+ if (attr->form == DW_FORM_block
+ || attr->form == DW_FORM_block1
+ || attr->form == DW_FORM_block2
+ || attr->form == DW_FORM_block4)
+ return dwarf2_attr_block;
+ complaint (&symfile_complaints, _("Attribute value is not a constant (%s)"),
+ dwarf_form_name (attr->form));
+ return dwarf2_attr_unknown;
}
static struct die_info *
@@ -9903,6 +10050,34 @@ attr_form_is_constant (struct attribute
}
}
+/* Convert DW_BLOCK into struct dwarf2_locexpr_baton. ATTR must be a DW_BLOCK
+ attribute type. */
+
+static struct dwarf2_locexpr_baton *
+dwarf2_attr_to_locexpr_baton (struct attribute *attr, struct dwarf2_cu *cu)
+{
+ struct dwarf2_locexpr_baton *baton;
+
+ gdb_assert (attr_form_is_block (attr));
+
+ baton = obstack_alloc (&cu->objfile->objfile_obstack, sizeof (*baton));
+ baton->objfile = cu->objfile;
+ gdb_assert (baton->objfile);
+
+ /* Note that we're just copying the block's data pointer
+ here, not the actual data. We're still pointing into the
+ info_buffer for SYM's objfile; right now we never release
+ that buffer, but when we do clean up properly this may
+ need to change. */
+ baton->size = DW_BLOCK (attr)->size;
+ baton->data = DW_BLOCK (attr)->data;
+ gdb_assert (baton->size == 0 || baton->data != NULL);
+
+ return baton;
+}
+
+/* SYM may get its SYMBOL_CLASS overriden on invalid ATTR content. */
+
static void
dwarf2_symbol_mark_computed (struct attribute *attr, struct symbol *sym,
struct dwarf2_cu *cu)
@@ -9938,34 +10113,24 @@ dwarf2_symbol_mark_computed (struct attr
SYMBOL_OPS (sym) = &dwarf2_loclist_funcs;
SYMBOL_LOCATION_BATON (sym) = baton;
}
+ else if (attr_form_is_block (attr))
+ {
+ SYMBOL_OPS (sym) = &dwarf2_locexpr_funcs;
+ SYMBOL_LOCATION_BATON (sym) = dwarf2_attr_to_locexpr_baton (attr, cu);
+ }
else
{
- struct dwarf2_locexpr_baton *baton;
+ dwarf2_invalid_attrib_class_complaint ("location description",
+ SYMBOL_NATURAL_NAME (sym));
- baton = obstack_alloc (&cu->objfile->objfile_obstack,
- sizeof (struct dwarf2_locexpr_baton));
- baton->objfile = objfile;
+ /* Some methods are called without checking SYMBOL_OPS validity. */
+ SYMBOL_OPS (sym) = &dwarf2_missing_funcs;
+ SYMBOL_LOCATION_BATON (sym) = NULL;
- if (attr_form_is_block (attr))
- {
- /* Note that we're just copying the block's data pointer
- here, not the actual data. We're still pointing into the
- info_buffer for SYM's objfile; right now we never release
- that buffer, but when we do clean up properly this may
- need to change. */
- baton->size = DW_BLOCK (attr)->size;
- baton->data = DW_BLOCK (attr)->data;
- }
- else
- {
- dwarf2_invalid_attrib_class_complaint ("location description",
- SYMBOL_NATURAL_NAME (sym));
- baton->size = 0;
- baton->data = NULL;
- }
-
- SYMBOL_OPS (sym) = &dwarf2_locexpr_funcs;
- SYMBOL_LOCATION_BATON (sym) = baton;
+ /* For functions a missing DW_AT_frame_base does not optimize out the
+ whole function definition, only its frame base resolving. */
+ if (attr->name == DW_AT_location)
+ SYMBOL_CLASS (sym) = LOC_OPTIMIZED_OUT;
}
}
@@ -10205,6 +10370,27 @@ offset_and_type_eq (const void *item_lhs
return ofs_lhs->offset == ofs_rhs->offset;
}
+/* Fill in generic attributes applicable for type DIEs. */
+
+static void
+fetch_die_type_attrs (struct die_info *die, struct type *type,
+ struct dwarf2_cu *cu)
+{
+ struct attribute *attr;
+
+ attr = dwarf2_attr (die, DW_AT_data_location, cu);
+ if (attr_form_is_block (attr))
+ TYPE_DATA_LOCATION (type) = dwarf2_attr_to_locexpr_baton (attr, cu);
+
+ attr = dwarf2_attr (die, DW_AT_allocated, cu);
+ if (attr_form_is_block (attr))
+ TYPE_ALLOCATED (type) = dwarf2_attr_to_locexpr_baton (attr, cu);
+
+ attr = dwarf2_attr (die, DW_AT_associated, cu);
+ if (attr_form_is_block (attr))
+ TYPE_ASSOCIATED (type) = dwarf2_attr_to_locexpr_baton (attr, cu);
+}
+
/* Set the type associated with DIE to TYPE. Save it in CU's hash
table if necessary. */
@@ -10215,6 +10401,8 @@ set_die_type (struct die_info *die, stru
die->type = type;
+ fetch_die_type_attrs (die, type, cu);
+
if (cu->per_cu == NULL)
return;
--- ./gdb/eval.c 2008-11-06 20:50:14.000000000 +0100
+++ ./gdb/eval.c 2008-11-06 20:51:35.000000000 +0100
@@ -38,6 +38,7 @@
#include "ui-out.h"
#include "exceptions.h"
#include "regcache.h"
+#include "dwarf2loc.h"
#include "gdb_assert.h"
@@ -429,6 +430,7 @@ evaluate_subexp_standard (struct type *e
long mem_offset;
struct type **arg_types;
int save_pos1;
+ struct cleanup *old_chain;
pc = (*pos)++;
op = exp->elts[pc].opcode;
@@ -1280,7 +1282,10 @@ evaluate_subexp_standard (struct type *e
/* First determine the type code we are dealing with. */
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ old_chain = make_cleanup (null_cleanup, 0);
+ object_address_set (VALUE_ADDRESS (arg1));
type = check_typedef (value_type (arg1));
+ do_cleanups (old_chain);
code = TYPE_CODE (type);
if (code == TYPE_CODE_PTR)
@@ -1644,13 +1649,19 @@ evaluate_subexp_standard (struct type *e
{
int subscript_array[MAX_FORTRAN_DIMS];
int array_size_array[MAX_FORTRAN_DIMS];
+ int byte_stride_array[MAX_FORTRAN_DIMS];
int ndimensions = 1, i;
struct type *tmp_type;
int offset_item; /* The array offset where the item lives */
+ CORE_ADDR offset_byte; /* byte_stride based offset */
+ unsigned element_size;
if (nargs > MAX_FORTRAN_DIMS)
error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
+ old_chain = make_cleanup (null_cleanup, 0);
+ object_address_set (VALUE_ADDRESS (arg1));
+
tmp_type = check_typedef (value_type (arg1));
ndimensions = calc_f77_array_dims (type);
@@ -1678,6 +1689,9 @@ evaluate_subexp_standard (struct type *e
upper = f77_get_upperbound (tmp_type);
lower = f77_get_lowerbound (tmp_type);
+ byte_stride_array[nargs - i - 1] =
+ TYPE_ARRAY_BYTE_STRIDE_VALUE (tmp_type);
+
array_size_array[nargs - i - 1] = upper - lower + 1;
/* Zero-normalize subscripts so that offsetting will work. */
@@ -1696,17 +1710,25 @@ evaluate_subexp_standard (struct type *e
tmp_type = check_typedef (TYPE_TARGET_TYPE (tmp_type));
}
- /* Now let us calculate the offset for this item */
+ /* Kept for the f77_get_upperbound / f77_get_lowerbound calls above. */
+ do_cleanups (old_chain);
- offset_item = subscript_array[ndimensions - 1];
+ /* Now let us calculate the offset for this item */
- for (i = ndimensions - 1; i > 0; --i)
- offset_item =
- array_size_array[i - 1] * offset_item + subscript_array[i - 1];
+ offset_item = 0;
+ offset_byte = 0;
- /* Construct a value node with the value of the offset */
+ for (i = ndimensions - 1; i >= 0; --i)
+ {
+ offset_item *= array_size_array[i];
+ if (byte_stride_array[i] == 0)
+ offset_item += subscript_array[i];
+ else
+ offset_byte += subscript_array[i] * byte_stride_array[i];
+ }
- arg2 = value_from_longest (builtin_type_f_integer, offset_item);
+ element_size = TYPE_LENGTH (TYPE_TARGET_TYPE (tmp_type));
+ offset_byte += offset_item * element_size;
/* Let us now play a dirty trick: we will take arg1
which is a value node pointing to the topmost level
@@ -1716,7 +1738,7 @@ evaluate_subexp_standard (struct type *e
returns the correct type value */
deprecated_set_value_type (arg1, tmp_type);
- return value_ind (value_add (value_coerce_array (arg1), arg2));
+ return value_subscripted_rvalue (arg1, offset_byte);
}
case BINOP_LOGICAL_AND:
@@ -2300,9 +2322,12 @@ evaluate_subexp_for_sizeof (struct expre
case OP_VAR_VALUE:
(*pos) += 4;
- type = check_typedef (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
- return
- value_from_longest (builtin_type_int, (LONGEST) TYPE_LENGTH (type));
+ /* We do not need to call read_var_value but the object evaluation may
+ need to have executed object_address_set which needs valid
+ SYMBOL_VALUE_ADDRESS of the symbol. Still VALUE returned by
+ read_var_value we left as lazy. */
+ type = value_type (read_var_value (exp->elts[pc + 2].symbol, NULL));
+ return value_from_longest (builtin_type_int, (LONGEST) TYPE_LENGTH (type));
default:
val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
--- ./gdb/f-lang.h 2008-11-06 20:50:14.000000000 +0100
+++ ./gdb/f-lang.h 2008-11-06 20:51:03.000000000 +0100
@@ -28,6 +28,10 @@ extern void f_error (char *); /* Defined
extern void f_print_type (struct type *, char *, struct ui_file *, int,
int);
+extern const char *f_object_address_data_valid_print_to_stream
+ (struct type *type, struct ui_file *stream);
+extern void f_object_address_data_valid_or_error (struct type *type);
+
extern int f_val_print (struct type *, const gdb_byte *, int, CORE_ADDR,
struct ui_file *, int, int, int,
enum val_prettyprint);
--- ./gdb/f-typeprint.c 2008-11-06 20:50:14.000000000 +0100
+++ ./gdb/f-typeprint.c 2008-11-06 20:51:03.000000000 +0100
@@ -31,7 +31,7 @@
#include "gdbcore.h"
#include "target.h"
#include "f-lang.h"
-
+#include "dwarf2loc.h"
#include "gdb_string.h"
#include <errno.h>
@@ -39,7 +39,7 @@
static void f_type_print_args (struct type *, struct ui_file *);
#endif
-static void f_type_print_varspec_suffix (struct type *, struct ui_file *,
+static void f_type_print_varspec_suffix (struct type *, struct ui_file *, int,
int, int, int);
void f_type_print_varspec_prefix (struct type *, struct ui_file *,
@@ -48,6 +48,34 @@ void f_type_print_varspec_prefix (struct
void f_type_print_base (struct type *, struct ui_file *, int, int);
+const char *
+f_object_address_data_valid_print_to_stream (struct type *type,
+ struct ui_file *stream)
+{
+ const char *msg;
+
+ msg = object_address_data_not_valid (type);
+ if (msg != NULL)
+ {
+ /* Assuming the content printed to STREAM should not be localized. */
+ fprintf_filtered (stream, "<%s>", msg);
+ }
+
+ return msg;
+}
+
+void
+f_object_address_data_valid_or_error (struct type *type)
+{
+ const char *msg;
+
+ msg = object_address_data_not_valid (type);
+ if (msg != NULL)
+ {
+ error (_("Cannot access it because the %s."), _(msg));
+ }
+}
+
/* LEVEL is the depth to indent lines by. */
void
@@ -57,6 +85,9 @@ f_print_type (struct type *type, char *v
enum type_code code;
int demangled_args;
+ if (f_object_address_data_valid_print_to_stream (type, stream) != NULL)
+ return;
+
f_type_print_base (type, stream, show, level);
code = TYPE_CODE (type);
if ((varstring != NULL && *varstring != '\0')
@@ -78,7 +109,7 @@ f_print_type (struct type *type, char *v
so don't print an additional pair of ()'s */
demangled_args = varstring[strlen (varstring) - 1] == ')';
- f_type_print_varspec_suffix (type, stream, show, 0, demangled_args);
+ f_type_print_varspec_suffix (type, stream, show, 0, demangled_args, 0);
}
/* Print any asterisks or open-parentheses needed before the
@@ -147,11 +178,13 @@ f_type_print_varspec_prefix (struct type
static void
f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
- int show, int passed_a_ptr, int demangled_args)
+ int show, int passed_a_ptr, int demangled_args,
+ int arrayprint_recurse_level)
{
int upper_bound, lower_bound;
- static int arrayprint_recurse_level = 0;
int retcode;
+ /* No static variables (such as ARRAYPRINT_RECURSE_LEVEL) permitted as ERROR
+ may occur during the evaluation of DWARF_BLOCK values. */
if (type == 0)
return;
@@ -161,6 +194,9 @@ f_type_print_varspec_suffix (struct type
QUIT;
+ if (TYPE_CODE (type) != TYPE_CODE_TYPEDEF)
+ CHECK_TYPEDEF (type);
+
switch (TYPE_CODE (type))
{
case TYPE_CODE_ARRAY:
@@ -170,7 +206,8 @@ f_type_print_varspec_suffix (struct type
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);
+ 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. */
@@ -188,7 +225,8 @@ f_type_print_varspec_suffix (struct type
}
if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
- f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0);
+ 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
@@ -198,13 +236,14 @@ f_type_print_varspec_suffix (struct type
case TYPE_CODE_PTR:
case TYPE_CODE_REF:
- f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0);
+ f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0,
+ arrayprint_recurse_level);
fprintf_filtered (stream, ")");
break;
case TYPE_CODE_FUNC:
f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
- passed_a_ptr, 0);
+ passed_a_ptr, 0, arrayprint_recurse_level);
if (passed_a_ptr)
fprintf_filtered (stream, ")");
--- ./gdb/f-valprint.c 2008-11-06 20:50:14.000000000 +0100
+++ ./gdb/f-valprint.c 2008-11-06 20:51:03.000000000 +0100
@@ -54,15 +54,17 @@ int f77_array_offset_tbl[MAX_FORTRAN_DIM
/* The following macro gives us the size of the nth dimension, Where
n is 1 based. */
-#define F77_DIM_SIZE(n) (f77_array_offset_tbl[n][1])
+#define F77_DIM_COUNT(n) (f77_array_offset_tbl[n][1])
-/* The following gives us the offset for row n where n is 1-based. */
+/* The following gives us the element size for row n where n is 1-based. */
-#define F77_DIM_OFFSET(n) (f77_array_offset_tbl[n][0])
+#define F77_DIM_BYTE_STRIDE(n) (f77_array_offset_tbl[n][0])
int
f77_get_lowerbound (struct type *type)
{
+ f_object_address_data_valid_or_error (type);
+
if (TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED (type))
error (_("Lower bound may not be '*' in F77"));
@@ -72,6 +74,8 @@ f77_get_lowerbound (struct type *type)
int
f77_get_upperbound (struct type *type)
{
+ f_object_address_data_valid_or_error (type);
+
if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
{
/* We have an assumed size array on our hands. Assume that
@@ -135,24 +139,29 @@ f77_create_arrayprint_offset_tbl (struct
upper = f77_get_upperbound (tmp_type);
lower = f77_get_lowerbound (tmp_type);
- F77_DIM_SIZE (ndimen) = upper - lower + 1;
+ F77_DIM_COUNT (ndimen) = upper - lower + 1;
+
+ F77_DIM_BYTE_STRIDE (ndimen) =
+ TYPE_ARRAY_BYTE_STRIDE_VALUE (tmp_type);
tmp_type = TYPE_TARGET_TYPE (tmp_type);
ndimen++;
}
- /* Now we multiply eltlen by all the offsets, so that later we
+ /* Now we multiply eltlen by all the BYTE_STRIDEs, so that later we
can print out array elements correctly. Up till now we
- know an offset to apply to get the item but we also
+ know an eltlen to apply to get the item but we also
have to know how much to add to get to the next item */
ndimen--;
eltlen = TYPE_LENGTH (tmp_type);
- F77_DIM_OFFSET (ndimen) = eltlen;
+ if (F77_DIM_BYTE_STRIDE (ndimen) == 0)
+ F77_DIM_BYTE_STRIDE (ndimen) = eltlen;
while (--ndimen > 0)
{
- eltlen *= F77_DIM_SIZE (ndimen + 1);
- F77_DIM_OFFSET (ndimen) = eltlen;
+ eltlen *= F77_DIM_COUNT (ndimen + 1);
+ if (F77_DIM_BYTE_STRIDE (ndimen) == 0)
+ F77_DIM_BYTE_STRIDE (ndimen) = eltlen;
}
}
@@ -172,33 +181,33 @@ f77_print_array_1 (int nss, int ndimensi
if (nss != ndimensions)
{
- for (i = 0; (i < F77_DIM_SIZE (nss) && (*elts) < print_max); i++)
+ for (i = 0; (i < F77_DIM_COUNT (nss) && (*elts) < print_max); i++)
{
fprintf_filtered (stream, "( ");
f77_print_array_1 (nss + 1, ndimensions, TYPE_TARGET_TYPE (type),
- valaddr + i * F77_DIM_OFFSET (nss),
- address + i * F77_DIM_OFFSET (nss),
+ valaddr + i * F77_DIM_BYTE_STRIDE (nss),
+ address + i * F77_DIM_BYTE_STRIDE (nss),
stream, format, deref_ref, recurse, pretty, elts);
fprintf_filtered (stream, ") ");
}
- if (*elts >= print_max && i < F77_DIM_SIZE (nss))
+ if (*elts >= print_max && i < F77_DIM_COUNT (nss))
fprintf_filtered (stream, "...");
}
else
{
- for (i = 0; i < F77_DIM_SIZE (nss) && (*elts) < print_max;
+ for (i = 0; i < F77_DIM_COUNT (nss) && (*elts) < print_max;
i++, (*elts)++)
{
val_print (TYPE_TARGET_TYPE (type),
- valaddr + i * F77_DIM_OFFSET (ndimensions),
+ valaddr + i * F77_DIM_BYTE_STRIDE (ndimensions),
0,
- address + i * F77_DIM_OFFSET (ndimensions),
+ address + i * F77_DIM_BYTE_STRIDE (ndimensions),
stream, format, deref_ref, recurse, pretty);
- if (i != (F77_DIM_SIZE (nss) - 1))
+ if (i != (F77_DIM_COUNT (nss) - 1))
fprintf_filtered (stream, ", ");
- if ((*elts == print_max - 1) && (i != (F77_DIM_SIZE (nss) - 1)))
+ if ((*elts == print_max - 1) && (i != (F77_DIM_COUNT (nss) - 1)))
fprintf_filtered (stream, "...");
}
}
@@ -257,6 +266,9 @@ f_val_print (struct type *type, const gd
CORE_ADDR addr;
int index;
+ if (f_object_address_data_valid_print_to_stream (type, stream) != NULL)
+ return 0;
+
CHECK_TYPEDEF (type);
switch (TYPE_CODE (type))
{
--- ./gdb/findvar.c 2008-11-06 20:50:14.000000000 +0100
+++ ./gdb/findvar.c 2008-11-06 20:51:03.000000000 +0100
@@ -34,6 +34,7 @@
#include "regcache.h"
#include "user-regs.h"
#include "block.h"
+#include "dwarf2loc.h"
/* Basic byte-swapping routines. GDB has needed these for a long time...
All extract a target-format integer at ADDR which is LEN bytes long. */
@@ -365,29 +366,16 @@ symbol_read_needs_frame (struct symbol *
and a stack frame id, read the value of the variable
and return a (pointer to a) struct value containing the value.
If the variable cannot be found, return a zero pointer.
- If FRAME is NULL, use the selected frame. */
+ If FRAME is NULL, use the selected frame.
+ We have to first find the address of the variable before allocating struct
+ value to return as its size may depend on DW_OP_PUSH_OBJECT_ADDRESS possibly
+ used by its type. */
struct value *
read_var_value (struct symbol *var, struct frame_info *frame)
{
- struct value *v;
struct type *type = SYMBOL_TYPE (var);
CORE_ADDR addr;
- int len;
-
- if (SYMBOL_CLASS (var) == LOC_COMPUTED
- || SYMBOL_CLASS (var) == LOC_COMPUTED_ARG
- || SYMBOL_CLASS (var) == LOC_REGISTER
- || SYMBOL_CLASS (var) == LOC_REGPARM)
- /* These cases do not use V. */
- v = NULL;
- else
- {
- v = allocate_value (type);
- VALUE_LVAL (v) = lval_memory; /* The most likely possibility. */
- }
-
- len = TYPE_LENGTH (type);
/* FIXME drow/2003-09-06: this call to the selected frame should be
pushed upwards to the callers. */
@@ -397,31 +385,39 @@ read_var_value (struct symbol *var, stru
switch (SYMBOL_CLASS (var))
{
case LOC_CONST:
- /* Put the constant back in target format. */
- store_signed_integer (value_contents_raw (v), len,
- (LONGEST) SYMBOL_VALUE (var));
- VALUE_LVAL (v) = not_lval;
- return v;
+ {
+ /* Put the constant back in target format. */
+ struct value *v = allocate_value (type);
+ VALUE_LVAL (v) = not_lval;
+ store_signed_integer (value_contents_raw (v), TYPE_LENGTH (type),
+ (LONGEST) SYMBOL_VALUE (var));
+ return v;
+ }
case LOC_LABEL:
- /* Put the constant back in target format. */
- if (overlay_debugging)
- {
- CORE_ADDR addr
- = symbol_overlayed_address (SYMBOL_VALUE_ADDRESS (var),
- SYMBOL_BFD_SECTION (var));
- store_typed_address (value_contents_raw (v), type, addr);
- }
- else
- store_typed_address (value_contents_raw (v), type,
- SYMBOL_VALUE_ADDRESS (var));
- VALUE_LVAL (v) = not_lval;
- return v;
+ {
+ /* Put the constant back in target format. */
+ struct value *v = allocate_value (type);
+ VALUE_LVAL (v) = not_lval;
+ if (overlay_debugging)
+ {
+ CORE_ADDR addr
+ = symbol_overlayed_address (SYMBOL_VALUE_ADDRESS (var),
+ SYMBOL_BFD_SECTION (var));
+ store_typed_address (value_contents_raw (v), type, addr);
+ }
+ else
+ store_typed_address (value_contents_raw (v), type,
+ SYMBOL_VALUE_ADDRESS (var));
+ return v;
+ }
case LOC_CONST_BYTES:
{
- memcpy (value_contents_raw (v), SYMBOL_VALUE_BYTES (var), len);
+ struct value *v = allocate_value (type);
VALUE_LVAL (v) = not_lval;
+ memcpy (value_contents_raw (v), SYMBOL_VALUE_BYTES (var),
+ TYPE_LENGTH (type));
return v;
}
@@ -503,12 +499,23 @@ addresses have not been bound by the dyn
break;
case LOC_BLOCK:
- if (overlay_debugging)
- VALUE_ADDRESS (v) = symbol_overlayed_address
- (BLOCK_START (SYMBOL_BLOCK_VALUE (var)), SYMBOL_BFD_SECTION (var));
- else
- VALUE_ADDRESS (v) = BLOCK_START (SYMBOL_BLOCK_VALUE (var));
- return v;
+ {
+ CORE_ADDR addr;
+ struct value *v;
+
+ if (overlay_debugging)
+ addr = symbol_overlayed_address
+ (BLOCK_START (SYMBOL_BLOCK_VALUE (var)), SYMBOL_BFD_SECTION (var));
+ else
+ addr = BLOCK_START (SYMBOL_BLOCK_VALUE (var));
+ /* ADDR is set here for ALLOCATE_VALUE's CHECK_TYPEDEF for
+ DW_OP_push_object_address. */
+ object_address_set (addr);
+ v = allocate_value (type);
+ VALUE_ADDRESS (v) = addr;
+ VALUE_LVAL (v) = lval_memory;
+ return v;
+ }
case LOC_REGISTER:
case LOC_REGPARM:
@@ -530,7 +537,6 @@ addresses have not been bound by the dyn
error (_("Value of register variable not available."));
addr = value_as_address (regval);
- VALUE_LVAL (v) = lval_memory;
}
else
{
@@ -570,18 +576,33 @@ addresses have not been bound by the dyn
break;
case LOC_OPTIMIZED_OUT:
- VALUE_LVAL (v) = not_lval;
- set_value_optimized_out (v, 1);
- return v;
+ {
+ struct value *v = allocate_value (type);
+
+ VALUE_LVAL (v) = not_lval;
+ set_value_optimized_out (v, 1);
+ return v;
+ }
default:
error (_("Cannot look up value of a botched symbol."));
break;
}
- VALUE_ADDRESS (v) = addr;
- set_value_lazy (v, 1);
- return v;
+ {
+ struct value *v;
+
+ /* ADDR is set here for ALLOCATE_VALUE's CHECK_TYPEDEF for
+ DW_OP_PUSH_OBJECT_ADDRESS. */
+ object_address_set (addr);
+ v = allocate_value (type);
+ VALUE_ADDRESS (v) = addr;
+ VALUE_LVAL (v) = lval_memory;
+
+ set_value_lazy (v, 1);
+
+ return v;
+ }
}
/* Install default attributes for register values. */
@@ -618,10 +639,11 @@ struct value *
value_from_register (struct type *type, int regnum, struct frame_info *frame)
{
struct gdbarch *gdbarch = get_frame_arch (frame);
- struct type *type1 = check_typedef (type);
struct value *v;
- if (gdbarch_convert_register_p (gdbarch, regnum, type1))
+ type = check_typedef (type);
+
+ if (gdbarch_convert_register_p (gdbarch, regnum, type))
{
/* The ISA/ABI need to something weird when obtaining the
specified value from this register. It might need to
@@ -635,7 +657,7 @@ value_from_register (struct type *type,
VALUE_FRAME_ID (v) = get_frame_id (frame);
VALUE_REGNUM (v) = regnum;
gdbarch_register_to_value (gdbarch,
- frame, regnum, type1, value_contents_raw (v));
+ frame, regnum, type, value_contents_raw (v));
}
else
{
--- ./gdb/gdbtypes.c 2008-11-06 20:50:14.000000000 +0100
+++ ./gdb/gdbtypes.c 2008-11-06 20:51:03.000000000 +0100
@@ -38,6 +38,8 @@
#include "cp-abi.h"
#include "gdb_assert.h"
#include "hashtab.h"
+#include "dwarf2expr.h"
+#include "dwarf2loc.h"
/* These variables point to the objects
representing the predefined C data types. */
@@ -471,11 +473,13 @@ make_qualified_type (struct type *type,
struct type *ntype;
ntype = type;
- do {
- if (TYPE_INSTANCE_FLAGS (ntype) == new_flags)
- return ntype;
- ntype = TYPE_CHAIN (ntype);
- } while (ntype != type);
+ do
+ {
+ if (TYPE_INSTANCE_FLAGS (ntype) == new_flags)
+ return ntype;
+ ntype = TYPE_CHAIN (ntype);
+ }
+ while (ntype != type);
/* Create a new type instance. */
if (storage == NULL)
@@ -682,16 +686,21 @@ allocate_stub_method (struct type *type)
RESULT_TYPE, or creating a new type, inheriting the objfile from
INDEX_TYPE.
- Indices will be of type INDEX_TYPE, and will range from LOW_BOUND
- to HIGH_BOUND, inclusive.
+ Indices will be of type INDEX_TYPE. NFIELDS should be 2 for standard
+ arrays, 3 for custom TYPE_BYTE_STRIDE. Use CREATE_RANGE_TYPE for common
+ constant TYPE_LOW_BOUND/TYPE_HIGH_BOUND ranges instead.
+
+ You must to decide TYPE_UNSIGNED yourself as being done in CREATE_RANGE_TYPE.
FIXME: Maybe we should check the TYPE_CODE of RESULT_TYPE to make
sure it is TYPE_CODE_UNDEF before we bash it into a range type? */
struct type *
-create_range_type (struct type *result_type, struct type *index_type,
- int low_bound, int high_bound)
+create_range_type_nfields (struct type *result_type, struct type *index_type,
+ int nfields)
{
+ int fieldno;
+
if (result_type == NULL)
{
result_type = alloc_type (TYPE_OBJFILE (index_type));
@@ -702,17 +711,33 @@ create_range_type (struct type *result_t
TYPE_FLAGS (result_type) |= TYPE_FLAG_TARGET_STUB;
else
TYPE_LENGTH (result_type) = TYPE_LENGTH (check_typedef (index_type));
- TYPE_NFIELDS (result_type) = 2;
+ TYPE_NFIELDS (result_type) = nfields;
TYPE_FIELDS (result_type) = (struct field *)
- TYPE_ALLOC (result_type, 2 * sizeof (struct field));
- memset (TYPE_FIELDS (result_type), 0, 2 * sizeof (struct field));
- TYPE_FIELD_BITPOS (result_type, 0) = low_bound;
- TYPE_FIELD_BITPOS (result_type, 1) = high_bound;
+ TYPE_ALLOC (result_type,
+ TYPE_NFIELDS (result_type) * sizeof (struct field));
+ memset (TYPE_FIELDS (result_type), 0,
+ TYPE_NFIELDS (result_type) * sizeof (struct field));
+
+ return (result_type);
+}
+
+/* Simplified CREATE_RANGE_TYPE_NFIELDS for constant ranges from LOW_BOUND to
+ HIGH_BOUND, inclusive. TYPE_BYTE_STRIDE is always set to zero (default
+ native target type length). */
+
+struct type *
+create_range_type (struct type *result_type, struct type *index_type,
+ int low_bound, int high_bound)
+{
+ result_type = create_range_type_nfields (result_type, index_type, 2);
+
+ TYPE_LOW_BOUND (result_type) = low_bound;
+ TYPE_HIGH_BOUND (result_type) = high_bound;
if (low_bound >= 0)
TYPE_FLAGS (result_type) |= TYPE_FLAG_UNSIGNED;
- return (result_type);
+ return result_type;
}
/* Set *LOWP and *HIGHP to the lower and upper bounds of discrete type
@@ -726,6 +751,9 @@ get_discrete_bounds (struct type *type,
switch (TYPE_CODE (type))
{
case TYPE_CODE_RANGE:
+ if (TYPE_RANGE_UPPER_BOUND_IS_UNDEFINED (type)
+ || TYPE_RANGE_LOWER_BOUND_IS_UNDEFINED (type))
+ return -1;
*lowp = TYPE_LOW_BOUND (type);
*highp = TYPE_HIGH_BOUND (type);
return 1;
@@ -808,17 +836,6 @@ create_array_type (struct type *result_t
}
TYPE_CODE (result_type) = TYPE_CODE_ARRAY;
TYPE_TARGET_TYPE (result_type) = element_type;
- if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
- low_bound = high_bound = 0;
- CHECK_TYPEDEF (element_type);
- /* Be careful when setting the array length. Ada arrays can be
- empty arrays with the high_bound being smaller than the low_bound.
- In such cases, the array length should be zero. */
- if (high_bound < low_bound)
- TYPE_LENGTH (result_type) = 0;
- else
- TYPE_LENGTH (result_type) =
- TYPE_LENGTH (element_type) * (high_bound - low_bound + 1);
TYPE_NFIELDS (result_type) = 1;
TYPE_FIELDS (result_type) =
(struct field *) TYPE_ALLOC (result_type, sizeof (struct field));
@@ -826,9 +843,48 @@ create_array_type (struct type *result_t
TYPE_FIELD_TYPE (result_type, 0) = range_type;
TYPE_VPTR_FIELDNO (result_type) = -1;
- /* TYPE_FLAG_TARGET_STUB will take care of zero length arrays */
+ /* DWARF blocks may depend on runtime information like
+ DW_OP_PUSH_OBJECT_ADDRESS not being available during the
+ CREATE_ARRAY_TYPE time. */
+ if (TYPE_RANGE_BOUND_IS_DWARF_BLOCK (range_type, 0)
+ || TYPE_RANGE_BOUND_IS_DWARF_BLOCK (range_type, 1)
+ || TYPE_RANGE_UPPER_BOUND_IS_UNDEFINED (range_type)
+ || TYPE_RANGE_LOWER_BOUND_IS_UNDEFINED (range_type)
+ || get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
+ {
+ low_bound = 0;
+ high_bound = -1;
+ }
+
+ /* Be careful when setting the array length. Ada arrays can be
+ empty arrays with the high_bound being smaller than the low_bound.
+ In such cases, the array length should be zero. TYPE_TARGET_STUB needs to
+ be checked as it may have dependencies on DWARF blocks depending on
+ runtime information not available during the CREATE_ARRAY_TYPE time. */
+ if (high_bound < low_bound || TYPE_TARGET_STUB (element_type))
+ TYPE_LENGTH (result_type) = 0;
+ else
+ {
+ CHECK_TYPEDEF (element_type);
+ TYPE_LENGTH (result_type) =
+ TYPE_LENGTH (element_type) * (high_bound - low_bound + 1);
+ }
+
+ if (TYPE_DYNAMIC (range_type))
+ TYPE_FLAGS (result_type) |= TYPE_FLAG_DYNAMIC;
+
+ /* Multidimensional dynamic arrays need to have all the outer dimensions
+ dynamic to update the outer TYPE_TARGET_TYPE pointer with the new type
+ with statically evaluated dimensions. */
+ if (TYPE_DYNAMIC (element_type))
+ TYPE_FLAGS (result_type) |= TYPE_FLAG_DYNAMIC;
+
if (TYPE_LENGTH (result_type) == 0)
- TYPE_FLAGS (result_type) |= TYPE_FLAG_TARGET_STUB;
+ {
+ /* The real size will be computed for specific instances by
+ CHECK_TYPEDEF. */
+ TYPE_FLAGS (result_type) |= TYPE_FLAG_TARGET_STUB;
+ }
return (result_type);
}
@@ -1377,6 +1433,65 @@ stub_noname_complaint (void)
complaint (&symfile_complaints, _("stub type has NULL name"));
}
+/* Calculate the memory length of array TYPE.
+
+ TARGET_TYPE should be set to `check_typedef (TYPE_TARGET_TYPE (type))' as
+ a performance hint. Feel free to pass NULL. Set FULL_SPAN to return the
+ size incl. the possible padding of the last element - it may differ from the
+ cleared FULL_SPAN return value (the expected SIZEOF) for non-zero
+ TYPE_BYTE_STRIDE values. */
+
+static CORE_ADDR
+type_length_get (struct type *type, struct type *target_type, int full_span)
+{
+ struct type *range_type;
+ int count;
+ CORE_ADDR byte_stride = 0; /* `= 0' for a false GCC warning. */
+ CORE_ADDR element_size;
+
+ if (TYPE_CODE (type) != TYPE_CODE_ARRAY
+ && TYPE_CODE (type) != TYPE_CODE_STRING)
+ return TYPE_LENGTH (type);
+
+ /* Avoid executing TYPE_HIGH_BOUND for invalid (unallocated/unassociated)
+ Fortran arrays. The allocated data will never be used so they can be
+ zero-length. */
+ if (object_address_data_not_valid (type))
+ return 0;
+
+ range_type = TYPE_INDEX_TYPE (type);
+ if (TYPE_RANGE_LOWER_BOUND_IS_UNDEFINED (range_type)
+ || TYPE_RANGE_UPPER_BOUND_IS_UNDEFINED (range_type))
+ return 0;
+ count = TYPE_HIGH_BOUND (range_type) - TYPE_LOW_BOUND (range_type) + 1;
+ /* It may happen for wrong DWARF annotations returning garbage data. */
+ if (count < 0)
+ warning (_("Range for type %s has invalid bounds %d..%d"),
+ TYPE_NAME (type), TYPE_LOW_BOUND (range_type),
+ TYPE_HIGH_BOUND (range_type));
+ /* The code below does not handle count == 0 right. */
+ if (count <= 0)
+ return 0;
+ if (full_span || count > 1)
+ {
+ /* We do not use TYPE_ARRAY_BYTE_STRIDE_VALUE (type) here as we want to
+ force FULL_SPAN to 1. */
+ byte_stride = TYPE_BYTE_STRIDE (range_type);
+ if (byte_stride == 0)
+ {
+ if (target_type == NULL)
+ target_type = check_typedef (TYPE_TARGET_TYPE (type));
+ byte_stride = type_length_get (target_type, NULL, 1);
+ }
+ }
+ if (full_span)
+ return count * byte_stride;
+ if (target_type == NULL)
+ target_type = check_typedef (TYPE_TARGET_TYPE (type));
+ element_size = type_length_get (target_type, NULL, 1);
+ return (count - 1) * byte_stride + element_size;
+}
+
/* Added by Bryan Boreham, Kewill, Sun Sep 17 18:07:17 1989.
If this is a stubbed struct (i.e. declared as struct foo *), see if
@@ -1393,7 +1508,8 @@ stub_noname_complaint (void)
/* Find the real type of TYPE. This function returns the real type,
after removing all layers of typedefs and completing opaque or stub
types. Completion changes the TYPE argument, but stripping of
- typedefs does not. */
+ typedefs does not. Still original passed TYPE will have TYPE_LENGTH
+ updated. FIXME: Remove this dependency (only ada_to_fixed_type?). */
struct type *
check_typedef (struct type *type)
@@ -1505,34 +1621,85 @@ check_typedef (struct type *type)
}
}
- if (TYPE_TARGET_STUB (type))
+ if (TYPE_DYNAMIC (type) || (TYPE_CODE (type) == TYPE_CODE_RANGE
+ && TYPE_RANGE_HIGH_BOUND_IS_COUNT (type)))
+ {
+ struct type *ntype;
+
+ /* make_cv_type does not copy the contents of TYPE_MAIN_TYPE while we are
+ changing fields in it below. Do a full TYPE_MAIN_TYPE copy. */
+
+ ntype = alloc_type (TYPE_OBJFILE (type));
+ *TYPE_MAIN_TYPE (ntype) = *TYPE_MAIN_TYPE (type);
+ if (TYPE_NFIELDS (type))
+ {
+ size_t size = sizeof (*TYPE_FIELDS (type)) * TYPE_NFIELDS (type);
+
+ if (TYPE_OBJFILE (type))
+ TYPE_FIELDS (ntype) = obstack_alloc
+ (&TYPE_OBJFILE (type)->objfile_obstack, size);
+ else
+ TYPE_FIELDS (ntype) = xzalloc (size);
+ memcpy (TYPE_FIELDS (ntype), TYPE_FIELDS (type), size);
+ }
+ TYPE_INSTANCE_FLAGS (ntype) = TYPE_INSTANCE_FLAGS (type);
+ type = ntype;
+
+ if (TYPE_CODE (type) == TYPE_CODE_ARRAY
+ || TYPE_CODE (type) == TYPE_CODE_STRING)
+ {
+ struct type *range_type;
+
+ gdb_assert (TYPE_NFIELDS (type) == 1);
+ range_type = TYPE_INDEX_TYPE (type);
+ gdb_assert (TYPE_CODE (range_type) == TYPE_CODE_RANGE);
+ TYPE_INDEX_TYPE (type) = check_typedef (range_type);
+ }
+ else if (TYPE_CODE (type) == TYPE_CODE_RANGE)
+ {
+ int fieldno;
+
+ /* Evaluate the DWARF ranges and set them statically. */
+ for (fieldno = 0; fieldno < TYPE_NFIELDS (type); fieldno++)
+ if (TYPE_RANGE_BOUND_IS_DWARF_BLOCK (type, fieldno))
+ {
+ struct dwarf2_locexpr_baton *dlbaton;
+ CORE_ADDR val;
+
+ dlbaton = TYPE_FIELD_DWARF_BLOCK (type, fieldno);
+ val = dwarf_locexpr_baton_eval (dlbaton);
+ TYPE_RANGE_BOUND_UNSET_DWARF_BLOCK (type, fieldno);
+ TYPE_FIELD_BITPOS (type, fieldno) = val;
+ }
+
+ /* Convert TYPE_RANGE_HIGH_BOUND_IS_COUNT-modified TYPE_HIGH_BOUND
+ meanint the count (not the high bound) into a regular bound. */
+ if (TYPE_RANGE_HIGH_BOUND_IS_COUNT (type))
+ {
+ TYPE_FLAGS (type) &= ~TYPE_FLAG_RANGE_HIGH_BOUND_IS_COUNT;
+ TYPE_HIGH_BOUND (type) = TYPE_LOW_BOUND (type)
+ + TYPE_HIGH_BOUND (type) - 1;
+ }
+ }
+ }
+
+ if (!currently_reading_symtab
+ && (TYPE_TARGET_STUB (type) || TYPE_DYNAMIC (type)))
{
- struct type *range_type;
struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type));
+ if (TYPE_DYNAMIC (type))
+ TYPE_TARGET_TYPE (type) = target_type;
if (TYPE_STUB (target_type) || TYPE_TARGET_STUB (target_type))
{
/* Empty. */
}
else if (TYPE_CODE (type) == TYPE_CODE_ARRAY
- && TYPE_NFIELDS (type) == 1
- && (TYPE_CODE (range_type = TYPE_FIELD_TYPE (type, 0))
- == TYPE_CODE_RANGE))
+ || TYPE_CODE (type) == TYPE_CODE_STRING)
{
/* Now recompute the length of the array type, based on its
- number of elements and the target type's length.
- Watch out for Ada null Ada arrays where the high bound
- is smaller than the low bound. */
- const int low_bound = TYPE_FIELD_BITPOS (range_type, 0);
- const int high_bound = TYPE_FIELD_BITPOS (range_type, 1);
- int nb_elements;
-
- if (high_bound < low_bound)
- nb_elements = 0;
- else
- nb_elements = high_bound - low_bound + 1;
-
- TYPE_LENGTH (type) = nb_elements * TYPE_LENGTH (target_type);
+ number of elements and the target type's length. */
+ TYPE_LENGTH (type) = type_length_get (type, target_type, 0);
TYPE_FLAGS (type) &= ~TYPE_FLAG_TARGET_STUB;
}
else if (TYPE_CODE (type) == TYPE_CODE_RANGE)
@@ -1540,9 +1707,12 @@ check_typedef (struct type *type)
TYPE_LENGTH (type) = TYPE_LENGTH (target_type);
TYPE_FLAGS (type) &= ~TYPE_FLAG_TARGET_STUB;
}
+ TYPE_FLAGS (type) &= ~TYPE_FLAG_DYNAMIC;
}
+
/* Cache TYPE_LENGTH for future use. */
TYPE_LENGTH (orig_type) = TYPE_LENGTH (type);
+
return type;
}
--- ./gdb/gdbtypes.h 2008-11-06 20:50:14.000000000 +0100
+++ ./gdb/gdbtypes.h 2008-11-06 20:51:03.000000000 +0100
@@ -310,6 +310,16 @@ enum type_code
#define TYPE_FLAG_NOTTEXT (1 << 17)
#define TYPE_NOTTEXT(t) (TYPE_FLAGS (t) & TYPE_FLAG_NOTTEXT)
+/* Type needs to be evaluated on each CHECK_TYPEDEF and its results must not be
+ sticky. Used for TYPE_RANGE_BOUND_IS_DWARF_BLOCK. */
+
+#define TYPE_FLAG_DYNAMIC (1 << 18)
+#define TYPE_DYNAMIC(t) (TYPE_FLAGS (t) & TYPE_FLAG_DYNAMIC)
+
+/* Is HIGH_BOUND a low-bound relative count (1) or the high bound itself (0)? */
+#define TYPE_FLAG_RANGE_HIGH_BOUND_IS_COUNT (1 << 19)
+#define TYPE_RANGE_HIGH_BOUND_IS_COUNT(t) (TYPE_FLAGS (t) & TYPE_FLAG_RANGE_HIGH_BOUND_IS_COUNT)
+
/* Determine which field of the union main_type.fields[x].loc is used. */
enum field_loc_kind
@@ -391,6 +401,15 @@ struct main_type
short vptr_fieldno;
+ /* For DW_AT_data_location. FIXME: Support also its constant form. */
+ struct dwarf2_locexpr_baton *data_location;
+
+ /* For DW_AT_allocated. FIXME: Support also its constant form. */
+ struct dwarf2_locexpr_baton *allocated;
+
+ /* For DW_AT_associated. FIXME: Support also its constant form. */
+ struct dwarf2_locexpr_baton *associated;
+
/* For structure and union types, a description of each field.
For set and pascal array types, there is one "field",
whose type is the domain type of the set or array.
@@ -778,9 +797,9 @@ extern void allocate_cplus_struct_type (
#define TYPE_POINTER_TYPE(thistype) (thistype)->pointer_type
#define TYPE_REFERENCE_TYPE(thistype) (thistype)->reference_type
#define TYPE_CHAIN(thistype) (thistype)->chain
-/* Note that if thistype is a TYPEDEF type, you have to call check_typedef.
- But check_typedef does set the TYPE_LENGTH of the TYPEDEF type,
- so you only have to call check_typedef once. Since allocate_value
+/* Note that if thistype is a TYPEDEF, ARRAY or STRING type, you have to call
+ check_typedef. But check_typedef does set the TYPE_LENGTH of the TYPEDEF
+ type, so you only have to call check_typedef once. Since allocate_value
calls check_typedef, TYPE_LENGTH (VALUE_TYPE (X)) is safe. */
#define TYPE_LENGTH(thistype) (thistype)->length
#define TYPE_OBJFILE(thistype) TYPE_MAIN_TYPE(thistype)->objfile
@@ -792,23 +811,49 @@ extern void allocate_cplus_struct_type (
#define TYPE_FIELDS(thistype) TYPE_MAIN_TYPE(thistype)->fields
#define TYPE_TEMPLATE_ARGS(thistype) TYPE_CPLUS_SPECIFIC(thistype)->template_args
#define TYPE_INSTANTIATIONS(thistype) TYPE_CPLUS_SPECIFIC(thistype)->instantiations
+#define TYPE_DATA_LOCATION(thistype) TYPE_MAIN_TYPE (thistype)->data_location
+#define TYPE_ALLOCATED(thistype) TYPE_MAIN_TYPE (thistype)->allocated
+#define TYPE_ASSOCIATED(thistype) TYPE_MAIN_TYPE (thistype)->associated
#define TYPE_INDEX_TYPE(type) TYPE_FIELD_TYPE (type, 0)
+/* `TYPE_NFIELDS (range_type) >= 3' check is required before accessing it: */
+#define SET_TYPE_BYTE_STRIDE(range_type, n) \
+ (TYPE_FIELD_BITPOS (range_type, 2) = (n))
#define TYPE_LOW_BOUND(range_type) TYPE_FIELD_BITPOS (range_type, 0)
#define TYPE_HIGH_BOUND(range_type) TYPE_FIELD_BITPOS (range_type, 1)
+#define TYPE_BYTE_STRIDE(range_type) \
+ (TYPE_NFIELDS (range_type) < 3 ? 0 : TYPE_FIELD_BITPOS (range_type, 2))
-/* Moto-specific stuff for FORTRAN arrays */
-
-#define TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED(arraytype) \
- (TYPE_FIELD_ARTIFICIAL((TYPE_FIELD_TYPE((arraytype),0)),1))
+/* Whether we should use TYPE_FIELD_DWARF_BLOCK (and not TYPE_FIELD_BITPOS). */
+#define TYPE_RANGE_BOUND_IS_DWARF_BLOCK(range_type, fieldno) \
+ (TYPE_FIELD_LOC_KIND (range_type, fieldno) == FIELD_LOC_KIND_DWARF_BLOCK)
+#define TYPE_RANGE_BOUND_SET_DWARF_BLOCK(range_type, fieldno) \
+ (TYPE_FIELD_LOC_KIND (range_type, fieldno) = FIELD_LOC_KIND_DWARF_BLOCK)
+#define TYPE_RANGE_BOUND_UNSET_DWARF_BLOCK(range_type, fieldno) \
+ (TYPE_FIELD_LOC_KIND (range_type, fieldno) = FIELD_LOC_KIND_BITPOS)
+#define TYPE_ARRAY_BOUND_IS_DWARF_BLOCK(array_type, fieldno) \
+ TYPE_RANGE_BOUND_IS_DWARF_BLOCK (TYPE_INDEX_TYPE (array_type), fieldno)
+
+/* Unbound arrays, such as GCC array[]; at end of struct. */
+#define TYPE_RANGE_LOWER_BOUND_IS_UNDEFINED(rangetype) \
+ TYPE_FIELD_ARTIFICIAL((rangetype),0)
+#define TYPE_RANGE_UPPER_BOUND_IS_UNDEFINED(rangetype) \
+ TYPE_FIELD_ARTIFICIAL((rangetype),1)
#define TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED(arraytype) \
- (TYPE_FIELD_ARTIFICIAL((TYPE_FIELD_TYPE((arraytype),0)),0))
-
-#define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \
- (TYPE_FIELD_BITPOS((TYPE_FIELD_TYPE((arraytype),0)),1))
+ TYPE_RANGE_LOWER_BOUND_IS_UNDEFINED (TYPE_INDEX_TYPE (arraytype))
+#define TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED(arraytype) \
+ TYPE_RANGE_UPPER_BOUND_IS_UNDEFINED (TYPE_INDEX_TYPE (arraytype))
#define TYPE_ARRAY_LOWER_BOUND_VALUE(arraytype) \
- (TYPE_FIELD_BITPOS((TYPE_FIELD_TYPE((arraytype),0)),0))
+ TYPE_LOW_BOUND (TYPE_INDEX_TYPE (arraytype))
+#define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \
+ TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (arraytype))
+/* TYPE_BYTE_STRIDE (TYPE_INDEX_TYPE (arraytype)) with a fallback to the
+ element size if no specific stride value is known. */
+#define TYPE_ARRAY_BYTE_STRIDE_VALUE(arraytype) \
+ (TYPE_NFIELDS (TYPE_INDEX_TYPE (arraytype)) < 2 \
+ ? TYPE_LENGTH (TYPE_TARGET_TYPE (arraytype)) \
+ : TYPE_BYTE_STRIDE (TYPE_INDEX_TYPE (arraytype)))
/* C++ */
@@ -1271,12 +1316,26 @@ extern struct type *make_function_type (
extern struct type *lookup_function_type (struct type *);
+extern struct type *create_range_type_nfields (struct type *result_type,
+ struct type *index_type,
+ int nfields);
+
extern struct type *create_range_type (struct type *, struct type *, int,
int);
extern struct type *create_array_type (struct type *, struct type *,
struct type *);
+extern CORE_ADDR type_range_any_field_internal (struct type *range_type,
+ int fieldno);
+
+extern int type_range_high_bound_internal (struct type *range_type);
+
+extern int type_range_count_bound_internal (struct type *range_type);
+
+extern CORE_ADDR type_range_byte_stride_internal (struct type *range_type,
+ struct type *element_type);
+
extern struct type *create_string_type (struct type *, struct type *);
extern struct type *create_set_type (struct type *, struct type *);
--- ./gdb/printcmd.c 2008-11-06 20:50:14.000000000 +0100
+++ ./gdb/printcmd.c 2008-11-06 20:51:03.000000000 +0100
@@ -888,6 +888,11 @@ print_command_1 (char *exp, int inspect,
else
val = access_value_history (0);
+ /* Do not try to OBJECT_ADDRESS_SET here anything. We are interested in the
+ source variable base addresses as found by READ_VAR_VALUE. The value here
+ can be already a calculated expression address inappropriate for
+ DW_OP_push_object_address. */
+
if (voidprint || (val && value_type (val) &&
TYPE_CODE (value_type (val)) != TYPE_CODE_VOID))
{
--- ./gdb/testsuite/gdb.base/vla-overflow.c 1970-01-01 01:00:00.000000000 +0100
+++ ./gdb/testsuite/gdb.base/vla-overflow.c 2008-11-06 20:51:03.000000000 +0100
@@ -0,0 +1,30 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+ Copyright 2008 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program. If not, see <http://www.gnu.org/licenses/>. */
+
+#include <stdlib.h>
+
+int
+main (int argc, char **argv)
+{
+ int array[argc];
+
+ array[0] = array[0];
+
+ abort ();
+
+ return 0;
+}
--- ./gdb/testsuite/gdb.base/vla-overflow.exp 1970-01-01 01:00:00.000000000 +0100
+++ ./gdb/testsuite/gdb.base/vla-overflow.exp 2008-11-06 20:51:35.000000000 +0100
@@ -0,0 +1,108 @@
+# Copyright 2008 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+# We could crash in:
+# #0 block_linkage_function (bl=0x0) at ../../gdb/block.c:69
+# #1 in dwarf_block_get_frame_base (...) at ../../gdb/dwarf2block.c:97
+# 97 framefunc = block_linkage_function (get_frame_block (frame, NULL));
+# #2 in execute_stack_op (...) at ../../gdb/dwarf2expr.c:496
+# #3 in dwarf_block_exec_core () at ../../gdb/dwarf2block.c:156
+# #4 dwarf_block_exec (...) at ../../gdb/dwarf2block.c:206
+# #5 in range_type_count_bound_internal (...) at ../../gdb/gdbtypes.c:1430
+# #6 in create_array_type (...) at ../../gdb/gdbtypes.c:840
+# ...
+# #21 in psymtab_to_symtab (...) at ../../gdb/symfile.c:292
+# ...
+# #29 in backtrace_command_1 () at ../../gdb/stack.c:1273
+
+set testfile vla-overflow
+set shfile ${objdir}/${subdir}/${testfile}-gdb.sh
+set srcfile ${testfile}.c
+set binfile ${objdir}/${subdir}/${testfile}
+if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug}] != "" } {
+ untested "Couldn't compile test program"
+ return -1
+}
+
+set f [open "|getconf PAGESIZE" "r"]
+gets $f pagesize
+close $f
+
+gdb_exit
+gdb_start
+gdb_reinitialize_dir $srcdir/$subdir
+gdb_load ${binfile}
+
+set pid_of_gdb [exp_pid -i [board_info host fileid]]
+
+if { [runto_main] < 0 } {
+ untested vla-overflow
+ return -1
+}
+
+# Get the GDB memory size when we stay at main.
+
+proc memory_v_pages_get {} {
+ global pid_of_gdb pagesize
+ set fd [open "/proc/$pid_of_gdb/statm"]
+ gets $fd line
+ close $fd
+ # number of pages of virtual memory
+ scan $line "%d" drs
+ return $drs
+}
+
+set pages_found [memory_v_pages_get]
+
+set mb_reserve 10
+verbose -log "pages_found = $pages_found, mb_reserve = $mb_reserve"
+set kb_found [expr $pages_found * $pagesize / 1024]
+set kb_permit [expr $kb_found + 1 * 1024 + $mb_reserve * 1024]
+verbose -log "kb_found = $kb_found, kb_permit = $kb_permit"
+
+# Create the ulimit wrapper.
+set f [open $shfile "w"]
+puts $f "#! /bin/sh"
+puts $f "ulimit -v $kb_permit"
+puts $f "exec $GDB \"\$@\""
+close $f
+remote_exec host "chmod +x $shfile"
+
+gdb_exit
+set GDBold $GDB
+set GDB "$shfile"
+gdb_start
+set GDB $GDBold
+
+gdb_reinitialize_dir $srcdir/$subdir
+gdb_load ${binfile}
+
+set pid_of_gdb [exp_pid -i [board_info host fileid]]
+
+# Check the size again after the second run.
+# We must not stop in main as it would cache `array' and never crash later.
+
+gdb_run_cmd
+
+verbose -log "kb_found before abort() = [expr [memory_v_pages_get] * $pagesize / 1024]"
+
+gdb_test "" "Program received signal SIGABRT, Aborted..*" "Enter abort()"
+
+verbose -log "kb_found in abort() = [expr [memory_v_pages_get] * $pagesize / 1024]"
+
+# `abort' can get expressed as `*__GI_abort'.
+gdb_test "bt" "in \[^ \]*abort \\(.* in main \\(.*" "Backtrace after abort()"
+
+verbose -log "kb_found in bt after abort() = [expr [memory_v_pages_get] * $pagesize / 1024]"
--- ./gdb/testsuite/gdb.base/vla.c 1970-01-01 01:00:00.000000000 +0100
+++ ./gdb/testsuite/gdb.base/vla.c 2008-11-06 20:51:03.000000000 +0100
@@ -0,0 +1,55 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+ Copyright 2008 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program. If not, see <http://www.gnu.org/licenses/>. */
+
+#include <string.h>
+
+void
+marker (void)
+{
+}
+
+void
+bar (char *a, char *b, char *c, int size)
+{
+ memset (a, '1', size);
+ memset (b, '2', size);
+ memset (c, '3', 48);
+}
+
+void
+foo (int size)
+{
+ char temp1[size];
+ char temp3[48];
+
+ temp1[size - 1] = '\0';
+ {
+ char temp2[size];
+
+ bar (temp1, temp2, temp3, size);
+
+ marker (); /* break-here */
+ }
+}
+
+int
+main (void)
+{
+ foo (26);
+ foo (78);
+ return 0;
+}
--- ./gdb/testsuite/gdb.base/vla.exp 1970-01-01 01:00:00.000000000 +0100
+++ ./gdb/testsuite/gdb.base/vla.exp 2008-11-06 20:51:03.000000000 +0100
@@ -0,0 +1,62 @@
+# Copyright 2008 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+set testfile vla
+set srcfile ${testfile}.c
+set binfile ${objdir}/${subdir}/${testfile}
+if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug}] != "" } {
+ untested "Couldn't compile test program"
+ return -1
+}
+
+gdb_exit
+gdb_start
+gdb_reinitialize_dir $srcdir/$subdir
+gdb_load ${binfile}
+
+if ![runto_main] {
+ untested vla
+ return -1
+}
+
+gdb_breakpoint [gdb_get_line_number "break-here"]
+
+gdb_continue_to_breakpoint "break-here"
+
+gdb_test "whatis temp1" "type = char \\\[variable\\\]" "first: whatis temp1"
+gdb_test "whatis temp2" "type = char \\\[variable\\\]" "first: whatis temp2"
+gdb_test "whatis temp3" "type = char \\\[48\\\]" "first: whatis temp3"
+
+gdb_test "ptype temp1" "type = char \\\[26\\\]" "first: ptype temp1"
+gdb_test "ptype temp2" "type = char \\\[26\\\]" "first: ptype temp2"
+gdb_test "ptype temp3" "type = char \\\[48\\\]" "first: ptype temp3"
+
+gdb_test "p temp1" " = '1' <repeats 26 times>" "first: print temp1"
+gdb_test "p temp2" " = '2' <repeats 26 times>" "first: print temp2"
+gdb_test "p temp3" " = '3' <repeats 48 times>" "first: print temp3"
+
+gdb_continue_to_breakpoint "break-here"
+
+gdb_test "whatis temp1" "type = char \\\[variable\\\]" "second: whatis temp1"
+gdb_test "whatis temp2" "type = char \\\[variable\\\]" "second: whatis temp2"
+gdb_test "whatis temp3" "type = char \\\[48\\\]" "second: whatis temp3"
+
+gdb_test "ptype temp1" "type = char \\\[78\\\]" "second: ptype temp1"
+gdb_test "ptype temp2" "type = char \\\[78\\\]" "second: ptype temp2"
+gdb_test "ptype temp3" "type = char \\\[48\\\]" "second: ptype temp3"
+
+gdb_test "p temp1" " = '1' <repeats 78 times>" "second: print temp1"
+gdb_test "p temp2" " = '2' <repeats 78 times>" "second: print temp2"
+gdb_test "p temp3" " = '3' <repeats 48 times>" "second: print temp3"
--- ./gdb/testsuite/gdb.dwarf2/dw2-stripped.c 1970-01-01 01:00:00.000000000 +0100
+++ ./gdb/testsuite/gdb.dwarf2/dw2-stripped.c 2008-11-06 20:51:35.000000000 +0100
@@ -0,0 +1,42 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+ Copyright 2004 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ USA. */
+
+
+/* The function `func1' traced into must have debug info on offset > 0;
+ (DW_UNSND (attr)). This is the reason of `func0' existence. */
+
+void
+func0(int a, int b)
+{
+}
+
+/* `func1' being traced into must have some arguments to dump. */
+
+void
+func1(int a, int b)
+{
+ func0 (a,b);
+}
+
+int
+main(void)
+{
+ func1 (1, 2);
+ return 0;
+}
--- ./gdb/testsuite/gdb.dwarf2/dw2-stripped.exp 1970-01-01 01:00:00.000000000 +0100
+++ ./gdb/testsuite/gdb.dwarf2/dw2-stripped.exp 2008-11-06 20:51:35.000000000 +0100
@@ -0,0 +1,79 @@
+# Copyright 2006 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+# Minimal DWARF-2 unit test
+
+# This test can only be run on targets which support DWARF-2.
+# For now pick a sampling of likely targets.
+if {![istarget *-*-linux*]
+ && ![istarget *-*-gnu*]
+ && ![istarget *-*-elf*]
+ && ![istarget *-*-openbsd*]
+ && ![istarget arm-*-eabi*]
+ && ![istarget powerpc-*-eabi*]} {
+ return 0
+}
+
+set testfile "dw2-stripped"
+set srcfile ${testfile}.c
+set binfile ${objdir}/${subdir}/${testfile}.x
+
+remote_exec build "rm -f ${binfile}"
+
+# get the value of gcc_compiled
+if [get_compiler_info ${binfile}] {
+ return -1
+}
+
+# This test can only be run on gcc as we use additional_flags=FIXME
+if {$gcc_compiled == 0} {
+ return 0
+}
+
+if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug additional_flags=-ggdb3}] != "" } {
+ return -1
+}
+
+remote_exec build "objcopy -R .debug_loc ${binfile}"
+set strip_output [remote_exec build "objdump -h ${binfile}"]
+
+set test "stripping test file preservation"
+if [ regexp ".debug_info " $strip_output] {
+ pass "$test (.debug_info preserved)"
+} else {
+ fail "$test (.debug_info got also stripped)"
+}
+
+set test "stripping test file functionality"
+if [ regexp ".debug_loc " $strip_output] {
+ fail "$test (.debug_loc still present)"
+} else {
+ pass "$test (.debug_loc stripped)"
+}
+
+gdb_exit
+gdb_start
+gdb_reinitialize_dir $srcdir/$subdir
+gdb_load ${binfile}
+
+# For C programs, "start" should stop in main().
+
+gdb_test "start" \
+ ".*main \\(\\) at .*" \
+ "start"
+gdb_test "step" \
+ "func.* \\(.*\\) at .*" \
+ "step"
--- ./gdb/testsuite/gdb.fortran/dynamic.exp 1970-01-01 01:00:00.000000000 +0100
+++ ./gdb/testsuite/gdb.fortran/dynamic.exp 2008-11-06 20:51:03.000000000 +0100
@@ -0,0 +1,141 @@
+# Copyright 2007 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+# This file was written by Jan Kratochvil <jan.kratochvil@redhat.com>.
+
+# This file is part of the gdb testsuite. It contains tests for dynamically
+# allocated Fortran arrays.
+# It depends on the GCC dynamic Fortran arrays DWARF support:
+# http://gcc.gnu.org/bugzilla/show_bug.cgi?id=22244
+
+set testfile "dynamic"
+set srcfile ${testfile}.f90
+set binfile ${objdir}/${subdir}/${testfile}
+
+if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug f77 quiet}] != "" } {
+ untested "Couldn't compile ${srcfile}"
+ return -1
+}
+
+gdb_exit
+gdb_start
+gdb_reinitialize_dir $srcdir/$subdir
+gdb_load ${binfile}
+
+if ![runto MAIN__] then {
+ perror "couldn't run to breakpoint MAIN__"
+ continue
+}
+
+gdb_breakpoint [gdb_get_line_number "varx-init"]
+gdb_continue_to_breakpoint "varx-init"
+gdb_test "p varx" "\\$\[0-9\]* = <(object|the array) is not allocated>" "p varx unallocated"
+gdb_test "ptype varx" "type = <(object|the array) is not allocated>" "ptype varx unallocated"
+gdb_test "p varx(1,5,17)" "(Cannot access it|Unable to access the object) because the (object|array) is not allocated\\." "p varx(1,5,17) unallocated"
+gdb_test "p varx(1,5,17)=1" "(Cannot access it|Unable to access the object) because the (object|array) is not allocated\\." "p varx(1,5,17)=1 unallocated"
+gdb_test "ptype varx(1,5,17)" "(Cannot access it|Unable to access the object) because the (object|array) is not allocated\\." "ptype varx(1,5,17) unallocated"
+
+gdb_breakpoint [gdb_get_line_number "varx-allocated"]
+gdb_continue_to_breakpoint "varx-allocated"
+# $1 = (( ( 0, 0, 0, 0, 0, 0) ( 0, 0, 0, 0, 0, 0) --- , 0) ) ( ( 0, 0, ...) ...) ...)
+gdb_test "ptype varx" "type = real(\\(kind=4\\)|\\*4) \\(6,5:15,17:28\\)" "ptype varx allocated"
+# Intel Fortran Compiler 10.1.008 uses -1 there, GCC uses 1.
+gdb_test "p l" "\\$\[0-9\]* = (\\.TRUE\\.|4294967295)" "p l if varx allocated"
+
+gdb_breakpoint [gdb_get_line_number "varx-filled"]
+gdb_continue_to_breakpoint "varx-filled"
+gdb_test "p varx(2, 5, 17)" "\\$\[0-9\]* = 6"
+gdb_test "p varx(1, 5, 17)" "\\$\[0-9\]* = 7"
+gdb_test "p varx(2, 6, 18)" "\\$\[0-9\]* = 8"
+gdb_test "p varx(6, 15, 28)" "\\$\[0-9\]* = 9"
+# The latter one is for the Intel Fortran Compiler 10.1.008 pointer type.
+gdb_test "p varv" "\\$\[0-9\]* = (<(object|the array) is not associated>|.*(Cannot access it|Unable to access the object) because the object is not associated.)" "p varv unassociated"
+gdb_test "ptype varv" "type = (<(object|the array) is not associated>|.*(Cannot access it|Unable to access the object) because the object is not associated.)" "ptype varv unassociated"
+
+gdb_breakpoint [gdb_get_line_number "varv-associated"]
+gdb_continue_to_breakpoint "varv-associated"
+gdb_test "p varx(3, 7, 19)" "\\$\[0-9\]* = 6" "p varx(3, 7, 19) with varv associated"
+gdb_test "p varv(3, 7, 19)" "\\$\[0-9\]* = 6" "p varv(3, 7, 19) associated"
+# Intel Fortran Compiler 10.1.008 uses -1 there, GCC uses 1.
+gdb_test "p l" "\\$\[0-9\]* = (\\.TRUE\\.|4294967295)" "p l if varv associated"
+gdb_test "ptype varx" "type = real(\\(kind=4\\)|\\*4) \\(6,5:15,17:28\\)" "ptype varx with varv associated"
+# Intel Fortran Compiler 10.1.008 uses the pointer type.
+gdb_test "ptype varv" "type = (PTR TO -> \\( )?real(\\(kind=4\\)|\\*4) \\(6,5:15,17:28\\)\\)?" "ptype varv associated"
+
+gdb_breakpoint [gdb_get_line_number "varv-filled"]
+gdb_continue_to_breakpoint "varv-filled"
+gdb_test "p varx(3, 7, 19)" "\\$\[0-9\]* = 10" "p varx(3, 7, 19) with varv filled"
+gdb_test "p varv(3, 7, 19)" "\\$\[0-9\]* = 10" "p varv(3, 7, 19) filled"
+
+gdb_breakpoint [gdb_get_line_number "varv-deassociated"]
+gdb_continue_to_breakpoint "varv-deassociated"
+# The latter one is for the Intel Fortran Compiler 10.1.008 pointer type.
+gdb_test "p varv" "\\$\[0-9\]* = (<(object|the array) is not associated>|.*(Cannot access it|Unable to access the object) because the object is not associated.)" "p varv deassociated"
+gdb_test "ptype varv" "type = (<(object|the array) is not associated>|.*(Cannot access it|Unable to access the object) because the object is not associated.)" "ptype varv deassociated"
+gdb_test "p l" "\\$\[0-9\]* = \\.FALSE\\." "p l if varv deassociated"
+gdb_test "p varv(1,5,17)" "(Cannot access it|Unable to access the object) because the (object|array) is not associated\\."
+gdb_test "ptype varv(1,5,17)" "(Cannot access it|Unable to access the object) because the (object|array) is not associated\\."
+
+gdb_breakpoint [gdb_get_line_number "varx-deallocated"]
+gdb_continue_to_breakpoint "varx-deallocated"
+gdb_test "p varx" "\\$\[0-9\]* = <(object|the array) is not allocated>" "p varx deallocated"
+gdb_test "ptype varx" "type = <(object|the array) is not allocated>" "ptype varx deallocated"
+gdb_test "p l" "\\$\[0-9\]* = \\.FALSE\\." "p l if varx deallocated"
+gdb_test "p varx(1,5,17)" "(Cannot access it|Unable to access the object) because the (object|array) is not allocated\\." "p varx(1,5,17) deallocated"
+gdb_test "ptype varx(1,5,17)" "(Cannot access it|Unable to access the object) because the (object|array) is not allocated\\." "ptype varx(1,5,17) deallocated"
+
+gdb_breakpoint [gdb_get_line_number "vary-passed"]
+gdb_continue_to_breakpoint "vary-passed"
+# $1 = (( ( 1, 1, 1, 1, 1, 1) ( 1, 1, 1, 1, 1, 1) --- , 1) ) ( ( 1, 1, ...) ...) ...)
+gdb_test "p vary" "\\$\[0-9\]* = \\(\[()1, .\]*\\)"
+
+gdb_breakpoint [gdb_get_line_number "vary-filled"]
+gdb_continue_to_breakpoint "vary-filled"
+gdb_test "ptype vary" "type = real(\\(kind=4\\)|\\*4) \\(10,10\\)"
+gdb_test "p vary(1, 1)" "\\$\[0-9\]* = 8"
+gdb_test "p vary(2, 2)" "\\$\[0-9\]* = 9"
+gdb_test "p vary(1, 3)" "\\$\[0-9\]* = 10"
+# $1 = (( ( 3, 3, 3, 3, 3, 3) ( 3, 3, 3, 3, 3, 3) --- , 3) ) ( ( 3, 3, ...) ...) ...)
+gdb_test "p varw" "\\$\[0-9\]* = \\(\[()3, .\]*\\)"
+
+gdb_breakpoint [gdb_get_line_number "varw-almostfilled"]
+gdb_continue_to_breakpoint "varw-almostfilled"
+gdb_test "ptype varw" "type = real(\\(kind=4\\)|\\*4) \\(5,4,3\\)"
+gdb_test "p varw(3,1,1)=1" "\\$\[0-9\]* = 1"
+# $1 = (( ( 6, 5, 1, 5, 5, 5) ( 5, 5, 5, 5, 5, 5) --- , 5) ) ( ( 5, 5, ...) ...) ...)
+gdb_test "p varw" "\\$\[0-9\]* = \\( *\\( *\\( *6, *5, *1,\[()5, .\]*\\)" "p varw filled"
+# "up" works with GCC but other Fortran compilers may copy the values into the
+# outer function only on the exit of the inner function.
+gdb_test "finish" ".*call bar \\(y, x\\)"
+gdb_test "p z(2,4,5)" "\\$\[0-9\]* = 3"
+gdb_test "p z(2,4,6)" "\\$\[0-9\]* = 6"
+gdb_test "p z(2,4,7)" "\\$\[0-9\]* = 5"
+gdb_test "p z(4,4,6)" "\\$\[0-9\]* = 1"
+
+gdb_breakpoint [gdb_get_line_number "varz-almostfilled"]
+gdb_continue_to_breakpoint "varz-almostfilled"
+# GCC uses the pointer type here, Intel Fortran Compiler 10.1.008 does not.
+gdb_test "ptype varz" "type = (PTR TO -> \\( )?real(\\(kind=4\\)|\\*4) \\(\\*\\)\\)?"
+# Intel Fortran Compiler 10.1.008 has a bug here - (2:11,7:7)
+# as it produces DW_AT_lower_bound == DW_AT_upper_bound == 7.
+gdb_test "ptype vart" "type = (PTR TO -> \\( )?real(\\(kind=4\\)|\\*4) \\(2:11,7:\\*\\)\\)?"
+gdb_test "p varz(3)" "\\$\[0-9\]* = 4"
+# maps to foo::vary(1,1)
+gdb_test "p vart(2,7)" "\\$\[0-9\]* = 8"
+# maps to foo::vary(2,2)
+gdb_test "p vart(3,8)" "\\$\[0-9\]* = 9"
+# maps to foo::vary(1,3)
+gdb_test "p vart(2,9)" "\\$\[0-9\]* = 10"
--- ./gdb/testsuite/gdb.fortran/dynamic.f90 1970-01-01 01:00:00.000000000 +0100
+++ ./gdb/testsuite/gdb.fortran/dynamic.f90 2008-11-06 20:51:03.000000000 +0100
@@ -0,0 +1,97 @@
+! Copyright 2007 Free Software Foundation, Inc.
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+!
+! Ihis file is the Fortran source file for dynamic.exp.
+! Original file written by Jakub Jelinek <jakub@redhat.com>.
+! Modified for the GDB testcase by Jan Kratochvil <jan.kratochvil@redhat.com>.
+
+subroutine baz
+ real, target, allocatable :: varx (:, :, :)
+ real, pointer :: varv (:, :, :)
+ real, target :: varu (1, 2, 3)
+ logical :: l
+ allocate (varx (1:6, 5:15, 17:28)) ! varx-init
+ l = allocated (varx)
+ varx(:, :, :) = 6 ! varx-allocated
+ varx(1, 5, 17) = 7
+ varx(2, 6, 18) = 8
+ varx(6, 15, 28) = 9
+ varv => varx ! varx-filled
+ l = associated (varv)
+ varv(3, 7, 19) = 10 ! varv-associated
+ varv => null () ! varv-filled
+ l = associated (varv)
+ deallocate (varx) ! varv-deassociated
+ l = allocated (varx)
+ varu(:, :, :) = 10 ! varx-deallocated
+ allocate (varv (1:6, 5:15, 17:28))
+ l = associated (varv)
+ varv(:, :, :) = 6
+ varv(1, 5, 17) = 7
+ varv(2, 6, 18) = 8
+ varv(6, 15, 28) = 9
+ deallocate (varv)
+ l = associated (varv)
+ varv => varu
+ varv(1, 1, 1) = 6
+ varv(1, 2, 3) = 7
+ l = associated (varv)
+end subroutine baz
+subroutine foo (vary, varw)
+ real :: vary (:, :)
+ real :: varw (:, :, :)
+ vary(:, :) = 4 ! vary-passed
+ vary(1, 1) = 8
+ vary(2, 2) = 9
+ vary(1, 3) = 10
+ varw(:, :, :) = 5 ! vary-filled
+ varw(1, 1, 1) = 6
+ varw(2, 2, 2) = 7 ! varw-almostfilled
+end subroutine foo
+subroutine bar (varz, vart)
+ real :: varz (*)
+ real :: vart (2:11, 7:*)
+ varz(1:3) = 4
+ varz(2) = 5 ! varz-almostfilled
+end subroutine bar
+program test
+ interface
+ subroutine foo (vary, varw)
+ real :: vary (:, :)
+ real :: varw (:, :, :)
+ end subroutine
+ end interface
+ interface
+ subroutine bar (varz, vart)
+ real :: varz (*)
+ real :: vart (2:11, 7:*)
+ end subroutine
+ end interface
+ real :: x (10, 10), y (5), z(8, 8, 8)
+ x(:,:) = 1
+ y(:) = 2
+ z(:,:,:) = 3
+ call baz
+ call foo (x, z(2:6, 4:7, 6:8))
+ call bar (y, x)
+ if (x (1, 1) .ne. 8 .or. x (2, 2) .ne. 9 .or. x (1, 2) .ne. 4) call abort
+ if (x (1, 3) .ne. 10) call abort
+ if (z (2, 4, 6) .ne. 6 .or. z (3, 5, 7) .ne. 7 .or. z (2, 4, 7) .ne. 5) call abort
+ if (any (y .ne. (/4, 5, 4, 2, 2/))) call abort
+ call foo (transpose (x), z)
+ if (x (1, 1) .ne. 8 .or. x (2, 2) .ne. 9 .or. x (1, 2) .ne. 4) call abort
+ if (x (3, 1) .ne. 10) call abort
+end
--- ./gdb/testsuite/gdb.fortran/string.exp 1970-01-01 01:00:00.000000000 +0100
+++ ./gdb/testsuite/gdb.fortran/string.exp 2008-11-06 20:51:03.000000000 +0100
@@ -0,0 +1,59 @@
+# Copyright 2008 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+# This file was written by Jan Kratochvil <jan.kratochvil@redhat.com>.
+
+# This file is part of the gdb testsuite. It contains tests for Fortran
+# strings with dynamic length.
+
+set testfile "string"
+set srcfile ${testfile}.f90
+set binfile ${objdir}/${subdir}/${testfile}
+
+if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug f77 quiet}] != "" } {
+ untested "Couldn't compile ${srcfile}"
+ return -1
+}
+
+gdb_exit
+gdb_start
+gdb_reinitialize_dir $srcdir/$subdir
+gdb_load ${binfile}
+
+if ![runto MAIN__] then {
+ perror "couldn't run to breakpoint MAIN__"
+ continue
+}
+
+gdb_breakpoint [gdb_get_line_number "var-init"]
+gdb_continue_to_breakpoint "var-init"
+gdb_test "ptype c" "type = character(\\(kind=1\\)|\\*1)"
+gdb_test "ptype d" "type = character(\\(kind=8\\)|\\*8)"
+gdb_test "ptype e" "type = character(\\(kind=4\\)|\\*4)"
+gdb_test "ptype f" "type = character(\\(kind=4\\)|\\*4) \\(7,8:10\\)"
+gdb_test "ptype *e" "Attempt to take contents of a non-pointer value."
+gdb_test "ptype *f" "type = character(\\(kind=4\\)|\\*4) \\(7\\)"
+gdb_test "p c" "\\$\[0-9\]* = 'c'"
+gdb_test "p d" "\\$\[0-9\]* = 'd '"
+gdb_test "p e" "\\$\[0-9\]* = 'g '"
+gdb_test "p f" "\\$\[0-9\]* = \\(\\( 'h ', 'h ', 'h ', 'h ', 'h ', 'h ', 'h '\\) \\( 'h ', 'h ', 'h ', 'h ', 'h ', 'h ', 'h '\\) \\( 'h ', 'h ', 'h ', 'h ', 'h ', 'h ', 'h '\\) \\)"
+gdb_test "p *e" "Attempt to take contents of a non-pointer value."
+gdb_test "p *f" "Attempt to take contents of a non-pointer value."
+
+gdb_breakpoint [gdb_get_line_number "var-finish"]
+gdb_continue_to_breakpoint "var-finish"
+gdb_test "p e" "\\$\[0-9\]* = 'e '" "p e re-set"
+gdb_test "p f" "\\$\[0-9\]* = \\(\\( 'f ', 'f ', 'f ', 'f ', 'f ', 'f ', 'f '\\) \\( 'f2 ', 'f ', 'f ', 'f ', 'f ', 'f ', 'f '\\) \\( 'f ', 'f ', 'f ', 'f ', 'f ', 'f ', 'f '\\) \\)" "p *f re-set"
--- ./gdb/testsuite/gdb.fortran/string.f90 1970-01-01 01:00:00.000000000 +0100
+++ ./gdb/testsuite/gdb.fortran/string.f90 2008-11-06 20:51:03.000000000 +0100
@@ -0,0 +1,37 @@
+! Copyright 2008 Free Software Foundation, Inc.
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+!
+! Ihis file is the Fortran source file for dynamic.exp.
+! Original file written by Jakub Jelinek <jakub@redhat.com>.
+! Modified for the GDB testcase by Jan Kratochvil <jan.kratochvil@redhat.com>.
+
+subroutine foo (e, f)
+ character (len=1) :: c
+ character (len=8) :: d
+ character (len=*) :: e
+ character (len=*) :: f (1:7, 8:10)
+ c = 'c'
+ d = 'd'
+ e = 'e' ! var-init
+ f = 'f'
+ f(1,9) = 'f2'
+ c = 'c' ! var-finish
+end subroutine foo
+ character (len=4) :: g, h (1:7, 8:10)
+ g = 'g'
+ h = 'h'
+ call foo (g, h)
+end
--- ./gdb/typeprint.c 2008-11-06 20:50:14.000000000 +0100
+++ ./gdb/typeprint.c 2008-11-06 20:51:35.000000000 +0100
@@ -33,6 +33,7 @@
#include "cp-abi.h"
#include "typeprint.h"
#include "gdb_string.h"
+#include "dwarf2loc.h"
#include <errno.h>
/* For real-type printing in whatis_exp() */
@@ -102,6 +103,9 @@ void
type_print (struct type *type, char *varstring, struct ui_file *stream,
int show)
{
+ if (show >= 0)
+ type = check_typedef (type);
+
LA_PRINT_TYPE (type, varstring, stream, show, 0);
}
@@ -113,7 +117,8 @@ whatis_exp (char *exp, int show)
{
struct expression *expr;
struct value *val;
- struct cleanup *old_chain = NULL;
+ /* Required at least for the object_address_set call. */
+ struct cleanup *old_chain = make_cleanup (null_cleanup, NULL);
struct type *real_type = NULL;
struct type *type;
int full = 0;
@@ -123,12 +128,13 @@ whatis_exp (char *exp, int show)
if (exp)
{
expr = parse_expression (exp);
- old_chain = make_cleanup (free_current_contents, &expr);
+ make_cleanup (free_current_contents, &expr);
val = evaluate_type (expr);
}
else
val = access_value_history (0);
+ object_address_set (VALUE_ADDRESS (val));
type = value_type (val);
if (objectprint)
@@ -164,8 +170,7 @@ whatis_exp (char *exp, int show)
type_print (type, "", gdb_stdout, show);
printf_filtered ("\n");
- if (exp)
- do_cleanups (old_chain);
+ do_cleanups (old_chain);
}
static void
--- ./gdb/valarith.c 2008-11-06 20:50:14.000000000 +0100
+++ ./gdb/valarith.c 2008-11-06 20:51:03.000000000 +0100
@@ -39,7 +39,6 @@
#define TRUNCATION_TOWARDS_ZERO ((-5 / 2) == -2)
#endif
-static struct value *value_subscripted_rvalue (struct value *, struct value *, int);
static struct type *unop_result_type (enum exp_opcode op, struct type *type1);
static struct type *binop_result_type (enum exp_opcode op, struct type *type1,
struct type *type2);
@@ -180,9 +179,9 @@ an integer nor a pointer of the same typ
struct value *
value_subscript (struct value *array, struct value *idx)
{
- struct value *bound;
int c_style = current_language->c_style_arrays;
struct type *tarray;
+ LONGEST index = value_as_long (idx);
array = coerce_ref (array);
tarray = check_typedef (value_type (array));
@@ -195,13 +194,26 @@ value_subscript (struct value *array, st
get_discrete_bounds (range_type, &lowerbound, &upperbound);
if (VALUE_LVAL (array) != lval_memory)
- return value_subscripted_rvalue (array, idx, lowerbound);
+ {
+ if (index >= lowerbound && index <= upperbound)
+ {
+ CORE_ADDR element_size = TYPE_LENGTH (TYPE_TARGET_TYPE (tarray));
+ CORE_ADDR offset = (index - lowerbound) * element_size;
+
+ return value_subscripted_rvalue (array, offset);
+ }
+ error (_("array or string index out of range"));
+ }
if (c_style == 0)
{
- LONGEST index = value_as_long (idx);
if (index >= lowerbound && index <= upperbound)
- return value_subscripted_rvalue (array, idx, lowerbound);
+ {
+ CORE_ADDR element_size = TYPE_LENGTH (TYPE_TARGET_TYPE (tarray));
+ CORE_ADDR offset = (index - lowerbound) * element_size;
+
+ return value_subscripted_rvalue (array, offset);
+ }
/* Emit warning unless we have an array of unknown size.
An array of unknown size has lowerbound 0 and upperbound -1. */
if (upperbound > -1)
@@ -210,12 +222,7 @@ value_subscript (struct value *array, st
c_style = 1;
}
- if (lowerbound != 0)
- {
- bound = value_from_longest (builtin_type_int, (LONGEST) lowerbound);
- idx = value_sub (idx, bound);
- }
-
+ index -= lowerbound;
array = value_coerce_array (array);
}
@@ -248,43 +255,57 @@ value_subscript (struct value *array, st
}
if (c_style)
- return value_ind (value_add (array, idx));
+ {
+ struct value *idx;
+
+ idx = value_from_longest (builtin_type_int32, index);
+ return value_ind (value_add (array, idx));
+ }
else
error (_("not an array or string"));
}
-/* Return the value of EXPR[IDX], expr an aggregate rvalue
- (eg, a vector register). This routine used to promote floats
- to doubles, but no longer does. */
+/* Return the value of *((void *) ARRAY + ELEMENT), ARRAY an aggregate rvalue
+ (eg, a vector register). This routine used to promote floats to doubles,
+ but no longer does. OFFSET is zero-based with 0 for the lowermost existing
+ element, it must be expressed in bytes (therefore multiplied by
+ check_typedef (TYPE_TARGET_TYPE (array_type)). */
-static struct value *
-value_subscripted_rvalue (struct value *array, struct value *idx, int lowerbound)
+struct value *
+value_subscripted_rvalue (struct value *array, CORE_ADDR offset)
{
struct type *array_type = check_typedef (value_type (array));
struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type));
- unsigned int elt_size = TYPE_LENGTH (elt_type);
- LONGEST index = value_as_long (idx);
- unsigned int elt_offs = elt_size * longest_to_int (index - lowerbound);
struct value *v;
- if (index < lowerbound || elt_offs >= TYPE_LENGTH (array_type))
- error (_("no such vector element"));
+ /* Do not check TYPE_LENGTH (array_type) as we may have been given the
+ innermost dimension of a multi-dimensional Fortran array where its length
+ is shorter than the possibly accessed element offset. */
v = allocate_value (elt_type);
if (value_lazy (array))
set_value_lazy (v, 1);
else
- memcpy (value_contents_writeable (v),
- value_contents (array) + elt_offs, elt_size);
+ {
+ unsigned int elt_size = TYPE_LENGTH (elt_type);
+ memcpy (value_contents_writeable (v),
+ value_contents (array) + offset, elt_size);
+ }
if (VALUE_LVAL (array) == lval_internalvar)
VALUE_LVAL (v) = lval_internalvar_component;
else
VALUE_LVAL (v) = VALUE_LVAL (array);
+
VALUE_ADDRESS (v) = VALUE_ADDRESS (array);
+ /* We need to already adjust the address according to the former type as
+ V will have a different type (ELT_TYPE) which may no longer contain the
+ adjustment code like TYPE_FORTRAN_ARRAY_DATA_LOCATION. */
+ object_address_get_data (array_type, &VALUE_ADDRESS (v));
+
VALUE_REGNUM (v) = VALUE_REGNUM (array);
VALUE_FRAME_ID (v) = VALUE_FRAME_ID (array);
- set_value_offset (v, value_offset (array) + elt_offs);
+ set_value_offset (v, value_offset (array) + offset);
return v;
}
--- ./gdb/valops.c 2008-11-06 20:50:14.000000000 +0100
+++ ./gdb/valops.c 2008-11-06 20:51:35.000000000 +0100
@@ -37,6 +37,7 @@
#include "dictionary.h"
#include "cp-support.h"
#include "dfp.h"
+#include "dwarf2loc.h"
#include <errno.h>
#include "gdb_string.h"
@@ -504,6 +505,49 @@ value_one (struct type *type, enum lval_
return val;
}
+/* object_address_set must be already called before this function. */
+
+const char *
+object_address_data_not_valid (struct type *type)
+{
+ /* DW_AT_associated has a preference over DW_AT_allocated. */
+ if (TYPE_ASSOCIATED (type) != NULL
+ && 0 == dwarf_locexpr_baton_eval (TYPE_ASSOCIATED (type)))
+ return N_("object is not associated");
+
+ if (TYPE_ALLOCATED (type) != NULL
+ && 0 == dwarf_locexpr_baton_eval (TYPE_ALLOCATED (type)))
+ return N_("object is not allocated");
+
+ return NULL;
+}
+
+/* Return non-zero if the variable is valid. If it is valid the function
+ may store the data address (DW_AT_DATA_LOCATION) of TYPE at *ADDRESS_RETURN.
+ You must set *ADDRESS_RETURN as VALUE_ADDRESS (VAL) before calling this
+ function. If no DW_AT_DATA_LOCATION is present for TYPE the address at
+ *ADDRESS_RETURN is left unchanged. ADDRESS_RETURN must not be NULL, use
+ object_address_data_not_valid () for just the data validity check. */
+
+int
+object_address_get_data (struct type *type, CORE_ADDR *address_return)
+{
+ gdb_assert (address_return != NULL);
+
+ object_address_set (*address_return);
+ if (object_address_data_not_valid (type) != NULL)
+ {
+ /* Do not try to evaluate DW_AT_data_location as it may even crash
+ (it would just return the value zero in the gfortran case). */
+ return 0;
+ }
+
+ if (TYPE_DATA_LOCATION (type) != NULL)
+ *address_return = dwarf_locexpr_baton_eval (TYPE_DATA_LOCATION (type));
+
+ return 1;
+}
+
/* Return a value with type TYPE located at ADDR.
Call value_at only if the data needs to be fetched immediately;
@@ -570,12 +614,21 @@ value_at_lazy (struct type *type, CORE_A
int
value_fetch_lazy (struct value *val)
{
- CORE_ADDR addr = VALUE_ADDRESS (val) + value_offset (val);
- int length = TYPE_LENGTH (value_enclosing_type (val));
+ CORE_ADDR addr;
+ int length;
- struct type *type = value_type (val);
- if (length)
- read_memory (addr, value_contents_all_raw (val), length);
+ addr = VALUE_ADDRESS (val);
+ if (object_address_get_data (value_type (val), &addr))
+ {
+ struct type *type = value_enclosing_type (val);
+ int length = TYPE_LENGTH (check_typedef (type));
+
+ if (length)
+ {
+ addr += value_offset (val);
+ read_memory (addr, value_contents_all_raw (val), length);
+ }
+ }
set_value_lazy (val, 0);
return 0;
@@ -887,12 +940,17 @@ struct value *
value_coerce_array (struct value *arg1)
{
struct type *type = check_typedef (value_type (arg1));
+ CORE_ADDR address;
if (VALUE_LVAL (arg1) != lval_memory)
error (_("Attempt to take address of value not located in memory."));
+ address = VALUE_ADDRESS (arg1);
+ if (!object_address_get_data (type, &address))
+ error (_("Attempt to take address of non-valid value."));
+
return value_from_pointer (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
- (VALUE_ADDRESS (arg1) + value_offset (arg1)));
+ address + value_offset (arg1));
}
/* Given a value which is a function, return a value which is a pointer
--- ./gdb/value.h 2008-11-06 20:50:14.000000000 +0100
+++ ./gdb/value.h 2008-11-06 20:51:03.000000000 +0100
@@ -284,6 +284,10 @@ extern struct value *value_from_decfloat
const gdb_byte *decbytes);
extern struct value *value_from_string (char *string);
+extern const char *object_address_data_not_valid (struct type *type);
+extern int object_address_get_data (struct type *type,
+ CORE_ADDR *address_return);
+
extern struct value *value_at (struct type *type, CORE_ADDR addr);
extern struct value *value_at_lazy (struct type *type, CORE_ADDR addr);
@@ -554,4 +558,7 @@ extern struct value *value_allocate_spac
extern struct value *value_of_local (const char *name, int complain);
+extern struct value *value_subscripted_rvalue (struct value *array,
+ CORE_ADDR offset);
+
#endif /* !defined (VALUE_H) */
Reference in New Issue View Git Blame Copy Permalink