168 lines
5.8 KiB
Diff
168 lines
5.8 KiB
Diff
RE: [ping] [PATCH v2 0/6] fortran: multi-dimensional subarrays with strides
|
|
https://sourceware.org/ml/gdb-patches/2016-07/msg00009.html
|
|
|
|
From 338e4c860ad205896b4a95c79f54470c79eeb348 Mon Sep 17 00:00:00 2001
|
|
From: Christoph Weinmann <christoph.t.weinmann@intel.com>
|
|
Date: Wed, 1 Jun 2016 15:11:24 +0200
|
|
Subject: [PATCH 4/6] fortran: enable parsing of stride parameter for subranges
|
|
|
|
Allow the user to provide a stride parameter for Fortran
|
|
subarrays. The stride parameter can be any integer except
|
|
'0'. The default stride value is '1'.
|
|
|
|
2013-11-27 Christoph Weinmann <christoph.t.weinmann@intel.com>
|
|
|
|
* eval.c (value_f90_subarray): Add expression evaluation
|
|
for a stride parameter in a Fortran range expression.
|
|
* expression.h (range_type): Add field to enum to show when
|
|
a stride value was provided by the user.
|
|
* f-exp.y: Add yacc rules for writing info on the elt stack
|
|
when the user provided a stride argument.
|
|
* parse.c (operator_length_standard): Check if a stride
|
|
value was provided, and increment argument counter
|
|
accordingly.
|
|
|
|
|
|
Signed-off-by: Christoph Weinmann <christoph.t.weinmann@intel.com>
|
|
---
|
|
gdb/eval.c | 11 ++++++++++-
|
|
gdb/expression.h | 7 +++++--
|
|
gdb/f-exp.y | 31 ++++++++++++++++++++++++++++++-
|
|
gdb/parse.c | 3 +++
|
|
gdb/valops.c | 4 ++--
|
|
5 files changed, 50 insertions(+), 6 deletions(-)
|
|
|
|
diff --git a/gdb/eval.c b/gdb/eval.c
|
|
index 44e8600..b5aaf1c 100644
|
|
--- a/gdb/eval.c
|
|
+++ b/gdb/eval.c
|
|
@@ -419,7 +419,7 @@ value_f90_subarray (struct value *array, struct expression *exp,
|
|
typedef struct subscript_range
|
|
{
|
|
enum range_type f90_range_type;
|
|
- LONGEST low, high;
|
|
+ LONGEST low, high, stride;
|
|
} subscript_range;
|
|
|
|
typedef enum subscript_kind
|
|
@@ -490,6 +490,15 @@ value_f90_subarray (struct value *array, struct expression *exp,
|
|
== SUBARRAY_HIGH_BOUND)
|
|
range->high = value_as_long (evaluate_subexp (NULL_TYPE, exp,
|
|
pos, noside));
|
|
+
|
|
+ /* Assign the user's stride value if provided. */
|
|
+ if ((range->f90_range_type & SUBARRAY_STRIDE) == SUBARRAY_STRIDE)
|
|
+ range->stride = value_as_long (evaluate_subexp (NULL_TYPE, exp,
|
|
+ pos, noside));
|
|
+
|
|
+ /* Assign the default stride value '1'. */
|
|
+ else
|
|
+ range->stride = 1;
|
|
}
|
|
/* User input is an index. E.g.: "p arry(5)". */
|
|
else
|
|
diff --git a/gdb/expression.h b/gdb/expression.h
|
|
index 5a6b720..34ca54b 100644
|
|
--- a/gdb/expression.h
|
|
+++ b/gdb/expression.h
|
|
@@ -153,13 +153,16 @@ extern void dump_raw_expression (struct expression *,
|
|
extern void dump_prefix_expression (struct expression *, struct ui_file *);
|
|
|
|
/* In an OP_RANGE expression, either bound can be provided by the user, or not.
|
|
- This enumeration type is to identify this. */
|
|
+ In addition to this, the user can also specify a stride value to indicated
|
|
+ only certain elements of the array. This enumeration type is to identify
|
|
+ this. */
|
|
|
|
enum range_type
|
|
{
|
|
SUBARRAY_NONE_BOUND = 0x0, /* "( : )" */
|
|
SUBARRAY_LOW_BOUND = 0x1, /* "(low:)" */
|
|
- SUBARRAY_HIGH_BOUND = 0x2 /* "(:high)" */
|
|
+ SUBARRAY_HIGH_BOUND = 0x2, /* "(:high)" */
|
|
+ SUBARRAY_STRIDE = 0x4 /* "(::stride)" */
|
|
};
|
|
|
|
#endif /* !defined (EXPRESSION_H) */
|
|
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
|
|
index e2c54b6..71f1823 100644
|
|
--- a/gdb/f-exp.y
|
|
+++ b/gdb/f-exp.y
|
|
@@ -280,7 +280,36 @@ subrange: ':' exp %prec ABOVE_COMMA
|
|
|
|
subrange: ':' %prec ABOVE_COMMA
|
|
{ write_exp_elt_opcode (pstate, OP_RANGE);
|
|
- write_exp_elt_longcst (pstate, 0);
|
|
+ write_exp_elt_longcst (pstate, SUBARRAY_NONE_BOUND);
|
|
+ write_exp_elt_opcode (pstate, OP_RANGE); }
|
|
+ ;
|
|
+
|
|
+/* Each subrange type can have a stride argument. */
|
|
+subrange: exp ':' exp ':' exp %prec ABOVE_COMMA
|
|
+ { write_exp_elt_opcode (pstate, OP_RANGE);
|
|
+ write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND
|
|
+ | SUBARRAY_HIGH_BOUND
|
|
+ | SUBARRAY_STRIDE);
|
|
+ write_exp_elt_opcode (pstate, OP_RANGE); }
|
|
+ ;
|
|
+
|
|
+subrange: exp ':' ':' exp %prec ABOVE_COMMA
|
|
+ { write_exp_elt_opcode (pstate, OP_RANGE);
|
|
+ write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND
|
|
+ | SUBARRAY_STRIDE);
|
|
+ write_exp_elt_opcode (pstate, OP_RANGE); }
|
|
+ ;
|
|
+
|
|
+subrange: ':' exp ':' exp %prec ABOVE_COMMA
|
|
+ { write_exp_elt_opcode (pstate, OP_RANGE);
|
|
+ write_exp_elt_longcst (pstate, SUBARRAY_HIGH_BOUND
|
|
+ | SUBARRAY_STRIDE);
|
|
+ write_exp_elt_opcode (pstate, OP_RANGE); }
|
|
+ ;
|
|
+
|
|
+subrange: ':' ':' exp %prec ABOVE_COMMA
|
|
+ { write_exp_elt_opcode (pstate, OP_RANGE);
|
|
+ write_exp_elt_longcst (pstate, SUBARRAY_STRIDE);
|
|
write_exp_elt_opcode (pstate, OP_RANGE); }
|
|
;
|
|
|
|
diff --git a/gdb/parse.c b/gdb/parse.c
|
|
index 6d54a77..992af87 100644
|
|
--- a/gdb/parse.c
|
|
+++ b/gdb/parse.c
|
|
@@ -1018,6 +1018,9 @@ operator_length_standard (const struct expression *expr, int endpos,
|
|
if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND)
|
|
args++;
|
|
|
|
+ if ((range_type & SUBARRAY_STRIDE) == SUBARRAY_STRIDE)
|
|
+ args++;
|
|
+
|
|
break;
|
|
|
|
default:
|
|
diff --git a/gdb/valops.c b/gdb/valops.c
|
|
index 817a4cf..fbc7dcb 100644
|
|
--- a/gdb/valops.c
|
|
+++ b/gdb/valops.c
|
|
@@ -3834,7 +3834,7 @@ value_slice_1 (struct value *array, int lowbound, int length, int call_count)
|
|
if (call_count == 1)
|
|
{
|
|
range_type = TYPE_INDEX_TYPE (array_type);
|
|
- slice_range_size = elem_count;
|
|
+ slice_range_size = ary_low_bound + elem_count - 1;
|
|
|
|
/* Check if the array bounds are valid. */
|
|
if (get_discrete_bounds (range_type, &ary_low_bound, &ary_high_bound) < 0)
|
|
@@ -3846,7 +3846,7 @@ value_slice_1 (struct value *array, int lowbound, int length, int call_count)
|
|
else
|
|
{
|
|
range_type = TYPE_INDEX_TYPE (TYPE_TARGET_TYPE (array_type));
|
|
- slice_range_size = (ary_low_bound + row_count - 1) * (elem_count);
|
|
+ slice_range_size = ary_low_bound + (row_count * elem_count) - 1;
|
|
ary_low_bound = TYPE_LOW_BOUND (range_type);
|
|
}
|
|
|
|
--
|
|
2.5.5
|
|
|