From: Tobias Burnus Date: Fri, 13 May 2022 18:00:34 +0000 (+0200) Subject: OpenMP/Fortran: Use firstprivat not alloc for ptr attach for arrays X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=438b4cec449984c98c576c2ea7270394a783c72d;p=thirdparty%2Fgcc.git OpenMP/Fortran: Use firstprivat not alloc for ptr attach for arrays For a non-descriptor array, map(A(n:m)) was mapped as map(tofrom:A[n-1] [len: ...]) map(alloc:A [pointer assign, bias: ...]) with this patch, it is changed to map(tofrom:A[n-1] [len: ...]) map(firstprivate:A [pointer assign, bias: ...]) The latter avoids an alloc - and also avoids the race condition with nowait in the enclosed testcase. (Note: predantically, the testcase is invalid since OpenMP 5.1, violating the map clause restriction at [354:10-13]. gcc/fortran/ChangeLog: * trans-openmp.cc (gfc_trans_omp_clauses): When mapping nondescriptor array sections, use GOMP_MAP_FIRSTPRIVATE_POINTER instead of GOMP_MAP_POINTER for the pointer attachment. libgomp/ChangeLog: * testsuite/libgomp.fortran/target-nowait-array-section.f90: New test. (cherry picked from commit a46d6268371c446566f656858aada8775a0c988e) --- diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp index 63eba462c436..21592517cb0f 100644 --- a/gcc/fortran/ChangeLog.omp +++ b/gcc/fortran/ChangeLog.omp @@ -1,3 +1,12 @@ +2022-07-04 Tobias Burnus + + Backport from mainline: + 2022-05-13 Tobias Burnus + + * trans-openmp.cc (gfc_trans_omp_clauses): When mapping nondescriptor + array sections, use GOMP_MAP_FIRSTPRIVATE_POINTER instead of + GOMP_MAP_POINTER for the pointer attachment. + 2022-06-30 Kwok Cheung Yeung * openmp.cc (gfc_resolve_omp_allocate): Initialize tail to NULL. diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index 3e756a02d013..b047b869d43c 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -4774,9 +4774,15 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, /* An array element or array section which is not part of a derived type, etc. */ bool element = n->expr->ref->u.ar.type == AR_ELEMENT; - gfc_trans_omp_array_section (block, n, decl, element, - GOMP_MAP_POINTER, node, node2, - node3, node4); + tree type = TREE_TYPE (decl); + gomp_map_kind k = GOMP_MAP_POINTER; + if (!openacc + && !GFC_DESCRIPTOR_TYPE_P (type) + && !(POINTER_TYPE_P (type) + && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (type)))) + k = GOMP_MAP_FIRSTPRIVATE_POINTER; + gfc_trans_omp_array_section (block, n, decl, element, k, + node, node2, node3, node4); } else if (n->expr && n->expr->expr_type == EXPR_VARIABLE diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp index 6d3c4772e863..134387d47c41 100644 --- a/libgomp/ChangeLog.omp +++ b/libgomp/ChangeLog.omp @@ -1,3 +1,10 @@ +2022-07-04 Tobias Burnus + + Backport from mainline: + 2022-05-13 Tobias Burnus + + * testsuite/libgomp.fortran/target-nowait-array-section.f90: New test. + 2022-06-20 Andrew Stubbs * plugin/plugin-gcn.c (struct usm_splay_tree_key_s): New. diff --git a/libgomp/testsuite/libgomp.fortran/target-nowait-array-section.f90 b/libgomp/testsuite/libgomp.fortran/target-nowait-array-section.f90 new file mode 100644 index 000000000000..7560cff746ba --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target-nowait-array-section.f90 @@ -0,0 +1,56 @@ +! Runs the the target region asynchrolously and checks for it +! +! Note that map(alloc: work(:, i)) + nowait should be save +! given that a nondescriptor array is used. However, it still +! violates a map clause restriction, added in OpenMP 5.1 [354:10-13]. + +PROGRAM test_target_teams_distribute_nowait + USE ISO_Fortran_env, only: INT64 + implicit none + INTEGER, parameter :: N = 1024, N_TASKS = 16 + INTEGER :: i, j, k, my_ticket + INTEGER :: order(n_tasks) + INTEGER(INT64) :: work(n, n_tasks) + INTEGER :: ticket + logical :: async + + ticket = 0 + + !$omp target enter data map(to: ticket, order) + + !$omp parallel do num_threads(n_tasks) + DO i = 1, n_tasks + !$omp target map(alloc: work(:, i), ticket) private(my_ticket) nowait + !!$omp target teams distribute map(alloc: work(:, i), ticket) private(my_ticket) nowait + DO j = 1, n + ! Waste cyles +! work(j, i) = 0 +! DO k = 1, n*(n_tasks - i) +! work(j, i) = work(j, i) + i*j*k +! END DO + my_ticket = 0 + !$omp atomic capture + ticket = ticket + 1 + my_ticket = ticket + !$omp end atomic + !$omp atomic write + order(i) = my_ticket + END DO + !$omp end target !teams distribute + END DO + !$omp end parallel do + + !$omp target exit data map(from:ticket, order) + + IF (ticket .ne. n_tasks*n) stop 1 + if (maxval(order) /= n_tasks*n) stop 2 + ! order(i) == n*i if synchronous and between n and n*n_tasks if run concurrently + do i = 1, n_tasks + if (order(i) < n .or. order(i) > n*n_tasks) stop 3 + end do + async = .false. + do i = 1, n_tasks + if (order(i) /= n*i) async = .true. + end do + if (.not. async) stop 4 ! Did not run asynchronously +end