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)) + decls->add (base); + return false; +} + +/* Collect into ESCAPING the memory decls referenced outside LOOP. Must run + before LOOP is duplicated as a duplicated body would otherwise make a private + decl look like it escapes. */ + +static void +gather_escaping_decls (class loop *loop, hash_set<tree> *escaping) +{ + basic_block *bbs = get_loop_body (loop); + unsigned i; + + auto_bitmap in_loop; + for (i = 0; i < loop->num_nodes; i++) + bitmap_set_bit (in_loop, bbs[i]->index); + free (bbs); + + basic_block bb; + FOR_EACH_BB_FN (bb, cfun) + if (!bitmap_bit_p (in_loop, bb->index)) + { + /* PHI arguments may contain decl addresses. */ + for (gphi_iterator gpi = gsi_start_phis (bb); !gsi_end_p (gpi); + gsi_next (&gpi)) + walk_stmt_load_store_addr_ops (gpi.phi (), escaping, NULL, NULL, + record_memory_decl); + + for (gimple_stmt_iterator gsi = gsi_start_nondebug_bb (bb); + !gsi_end_p (gsi); gsi_next_nondebug (&gsi)) + walk_stmt_load_store_addr_ops (gsi_stmt (gsi), escaping, + record_memory_decl, record_memory_decl, + record_memory_decl); + } +} + /* Eliminates the references to local variables from the single entry single exit region between the ENTRY and EXIT edges. @@ -1288,10 +1345,15 @@ eliminate_local_variables_stmt (edge entry, gimple_stmt_iterator *gsi, necessary). 2) Dereferencing a local variable -- these are replaced with indirect - references. */ + references. + + A memory decl not in ESCAPING is iteration-private and left untouched, so the + outliner gives each thread its own copy. This is a conservative approach to + avoid hoisting memory that would otherwise end up being overwritten and cause + data races when written by multiple threads. */ static void -eliminate_local_variables (edge entry, edge exit) +eliminate_local_variables (edge entry, edge exit, hash_set<tree> *escaping) { basic_block bb; auto_vec<basic_block, 3> body; @@ -1314,7 +1376,8 @@ eliminate_local_variables (edge entry, edge exit) has_debug_stmt = true; } else - eliminate_local_variables_stmt (entry, &gsi, &decl_address); + eliminate_local_variables_stmt (entry, &gsi, &decl_address, + escaping); } if (has_debug_stmt) @@ -1322,7 +1385,8 @@ eliminate_local_variables (edge entry, edge exit) if (bb != entry_bb && bb != exit_bb) for (gsi = gsi_start_bb (bb); !gsi_end_p (gsi); gsi_next (&gsi)) if (gimple_debug_bind_p (gsi_stmt (gsi))) - eliminate_local_variables_stmt (entry, &gsi, &decl_address); + eliminate_local_variables_stmt (entry, &gsi, &decl_address, + escaping); } /* Returns true if expression EXPR is not defined between ENTRY and @@ -2822,6 +2886,11 @@ gen_parallel_loop (class loop *loop, location_t loc; gimple *cond_stmt; + /* Compute this before the loop is duplicated below. */ + hash_set<tree> escaping; + if (loop->can_be_parallel) + gather_escaping_decls (loop, &escaping); + /* From --------------------------------------------------------------------- @@ -2994,7 +3063,8 @@ gen_parallel_loop (class loop *loop, been done for oacc_kernels_p in pass_lower_omp/lower_omp (). */ if (!oacc_kernels_p) { - eliminate_local_variables (entry, exit); + eliminate_local_variables (entry, exit, + loop->can_be_parallel ? &escaping : NULL); /* In the old loop, move all variables non-local to the loop to a structure and back, and create separate decls for the variables used in loop. */ -- 2.43.0
