[09/11] Fortran dynamic arrays support: Dynamic array bounds for Fortran
Jan Kratochvil
jan.kratochvil@redhat.com
Fri Nov 16 03:20:00 GMT 2007
Hi,
the dynamic bounds part for Fortran, it could be even a single patch.
Regards,
Jan
-------------- next part --------------
2007-11-16 Jan Kratochvil <jan.kratochvil@redhat.com>
* eval.c (evaluate_subexp_standard): New variables BYTE_STRIDE_ARRAY,
OFFSET_BYTE and ELEMENT_SIZE. Calculate the array offsets using the
TYPE_ARRAY_BYTE_STRIDE_VALUE_WITH_ADDRESS value, if provided.
* f-lang.h (f77_get_dynamic_upperbound, f77_get_dynamic_lowerbound):
Add the parameter ADDRESS to the prototypes.
* f-typeprint.c (f_type_print_varspec_suffix): Likewise.
(f_print_type_with_address): Add the ADDRESS parameter to the call of
F_TYPE_PRINT_VARSPEC_SUFFIX.
(f_type_print_varspec_prefix): Add the ADDRESS parameter. Update all
its callers.
* f-valprint.c (f77_create_arrayprint_offset_tbl): Add the ADDRESS
parameter to the prototype.
(F77_DIM_SIZE): Rename to ...
(F77_DIM_COUNT): ... here. Update all its uses.
(F77_DIM_OFFSET): Rename to ...
(F77_DIM_BYTE_STRIDE): ... here. Update all its uses.
(f77_get_dynamic_lowerbound): Add the ADDRESS parameter. Update all
its callers. Add a function comment. Replace the call to
TYPE_ARRAY_LOWER_BOUND_VALUE with the call to
TYPE_ARRAY_LOWER_BOUND_VALUE_WITH_ADDRESS.
(f77_get_dynamic_upperbound): Add the ADDRESS parameter. Update all
its callers. Add a function comment. Replace the call to
TYPE_ARRAY_UPPER_BOUND_VALUE with the call to
TYPE_ARRAY_UPPER_BOUND_VALUE_WITH_ADDRESS.
(f77_create_arrayprint_offset_tbl): Add the ADDRESS parameter. Update
all its callers. Update the F77_DIM_BYTE_STRIDE calculation to use the
TYPE_ARRAY_BYTE_STRIDE_VALUE_WITH_ADDRESS value, if provided.
Index: sources/gdb/eval.c
===================================================================
--- sources.orig/gdb/eval.c 2007-11-15 23:59:43.000000000 +0100
+++ sources/gdb/eval.c 2007-11-16 00:23:42.000000000 +0100
@@ -1615,9 +1615,12 @@ 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);
@@ -1646,14 +1649,20 @@ evaluate_subexp_standard (struct type *e
/* Internal type of array is arranged right to left */
for (i = 0; i < nargs; i++)
{
- retcode = f77_get_dynamic_upperbound (tmp_type, &upper);
+ retcode = f77_get_dynamic_upperbound (tmp_type,
+ VALUE_ADDRESS (arg1), &upper);
if (retcode == BOUND_FETCH_ERROR)
error (_("Cannot obtain dynamic upper bound"));
- retcode = f77_get_dynamic_lowerbound (tmp_type, &lower);
+ retcode = f77_get_dynamic_lowerbound (tmp_type,
+ VALUE_ADDRESS (arg1), &lower);
if (retcode == BOUND_FETCH_ERROR)
error (_("Cannot obtain dynamic lower bound"));
+ byte_stride_array[nargs - i - 1] =
+ TYPE_ARRAY_BYTE_STRIDE_VALUE_WITH_ADDRESS (tmp_type,
+ VALUE_ADDRESS (arg1));
+
array_size_array[nargs - i - 1] = upper - lower + 1;
/* Zero-normalize subscripts so that offsetting will work. */
@@ -1674,11 +1683,22 @@ evaluate_subexp_standard (struct type *e
/* Now let us calculate the offset for this item */
- offset_item = subscript_array[ndimensions - 1];
+ offset_item = 0;
+ offset_byte = 0;
+
+ 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];
+ }
- for (i = ndimensions - 1; i > 0; --i)
- offset_item =
- array_size_array[i - 1] * offset_item + subscript_array[i - 1];
+ element_size = TYPE_LENGTH (TYPE_TARGET_TYPE (tmp_type));
+ if (offset_byte % element_size != 0)
+ warning (_("Fortran array stride not divisible by the element size"));
+ offset_item += offset_byte / element_size;
/* Construct a value node with the value of the offset */
Index: sources/gdb/f-lang.h
===================================================================
--- sources.orig/gdb/f-lang.h 2007-11-16 00:00:16.000000000 +0100
+++ sources/gdb/f-lang.h 2007-11-16 00:23:42.000000000 +0100
@@ -97,9 +97,9 @@ extern SAVED_F77_COMMON_PTR find_common_
extern char *real_main_name; /* Name of main function */
extern int real_main_c_value; /* C_value field of main function */
-extern int f77_get_dynamic_upperbound (struct type *, int *);
+extern int f77_get_dynamic_upperbound (struct type *, CORE_ADDR, int *);
-extern int f77_get_dynamic_lowerbound (struct type *, int *);
+extern int f77_get_dynamic_lowerbound (struct type *, CORE_ADDR, int *);
extern void f77_get_dynamic_array_length (struct type *);
Index: sources/gdb/f-typeprint.c
===================================================================
--- sources.orig/gdb/f-typeprint.c 2007-11-16 00:00:16.000000000 +0100
+++ sources/gdb/f-typeprint.c 2007-11-16 00:23:42.000000000 +0100
@@ -42,8 +42,8 @@ static void f_type_print_args (struct ty
static void print_equivalent_f77_float_type (int level, struct type *,
struct ui_file *);
-static void f_type_print_varspec_suffix (struct type *, struct ui_file *,
- int, int, int);
+static void f_type_print_varspec_suffix (struct type *, CORE_ADDR,
+ struct ui_file *, int, int, int);
void f_type_print_varspec_prefix (struct type *, struct ui_file *,
int, int);
@@ -82,7 +82,7 @@ f_print_type_with_address (struct type *
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, address, stream, show, 0, demangled_args);
}
/* Print any asterisks or open-parentheses needed before the
@@ -150,8 +150,9 @@ f_type_print_varspec_prefix (struct type
Args work like c_type_print_varspec_prefix. */
static void
-f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
- int show, int passed_a_ptr, int demangled_args)
+f_type_print_varspec_suffix (struct type *type, CORE_ADDR address,
+ struct ui_file *stream, int show, int passed_a_ptr,
+ int demangled_args)
{
int upper_bound, lower_bound;
int lower_bound_was_default = 0;
@@ -175,9 +176,10 @@ 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), address, stream,
+ 0, 0, 0);
- retcode = f77_get_dynamic_lowerbound (type, &lower_bound);
+ retcode = f77_get_dynamic_lowerbound (type, address, &lower_bound);
lower_bound_was_default = 0;
@@ -200,7 +202,7 @@ f_type_print_varspec_suffix (struct type
fprintf_filtered (stream, "*");
else
{
- retcode = f77_get_dynamic_upperbound (type, &upper_bound);
+ retcode = f77_get_dynamic_upperbound (type, address, &upper_bound);
if (retcode == BOUND_FETCH_ERROR)
fprintf_filtered (stream, "???");
@@ -209,7 +211,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), address, stream,
+ 0, 0, 0);
if (arrayprint_recurse_level == 1)
fprintf_filtered (stream, ")");
else
@@ -219,12 +222,13 @@ 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), address, stream, 0,
+ 1, 0);
fprintf_filtered (stream, ")");
break;
case TYPE_CODE_FUNC:
- f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
+ f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), address, stream, 0,
passed_a_ptr, 0);
if (passed_a_ptr)
fprintf_filtered (stream, ")");
@@ -381,7 +385,7 @@ f_type_print_base (struct type *type, st
fprintfi_filtered (level, stream, "character*(*)");
else
{
- retcode = f77_get_dynamic_upperbound (type, &upper_bound);
+ retcode = f77_get_dynamic_upperbound (type, 0, &upper_bound);
if (retcode == BOUND_FETCH_ERROR)
fprintf_filtered (stream, "character*???");
Index: sources/gdb/f-valprint.c
===================================================================
--- sources.orig/gdb/f-valprint.c 2007-11-15 23:59:43.000000000 +0100
+++ sources/gdb/f-valprint.c 2007-11-16 00:25:27.000000000 +0100
@@ -42,8 +42,8 @@ static int there_is_a_visible_common_nam
extern void _initialize_f_valprint (void);
static void info_common_command (char *, int);
static void list_all_visible_commons (char *);
-static void f77_create_arrayprint_offset_tbl (struct type *,
- struct ui_file *);
+static void f77_create_arrayprint_offset_tbl (struct type *, struct ui_file *,
+ CORE_ADDR address);
static void f77_get_dynamic_length_of_aggregate (struct type *);
int f77_array_offset_tbl[MAX_FORTRAN_DIMS + 1][2];
@@ -54,14 +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])
+
+/* ADDRESS is the value address at the inferior. */
int
-f77_get_dynamic_lowerbound (struct type *type, int *lower_bound)
+f77_get_dynamic_lowerbound (struct type *type, CORE_ADDR address,
+ int *lower_bound)
{
struct frame_info *frame;
CORE_ADDR current_frame_addr;
@@ -87,7 +90,7 @@ f77_get_dynamic_lowerbound (struct type
break;
case BOUND_SIMPLE:
- *lower_bound = TYPE_ARRAY_LOWER_BOUND_VALUE (type);
+ *lower_bound = TYPE_ARRAY_LOWER_BOUND_VALUE_WITH_ADDRESS (type, address);
break;
case BOUND_CANNOT_BE_DETERMINED:
@@ -121,8 +124,11 @@ f77_get_dynamic_lowerbound (struct type
return BOUND_FETCH_OK;
}
+/* ADDRESS is the value address at the inferior. */
+
int
-f77_get_dynamic_upperbound (struct type *type, int *upper_bound)
+f77_get_dynamic_upperbound (struct type *type, CORE_ADDR address,
+ int *upper_bound)
{
struct frame_info *frame;
CORE_ADDR current_frame_addr = 0;
@@ -148,7 +154,7 @@ f77_get_dynamic_upperbound (struct type
break;
case BOUND_SIMPLE:
- *upper_bound = TYPE_ARRAY_UPPER_BOUND_VALUE (type);
+ *upper_bound = TYPE_ARRAY_UPPER_BOUND_VALUE_WITH_ADDRESS (type, address);
break;
case BOUND_CANNOT_BE_DETERMINED:
@@ -157,7 +163,7 @@ f77_get_dynamic_upperbound (struct type
1 element.If the user wants to see more elements, let
him manually ask for 'em and we'll subscript the
array and show him */
- f77_get_dynamic_lowerbound (type, upper_bound);
+ f77_get_dynamic_lowerbound (type, 0, upper_bound);
break;
case BOUND_BY_REF_ON_STACK:
@@ -210,11 +216,11 @@ f77_get_dynamic_length_of_aggregate (str
f77_get_dynamic_length_of_aggregate (TYPE_TARGET_TYPE (type));
/* Recursion ends here, start setting up lengths. */
- retcode = f77_get_dynamic_lowerbound (type, &lower_bound);
+ retcode = f77_get_dynamic_lowerbound (type, 0, &lower_bound);
if (retcode == BOUND_FETCH_ERROR)
error (_("Cannot obtain valid array lower bound"));
- retcode = f77_get_dynamic_upperbound (type, &upper_bound);
+ retcode = f77_get_dynamic_upperbound (type, 0, &upper_bound);
if (retcode == BOUND_FETCH_ERROR)
error (_("Cannot obtain valid array upper bound"));
@@ -225,10 +231,11 @@ f77_get_dynamic_length_of_aggregate (str
}
/* Function that sets up the array offset,size table for the array
- type "type". */
+ type "type". ADDRESS is the value address at the inferior. */
static void
-f77_create_arrayprint_offset_tbl (struct type *type, struct ui_file *stream)
+f77_create_arrayprint_offset_tbl (struct type *type, struct ui_file *stream,
+ CORE_ADDR address)
{
struct type *tmp_type;
int eltlen;
@@ -242,32 +249,37 @@ f77_create_arrayprint_offset_tbl (struct
if (TYPE_ARRAY_UPPER_BOUND_TYPE (tmp_type) == BOUND_CANNOT_BE_DETERMINED)
fprintf_filtered (stream, "<assumed size array> ");
- retcode = f77_get_dynamic_upperbound (tmp_type, &upper);
+ retcode = f77_get_dynamic_upperbound (tmp_type, address, &upper);
if (retcode == BOUND_FETCH_ERROR)
error (_("Cannot obtain dynamic upper bound"));
- retcode = f77_get_dynamic_lowerbound (tmp_type, &lower);
+ retcode = f77_get_dynamic_lowerbound (tmp_type, address, &lower);
if (retcode == BOUND_FETCH_ERROR)
error (_("Cannot obtain dynamic lower bound"));
- F77_DIM_SIZE (ndimen) = upper - lower + 1;
+ F77_DIM_COUNT (ndimen) = upper - lower + 1;
+
+ F77_DIM_BYTE_STRIDE (ndimen) =
+ TYPE_ARRAY_BYTE_STRIDE_VALUE_WITH_ADDRESS (tmp_type, address);
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;
}
}
@@ -287,33 +299,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, "...");
}
}
@@ -341,7 +353,7 @@ f77_print_array (struct type *type, cons
offset table to get at the various row's elements. The
offset table contains entries for both offset and subarray size. */
- f77_create_arrayprint_offset_tbl (type, stream);
+ f77_create_arrayprint_offset_tbl (type, stream, address);
f77_print_array_1 (1, ndimensions, type, valaddr, address, stream, format,
deref_ref, recurse, pretty, &elts);
More information about the Gdb-patches
mailing list