All, forgive my confusing emails.
The attached patch is v3 of the original submission and Part 2 of 2.
Part 1 was sent on my previous email, this is the followup.
Regression tested on x86_64.
OK for mainline? (after Part 1 is applied)
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, 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.
A dummy whose spacing is folded that way is not addressed through its span
at all, and the descriptor built for it holds the element length as its
span, so is_subref_array must not be true for it: passing it on needs
neither a copy nor a test. The predicate is therefore split in two. What
lets the elements be spaced by more than the element size is that the
actual argument of a TARGET dummy is never copied, which is now
gfc_dummy_requires_direct_arg; gfc_is_span_addressed_dummy is that
property less the dummies whose spacing is folded into their strides, and
moves to trans-array.cc, the element size of the type being a back end
property.
Second, 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. This applies
to what is left span addressed: character, complex and derived type
elements, and an assumed rank dummy, which has no strides to fold into.
PR fortran/126964
gcc/fortran/ChangeLog:
* gfortran.h (gfc_dummy_requires_direct_arg): New prototype.
* symbol.cc (gfc_is_span_addressed_dummy): Rename to...
(gfc_dummy_requires_direct_arg): ... this and move the addressing
out of the description.
* 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_is_span_addressed_dummy): New function, false for a dummy
whose element spacing is folded into its strides.
(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 rather than giving it a span variable.
(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.
(copy_in_out_allowed): Use gfc_dummy_requires_direct_arg, the
actual argument of a span normalized dummy being uncopied too.
(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_repack_2.f90: New test.
* gfortran.dg/target_dummy_span_1.f90: New test.
* gfortran.dg/c_loc_test_22.f90: Update for addressing by the
element length.
* gfortran.dg/gomp/target-span-1.f90: Likewise.
* gfortran.dg/class_to_type_9.f90: Likewise, and expect an
assumed shape dummy to take no copy of a strided actual argument.
libgomp/ChangeLog:
* testsuite/libgomp.oacc-fortran/host_data-5.F90: Expect no copy
of a span normalized dummy passed to a dummy without a descriptor.
---commit 0a3176621b00954cce881d2bbc6f8a4b83587e01
Author: Jerry DeLisle <[email protected]>
Date: Fri Aug 21 16:17:14 2026 -0700
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, 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.
A dummy whose spacing is folded that way is not addressed through its span
at all, and the descriptor built for it holds the element length as its
span, so is_subref_array must not be true for it: passing it on needs
neither a copy nor a test. The predicate is therefore split in two. What
lets the elements be spaced by more than the element size is that the
actual argument of a TARGET dummy is never copied, which is now
gfc_dummy_requires_direct_arg; gfc_is_span_addressed_dummy is that
property less the dummies whose spacing is folded into their strides, and
moves to trans-array.cc, the element size of the type being a back end
property.
Second, 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. This applies
to what is left span addressed: character, complex and derived type
elements, and an assumed rank dummy, which has no strides to fold into.
PR fortran/126964
gcc/fortran/ChangeLog:
* gfortran.h (gfc_dummy_requires_direct_arg): New prototype.
* symbol.cc (gfc_is_span_addressed_dummy): Rename to...
(gfc_dummy_requires_direct_arg): ... this and move the addressing
out of the description.
* 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_is_span_addressed_dummy): New function, false for a dummy
whose element spacing is folded into its strides.
(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 rather than giving it a span variable.
(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.
(copy_in_out_allowed): Use gfc_dummy_requires_direct_arg, the
actual argument of a span normalized dummy being uncopied too.
(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_repack_2.f90: New test.
* gfortran.dg/target_dummy_span_1.f90: New test.
* gfortran.dg/c_loc_test_22.f90: Update for addressing by the
element length.
* gfortran.dg/gomp/target-span-1.f90: Likewise.
* gfortran.dg/class_to_type_9.f90: Likewise, and expect an
assumed shape dummy to take no copy of a strided actual argument.
libgomp/ChangeLog:
* testsuite/libgomp.oacc-fortran/host_data-5.F90: Expect no copy
of a span normalized dummy passed to a dummy without a descriptor.
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index ccf39602e05..f298e5cb736 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3977,6 +3977,7 @@ bool gfc_check_symbol_typed (gfc_symbol*, gfc_namespace*, bool, locus);
gfc_namespace* gfc_find_proc_namespace (gfc_namespace*);
bool gfc_is_associate_pointer (gfc_symbol*);
+bool gfc_dummy_requires_direct_arg (gfc_symbol *);
bool gfc_is_span_addressed_dummy (gfc_symbol *);
gfc_symbol * gfc_find_dt_in_generic (gfc_symbol *);
gfc_formal_arglist *gfc_sym_get_dummy_args (gfc_symbol *);
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 74388144b0a..f4536cb2fa9 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -5702,14 +5702,15 @@ gfc_is_associate_pointer (gfc_symbol* sym)
}
-/* Check if a dummy argument must be addressed using the span of its
- descriptor. The actual argument of an assumed shape or assumed rank
- TARGET dummy is never copied, so its elements can be spaced by more
- than the element size. CLASS and assumed type entities already carry
- their element size and are excluded. */
+/* Check if the actual argument of a dummy must be passed directly, rather
+ than through a copy-in/copy-out temporary. A pointer associated with an
+ assumed shape or assumed rank TARGET dummy has to stay valid after the
+ call, so its actual argument is never copied and its elements can be
+ spaced by more than the element size. CLASS and assumed type entities
+ already carry their element size and are excluded. */
bool
-gfc_is_span_addressed_dummy (gfc_symbol *sym)
+gfc_dummy_requires_direct_arg (gfc_symbol *sym)
{
return sym->attr.dummy
&& sym->attr.target
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 765d4ddb36c..30742412632 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -514,6 +514,91 @@ span_addressed_array (tree expr)
}
+/* An actual argument whose elements are subobjects can be described to a
+ dummy that takes it directly 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_dummy_requires_direct_arg (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));
+}
+
+
+/* Check if a dummy argument must be addressed using the span of its
+ descriptor. Where the spacing of the elements is folded into the strides
+ instead, the dummy is addressed like any other array and its descriptor is
+ built with the element length as span, so it is not span addressed. */
+
+bool
+gfc_is_span_addressed_dummy (gfc_symbol *sym)
+{
+ return gfc_dummy_requires_direct_arg (sym)
+ && !gfc_span_folds_into_stride (sym);
+}
+
+
+/* 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
@@ -7539,6 +7624,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));
+ }
+
/* Load the span once here, like the bounds above, so that element
addressing does not reload it from the descriptor. The descriptor
itself is not available in an outlined region, such as an OpenMP
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 c5d3ef0254f..5630db863c8 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -1407,13 +1407,21 @@ 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.
- Create the variable that holds it here, since the body is translated
- before gfc_trans_dummy_array_bias loads it from the descriptor. */
- if (gfc_is_span_addressed_dummy (sym) && packed == PACKED_NO)
+ 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; create the variable that holds it here, since the body
+ is translated before gfc_trans_dummy_array_bias loads it from the
+ descriptor. */
+ if (packed == PACKED_NO)
{
- GFC_DECL_PTR_ARRAY_P (decl) = 1;
- GFC_DECL_SPAN (decl) = gfc_create_var (gfc_array_index_type, "span");
+ if (gfc_span_folds_into_stride (sym))
+ GFC_DECL_SPAN_NORMALIZED (decl) = 1;
+ else if (gfc_is_span_addressed_dummy (sym))
+ {
+ GFC_DECL_PTR_ARRAY_P (decl) = 1;
+ GFC_DECL_SPAN (decl) = gfc_create_var (gfc_array_index_type, "span");
+ }
}
if (sym->ns->proc_name->backend_decl == current_function_decl
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index ec2ff5b9114..4aac70f2ae2 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5558,7 +5558,7 @@ 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,
- bool deep_copy)
+ bool deep_copy, bool span_only)
{
gfc_se lse;
gfc_se rse;
@@ -5934,9 +5934,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);
@@ -7549,8 +7553,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
@@ -7562,7 +7594,7 @@ copy_in_out_allowed (gfc_symbol *fsym, gfc_expr *e, bool nodesc_arg)
if (fsym == NULL || nodesc_arg || gfc_has_vector_subscript (e))
return true;
- if (gfc_is_span_addressed_dummy (fsym))
+ if (gfc_dummy_requires_direct_arg (fsym))
return false;
return !(fsym->attr.pointer && !fsym->attr.contiguous && fsym->as
@@ -8666,13 +8698,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, false,
+ 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 e5162d5515c..bcb466ffe8f 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -565,7 +565,8 @@ void gfc_conv_subref_array_arg (gfc_se *, gfc_expr *, int, sym_intent, bool,
const char *proc_name = NULL,
gfc_symbol *sym = NULL,
bool check_contiguous = false,
- bool deep_copy = false);
+ bool deep_copy = false,
+ bool span_only = false);
void gfc_conv_is_contiguous_expr (gfc_se *, gfc_expr *);
@@ -1069,6 +1070,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;
};
@@ -1079,6 +1083,8 @@ struct GTY(()) lang_decl {
#define GFC_DECL_SAVED_DESCRIPTOR(node) \
(DECL_LANG_SPECIFIC(node)->saved_descriptor)
#define GFC_DECL_SPAN(node) (DECL_LANG_SPECIFIC(node)->span)
+#define GFC_DECL_SPAN_NORMALIZED(node) \
+ (DECL_LANG_SPECIFIC(node)->span_normalized)
/* Return the cached span of a span addressed dummy, or NULL_TREE. */
#define GFC_DECL_GET_SPAN(node) \
(DECL_P (node) && DECL_LANG_SPECIFIC (node) \
diff --git a/gcc/testsuite/gfortran.dg/c_loc_test_22.f90 b/gcc/testsuite/gfortran.dg/c_loc_test_22.f90
index 2360c33913b..fa5b06a588d 100644
--- a/gcc/testsuite/gfortran.dg/c_loc_test_22.f90
+++ b/gcc/testsuite/gfortran.dg/c_loc_test_22.f90
@@ -17,11 +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 runtime span that is
-! loaded from the descriptor on entry, 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 "span.\[0-9\]+ = yyy->span;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void .\\) yyy.\[0-9\]+ \\+ \\(sizetype\\) \\(\\(D.\[0-9\]+ \\* span.\[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 "span.\[0-9\]+ = 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
index 30ba7e1862e..e391d1bbc02 100644
--- a/gcc/testsuite/gfortran.dg/gomp/target-span-1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/target-span-1.f90
@@ -2,11 +2,12 @@
! { dg-additional-options "-fdump-tree-original" }
!
! PR fortran/126950
+! PR126964
!
! 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 loaded into a local variable on entry and that variable used inside
-! the target region, rather than the region dereferencing the descriptor.
+! 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
@@ -23,8 +24,9 @@ contains
end subroutine inner
end module m
-! The span is loaded from the descriptor once, on entry.
-! { dg-final { scan-tree-dump-times "span\.\[0-9\]+ = t->span;" 1 "original" } }
-! The element reference uses that variable, not the descriptor.
-! { dg-final { scan-tree-dump "t\.\[0-9\]+ \\+ \\(sizetype\\) \\(\\(offset\.\[0-9\]+ \\+ \[^)\]*stride\.\[0-9\]+\[^)\]*\\) \\* span\.\[0-9\]+\\)" "original" } }
+! 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..e94bd8a1353
--- /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
+! The spacing of the elements of a numeric TARGET assumed-shape dummy is
+! folded into the strides of its descriptor on entry, so the dummy is not
+! addressed through its span and its elements are not subobjects of larger
+! ones. Passing it on to a dummy that has a descriptor of its own therefore
+! needs neither a copy nor a test. 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 dummy is passed on directly: no copy and no test of its span.
+! { dg-final { scan-tree-dump-not "contiguous\\.\[0-9\]+" "original" } }
+! { dg-final { scan-tree-dump-not "atmp\\.\[0-9\]+" "original" } }
diff --git a/gcc/testsuite/gfortran.dg/target_dummy_repack_2.f90 b/gcc/testsuite/gfortran.dg/target_dummy_repack_2.f90
new file mode 100644
index 00000000000..3692eb768f9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/target_dummy_repack_2.f90
@@ -0,0 +1,84 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+! PR126964
+! A TARGET assumed-shape dummy of a type whose element length need not divide
+! the spacing 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
+ type :: t
+ complex :: z
+ real :: r
+ end type
+contains
+
+ ! Assumed shape, no TARGET: takes any stride, needs no repacking.
+ complex function elem (a, i, j) result (s)
+ complex, intent(in) :: a(:,:)
+ integer, intent(in) :: i, j
+ s = a(i,j)
+ end function
+
+ complex function sum_target (self) result (s)
+ complex, 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
+
+ complex function sum_plain (self) result (s)
+ complex, 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
+ type(t), allocatable, target :: v(:,:)
+ complex :: expect
+ integer :: i, j
+
+ allocate (v(2*n,n))
+ do j = 1, n
+ do i = 1, 2*n
+ v(i,j)%z = cmplx (i + 100*j, i - j)
+ v(i,j)%r = 0.0
+ end do
+ end do
+
+ ! Elements that are subobjects of larger ones.
+ expect = sum_plain (v%z)
+ if (abs (sum_target (v%z) - expect) > 1.0e-4) stop 1
+
+ ! Contiguous actual argument.
+ block
+ complex, allocatable, target :: c(:,:)
+ c = v%z
+ expect = sum_plain (c)
+ if (abs (sum_target (c) - expect) > 1.0e-4) stop 2
+ expect = sum_plain (c(1:2*n:2,:))
+ if (abs (sum_target (c(1:2*n:2,:)) - expect) > 1.0e-4) stop 3
+ end block
+
+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" } }
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/host_data-5.F90 b/libgomp/testsuite/libgomp.oacc-fortran/host_data-5.F90
index ae5104beb48..ee091d48a77 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/host_data-5.F90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/host_data-5.F90
@@ -77,14 +77,7 @@ subroutine foo (p2, parr, host_p, host_parr, cond)
! { dg-note {variable 'D\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: artificial} "" { target *-*-* } .-8 }
! { dg-note {variable 'transfer\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: artificial} "" { target *-*-* } .-9 }
! { dg-note {variable 'parm\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-10 }
- ! The TARGET dummy 'parr' is addressed by the span of its descriptor, so
- ! passing it to a dummy without a descriptor packs it when it is not
- ! contiguous.
- ! { dg-note {variable 'iftmp\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-14 }
- ! { dg-note {variable 'atmp\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-15 }
- ! { dg-note {variable 'arg_ptr\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-16 }
- ! { dg-note {variable 'contiguous\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-17 }
- ! { dg-note {variable 'S\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-18 }
+ ! { dg-note {variable 'parm\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: artificial} "" { target *-*-* } .-11 }
if (.not. acc_is_present(p, c_sizeof(p))) stop 11
if (.not. acc_is_present(parr, 1)) stop 12
! Not inside a host_data construct, so still the host pointer.
