From: Dhruv Chawla <[email protected]>
Leave iteration-private decls in place instead of hoisting them, so
move_sese_region_to_fn gives each thread function its own copy. This fixes the
testcase mentioned in PR83064, which involves a stack array used as a callee
return slot getting shared across multiple threads leading to a data race and
therefore multiple writes to the same location.
This is a conservative way to solve this issue, by assuming that any memory
decl not referenced outside the loop is private to the iteration. It
would still be possible to hoist such memory if it was provable that the
same location would not be written across multiple threads, but that
analysis would be much more complicated and potentially unlikely to have
much benefit. Globals are always hoisted.
The gather_escaping_decls function collects those that escape before the loop
is duplicated by versioning or the exit-first transformation, as that would
otherwise make a private decl look like it escapes.
This is an alternate attempt to fix PR125717, as this brings back the
performance on the 800.pot3d_s benchmark to the expected levels. The previous
attempt was at
https://gcc.gnu.org/pipermail/gcc-patches/2026-June/720592.html.
Bootstrapped and regtested on aarch64-linux-gnu.
Signed-off-by: Dhruv Chawla <[email protected]>
PR tree-optimization/83064
gcc/fortran/ChangeLog:
* trans-stmt.cc (gfc_trans_forall_loop): Emit
annot_expr_parallel_kind for do-concurrent loops.
gcc/ChangeLog:
* tree-parloops.cc (struct elv_data): Add escaping hash_set.
(eliminate_local_variables_1): Only hoist escaping local
variables.
(eliminate_local_variables_stmt): Pass the escaping set through
to eliminate_local_variables_1.
(record_memory_decl): New function.
(gather_escaping_decls): Likewise.
(eliminate_local_variables): Pass the escaping set through to
eliminate_local_variables_stmt.
(gen_parallel_loop): Compute escaping set via
gather_escaping_decls and pass to
eliminate_local_variables.
gcc/testsuite/ChangeLog:
* gfortran.dg/do_concurrent_6.f90: Update to handle parallel
annotation.
* gfortran.dg/do_concurrent_7.f90: Likewise.
* gfortran.dg/do_concurrent_16.f90: New test.
---
gcc/fortran/trans-stmt.cc | 12 +--
.../gfortran.dg/do_concurrent_16.f90 | 68 +++++++++++++++
gcc/testsuite/gfortran.dg/do_concurrent_6.f90 | 2 +-
gcc/testsuite/gfortran.dg/do_concurrent_7.f90 | 6 +-
gcc/tree-parloops.cc | 82 +++++++++++++++++--
5 files changed, 154 insertions(+), 16 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/do_concurrent_16.f90
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 526f42febf7..3c9ebdd0274 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -4349,13 +4349,13 @@ gfc_trans_forall_loop (forall_info *forall_tmp, tree
body,
cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node,
count, build_int_cst (TREE_TYPE (count), 0));
- /* PR 83064 means that we cannot use annot_expr_parallel_kind until
- the autoparallelizer can handle this. */
+ annot_expr_kind kind = forall_tmp->do_concurrent
+ ? annot_expr_parallel_kind
+ : annot_expr_ivdep_kind;
if (forall_tmp->do_concurrent || iter->annot.ivdep)
- cond = build3 (ANNOTATE_EXPR, TREE_TYPE (cond), cond,
- build_int_cst (integer_type_node,
- annot_expr_ivdep_kind),
- integer_zero_node);
+ cond
+ = build3 (ANNOTATE_EXPR, TREE_TYPE (cond), cond,
+ build_int_cst (integer_type_node, kind), integer_zero_node);
if (iter->annot.unroll && cond != error_mark_node)
cond = build3 (ANNOTATE_EXPR, TREE_TYPE (cond), cond,
diff --git a/gcc/testsuite/gfortran.dg/do_concurrent_16.f90
b/gcc/testsuite/gfortran.dg/do_concurrent_16.f90
new file mode 100644
index 00000000000..a3df15815bb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_concurrent_16.f90
@@ -0,0 +1,68 @@
+! { dg-do run }
+! { dg-require-effective-target pthread }
+! { dg-additional-options "-O2 -ftree-parallelize-loops=2
-fdump-tree-parloops2-details" }
+!
+! PR tree-optimization/83064
+!
+! Run two loops, one parallelized via do-concurrent and one serial. Compare
+! their results to make sure that the loop that is parallelized computes the
+! correct and expected result.
+
+program main
+ use, intrinsic :: iso_fortran_env
+ implicit none
+
+ integer, parameter :: nsplit = 4
+ integer(int64), parameter :: ne = 100000
+ integer(int64) :: stride, low(nsplit), high(nsplit), edof(ne), i
+ real(real64), dimension(nsplit) :: pi
+ real(real64) :: par, ser
+
+ edof(1::4) = 1
+ edof(2::4) = 2
+ edof(3::4) = 3
+ edof(4::4) = 4
+
+ stride = ceiling(real(ne)/nsplit)
+ do i = 1, nsplit
+ high(i) = stride*i
+ end do
+ do i = 2, nsplit
+ low(i) = high(i-1) + 1
+ end do
+ low(1) = 1
+ high(nsplit) = ne
+
+ ! Parallel loop.
+ pi = 0
+ do concurrent (i = 1:nsplit)
+ pi(i) = sum(compute( low(i), high(i) ))
+ end do
+ par = 4*sum(pi)
+
+ ! Serial loop as a reference.
+ pi = 0
+ do i = 1, nsplit
+ pi(i) = sum(compute( low(i), high(i) ))
+ end do
+ ser = 4*sum(pi)
+
+ if (abs(par - ser) > 1.0e-9_real64 * abs(ser)) stop 1
+
+contains
+
+ pure function compute( low, high ) result( tmp )
+ integer(int64), intent(in) :: low, high
+ real(real64), dimension(nsplit) :: tmp
+ integer(int64) :: j, k
+
+ tmp = 0
+ do j = low, high
+ k = edof(j)
+ tmp(k) = tmp(k) + (-1.0_real64)**(j+1) / real( 2*j-1 )
+ end do
+ end function
+
+end program main
+
+! { dg-final { scan-tree-dump "parallelizing \[^\n\r\]*loop" "parloops2" } }
diff --git a/gcc/testsuite/gfortran.dg/do_concurrent_6.f90
b/gcc/testsuite/gfortran.dg/do_concurrent_6.f90
index 9585a9f96f4..5320fd108a1 100644
--- a/gcc/testsuite/gfortran.dg/do_concurrent_6.f90
+++ b/gcc/testsuite/gfortran.dg/do_concurrent_6.f90
@@ -10,4 +10,4 @@ program main
print *,sum(a)
end program main
-! { dg-final { scan-tree-dump-times "ivdep" 1 "original" } }
+! { dg-final { scan-tree-dump-times "parallel" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/do_concurrent_7.f90
b/gcc/testsuite/gfortran.dg/do_concurrent_7.f90
index 604f6712d05..c4c73094960 100644
--- a/gcc/testsuite/gfortran.dg/do_concurrent_7.f90
+++ b/gcc/testsuite/gfortran.dg/do_concurrent_7.f90
@@ -21,6 +21,6 @@ program dc
end do
end program
-! { dg-final { scan-tree-dump "ANNOTATE_EXPR .* ivdep>, vector" "original" } }
-! { dg-final { scan-tree-dump "ANNOTATE_EXPR .* ivdep>, no-vector" "original"
} }
-! { dg-final { scan-tree-dump "ANNOTATE_EXPR .* ivdep>, unroll 4>, no-vector"
"original" } }
+! { dg-final { scan-tree-dump "ANNOTATE_EXPR .* parallel>, vector" "original"
} }
+! { dg-final { scan-tree-dump "ANNOTATE_EXPR .* parallel>, no-vector"
"original" } }
+! { dg-final { scan-tree-dump "ANNOTATE_EXPR .* parallel>, unroll 4>, no-vector"
"original" } }
diff --git a/gcc/tree-parloops.cc b/gcc/tree-parloops.cc
index 1da23f8d3c8..c16ebc7ba76 100644
--- a/gcc/tree-parloops.cc
+++ b/gcc/tree-parloops.cc
@@ -1151,6 +1151,7 @@ struct elv_data
struct walk_stmt_info info;
edge entry;
int_tree_htab_type *decl_address;
+ hash_set<tree> *escaping;
gimple_stmt_iterator *gsi;
bool changed;
bool reset;
@@ -1175,6 +1176,9 @@ eliminate_local_variables_1 (tree *tp, int
*walk_subtrees, void *data)
if (!SSA_VAR_P (t) || DECL_EXTERNAL (t))
return NULL_TREE;
+ if (dta->escaping && !is_global_var (t) && !dta->escaping->contains (t))
+ return NULL_TREE;
+
type = TREE_TYPE (t);
addr_type = build_pointer_type (type);
addr = take_address_of (t, addr_type, dta->entry, dta->decl_address,
@@ -1213,6 +1217,10 @@ eliminate_local_variables_1 (tree *tp, int
*walk_subtrees, void *data)
if (!var || !SSA_VAR_P (var) || DECL_EXTERNAL (var))
return NULL_TREE;
+ if (dta->escaping && !is_global_var (var)
+ && !dta->escaping->contains (var))
+ return NULL_TREE;
+
addr_type = TREE_TYPE (t);
addr = take_address_of (obj, addr_type, dta->entry, dta->decl_address,
dta->gsi);
@@ -1240,7 +1248,8 @@ eliminate_local_variables_1 (tree *tp, int
*walk_subtrees, void *data)
static void
eliminate_local_variables_stmt (edge entry, gimple_stmt_iterator *gsi,
- int_tree_htab_type *decl_address)
+ int_tree_htab_type *decl_address,
+ hash_set<tree> *escaping)
{
struct elv_data dta;
gimple *stmt = gsi_stmt (*gsi);
@@ -1248,6 +1257,7 @@ eliminate_local_variables_stmt (edge entry,
gimple_stmt_iterator *gsi,
memset (&dta.info, '\0', sizeof (dta.info));
dta.entry = entry;
dta.decl_address = decl_address;
+ dta.escaping = escaping;
dta.changed = false;
dta.reset = false;
@@ -1279,6 +1289,53 @@ eliminate_local_variables_stmt (edge entry,
gimple_stmt_iterator *gsi,
update_stmt (stmt);
}
+/* Callback for walk_stmt_load_store_addr_ops to record into DATA any memory
+ decls referenced by the gimple stmt. */
+
+static bool
+record_memory_decl (gimple *, tree base, tree, void *data)
+{
+ hash_set<tree> *decls = (hash_set<tree> *) data;
+ base = get_base_address (base);
+ if (DECL_P (base) && SSA_VAR_P (base) && !is_global_var (base)
+ && !DECL_EXTERNAL (base))
