OpenMP: Fortran - support omp flush's memorder clauses

gcc/fortran/ChangeLog:

	* gfortran.h (enum gfc_omp_memorder): Add.
	(gfc_omp_clauses): Use it.
	* openmp.c (gfc_match_omp_flush): Match memorder clauses.
	* trans-openmp.c (gfc_trans_omp_flush): Handle them.
	(gfc_trans_omp_directive): Update call.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/flush-1.f90: New test.
	* gfortran.dg/gomp/flush-2.f90: New test.
This commit is contained in:
Tobias Burnus 2020-10-22 17:09:22 +02:00
parent b69c00612d
commit c26d7df103
5 changed files with 123 additions and 4 deletions

View File

@ -1361,6 +1361,14 @@ enum gfc_omp_requires_kind
| OMP_REQ_ATOMIC_MEM_ORDER_RELAXED)
};
enum gfc_omp_memorder
{
OMP_MEMORDER_ACQ_REL,
OMP_MEMORDER_RELEASE,
OMP_MEMORDER_ACQUIRE,
OMP_MEMORDER_LAST
};
typedef struct gfc_omp_clauses
{
struct gfc_expr *if_expr;
@ -1376,6 +1384,7 @@ typedef struct gfc_omp_clauses
bool inbranch, notinbranch, defaultmap, nogroup;
bool sched_simd, sched_monotonic, sched_nonmonotonic;
bool simd, threads, depend_source, order_concurrent;
enum gfc_omp_memorder memorder;
enum gfc_omp_cancel_kind cancel;
enum gfc_omp_proc_bind_kind proc_bind;
struct gfc_expr *safelen_expr;

View File

@ -2766,15 +2766,44 @@ match
gfc_match_omp_flush (void)
{
gfc_omp_namelist *list = NULL;
gfc_omp_clauses *c = NULL;
gfc_gobble_whitespace ();
enum gfc_omp_memorder mo = OMP_MEMORDER_LAST;
if (gfc_match_omp_eos () == MATCH_NO && gfc_peek_ascii_char () != '(')
{
if (gfc_match ("acq_rel") == MATCH_YES)
mo = OMP_MEMORDER_ACQ_REL;
else if (gfc_match ("release") == MATCH_YES)
mo = OMP_MEMORDER_RELEASE;
else if (gfc_match ("acquire") == MATCH_YES)
mo = OMP_MEMORDER_ACQUIRE;
else
{
gfc_error ("Expected AQC_REL, RELEASE, or ACQUIRE at %C");
return MATCH_ERROR;
}
c = gfc_get_omp_clauses ();
c->memorder = mo;
}
gfc_match_omp_variable_list (" (", &list, true);
if (list && mo != OMP_MEMORDER_LAST)
{
gfc_error ("List specified together with memory order clause in FLUSH "
"directive at %C");
gfc_free_omp_namelist (list);
gfc_free_omp_clauses (c);
return MATCH_ERROR;
}
if (gfc_match_omp_eos () != MATCH_YES)
{
gfc_error ("Unexpected junk after $OMP FLUSH statement at %C");
gfc_free_omp_namelist (list);
gfc_free_omp_clauses (c);
return MATCH_ERROR;
}
new_st.op = EXEC_OMP_FLUSH;
new_st.ext.omp_namelist = list;
new_st.ext.omp_clauses = c;
return MATCH_YES;
}

View File

@ -38,6 +38,8 @@ along with GCC; see the file COPYING3. If not see
#include "gomp-constants.h"
#include "omp-general.h"
#include "omp-low.h"
#include "memmodel.h" /* For MEMMODEL_ enums. */
#undef GCC_DIAG_STYLE
#define GCC_DIAG_STYLE __gcc_tdiag__
#include "diagnostic-core.h"
@ -4785,10 +4787,30 @@ gfc_trans_oacc_combined_directive (gfc_code *code)
}
static tree
gfc_trans_omp_flush (void)
gfc_trans_omp_flush (gfc_code *code)
{
tree decl = builtin_decl_explicit (BUILT_IN_SYNC_SYNCHRONIZE);
return build_call_expr_loc (input_location, decl, 0);
tree call;
if (!code->ext.omp_clauses
|| code->ext.omp_clauses->memorder == OMP_MEMORDER_LAST)
{
call = builtin_decl_explicit (BUILT_IN_SYNC_SYNCHRONIZE);
call = build_call_expr_loc (input_location, call, 0);
}
else
{
enum memmodel mo = MEMMODEL_LAST;
switch (code->ext.omp_clauses->memorder)
{
case OMP_MEMORDER_ACQ_REL: mo = MEMMODEL_ACQ_REL; break;
case OMP_MEMORDER_RELEASE: mo = MEMMODEL_RELEASE; break;
case OMP_MEMORDER_ACQUIRE: mo = MEMMODEL_ACQUIRE; break;
default: gcc_unreachable (); break;
}
call = builtin_decl_explicit (BUILT_IN_ATOMIC_THREAD_FENCE);
call = build_call_expr_loc (input_location, call, 1,
build_int_cst (integer_type_node, mo));
}
return call;
}
static tree
@ -6033,7 +6055,7 @@ gfc_trans_omp_directive (gfc_code *code)
case EXEC_OMP_DO_SIMD:
return gfc_trans_omp_do_simd (code, NULL, NULL, NULL_TREE);
case EXEC_OMP_FLUSH:
return gfc_trans_omp_flush ();
return gfc_trans_omp_flush (code);
case EXEC_OMP_MASTER:
return gfc_trans_omp_master (code);
case EXEC_OMP_ORDERED:

