Attached is my attempt to address all of Mikael's comments.
Regression tested on x86_64. I also rechecked performance with a local benchmark
here.
OK for mainline?
Regards,
Jerry
---
[PATCH v2] fortran: [PR126964] Reduce the cost of a span addressed
dummy
Assisted-by: Claude Opus 5
r17-3342 made a TARGET assumed shape or assumed rank dummy be addressed
through the span of its descriptor, so that a pointer to it stays valid
when its elements are subobjects of larger ones. That costs in two ways,
and SPEC 465.tonto pays both.
First, is_subref_array became true for such a dummy, so passing one on to
another procedure takes the copy-in/copy-out path, with the copy made
conditional on the actual argument being contiguous. That is more than
the receiving dummy needs: a dummy that has a descriptor of its own
addresses its elements by the strides held in it, so it accepts an actual
argument of any stride; the one thing it cannot do is address elements
that are subobjects of larger ones, which is what a span differing from
the element length means. Narrow the condition to the span alone when the
dummy has a descriptor and is not CONTIGUOUS. A dummy that needs the
argument packed still gets the full test. The span test is a different
condition from contiguity, so it is a function of its own.
Second, addressing every element as offset * span leaves the step of a
data reference symbolic, so loop versioning cannot prove that the accesses
stay aligned and the loop is never vectorized. Fold the spacing into the
strides and the offset on entry instead, so that the elements are
addressed by the constant element length as usual. The element length
divides the spacing whenever the element size equals the element
alignment, which covers integer, real and logical elements of an assumed
shape dummy; elsewhere the span is still used to address them.
PR fortran/126964
gcc/fortran/ChangeLog:
* trans.h (struct lang_decl): Add span_normalized.
(GFC_DECL_SPAN_NORMALIZED): New macro.
(gfc_conv_subref_array_arg): Add span_only argument.
* trans-array.h (gfc_span_folds_into_stride): New prototype.
(gfc_conv_span_is_elem_len): Likewise.
* trans-array.cc (gfc_span_folds_into_stride): New function.
(gfc_conv_span_is_elem_len): New function.
(gfc_trans_dummy_array_bias): Fold the element spacing of a span
normalized dummy into its strides and its offset on entry.
* trans-decl.cc (gfc_build_dummy_array_decl): Mark such a dummy
span normalized.
(gfc_get_symbol_decl): Do not set GFC_DECL_PTR_ARRAY_P for it.
* trans-expr.cc (is_whole_span_addressed_dummy): New function.
(dummy_accepts_strided_arg): New function.
(gfc_conv_subref_array_arg): Take span_only and, with it, test the
span of the descriptor instead of contiguity.
(gfc_conv_procedure_call): Ask for the span test when a span
addressed dummy is passed on to a dummy that has a descriptor.
gcc/testsuite/ChangeLog:
* gfortran.dg/target_dummy_repack_1.f90: New test.
* gfortran.dg/target_dummy_span_1.f90: New test.
* gfortran.dg/gomp/target-span-1.f90: New test.
* gfortran.dg/c_loc_test_22.f90: Update for addressing by the
element length.
* gfortran.dg/class_to_type_9.f90: Likewise, and expect an
assumed shape dummy to take no copy of a strided actual argument.
---
On 8/31/26 7:12 AM, Mikael Morin wrote:
Le 26/08/2026 à 20:08, Jerry D a écrit :
Hi all,
The attached patch recovers most of the slowdown identified in the subject PR.
Test results from the original version of tonto SPEC benchmark are also
described in the PR126964 Comment #7:
"For the configuration in the initial report, I am getting roughly 2% slower
than the baseline before the blamed commit, meaning that most of the
performance has been recovered."
To develop this patch I used claude to analyze an archived open source copy of
tonto and generate an input "deck" to produce a local bench mark. This was
couple by multiple runs using callgrind to identify the "hot paths"
With the patch applied for a rank two dummy passed on from a loop calling it
120000 times, with a non-contiguous actual argument, the instructions executed
fall from 17151636793 to 11676814, against 10478570 before r17-3342.
As I stated above, this recovers most of the performance regression. It also
has peaked my curiosity so I plan some followup explorations.
Regression tested with full testsuite on x86_64.
OK for mainline?
Regards,
Jerry
---
fortran: [PR126964] Reduce the cost of a span addressed dummy
Assisted-by: Claude Opus 5
r17-3342 made a TARGET assumed shape or assumed rank dummy be addressed
through the span of its descriptor, so that a pointer to it stays valid
when its elements are subobjects of larger ones. That costs in two ways,
and SPEC 465.tonto pays both.
First, is_subref_array became true for such a dummy, so passing one on to
another procedure takes the copy-in/copy-out path, with the copy made
conditional on the actual argument being contiguous. That is more than
the receiving dummy needs: a dummy that has a descriptor of its own
addresses its elements by the strides held in it, so it accepts an actual
argument of any stride; the one thing it cannot do is address elements
that are subobjects of larger ones, which is what a span differing from
the element length means.
Not exactly. What is not supported is a span that is not divisible by the
element length. Checking for equality between the span and element length gives
a stronger condition than strictly necessary. But not a wrong condition of
course. I expect subojects of larger elements to possibly work if the
divisibility condition holds.
Narrow the condition to the span alone when the
dummy has a descriptor and is not CONTIGUOUS. A dummy that needs the
argument packed still gets the full test.
I think it works, but the second part of the fix (your next paragraph) should
avoid the need to do a runtime check. If the type is numeric, the array is
flagged as "normalized" instead of "pointer", and it's using array indexing with
stride instead of span. What's missing is gfc_is_span_addressed_dummy should
return false for it I suppose, and then is_subref_array would return false.
Second, addressing every element as offset * span leaves the step of a
data reference symbolic, so loop versioning cannot prove that the accesses
stay aligned and the loop is never vectorized. Fold the spacing into the
strides and the offset on entry instead, so that the elements are
addressed by the constant element length as usual. The element length
divides the spacing whenever the element size equals the element
alignment, which covers integer, real and logical elements of an assumed
shape dummy; elsewhere the span is still used to address them.
That part looks good.
Some more comments below.
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 2f11b61a4b8..9f45fea07b1 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -514,6 +514,41 @@ span_addressed_array (tree expr)
}
+/* An actual argument whose elements are subobjects can be described to a
+ span addressed dummy by the strides of its descriptor instead of by its
+ span, provided the element length divides the spacing. That holds when
+ the element size equals the element alignment: the type of the object the
+ elements are part of is then at least as aligned, so its size, and hence
+ the spacing, is a multiple of the element length. Folding the spacing
+ into the strides lets the elements be addressed by a constant element
+ length, which keeps the address evolutions analyzable. */
+
+bool
+gfc_span_folds_into_stride (gfc_symbol *sym)
+{
+ if (!gfc_is_span_addressed_dummy (sym))
+ return false;
+
+ /* A character element length is not necessarily constant and a complex or
+ derived type can be larger than its alignment. */
+ if (sym->ts.type != BT_INTEGER
+ && sym->ts.type != BT_REAL
+ && sym->ts.type != BT_LOGICAL)
+ return false;
This could be extended to single-field derived types and length one character.
Good enough as is for now.
+
+ /* An assumed rank dummy has no strides to fold the spacing into. */
+ if (!sym->as || sym->as->type != AS_ASSUMED_SHAPE || sym->as->rank < 1)
+ return false;
+
+ tree etype = gfc_typenode_for_spec (&sym->ts);
+ tree size = etype ? TYPE_SIZE_UNIT (etype) : NULL_TREE;
+
+ return (size
+ && tree_fits_uhwi_p (size)
+ && tree_to_uhwi (size) == TYPE_ALIGN_UNIT (etype));
I'm not sure about the guarantee we have that the same tree node will be used
for equal values. I think wi::to_wide (...) == wi::to_wide (...) could be used
instead. Again, good enough as is for now.
+}
+
+
/* If the symbol or expression reference a CFI descriptor, return the
pointer to the converted gfc descriptor. If an array reference is
present as the last argument, check that it is the one applied to
@@ -7520,6 +7555,45 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree
tmpdesc,
if (VAR_P (GFC_TYPE_ARRAY_OFFSET (type)))
gfc_add_modify (&init, GFC_TYPE_ARRAY_OFFSET (type), offset);
+ /* Fold the element spacing of the actual argument into the strides and the
+ offset, so that the elements are addressed by the constant element length
+ rather than by a span loaded from the descriptor. The unit case is kept
+ as a separate arm of the conditional rather than folded into the
+ multiplication, so that the strides remain recognizable as being one for
+ a contiguous innermost dimension. */
+ if (DECL_LANG_SPECIFIC (tmpdesc) && GFC_DECL_SPAN_NORMALIZED (tmpdesc))
+ {
+ tree element = fold_convert (gfc_array_index_type,
+ TYPE_SIZE_UNIT (gfc_get_element_type (type)));
+ tree span = gfc_evaluate_now (gfc_conv_descriptor_span_get (dumdesc),
+ &init);
+ tree unit = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
+ span, element);
+ tree factor = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+ gfc_array_index_type, span, element);
+ factor = gfc_evaluate_now (factor, &init);
+
+ auto scale = [&] (tree var)
+ {
+ tree scaled = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, var, factor);
+ scaled = fold_build3_loc (input_location, COND_EXPR,
+ gfc_array_index_type, unit, var, scaled);
+ gfc_add_modify (&init, var, scaled);
+ };
+
+ for (n = 0; n < as->rank; n++)
+ {
+ /* A span addressed dummy is never repacked, so every stride is a
+ variable loaded from the descriptor. */
+ gcc_assert (VAR_P (GFC_TYPE_ARRAY_STRIDE (type, n)));
+ scale (GFC_TYPE_ARRAY_STRIDE (type, n));
+ }
+
+ if (VAR_P (GFC_TYPE_ARRAY_OFFSET (type)))
Since you used asserts for GFC_TYPE_ARRAY_STRIDE, you can use an assert for
GFC_TYPE_ARRAY_OFFSET.
+ scale (GFC_TYPE_ARRAY_OFFSET (type));
+ }
+
gfc_trans_vla_type_sizes (sym, &init);
stmtInit = gfc_finish_block (&init);
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 06c96d5a0a9..647f5a498b2 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -2311,10 +2311,14 @@ gfc_conv_intrinsic_is_contiguous (gfc_se * se,
gfc_expr * expr)
}
/* This function does the work for gfc_conv_intrinsic_is_contiguous,
- plus it can be called directly. */
+ plus it can be called directly. With SPAN_ONLY, the strides are not
+ tested and the result is just that the span of the descriptor is the
+ element length, ie. that the elements are not subobjects of larger ones.
+ That is all that has to hold for a dummy that has a descriptor of its own,
+ since it addresses its elements by the strides held in it. */
void
-gfc_conv_is_contiguous_expr (gfc_se *se, gfc_expr *arg)
+gfc_conv_is_contiguous_expr (gfc_se *se, gfc_expr *arg, bool span_only)
We may want to check at some point that the element length divides the span
rather than just equals it. It is a different concept from contiguity, so
please don't touch gfc_conv_is_contiguous_expr and use a separate function to do
the check.
{
gfc_ss *ss;
gfc_se argse;
From b40d505e4b0ba397aae0b308efcef73f130b2cad Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Mon, 24 Aug 2026 08:48:16 -0700
Subject: [PATCH v2] fortran: [PR126964] Reduce the cost of a span addressed
dummy
Assisted-by: Claude Opus 5
r17-3342 made a TARGET assumed shape or assumed rank dummy be addressed
through the span of its descriptor, so that a pointer to it stays valid
when its elements are subobjects of larger ones. That costs in two ways,
and SPEC 465.tonto pays both.
First, is_subref_array became true for such a dummy, so passing one on to
another procedure takes the copy-in/copy-out path, with the copy made
conditional on the actual argument being contiguous. That is more than
the receiving dummy needs: a dummy that has a descriptor of its own
addresses its elements by the strides held in it, so it accepts an actual
argument of any stride; the one thing it cannot do is address elements
that are subobjects of larger ones, which is what a span differing from
the element length means. Narrow the condition to the span alone when the
dummy has a descriptor and is not CONTIGUOUS. A dummy that needs the
argument packed still gets the full test. The span test is a different
condition from contiguity, so it is a function of its own.
Second, addressing every element as offset * span leaves the step of a
data reference symbolic, so loop versioning cannot prove that the accesses
stay aligned and the loop is never vectorized. Fold the spacing into the
strides and the offset on entry instead, so that the elements are
addressed by the constant element length as usual. The element length
divides the spacing whenever the element size equals the element
alignment, which covers integer, real and logical elements of an assumed
shape dummy; elsewhere the span is still used to address them.
PR fortran/126964
gcc/fortran/ChangeLog:
* trans.h (struct lang_decl): Add span_normalized.
(GFC_DECL_SPAN_NORMALIZED): New macro.
(gfc_conv_subref_array_arg): Add span_only argument.
* trans-array.h (gfc_span_folds_into_stride): New prototype.
(gfc_conv_span_is_elem_len): Likewise.
* trans-array.cc (gfc_span_folds_into_stride): New function.
(gfc_conv_span_is_elem_len): New function.
(gfc_trans_dummy_array_bias): Fold the element spacing of a span
normalized dummy into its strides and its offset on entry.
* trans-decl.cc (gfc_build_dummy_array_decl): Mark such a dummy
span normalized.
(gfc_get_symbol_decl): Do not set GFC_DECL_PTR_ARRAY_P for it.
* trans-expr.cc (is_whole_span_addressed_dummy): New function.
(dummy_accepts_strided_arg): New function.
(gfc_conv_subref_array_arg): Take span_only and, with it, test the
span of the descriptor instead of contiguity.
(gfc_conv_procedure_call): Ask for the span test when a span
addressed dummy is passed on to a dummy that has a descriptor.
gcc/testsuite/ChangeLog:
* gfortran.dg/target_dummy_repack_1.f90: New test.
* gfortran.dg/target_dummy_span_1.f90: New test.
* gfortran.dg/gomp/target-span-1.f90: New test.
* gfortran.dg/c_loc_test_22.f90: Update for addressing by the
element length.
* gfortran.dg/class_to_type_9.f90: Likewise, and expect an
assumed shape dummy to take no copy of a strided actual argument.
---
gcc/fortran/trans-array.cc | 111 ++++++++++++++++++
gcc/fortran/trans-array.h | 5 +
gcc/fortran/trans-decl.cc | 15 ++-
gcc/fortran/trans-expr.cc | 59 ++++++++--
gcc/fortran/trans.h | 8 +-
gcc/testsuite/gfortran.dg/c_loc_test_22.f90 | 11 +-
gcc/testsuite/gfortran.dg/class_to_type_9.f90 | 11 +-
.../gfortran.dg/gomp/target-span-1.f90 | 32 +++++
.../gfortran.dg/target_dummy_repack_1.f90 | 77 ++++++++++++
.../gfortran.dg/target_dummy_span_1.f90 | 62 ++++++++++
10 files changed, 368 insertions(+), 23 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/gomp/target-span-1.f90
create mode 100644 gcc/testsuite/gfortran.dg/target_dummy_repack_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/target_dummy_span_1.f90
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 2f11b61a4b8..2fe9981cb00 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -514,6 +514,78 @@ span_addressed_array (tree expr)
}
+/* An actual argument whose elements are subobjects can be described to a
+ span addressed dummy by the strides of its descriptor instead of by its
+ span, provided the element length divides the spacing. That holds when
+ the element size equals the element alignment: the type of the object the
+ elements are part of is then at least as aligned, so its size, and hence
+ the spacing, is a multiple of the element length. Folding the spacing
+ into the strides lets the elements be addressed by a constant element
+ length, which keeps the address evolutions analyzable. */
+
+bool
+gfc_span_folds_into_stride (gfc_symbol *sym)
+{
+ if (!gfc_is_span_addressed_dummy (sym))
+ return false;
+
+ /* A character element length is not necessarily constant and a complex or
+ derived type can be larger than its alignment. */
+ if (sym->ts.type != BT_INTEGER
+ && sym->ts.type != BT_REAL
+ && sym->ts.type != BT_LOGICAL)
+ return false;
+
+ /* An assumed rank dummy has no strides to fold the spacing into. */
+ if (!sym->as || sym->as->type != AS_ASSUMED_SHAPE || sym->as->rank < 1)
+ return false;
+
+ tree etype = gfc_typenode_for_spec (&sym->ts);
+ tree size = etype ? TYPE_SIZE_UNIT (etype) : NULL_TREE;
+
+ return (size
+ && tree_fits_uhwi_p (size)
+ && tree_to_uhwi (size) == TYPE_ALIGN_UNIT (etype));
+}
+
+
+/* Set se->expr to a test that the span of the descriptor of ARG is the element
+ length, ie. that its elements are not subobjects of larger ones. This is
+ all that has to hold for an actual argument passed to a dummy that has a
+ descriptor of its own, since such a dummy addresses its elements by the
+ strides held in it and so takes an argument of any stride, but it addresses
+ them by the element length. The test is not contiguity, and it could be
+ relaxed to the element length dividing the span once the spacing is folded
+ into the strides of such a dummy in all cases. */
+
+void
+gfc_conv_span_is_elem_len (gfc_se *se, gfc_expr *arg)
+{
+ gfc_se argse;
+ gfc_ss *ss;
+
+ if (arg->ts.type == BT_CLASS)
+ gfc_add_class_array_ref (arg);
+
+ ss = gfc_walk_expr (arg);
+ gcc_assert (ss != gfc_ss_terminator);
+
+ gfc_init_se (&argse, NULL);
+ argse.data_not_needed = 1;
+ gfc_conv_expr_descriptor (&argse, arg);
+ gfc_add_block_to_block (&se->pre, &argse.pre);
+ gfc_add_block_to_block (&se->post, &argse.post);
+ gfc_free_ss_chain (ss);
+
+ tree desc = gfc_evaluate_now (argse.expr, &se->pre);
+ tree span = gfc_conv_descriptor_span_get (desc);
+ tree elem_len = fold_convert (TREE_TYPE (span),
+ gfc_conv_descriptor_elem_len_get (desc));
+ se->expr = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+ span, elem_len);
+}
+
+
/* If the symbol or expression reference a CFI descriptor, return the
pointer to the converted gfc descriptor. If an array reference is
present as the last argument, check that it is the one applied to
@@ -7520,6 +7592,45 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc,
if (VAR_P (GFC_TYPE_ARRAY_OFFSET (type)))
gfc_add_modify (&init, GFC_TYPE_ARRAY_OFFSET (type), offset);
+ /* Fold the element spacing of the actual argument into the strides and the
+ offset, so that the elements are addressed by the constant element length
+ rather than by a span loaded from the descriptor. The unit case is kept
+ as a separate arm of the conditional rather than folded into the
+ multiplication, so that the strides remain recognizable as being one for
+ a contiguous innermost dimension. */
+ if (DECL_LANG_SPECIFIC (tmpdesc) && GFC_DECL_SPAN_NORMALIZED (tmpdesc))
+ {
+ tree element = fold_convert (gfc_array_index_type,
+ TYPE_SIZE_UNIT (gfc_get_element_type (type)));
+ tree span = gfc_evaluate_now (gfc_conv_descriptor_span_get (dumdesc),
+ &init);
+ tree unit = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
+ span, element);
+ tree factor = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+ gfc_array_index_type, span, element);
+ factor = gfc_evaluate_now (factor, &init);
+
+ auto scale = [&] (tree var)
+ {
+ tree scaled = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, var, factor);
+ scaled = fold_build3_loc (input_location, COND_EXPR,
+ gfc_array_index_type, unit, var, scaled);
+ gfc_add_modify (&init, var, scaled);
+ };
+
+ /* A span addressed dummy is never repacked, so its strides and its
+ offset are all variables loaded from the descriptor. */
+ for (n = 0; n < as->rank; n++)
+ {
+ gcc_assert (VAR_P (GFC_TYPE_ARRAY_STRIDE (type, n)));
+ scale (GFC_TYPE_ARRAY_STRIDE (type, n));
+ }
+
+ gcc_assert (VAR_P (GFC_TYPE_ARRAY_OFFSET (type)));
+ scale (GFC_TYPE_ARRAY_OFFSET (type));
+ }
+
gfc_trans_vla_type_sizes (sym, &init);
stmtInit = gfc_finish_block (&init);
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index c0afccb28e2..15bade95b28 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -148,6 +148,11 @@ void gfc_conv_tmp_array_ref (gfc_se * se);
void gfc_get_dataptr_offset (stmtblock_t*, tree, tree, tree, bool, gfc_expr*);
/* Obtain the span of an array. */
tree gfc_get_array_span (tree, gfc_expr *);
+/* Whether the element spacing of a span addressed dummy can be folded into
+ the strides of its descriptor. */
+bool gfc_span_folds_into_stride (gfc_symbol *);
+/* Test that the elements of an array are not subobjects of larger ones. */
+void gfc_conv_span_is_elem_len (gfc_se *, gfc_expr *);
/* Evaluate an array expression. */
void gfc_conv_expr_descriptor (gfc_se *, gfc_expr *);
/* Convert an array for passing as an actual function parameter. */
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 1d85e5b94cd..236fad9f1e0 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -1407,9 +1407,17 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy)
GFC_DECL_SAVED_DESCRIPTOR (decl) = dummy;
/* The elements of the actual argument can be spaced by more than the
- element size, so the span of the descriptor is used to address them. */
+ element size. Where the element length divides that spacing, it is
+ folded into the strides on entry and the elements are addressed by the
+ element length as usual. Otherwise the span of the descriptor is used
+ to address them. */
if (gfc_is_span_addressed_dummy (sym) && packed == PACKED_NO)
- GFC_DECL_PTR_ARRAY_P (decl) = 1;
+ {
+ if (gfc_span_folds_into_stride (sym))
+ GFC_DECL_SPAN_NORMALIZED (decl) = 1;
+ else
+ GFC_DECL_PTR_ARRAY_P (decl) = 1;
+ }
if (sym->ns->proc_name->backend_decl == current_function_decl
|| sym->attr.contained)
@@ -1790,7 +1798,8 @@ gfc_get_symbol_decl (gfc_symbol * sym)
gfc_defer_symbol_init (sym);
if ((sym->attr.pointer && sym->attr.dimension && sym->ts.type != BT_CLASS)
- || gfc_is_span_addressed_dummy (sym))
+ || (gfc_is_span_addressed_dummy (sym)
+ && !gfc_span_folds_into_stride (sym)))
GFC_DECL_PTR_ARRAY_P (sym->backend_decl) = 1;
/* Create a character length variable. */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 1c95f1ce2c4..30d1c896c64 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5558,7 +5558,8 @@ void
gfc_conv_subref_array_arg (gfc_se *se, gfc_expr * expr, int g77,
sym_intent intent, bool formal_ptr,
const gfc_symbol *fsym, const char *proc_name,
- gfc_symbol *sym, bool check_contiguous)
+ gfc_symbol *sym, bool check_contiguous,
+ bool span_only)
{
gfc_se lse;
gfc_se rse;
@@ -5921,9 +5922,13 @@ class_array_fcn:
}
else
{
- /* cont_var = is_contiguous (expr); . */
+ /* cont_var = is_contiguous (expr), or just that the span is the
+ element length for a dummy that takes any stride. */
gfc_init_se (&cont_se, parmse);
- gfc_conv_is_contiguous_expr (&cont_se, expr);
+ if (span_only)
+ gfc_conv_span_is_elem_len (&cont_se, expr);
+ else
+ gfc_conv_is_contiguous_expr (&cont_se, expr);
gfc_add_block_to_block (&se->pre, &(&cont_se)->pre);
gfc_add_modify (&se->pre, cont_var, cont_se.expr);
gfc_add_block_to_block (&se->pre, &(&cont_se)->post);
@@ -6973,8 +6978,36 @@ is_subobject_ref (gfc_expr *e)
}
-/* Return true if the actual argument E for the dummy FSYM may be passed as a
- copy-in/copy-out temporary. A pointer associated with a TARGET or POINTER
+/* Return true if expr is a span addressed dummy that is passed on as a whole,
+ rather than a reference to a subobject of the elements of an array. */
+
+static bool
+is_whole_span_addressed_dummy (gfc_expr *e)
+{
+ return e->expr_type == EXPR_VARIABLE
+ && e->symtree && e->symtree->n.sym
+ && gfc_is_span_addressed_dummy (e->symtree->n.sym)
+ && !is_subobject_ref (e);
+}
+
+
+/* Return true if the dummy fsym has an array descriptor and so addresses its
+ elements by the strides held in it. Such a dummy accepts an actual
+ argument of any stride; only a dummy without a descriptor, or one declared
+ CONTIGUOUS, needs it packed into contiguous storage. */
+
+static bool
+dummy_accepts_strided_arg (gfc_symbol *fsym, bool nodesc_arg)
+{
+ return fsym && !nodesc_arg && !fsym->attr.contiguous && fsym->as
+ && (fsym->as->type == AS_ASSUMED_SHAPE
+ || fsym->as->type == AS_ASSUMED_RANK
+ || fsym->as->type == AS_DEFERRED);
+}
+
+
+/* Return true if the actual argument expr for the dummy fsym may be passed as
+ a copy-in/copy-out temporary. A pointer associated with a TARGET or POINTER
dummy must remain valid after the call, so the actual argument is passed
directly, with a descriptor whose span provides the element spacing. An
actual argument with a vector subscript is not definable and its pointer
@@ -8034,13 +8067,19 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
is converted to a temporary, which is passed and then
written back after the procedure call. The elements of
a span addressed dummy passed on as a whole are usually
- contiguous, so the copy is made conditional. */
- gfc_conv_subref_array_arg (&parmse, e, nodesc_arg,
+ contiguous, so the copy is made conditional. A dummy that
+ has a descriptor takes any stride, so for it the condition
+ is only that the span be the element length. */
+ {
+ bool whole_span = is_whole_span_addressed_dummy (e);
+ gfc_conv_subref_array_arg (&parmse, e, nodesc_arg,
fsym ? fsym->attr.intent : INTENT_INOUT,
fsym && fsym->attr.pointer, fsym, sym->name,
- NULL,
- gfc_is_span_addressed_dummy (e->symtree->n.sym)
- && !is_subobject_ref (e));
+ NULL, whole_span,
+ whole_span
+ && dummy_accepts_strided_arg (fsym,
+ nodesc_arg));
+ }
else if (e->ts.type == BT_CLASS && CLASS_DATA (e)->as
&& CLASS_DATA (e)->as->type == AS_ASSUMED_SIZE
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 408acf081f1..a3c7778373f 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -564,7 +564,8 @@ void gfc_conv_subref_array_arg (gfc_se *, gfc_expr *, int, sym_intent, bool,
const gfc_symbol *fsym = NULL,
const char *proc_name = NULL,
gfc_symbol *sym = NULL,
- bool check_contiguous = false);
+ bool check_contiguous = false,
+ bool span_only = false);
void gfc_conv_is_contiguous_expr (gfc_se *, gfc_expr *);
@@ -1072,6 +1073,9 @@ struct GTY(()) lang_decl {
unsigned int scalar_pointer : 1;
unsigned int scalar_target : 1;
unsigned int optional_arg : 1;
+ /* The element spacing of this dummy is held by the strides of its
+ descriptor rather than by its span. */
+ unsigned int span_normalized : 1;
};
@@ -1081,6 +1085,8 @@ struct GTY(()) lang_decl {
#define GFC_DECL_CAF_OFFSET(node) DECL_LANG_SPECIFIC(node)->caf_offset
#define GFC_DECL_SAVED_DESCRIPTOR(node) \
(DECL_LANG_SPECIFIC(node)->saved_descriptor)
+#define GFC_DECL_SPAN_NORMALIZED(node) \
+ (DECL_LANG_SPECIFIC(node)->span_normalized)
#define GFC_DECL_SCALAR_ALLOCATABLE(node) \
(DECL_LANG_SPECIFIC (node)->scalar_allocatable)
#define GFC_DECL_SCALAR_POINTER(node) \
diff --git a/gcc/testsuite/gfortran.dg/c_loc_test_22.f90 b/gcc/testsuite/gfortran.dg/c_loc_test_22.f90
index 91547e8e337..a4622b49c79 100644
--- a/gcc/testsuite/gfortran.dg/c_loc_test_22.f90
+++ b/gcc/testsuite/gfortran.dg/c_loc_test_22.f90
@@ -17,9 +17,12 @@ end
! { dg-final { scan-tree-dump-not " _gfortran_internal_pack" "original" } }
! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void .\\) &\\(.xxx.\[0-9\]+\\)\\\[0\\\];" 1 "original" } }
! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void .\\) &\\(.xxx.\[0-9\]+\\)\\\[D.\[0-9\]+ \\* 4\\\];" 1 "original" } }
-! A TARGET assumed-shape dummy is addressed with the descriptor's runtime
-! span, so the element offset is span-scaled instead of a constant 16.
-! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void .\\) &\\(.yyy.\[0-9\]+\\)\\\[0\\\];" 1 "original" } }
-! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void .\\) yyy.\[0-9\]+ \\+ \\(sizetype\\) \\(\\(yyy->span \\* D.\[0-9\]+\\) \\* 4\\);" 1 "original" } }
+! The elements of a TARGET assumed-shape dummy can be spaced by more than the
+! element length. For an element length that divides the spacing, the spacing
+! is folded into the strides on entry, so the elements are addressed by the
+! constant element length rather than by a span loaded from the descriptor.
+! { dg-final { scan-tree-dump-not "yyy->span \\*" "original" } }
+! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void .\\) yyy.\[0-9\]+;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void .\\) yyy.\[0-9\]+ \\+ \\(sizetype\\) \\(D.\[0-9\]+ \\* 16\\);" 1 "original" } }
! { dg-final { scan-tree-dump-times "D.\[0-9\]+ = parm.\[0-9\]+.data;\[^;]+ptr\[1-4\] = D.\[0-9\]+;" 4 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/class_to_type_9.f90 b/gcc/testsuite/gfortran.dg/class_to_type_9.f90
index 40f4e6a53de..47d90c5080e 100644
--- a/gcc/testsuite/gfortran.dg/class_to_type_9.f90
+++ b/gcc/testsuite/gfortran.dg/class_to_type_9.f90
@@ -1,10 +1,11 @@
! { dg-do run }
! PR fortran/53800
+! PR126964
! A TARGET dummy associated with elements that are spaced by more than the
! element size: pointers to it stay valid after the call, it is written
-! through, it is not contiguous, it is copied when passed on to a dummy
-! without the TARGET attribute and it is transferred element by element.
+! through, it is not contiguous, it is passed on to an assumed-shape dummy
+! by its strides and copied for a dummy that has no descriptor.
module m
implicit none
@@ -22,15 +23,15 @@ contains
write (line, '(4I3)') a
if (line(1:12) /= ' 1 4 9 16') stop 3
if (sum(a) /= 30) stop 4
- call packed(a)
+ call assumed_shape(a)
call assumed_size(a)
saved => a
a(2) = -a(2)
end subroutine
- subroutine packed(b) ! copy-in/copy-out
+ subroutine assumed_shape(b) ! strides passed on, no copy
integer :: b(:)
if (any(b /= [1, 4, 9, 16])) stop 5
- if (.not. is_contiguous(b)) stop 6
+ if (is_contiguous(b)) stop 6
end subroutine
subroutine assumed_size(c) ! no descriptor
integer :: c(*)
diff --git a/gcc/testsuite/gfortran.dg/gomp/target-span-1.f90 b/gcc/testsuite/gfortran.dg/gomp/target-span-1.f90
new file mode 100644
index 00000000000..0efd8ce709e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/target-span-1.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! PR 126964
+! PR 126950
+!
+! A TARGET assumed-shape dummy is addressed through the span of its
+! descriptor. The descriptor is not mapped to the device, so the span has
+! to be read on entry and folded into the local strides, rather than the
+! target region dereferencing the descriptor.
+
+module m
+ use iso_c_binding
+contains
+ subroutine tgt (t)
+ real(c_double), target :: t(:)
+ !$omp target has_device_addr(t)
+ call inner (t(1))
+ !$omp end target
+ end subroutine tgt
+
+ subroutine inner (a)
+ real(c_double) :: a
+ end subroutine inner
+end module m
+
+! The span is read from the descriptor once, on entry, and scales the strides.
+! { dg-final { scan-tree-dump-times "= t->span;" 1 "original" } }
+! { dg-final { scan-tree-dump "stride\.\[0-9\]+ = \[^;\]* != 8 \\? stride\.\[0-9\]+ \\* \[^;\]* : stride\.\[0-9\]+;" "original" } }
+! The element reference uses the local strides and the element length.
+! { dg-final { scan-tree-dump "t\.\[0-9\]+ \\+ \\(sizetype\\) \\(\\(offset\.\[0-9\]+ \\+ \[^)\]*stride\.\[0-9\]+\[^)\]*\\) \\* 8\\)" "original" } }
+! { dg-final { scan-tree-dump-not "\\* t->span" "original" } }
diff --git a/gcc/testsuite/gfortran.dg/target_dummy_repack_1.f90 b/gcc/testsuite/gfortran.dg/target_dummy_repack_1.f90
new file mode 100644
index 00000000000..d2379488ce9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/target_dummy_repack_1.f90
@@ -0,0 +1,77 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+! PR126964
+! A TARGET assumed-shape dummy is addressed through the span of its
+! descriptor. When it is passed on to a dummy that has a descriptor of its
+! own, that dummy addresses the elements by the strides it holds, so the only
+! condition for passing it directly is that the span be the element length.
+! Testing full contiguity instead made a non-contiguous actual argument be
+! copied on every call.
+!
+module m
+ implicit none
+contains
+
+ ! Assumed shape, no TARGET: takes any stride, needs no repacking.
+ real function elem (a, i, j) result (s)
+ real, intent(in) :: a(:,:)
+ integer, intent(in) :: i, j
+ s = a(i,j)
+ end function
+
+ real function sum_target (self) result (s)
+ real, target, intent(in) :: self(:,:)
+ integer :: i, j
+ s = 0.0
+ do j = 1, size (self,2)
+ do i = 1, size (self,1)
+ s = s + elem (self, i, j)
+ end do
+ end do
+ end function
+
+ real function sum_plain (self) result (s)
+ real, intent(in) :: self(:,:)
+ integer :: i, j
+ s = 0.0
+ do j = 1, size (self,2)
+ do i = 1, size (self,1)
+ s = s + elem (self, i, j)
+ end do
+ end do
+ end function
+
+end module
+
+program p
+ use m
+ implicit none
+ integer, parameter :: n = 6
+ real, allocatable, target :: a(:,:)
+ real :: expect
+ integer :: i, j
+
+ allocate (a(2*n,n))
+ do j = 1, n
+ do i = 1, 2*n
+ a(i,j) = real (i + 100*j)
+ end do
+ end do
+
+ ! Contiguous actual argument.
+ expect = sum_plain (a)
+ if (abs (sum_target (a) - expect) > 1.0e-4) stop 1
+
+ ! Non-contiguous actual argument: every other row.
+ expect = sum_plain (a(1:2*n:2,:))
+ if (abs (sum_target (a(1:2*n:2,:)) - expect) > 1.0e-4) stop 2
+
+ ! A section of the second dimension too.
+ expect = sum_plain (a(1:2*n:2,2:n:2))
+ if (abs (sum_target (a(1:2*n:2,2:n:2)) - expect) > 1.0e-4) stop 3
+
+end program
+
+! The condition for passing the dummy on must be the span alone; testing the
+! strides as well would repack a non-contiguous actual argument needlessly.
+! { dg-final { scan-tree-dump "contiguous\\.\[0-9\]+ = \[^;\]*span == \[^;&\]*elem_len;" "original" } }
diff --git a/gcc/testsuite/gfortran.dg/target_dummy_span_1.f90 b/gcc/testsuite/gfortran.dg/target_dummy_span_1.f90
new file mode 100644
index 00000000000..43870a2be78
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/target_dummy_span_1.f90
@@ -0,0 +1,62 @@
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! PR126964
+!
+! The elements of a TARGET assumed-shape dummy can be spaced by more than
+! the element length. Where the element length divides the spacing, the
+! spacing is folded into the strides on entry, so that the elements are
+! addressed by the constant element length rather than by a span loaded
+! from the descriptor. Addressing by a runtime span leaves the data
+! reference step symbolic, which stops the loops from being vectorized.
+
+module m
+ implicit none
+ type :: t
+ real(8) :: a, b
+ end type
+ real(8), pointer :: saved(:,:) => null()
+contains
+ subroutine axpy (self, n)
+ real(8), dimension(:,:), target :: self
+ integer, intent(in) :: n
+ integer :: k
+ do k = 1, n - 1
+ self(:,n) = self(:,n) + self(:,k)
+ end do
+ saved => self
+ end subroutine
+end module
+
+program p
+ use m
+ implicit none
+ type(t), target :: x(4,3)
+ integer :: i, j
+ x%a = -1.0_8
+ x%b = reshape ([(real (i, 8), i = 1, 12)], [4, 3])
+
+ call axpy (x%b, 3)
+
+ do j = 1, 2
+ do i = 1, 4
+ if (x(i,j)%b /= real (i + 4*(j-1), 8)) stop 1
+ end do
+ end do
+ if (any (x(:,3)%b /= [15.0_8, 18.0_8, 21.0_8, 24.0_8])) stop 2
+ if (any (x%a /= -1.0_8)) stop 3
+
+ saved = 0.0_8
+ if (any (x%b /= 0.0_8)) stop 4
+ if (any (x%a /= -1.0_8)) stop 5
+end program
+
+! The spacing is read from the descriptor once, on entry, and scales both
+! strides and the offset.
+! { dg-final { scan-tree-dump-times "= self->span;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "\\? stride\.\[0-9\]+ \\* \[^;\]+ : stride\.\[0-9\]+;" 2 "original" } }
+! { dg-final { scan-tree-dump-times "\\? offset\.\[0-9\]+ \\* \[^;\]+ : offset\.\[0-9\]+;" 1 "original" } }
+! No span variable is created and the elements are addressed by the element
+! length.
+! { dg-final { scan-tree-dump-not "span\.\[0-9\]+" "original" } }
+! { dg-final { scan-tree-dump-not "\\* self->span" "original" } }
--
2.55.0