View File

@ -0,0 +1,41 @@
! { dg-additional-options "-fdump-tree-gimple" }
! { dg-final { scan-tree-dump "foo \\(4\\);\[\n\r]* __atomic_thread_fence \\(4\\);\[\n\r]* foo \\(4\\);" "gimple" } }
! { dg-final { scan-tree-dump "foo \\(3\\);\[\n\r]* __atomic_thread_fence \\(3\\);\[\n\r]* foo \\(3\\);" "gimple" } }
! { dg-final { scan-tree-dump "foo \\(2\\);\[\n\r]* __atomic_thread_fence \\(2\\);\[\n\r]* foo \\(2\\);" "gimple" } }
! { dg-final { scan-tree-dump "foo \\(5\\);\[\n\r]* __sync_synchronize \\(\\);\[\n\r]* foo \\(5\\);" "gimple" } }
module m
interface
subroutine foo(x)
integer, value :: x
end
end interface
end module m
subroutine f1
use m
call foo (4)
!$omp flush acq_rel
call foo (4)
end
subroutine f2
use m
call foo (3)
!$omp flush release
call foo (3)
end
subroutine f3
use m
call foo (2)
!$omp flush acquire
call foo (2)
end
subroutine f4
use m
call foo (5)
!$omp flush
call foo (5)
end

View File

@ -0,0 +1,18 @@
module m
integer :: a, b
end module m
subroutine foo (void)
use m
!$omp flush
!$omp flush (a, b)
!$omp flush acquire
!$omp flush release
!$omp flush acq_rel
!$omp flush relaxed ! { dg-error "Expected AQC_REL, RELEASE, or ACQUIRE" }
!$omp flush seq_cst ! { dg-error "Expected AQC_REL, RELEASE, or ACQUIRE" }
!$omp flush foobar ! { dg-error "Expected AQC_REL, RELEASE, or ACQUIRE" }
!$omp flush acquire (a, b) ! { dg-error "List specified together with memory order clause in FLUSH directive" }
!$omp flush release (a, b) ! { dg-error "List specified together with memory order clause in FLUSH directive" }
!$omp flush acq_rel (a, b) ! { dg-error "List specified together with memory order clause in FLUSH directive" }
end