From a61c4964cd71446232d62ec9b10a7d45b440dd9f Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Wed, 21 Apr 2021 10:58:29 +0200 Subject: Fortran/OpenMP: Add 'omp depobj' and 'depend(mutexinoutset:' gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_namelist): Handle depobj + mutexinoutset in the depend clause. (show_omp_clauses, show_omp_node, show_code_node): Handle depobj. * gfortran.h (enum gfc_statement): Add ST_OMP_DEPOBJ. (enum gfc_omp_depend_op): Add OMP_DEPEND_UNSET, OMP_DEPEND_MUTEXINOUTSET and OMP_DEPEND_DEPOBJ. (gfc_omp_clauses): Add destroy, depobj_update and depobj. (enum gfc_exec_op): Add EXEC_OMP_DEPOBJ * match.h (gfc_match_omp_depobj): Match 'omp depobj'. * openmp.c (gfc_match_omp_clauses): Add depobj + mutexinoutset to depend clause. (gfc_match_omp_depobj, resolve_omp_clauses, gfc_resolve_omp_directive): Handle 'omp depobj'. * parse.c (decode_omp_directive, next_statement, gfc_ascii_statement): Likewise. * resolve.c (gfc_resolve_code): Likewise. * st.c (gfc_free_statement): Likewise. * trans-openmp.c (gfc_trans_omp_clauses): Handle depobj + mutexinoutset in the depend clause. (gfc_trans_omp_depobj, gfc_trans_omp_directive): Handle EXEC_OMP_DEPOBJ. * trans.c (trans_code): Likewise. libgomp/ChangeLog: * testsuite/libgomp.fortran/depobj-1.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/depobj-1.f90: New test. * gfortran.dg/gomp/depobj-2.f90: New test. --- gcc/fortran/trans-openmp.c | 68 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 68 insertions(+) (limited to 'gcc/fortran/trans-openmp.c') diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 349df1c..bf3f261 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -2545,6 +2545,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, tree decl = gfc_trans_omp_variable (n->sym, false); if (gfc_omp_privatize_by_reference (decl)) decl = build_fold_indirect_ref (decl); + if (n->u.depend_op == OMP_DEPEND_DEPOBJ + && POINTER_TYPE_P (TREE_TYPE (decl))) + decl = build_fold_indirect_ref (decl); if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))) { decl = gfc_conv_descriptor_data_get (decl); @@ -2587,6 +2590,13 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, case OMP_DEPEND_INOUT: OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_INOUT; break; + case OMP_DEPEND_MUTEXINOUTSET: + OMP_CLAUSE_DEPEND_KIND (node) + = OMP_CLAUSE_DEPEND_MUTEXINOUTSET; + break; + case OMP_DEPEND_DEPOBJ: + OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_DEPOBJ; + break; default: gcc_unreachable (); } @@ -4913,6 +4923,62 @@ gfc_trans_oacc_combined_directive (gfc_code *code) } static tree +gfc_trans_omp_depobj (gfc_code *code) +{ + stmtblock_t block; + gfc_se se; + gfc_init_se (&se, NULL); + gfc_init_block (&block); + gfc_conv_expr (&se, code->ext.omp_clauses->depobj); + gcc_assert (se.pre.head == NULL && se.post.head == NULL); + tree depobj = se.expr; + location_t loc = EXPR_LOCATION (depobj); + if (!POINTER_TYPE_P (TREE_TYPE (depobj))) + depobj = gfc_build_addr_expr (NULL, depobj); + depobj = fold_convert (build_pointer_type_for_mode (ptr_type_node, + TYPE_MODE (ptr_type_node), + true), depobj); + gfc_omp_namelist *n = code->ext.omp_clauses->lists[OMP_LIST_DEPEND]; + if (n) + { + tree var; + if (n->expr) + var = gfc_convert_expr_to_tree (&block, n->expr); + else + var = gfc_get_symbol_decl (n->sym); + if (!POINTER_TYPE_P (TREE_TYPE (var))) + var = gfc_build_addr_expr (NULL, var); + depobj = save_expr (depobj); + tree r = build_fold_indirect_ref_loc (loc, depobj); + gfc_add_expr_to_block (&block, + build2 (MODIFY_EXPR, void_type_node, r, var)); + } + + /* Only one may be set. */ + gcc_assert (((int)(n != NULL) + (int)(code->ext.omp_clauses->destroy) + + (int)(code->ext.omp_clauses->depobj_update != OMP_DEPEND_UNSET)) + == 1); + int k = -1; /* omp_clauses->destroy */ + if (!code->ext.omp_clauses->destroy) + switch (code->ext.omp_clauses->depobj_update != OMP_DEPEND_UNSET + ? code->ext.omp_clauses->depobj_update : n->u.depend_op) + { + case OMP_DEPEND_IN: k = GOMP_DEPEND_IN; break; + case OMP_DEPEND_OUT: k = GOMP_DEPEND_IN; break; + case OMP_DEPEND_INOUT: k = GOMP_DEPEND_IN; break; + case OMP_DEPEND_MUTEXINOUTSET: k = GOMP_DEPEND_MUTEXINOUTSET; break; + default: gcc_unreachable (); + } + tree t = build_int_cst (ptr_type_node, k); + depobj = build2_loc (loc, POINTER_PLUS_EXPR, TREE_TYPE (depobj), depobj, + TYPE_SIZE_UNIT (ptr_type_node)); + depobj = build_fold_indirect_ref_loc (loc, depobj); + gfc_add_expr_to_block (&block, build2 (MODIFY_EXPR, void_type_node, depobj, t)); + + return gfc_finish_block (&block); +} + +static tree gfc_trans_omp_flush (gfc_code *code) { tree call; @@ -6181,6 +6247,8 @@ gfc_trans_omp_directive (gfc_code *code) return gfc_trans_omp_cancellation_point (code); case EXEC_OMP_CRITICAL: return gfc_trans_omp_critical (code); + case EXEC_OMP_DEPOBJ: + return gfc_trans_omp_depobj (code); case EXEC_OMP_DISTRIBUTE: case EXEC_OMP_DO: case EXEC_OMP_SIMD: -- cgit v1.1 From 08fff201c92109b5476a4cc211c71de557ec87b1 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Tue, 4 May 2021 09:22:36 +0200 Subject: OpenMP/Fortran - fix pasto + testcase in depobj [PR100397] gcc/fortran/ChangeLog: PR testsuite/100397 * trans-openmp.c (gfc_trans_omp_depobj): Fix pasto in enum values. libgomp/ChangeLog: PR testsuite/100397 * testsuite/libgomp.fortran/depobj-1.f90 (dep2, dep3): Move var declaration to scope of non-'depend'-guarded assignment to avoid races. --- gcc/fortran/trans-openmp.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/trans-openmp.c') diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index bf3f261..aa3a82e 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -4964,8 +4964,8 @@ gfc_trans_omp_depobj (gfc_code *code) ? code->ext.omp_clauses->depobj_update : n->u.depend_op) { case OMP_DEPEND_IN: k = GOMP_DEPEND_IN; break; - case OMP_DEPEND_OUT: k = GOMP_DEPEND_IN; break; - case OMP_DEPEND_INOUT: k = GOMP_DEPEND_IN; break; + case OMP_DEPEND_OUT: k = GOMP_DEPEND_OUT; break; + case OMP_DEPEND_INOUT: k = GOMP_DEPEND_INOUT; break; case OMP_DEPEND_MUTEXINOUTSET: k = GOMP_DEPEND_MUTEXINOUTSET; break; default: gcc_unreachable (); } -- cgit v1.1 From 0e3702f8daeec5897982d185650b78a5c1c53c25 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 14 May 2021 19:21:47 +0200 Subject: Fortran/OpenMP: Support 'omp parallel master' gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_node, show_code_node): Handle EXEC_OMP_PARALLEL_MASTER. * frontend-passes.c (gfc_code_walker): Likewise. * gfortran.h (enum gfc_statement): Add ST_OMP_PARALLEL_MASTER and ST_OMP_END_PARALLEL_MASTER. (enum gfc_exec_op): Add EXEC_OMP_PARALLEL_MASTER.. * match.h (gfc_match_omp_parallel_master): Handle it. * openmp.c (gfc_match_omp_parallel_master, resolve_omp_clauses, omp_code_to_statement, gfc_resolve_omp_directive): Likewise. * parse.c (decode_omp_directive, case_exec_markers, gfc_ascii_statement, parse_omp_structured_block, parse_executable): Likewise. * resolve.c (gfc_resolve_blocks, gfc_resolve_code): Likewise. * st.c (gfc_free_statement): Likewise. * trans-openmp.c (gfc_trans_omp_parallel_master, gfc_trans_omp_workshare, gfc_trans_omp_directive): Likewise. * trans.c (trans_code): Likewise. libgomp/ChangeLog: * testsuite/libgomp.fortran/parallel-master.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/parallel-master-1.f90: New test. * gfortran.dg/gomp/parallel-master-2.f90: New test. --- gcc/fortran/trans-openmp.c | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) (limited to 'gcc/fortran/trans-openmp.c') diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index aa3a82e..5666cd6 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -5554,6 +5554,28 @@ gfc_trans_omp_parallel_do_simd (gfc_code *code, stmtblock_t *pblock, } static tree +gfc_trans_omp_parallel_master (gfc_code *code) +{ + stmtblock_t block; + tree stmt, omp_clauses; + + gfc_start_block (&block); + omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses, + code->loc); + pushlevel (); + stmt = gfc_trans_omp_master (code); + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + else + poplevel (0, 0); + stmt = build2_loc (gfc_get_location (&code->loc), OMP_PARALLEL, + void_type_node, stmt, omp_clauses); + OMP_PARALLEL_COMBINED (stmt) = 1; + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree gfc_trans_omp_parallel_sections (gfc_code *code) { stmtblock_t block; @@ -6092,6 +6114,7 @@ gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses) case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_MASTER: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_CRITICAL: @@ -6273,6 +6296,8 @@ gfc_trans_omp_directive (gfc_code *code) return gfc_trans_omp_parallel_do (code, NULL, NULL); case EXEC_OMP_PARALLEL_DO_SIMD: return gfc_trans_omp_parallel_do_simd (code, NULL, NULL); + case EXEC_OMP_PARALLEL_MASTER: + return gfc_trans_omp_parallel_master (code); case EXEC_OMP_PARALLEL_SECTIONS: return gfc_trans_omp_parallel_sections (code); case EXEC_OMP_PARALLEL_WORKSHARE: -- cgit v1.1 From 0e3b3b77e13cac764a135a7118613c47686e0a62 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Mon, 24 May 2021 16:50:51 +0200 Subject: OpenMP/Fortran: Handle polymorphic scalars in data-sharing FIRSTPRIVATE [PR86470] gcc/fortran/ChangeLog: PR fortran/86470 * trans-expr.c (gfc_copy_class_to_class): Add unshare_expr. * trans-openmp.c (gfc_is_polymorphic_nonptr, gfc_is_unlimited_polymorphic_nonptr): New. (gfc_omp_clause_copy_ctor, gfc_omp_clause_dtor): Handle polymorphic scalars. libgomp/ChangeLog: PR fortran/86470 * testsuite/libgomp.fortran/class-firstprivate-1.f90: New test. * testsuite/libgomp.fortran/class-firstprivate-2.f90: New test. * testsuite/libgomp.fortran/class-firstprivate-3.f90: New test. gcc/testsuite/ChangeLog: PR fortran/86470 * gfortran.dg/gomp/class-firstprivate-1.f90: New test. * gfortran.dg/gomp/class-firstprivate-2.f90: New test. * gfortran.dg/gomp/class-firstprivate-3.f90: New test. * gfortran.dg/gomp/class-firstprivate-4.f90: New test. --- gcc/fortran/trans-openmp.c | 162 ++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 161 insertions(+), 1 deletion(-) (limited to 'gcc/fortran/trans-openmp.c') diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 5666cd6..44542d9 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -360,6 +360,39 @@ gfc_has_alloc_comps (tree type, tree decl) return false; } +/* Return true if TYPE is polymorphic but not with pointer attribute. */ + +static bool +gfc_is_polymorphic_nonptr (tree type) +{ + if (POINTER_TYPE_P (type)) + type = TREE_TYPE (type); + return GFC_CLASS_TYPE_P (type); +} + +/* Return true if TYPE is unlimited polymorphic but not with pointer attribute; + unlimited means also intrinsic types are handled and _len is used. */ + +static bool +gfc_is_unlimited_polymorphic_nonptr (tree type) +{ + if (POINTER_TYPE_P (type)) + type = TREE_TYPE (type); + if (!GFC_CLASS_TYPE_P (type)) + return false; + + tree field = TYPE_FIELDS (type); /* _data */ + gcc_assert (field); + field = DECL_CHAIN (field); /* _vptr */ + gcc_assert (field); + field = DECL_CHAIN (field); + if (!field) + return false; + gcc_assert (strcmp ("_len", IDENTIFIER_POINTER (DECL_NAME (field))) == 0); + return true; +} + + /* Return true if DECL in private clause needs OMP_CLAUSE_PRIVATE_OUTER_REF on the private clause. */ bool @@ -743,12 +776,88 @@ tree gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src) { tree type = TREE_TYPE (dest), ptr, size, call; + tree decl_type = TREE_TYPE (OMP_CLAUSE_DECL (clause)); tree cond, then_b, else_b; stmtblock_t block, cond_block; gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_FIRSTPRIVATE || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR); + if (DECL_ARTIFICIAL (OMP_CLAUSE_DECL (clause)) + && DECL_LANG_SPECIFIC (OMP_CLAUSE_DECL (clause)) + && GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause))) + decl_type + = TREE_TYPE (GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause))); + + if (gfc_is_polymorphic_nonptr (decl_type)) + { + if (POINTER_TYPE_P (decl_type)) + decl_type = TREE_TYPE (decl_type); + decl_type = TREE_TYPE (TYPE_FIELDS (decl_type)); + if (GFC_DESCRIPTOR_TYPE_P (decl_type) || GFC_ARRAY_TYPE_P (decl_type)) + fatal_error (input_location, + "Sorry, polymorphic arrays not yet supported for " + "firstprivate"); + tree src_len; + tree nelems = build_int_cst (size_type_node, 1); /* Scalar. */ + tree src_data = gfc_class_data_get (unshare_expr (src)); + tree dest_data = gfc_class_data_get (unshare_expr (dest)); + bool unlimited = gfc_is_unlimited_polymorphic_nonptr (type); + + gfc_start_block (&block); + gfc_add_modify (&block, gfc_class_vptr_get (dest), + gfc_class_vptr_get (src)); + gfc_init_block (&cond_block); + + if (unlimited) + { + src_len = gfc_class_len_get (src); + gfc_add_modify (&cond_block, gfc_class_len_get (unshare_expr (dest)), src_len); + } + + /* Use: size = class._vtab._size * (class._len > 0 ? class._len : 1). */ + size = fold_convert (size_type_node, gfc_class_vtab_size_get (src)); + if (unlimited) + { + cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, + unshare_expr (src_len), + build_zero_cst (TREE_TYPE (src_len))); + cond = build3_loc (input_location, COND_EXPR, size_type_node, cond, + fold_convert (size_type_node, + unshare_expr (src_len)), + build_int_cst (size_type_node, 1)); + size = fold_build2_loc (input_location, MULT_EXPR, size_type_node, + size, cond); + } + + /* Malloc memory + call class->_vpt->_copy. */ + call = builtin_decl_explicit (BUILT_IN_MALLOC); + call = build_call_expr_loc (input_location, call, 1, size); + gfc_add_modify (&cond_block, dest_data, + fold_convert (TREE_TYPE (dest_data), call)); + gfc_add_expr_to_block (&cond_block, + gfc_copy_class_to_class (src, dest, nelems, + unlimited)); + + gcc_assert (TREE_CODE (dest_data) == COMPONENT_REF); + if (!GFC_DECL_GET_SCALAR_ALLOCATABLE (TREE_OPERAND (dest_data, 1))) + { + gfc_add_block_to_block (&block, &cond_block); + } + else + { + /* Create: if (class._data != 0) else class._data = NULL; */ + cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + src_data, null_pointer_node); + gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR, + void_type_node, cond, + gfc_finish_block (&cond_block), + fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, + unshare_expr (dest_data), null_pointer_node))); + } + return gfc_finish_block (&block); + } + if ((! GFC_DESCRIPTOR_TYPE_P (type) || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE) && (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause)) @@ -773,7 +882,7 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src) gfc_init_block (&cond_block); - gfc_add_modify (&cond_block, dest, src); + gfc_add_modify (&cond_block, dest, fold_convert (TREE_TYPE (dest), src)); if (GFC_DESCRIPTOR_TYPE_P (type)) { tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; @@ -1185,6 +1294,57 @@ tree gfc_omp_clause_dtor (tree clause, tree decl) { tree type = TREE_TYPE (decl), tem; + tree decl_type = TREE_TYPE (OMP_CLAUSE_DECL (clause)); + + if (DECL_ARTIFICIAL (OMP_CLAUSE_DECL (clause)) + && DECL_LANG_SPECIFIC (OMP_CLAUSE_DECL (clause)) + && GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause))) + decl_type + = TREE_TYPE (GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause))); + if (gfc_is_polymorphic_nonptr (decl_type)) + { + if (POINTER_TYPE_P (decl_type)) + decl_type = TREE_TYPE (decl_type); + decl_type = TREE_TYPE (TYPE_FIELDS (decl_type)); + if (GFC_DESCRIPTOR_TYPE_P (decl_type) || GFC_ARRAY_TYPE_P (decl_type)) + fatal_error (input_location, + "Sorry, polymorphic arrays not yet supported for " + "firstprivate"); + stmtblock_t block, cond_block; + gfc_start_block (&block); + gfc_init_block (&cond_block); + tree final = gfc_class_vtab_final_get (decl); + tree size = fold_convert (size_type_node, gfc_class_vtab_size_get (decl)); + gfc_se se; + gfc_init_se (&se, NULL); + symbol_attribute attr = {}; + tree data = gfc_class_data_get (decl); + tree desc = gfc_conv_scalar_to_descriptor (&se, data, attr); + + /* Call class->_vpt->_finalize + free. */ + tree call = build_fold_indirect_ref (final); + call = build_call_expr_loc (input_location, call, 3, + gfc_build_addr_expr (NULL, desc), + size, boolean_false_node); + gfc_add_block_to_block (&cond_block, &se.pre); + gfc_add_expr_to_block (&cond_block, fold_convert (void_type_node, call)); + gfc_add_block_to_block (&cond_block, &se.post); + /* Create: if (_vtab && _final) */ + tree cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + gfc_class_vptr_get (decl), + null_pointer_node); + tree cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + final, null_pointer_node); + cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR, + boolean_type_node, cond, cond2); + gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR, + void_type_node, cond, + gfc_finish_block (&cond_block), NULL_TREE)); + call = builtin_decl_explicit (BUILT_IN_FREE); + call = build_call_expr_loc (input_location, call, 1, data); + gfc_add_expr_to_block (&block, fold_convert (void_type_node, call)); + return gfc_finish_block (&block); + } if ((! GFC_DESCRIPTOR_TYPE_P (type) || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE) -- cgit v1.1 From 9a5de4d5af1c10a8c097de30ee4c71457216e975 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 28 May 2021 10:01:19 +0200 Subject: OpenMP: Add iterator support to Fortran's depend; add affinity clause gcc/c-family/ChangeLog: * c-pragma.h (enum pragma_omp_clause): Add PRAGMA_OMP_CLAUSE_AFFINITY. gcc/c/ChangeLog: * c-parser.c (c_parser_omp_clause_affinity): New. (c_parser_omp_clause_name, c_parser_omp_variable_list, c_parser_omp_all_clauses, OMP_TASK_CLAUSE_MASK): Handle affinity clause. * c-typeck.c (handle_omp_array_sections_1, handle_omp_array_sections, c_finish_omp_clauses): Likewise. gcc/cp/ChangeLog: * parser.c (cp_parser_omp_clause_affinity): New. (cp_parser_omp_clause_name, cp_parser_omp_var_list_no_open, cp_parser_omp_all_clauses, OMP_TASK_CLAUSE_MASK): Handle affinity clause. * semantics.c (handle_omp_array_sections_1, handle_omp_array_sections, finish_omp_clauses): Likewise. gcc/fortran/ChangeLog: * dump-parse-tree.c (show_iterator): New. (show_omp_namelist): Handle iterators. (show_omp_clauses): Handle affinity. * gfortran.h (gfc_free_omp_namelist): New union with 'udr' and new 'ns'. * match.c (gfc_free_omp_namelist): Add are to choose union element. * openmp.c (gfc_free_omp_clauses, gfc_match_omp_detach, gfc_match_omp_clause_reduction, gfc_match_omp_flush): Update call to gfc_free_omp_namelist. (gfc_match_omp_variable_list): Likewise; permit preceeding whitespace. (enum omp_mask1): Add OMP_CLAUSE_AFFINITY. (gfc_match_iterator): New. (gfc_match_omp_clauses): Use it; update call to gfc_free_omp_namelist. (OMP_TASK_CLAUSES): Add OMP_CLAUSE_AFFINITY. (gfc_match_omp_taskwait): Match depend clause. (resolve_omp_clauses): Handle affinity; update for udr/union change. (gfc_resolve_omp_directive): Resolve clauses of taskwait. * st.c (gfc_free_statement): Update gfc_free_omp_namelist call. * trans-openmp.c (gfc_trans_omp_array_reduction_or_udr): Likewise (handle_iterator): New. (gfc_trans_omp_clauses): Handle iterators for depend/affinity clause. (gfc_trans_omp_taskwait): Handle depend clause. (gfc_trans_omp_directive): Update call. gcc/ChangeLog: * gimplify.c (gimplify_omp_affinity): New. (gimplify_scan_omp_clauses): Call it; remove affinity clause afterwards. * tree-core.h (enum omp_clause_code): Add OMP_CLAUSE_AFFINITY. * tree-pretty-print.c (dump_omp_clause): Handle OMP_CLAUSE_AFFINITY. * tree.c (omp_clause_num_ops, omp_clause_code_name): Add clause. (walk_tree_1): Handle OMP_CLAUSE_AFFINITY. libgomp/ChangeLog: * testsuite/libgomp.fortran/depend-iterator-2.f90: New test. gcc/testsuite/ChangeLog: * c-c++-common/gomp/affinity-1.c: New test. * c-c++-common/gomp/affinity-2.c: New test. * c-c++-common/gomp/affinity-3.c: New test. * c-c++-common/gomp/affinity-4.c: New test. * c-c++-common/gomp/affinity-5.c: New test. * c-c++-common/gomp/affinity-6.c: New test. * c-c++-common/gomp/affinity-7.c: New test. * gfortran.dg/gomp/affinity-clause-1.f90: New test. * gfortran.dg/gomp/affinity-clause-2.f90: New test. * gfortran.dg/gomp/affinity-clause-3.f90: New test. * gfortran.dg/gomp/affinity-clause-4.f90: New test. * gfortran.dg/gomp/affinity-clause-5.f90: New test. * gfortran.dg/gomp/affinity-clause-6.f90: New test. * gfortran.dg/gomp/depend-iterator-1.f90: New test. * gfortran.dg/gomp/depend-iterator-2.f90: New test. * gfortran.dg/gomp/depend-iterator-3.f90: New test. * gfortran.dg/gomp/taskwait.f90: New test. --- gcc/fortran/trans-openmp.c | 198 ++++++++++++++++++++++++++++++++++++--------- 1 file changed, 159 insertions(+), 39 deletions(-) (limited to 'gcc/fortran/trans-openmp.c') diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 44542d9..7ea7aa3 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -35,6 +35,7 @@ along with GCC; see the file COPYING3. If not see #include "trans-array.h" #include "trans-const.h" #include "arith.h" +#include "constructor.h" #include "gomp-constants.h" #include "omp-general.h" #include "omp-low.h" @@ -1910,7 +1911,7 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where) locus old_loc = gfc_current_locus; const char *iname; bool t; - gfc_omp_udr *udr = n->udr ? n->udr->udr : NULL; + gfc_omp_udr *udr = n->u2.udr ? n->u2.udr->udr : NULL; decl = OMP_CLAUSE_DECL (c); gfc_current_locus = where; @@ -2029,9 +2030,9 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where) t = gfc_resolve_expr (e2); gcc_assert (t); } - else if (n->udr->initializer->op == EXEC_ASSIGN) + else if (n->u2.udr->initializer->op == EXEC_ASSIGN) { - e2 = gfc_copy_expr (n->udr->initializer->expr2); + e2 = gfc_copy_expr (n->u2.udr->initializer->expr2); t = gfc_resolve_expr (e2); gcc_assert (t); } @@ -2040,7 +2041,7 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where) struct omp_udr_find_orig_data cd; cd.omp_udr = udr; cd.omp_orig_seen = false; - gfc_code_walker (&n->udr->initializer, + gfc_code_walker (&n->u2.udr->initializer, gfc_dummy_code_callback, omp_udr_find_orig, &cd); if (cd.omp_orig_seen) OMP_CLAUSE_REDUCTION_OMP_ORIG_REF (c) = 1; @@ -2090,11 +2091,11 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where) iname = "ieor"; break; case ERROR_MARK: - if (n->udr->combiner->op == EXEC_ASSIGN) + if (n->u2.udr->combiner->op == EXEC_ASSIGN) { gfc_free_expr (e3); - e3 = gfc_copy_expr (n->udr->combiner->expr1); - e4 = gfc_copy_expr (n->udr->combiner->expr2); + e3 = gfc_copy_expr (n->u2.udr->combiner->expr1); + e4 = gfc_copy_expr (n->u2.udr->combiner->expr2); t = gfc_resolve_expr (e3); gcc_assert (t); t = gfc_resolve_expr (e4); @@ -2144,7 +2145,7 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where) if (e2) stmt = gfc_trans_assignment (e1, e2, false, false); else - stmt = gfc_trans_call (n->udr->initializer, false, + stmt = gfc_trans_call (n->u2.udr->initializer, false, NULL_TREE, NULL_TREE, false); if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); @@ -2157,7 +2158,7 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where) if (e4) stmt = gfc_trans_assignment (e3, e4, false, true); else - stmt = gfc_trans_call (n->udr->combiner, false, + stmt = gfc_trans_call (n->u2.udr->combiner, false, NULL_TREE, NULL_TREE, false); if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); @@ -2433,13 +2434,76 @@ gfc_trans_omp_array_section (stmtblock_t *block, gfc_omp_namelist *n, } static tree +handle_iterator (gfc_namespace *ns, stmtblock_t *iter_block, tree block) +{ + tree list = NULL_TREE; + for (gfc_symbol *sym = ns->proc_name; sym; sym = sym->tlink) + { + gfc_constructor *c; + gfc_se se; + + tree last = make_tree_vec (6); + tree iter_var = gfc_get_symbol_decl (sym); + tree type = TREE_TYPE (iter_var); + TREE_VEC_ELT (last, 0) = iter_var; + DECL_CHAIN (iter_var) = BLOCK_VARS (block); + BLOCK_VARS (block) = iter_var; + + /* begin */ + c = gfc_constructor_first (sym->value->value.constructor); + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, c->expr); + gfc_add_block_to_block (iter_block, &se.pre); + gfc_add_block_to_block (iter_block, &se.post); + TREE_VEC_ELT (last, 1) = fold_convert (type, + gfc_evaluate_now (se.expr, + iter_block)); + /* end */ + c = gfc_constructor_next (c); + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, c->expr); + gfc_add_block_to_block (iter_block, &se.pre); + gfc_add_block_to_block (iter_block, &se.post); + TREE_VEC_ELT (last, 2) = fold_convert (type, + gfc_evaluate_now (se.expr, + iter_block)); + /* step */ + c = gfc_constructor_next (c); + tree step; + if (c) + { + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, c->expr); + gfc_add_block_to_block (iter_block, &se.pre); + gfc_add_block_to_block (iter_block, &se.post); + gfc_conv_expr (&se, c->expr); + step = fold_convert (type, + gfc_evaluate_now (se.expr, + iter_block)); + } + else + step = build_int_cst (type, 1); + TREE_VEC_ELT (last, 3) = step; + /* orig_step */ + TREE_VEC_ELT (last, 4) = save_expr (step); + TREE_CHAIN (last) = list; + list = last; + } + return list; +} + +static tree gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, locus where, bool declare_simd = false, bool openacc = false) { - tree omp_clauses = NULL_TREE, chunk_size, c; + tree omp_clauses = NULL_TREE, prev_clauses, chunk_size, c; + tree iterator = NULL_TREE; + tree tree_block = NULL_TREE; + stmtblock_t iter_block; int list, ifc; enum omp_clause_code clause_code; + gfc_omp_namelist *prev = NULL; gfc_se se; if (clauses == NULL) @@ -2642,10 +2706,38 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, } } break; + case OMP_LIST_AFFINITY: case OMP_LIST_DEPEND: + iterator = NULL_TREE; + prev = NULL; + prev_clauses = omp_clauses; for (; n != NULL; n = n->next) { - if (n->u.depend_op == OMP_DEPEND_SINK_FIRST) + if (iterator && prev->u2.ns != n->u2.ns) + { + BLOCK_SUBBLOCKS (tree_block) = gfc_finish_block (&iter_block); + TREE_VEC_ELT (iterator, 5) = tree_block; + for (tree c = omp_clauses; c != prev_clauses; + c = OMP_CLAUSE_CHAIN (c)) + OMP_CLAUSE_DECL (c) = build_tree_list (iterator, + OMP_CLAUSE_DECL (c)); + prev_clauses = omp_clauses; + iterator = NULL_TREE; + } + if (n->u2.ns && (!prev || prev->u2.ns != n->u2.ns)) + { + gfc_init_block (&iter_block); + tree_block = make_node (BLOCK); + TREE_USED (tree_block) = 1; + BLOCK_VARS (tree_block) = NULL_TREE; + iterator = handle_iterator (n->u2.ns, block, + tree_block); + } + if (!iterator) + gfc_init_block (&iter_block); + prev = n; + if (list == OMP_LIST_DEPEND + && n->u.depend_op == OMP_DEPEND_SINK_FIRST) { tree vec = NULL_TREE; unsigned int i; @@ -2699,7 +2791,10 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if (!n->sym->attr.referenced) continue; - tree node = build_omp_clause (input_location, OMP_CLAUSE_DEPEND); + tree node = build_omp_clause (input_location, + list == OMP_LIST_DEPEND + ? OMP_CLAUSE_DEPEND + : OMP_CLAUSE_AFFINITY); if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL) { tree decl = gfc_trans_omp_variable (n->sym, false); @@ -2733,35 +2828,47 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, gfc_conv_expr_descriptor (&se, n->expr); ptr = gfc_conv_array_data (se.expr); } - gfc_add_block_to_block (block, &se.pre); - gfc_add_block_to_block (block, &se.post); + gfc_add_block_to_block (&iter_block, &se.pre); + gfc_add_block_to_block (&iter_block, &se.post); ptr = fold_convert (build_pointer_type (char_type_node), ptr); OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr); } - switch (n->u.depend_op) - { - case OMP_DEPEND_IN: - OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_IN; - break; - case OMP_DEPEND_OUT: - OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_OUT; - break; - case OMP_DEPEND_INOUT: - OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_INOUT; - break; - case OMP_DEPEND_MUTEXINOUTSET: - OMP_CLAUSE_DEPEND_KIND (node) - = OMP_CLAUSE_DEPEND_MUTEXINOUTSET; - break; - case OMP_DEPEND_DEPOBJ: - OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_DEPOBJ; - break; - default: - gcc_unreachable (); - } + if (list == OMP_LIST_DEPEND) + switch (n->u.depend_op) + { + case OMP_DEPEND_IN: + OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_IN; + break; + case OMP_DEPEND_OUT: + OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_OUT; + break; + case OMP_DEPEND_INOUT: + OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_INOUT; + break; + case OMP_DEPEND_MUTEXINOUTSET: + OMP_CLAUSE_DEPEND_KIND (node) + = OMP_CLAUSE_DEPEND_MUTEXINOUTSET; + break; + case OMP_DEPEND_DEPOBJ: + OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_DEPOBJ; + break; + default: + gcc_unreachable (); + } + if (!iterator) + gfc_add_block_to_block (block, &iter_block); omp_clauses = gfc_trans_add_clause (node, omp_clauses); } + if (iterator) + { + BLOCK_SUBBLOCKS (tree_block) = gfc_finish_block (&iter_block); + TREE_VEC_ELT (iterator, 5) = tree_block; + for (tree c = omp_clauses; c != prev_clauses; + c = OMP_CLAUSE_CHAIN (c)) + OMP_CLAUSE_DECL (c) = build_tree_list (iterator, + OMP_CLAUSE_DECL (c)); + } break; case OMP_LIST_MAP: for (; n != NULL; n = n->next) @@ -5857,10 +5964,23 @@ gfc_trans_omp_taskgroup (gfc_code *code) } static tree -gfc_trans_omp_taskwait (void) +gfc_trans_omp_taskwait (gfc_code *code) { - tree decl = builtin_decl_explicit (BUILT_IN_GOMP_TASKWAIT); - return build_call_expr_loc (input_location, decl, 0); + if (!code->ext.omp_clauses) + { + tree decl = builtin_decl_explicit (BUILT_IN_GOMP_TASKWAIT); + return build_call_expr_loc (input_location, decl, 0); + } + stmtblock_t block; + gfc_start_block (&block); + tree stmt = make_node (OMP_TASK); + TREE_TYPE (stmt) = void_type_node; + OMP_TASK_BODY (stmt) = NULL_TREE; + OMP_TASK_CLAUSES (stmt) = gfc_trans_omp_clauses (&block, + code->ext.omp_clauses, + code->loc); + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); } static tree @@ -6492,7 +6612,7 @@ gfc_trans_omp_directive (gfc_code *code) case EXEC_OMP_TASKLOOP_SIMD: return gfc_trans_omp_taskloop (code); case EXEC_OMP_TASKWAIT: - return gfc_trans_omp_taskwait (); + return gfc_trans_omp_taskwait (code); case EXEC_OMP_TASKYIELD: return gfc_trans_omp_taskyield (); case EXEC_OMP_TEAMS: -- cgit v1.1 From f6bf436d9ab907d090823895abb7a2d5ba7ff50c Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Tue, 1 Jun 2021 12:46:37 +0200 Subject: Fortran/OpenMP: Support (parallel) master taskloop (simd) [PR99928] PR middle-end/99928 gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_node, show_code_node): Handle (parallel) master taskloop (simd). * frontend-passes.c (gfc_code_walker): Set in_omp_workshare to false for parallel master taskloop (simd). * gfortran.h (enum gfc_statement): Add ST_OMP_(END_)(PARALLEL_)MASTER_TASKLOOP(_SIMD). (enum gfc_exec_op): EXEC_OMP_(PARALLEL_)MASTER_TASKLOOP(_SIMD). * match.h (gfc_match_omp_master_taskloop, gfc_match_omp_master_taskloop_simd, gfc_match_omp_parallel_master_taskloop, gfc_match_omp_parallel_master_taskloop_simd): New prototype. * openmp.c (gfc_match_omp_parallel_master_taskloop, gfc_match_omp_parallel_master_taskloop_simd, gfc_match_omp_master_taskloop, gfc_match_omp_master_taskloop_simd): New. (gfc_match_omp_taskloop_simd): Permit 'reduction' clause. (resolve_omp_clauses): Handle new combined directives; remove inscan-reduction check to reduce multiple errors; add task-reduction error for 'taskloop simd'. (gfc_resolve_omp_parallel_blocks, resolve_omp_do, omp_code_to_statement, gfc_resolve_omp_directive): Handle new combined constructs. * parse.c (decode_omp_directive, next_statement, gfc_ascii_statement, parse_omp_do, parse_omp_structured_block, parse_executable): Likewise. * resolve.c (gfc_resolve_blocks, gfc_resolve_code): Likewise. * st.c (gfc_free_statement): Likewise. * trans.c (trans_code): Likewise. * trans-openmp.c (gfc_split_omp_clauses, gfc_trans_omp_directive): Likewise. (gfc_trans_omp_parallel_master): Move after gfc_trans_omp_master_taskloop; handle parallel master taskloop (simd) as well. (gfc_trans_omp_taskloop): Take gfc_exec_op as arg. (gfc_trans_omp_master_taskloop): New. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/reduction5.f90: Remove dg-error; the issue is now diagnosed with less error output. * gfortran.dg/gomp/scan-1.f90: Likewise. * gfortran.dg/gomp/pr99928-3.f90: New test. * gfortran.dg/gomp/taskloop-1.f90: New test. --- gcc/fortran/trans-openmp.c | 112 +++++++++++++++++++++++++++++++++++---------- 1 file changed, 87 insertions(+), 25 deletions(-) (limited to 'gcc/fortran/trans-openmp.c') diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 7ea7aa3..2917d3d 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -5380,6 +5380,14 @@ gfc_split_omp_clauses (gfc_code *code, mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD; innermost = GFC_OMP_SPLIT_SIMD; break; + case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: + mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_TASKLOOP; + break; + case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: + mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; case EXEC_OMP_SIMD: innermost = GFC_OMP_SPLIT_SIMD; break; @@ -5427,9 +5435,11 @@ gfc_split_omp_clauses (gfc_code *code, | GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD; innermost = GFC_OMP_SPLIT_SIMD; break; + case EXEC_OMP_MASTER_TASKLOOP: case EXEC_OMP_TASKLOOP: innermost = GFC_OMP_SPLIT_TASKLOOP; break; + case EXEC_OMP_MASTER_TASKLOOP_SIMD: case EXEC_OMP_TASKLOOP_SIMD: mask = GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD; innermost = GFC_OMP_SPLIT_SIMD; @@ -5821,28 +5831,6 @@ gfc_trans_omp_parallel_do_simd (gfc_code *code, stmtblock_t *pblock, } static tree -gfc_trans_omp_parallel_master (gfc_code *code) -{ - stmtblock_t block; - tree stmt, omp_clauses; - - gfc_start_block (&block); - omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses, - code->loc); - pushlevel (); - stmt = gfc_trans_omp_master (code); - if (TREE_CODE (stmt) != BIND_EXPR) - stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); - else - poplevel (0, 0); - stmt = build2_loc (gfc_get_location (&code->loc), OMP_PARALLEL, - void_type_node, stmt, omp_clauses); - OMP_PARALLEL_COMBINED (stmt) = 1; - gfc_add_expr_to_block (&block, stmt); - return gfc_finish_block (&block); -} - -static tree gfc_trans_omp_parallel_sections (gfc_code *code) { stmtblock_t block; @@ -6217,7 +6205,7 @@ gfc_trans_omp_target (gfc_code *code) } static tree -gfc_trans_omp_taskloop (gfc_code *code) +gfc_trans_omp_taskloop (gfc_code *code, gfc_exec_op op) { stmtblock_t block; gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM]; @@ -6229,7 +6217,7 @@ gfc_trans_omp_taskloop (gfc_code *code) omp_clauses = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TASKLOOP], code->loc); - switch (code->op) + switch (op) { case EXEC_OMP_TASKLOOP: /* This is handled in gfc_trans_omp_do. */ @@ -6259,6 +6247,75 @@ gfc_trans_omp_taskloop (gfc_code *code) } static tree +gfc_trans_omp_master_taskloop (gfc_code *code, gfc_exec_op op) +{ + stmtblock_t block; + tree stmt; + + gfc_start_block (&block); + pushlevel (); + if (op == EXEC_OMP_MASTER_TASKLOOP_SIMD) + stmt = gfc_trans_omp_taskloop (code, EXEC_OMP_TASKLOOP_SIMD); + else + { + gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM]; + gcc_assert (op == EXEC_OMP_MASTER_TASKLOOP); + if (op != code->op) + gfc_split_omp_clauses (code, clausesa); + stmt = gfc_trans_omp_do (code, EXEC_OMP_TASKLOOP, NULL, + op != code->op + ? &clausesa[GFC_OMP_SPLIT_TASKLOOP] + : code->ext.omp_clauses, NULL); + } + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + else + poplevel (0, 0); + stmt = build1_v (OMP_MASTER, stmt); + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree +gfc_trans_omp_parallel_master (gfc_code *code) +{ + stmtblock_t block; + tree stmt, omp_clauses; + gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM]; + + if (code->op != EXEC_OMP_PARALLEL_MASTER) + gfc_split_omp_clauses (code, clausesa); + + gfc_start_block (&block); + omp_clauses = gfc_trans_omp_clauses (&block, + code->op == EXEC_OMP_PARALLEL_MASTER + ? code->ext.omp_clauses + : &clausesa[GFC_OMP_SPLIT_PARALLEL], + code->loc); + pushlevel (); + if (code->op == EXEC_OMP_PARALLEL_MASTER) + stmt = gfc_trans_omp_master (code); + else + { + gcc_assert (code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP + || code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD); + gfc_exec_op op = (code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP + ? EXEC_OMP_MASTER_TASKLOOP + : EXEC_OMP_MASTER_TASKLOOP_SIMD); + stmt = gfc_trans_omp_master_taskloop (code, op); + } + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + else + poplevel (0, 0); + stmt = build2_loc (gfc_get_location (&code->loc), OMP_PARALLEL, + void_type_node, stmt, omp_clauses); + OMP_PARALLEL_COMBINED (stmt) = 1; + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree gfc_trans_omp_target_data (gfc_code *code) { stmtblock_t block; @@ -6568,6 +6625,9 @@ gfc_trans_omp_directive (gfc_code *code) return gfc_trans_omp_flush (code); case EXEC_OMP_MASTER: return gfc_trans_omp_master (code); + case EXEC_OMP_MASTER_TASKLOOP: + case EXEC_OMP_MASTER_TASKLOOP_SIMD: + return gfc_trans_omp_master_taskloop (code, code->op); case EXEC_OMP_ORDERED: return gfc_trans_omp_ordered (code); case EXEC_OMP_PARALLEL: @@ -6577,6 +6637,8 @@ gfc_trans_omp_directive (gfc_code *code) case EXEC_OMP_PARALLEL_DO_SIMD: return gfc_trans_omp_parallel_do_simd (code, NULL, NULL); case EXEC_OMP_PARALLEL_MASTER: + case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: + case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: return gfc_trans_omp_parallel_master (code); case EXEC_OMP_PARALLEL_SECTIONS: return gfc_trans_omp_parallel_sections (code); @@ -6610,7 +6672,7 @@ gfc_trans_omp_directive (gfc_code *code) case EXEC_OMP_TASKGROUP: return gfc_trans_omp_taskgroup (code); case EXEC_OMP_TASKLOOP_SIMD: - return gfc_trans_omp_taskloop (code); + return gfc_trans_omp_taskloop (code, code->op); case EXEC_OMP_TASKWAIT: return gfc_trans_omp_taskwait (code); case EXEC_OMP_TASKYIELD: -- cgit v1.1 From 178191e1dfafd8db149edcdef7a39e9e2c00f216 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 4 Jun 2021 12:06:59 +0200 Subject: Fortran/OpenMP: Add omp loop [PR99928] PR middle-end/99928 gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_clauses): Handle bind clause. (show_omp_node): Handle loop directive. * frontend-passes.c (gfc_code_walker): Likewise. * gfortran.h (enum gfc_statement): Add ST_OMP_(END_)(TARGET_)(|PARALLEL_|TEAMS_)LOOP. (enum gfc_omp_bind_type): New. (gfc_omp_clauses): Use it. (enum gfc_exec_op): Add EXEC_OMP_(TARGET_)(|PARALLEL_|TEAMS_)LOOP. * match.h (gfc_match_omp_loop, gfc_match_omp_parallel_loop, gfc_match_omp_target_parallel_loop, gfc_match_omp_target_teams_loop, gfc_match_omp_teams_loop): New. * openmp.c (enum omp_mask1): Add OMP_CLAUSE_BIND. (gfc_match_omp_clauses): Handle it. (OMP_LOOP_CLAUSES, gfc_match_omp_loop, gfc_match_omp_teams_loop, gfc_match_omp_target_teams_loop, gfc_match_omp_parallel_loop, gfc_match_omp_target_parallel_loop): New. (resolve_omp_clauses, resolve_omp_do, omp_code_to_statement, gfc_resolve_omp_directive): Handle omp loop. * parse.c (decode_omp_directive case_exec_markers, gfc_ascii_statement, parse_omp_do, parse_executable): Likewise. (parse_omp_structured_block): Remove ST_ which use parse_omp_do. * resolve.c (gfc_resolve_blocks): Add omp loop. * st.c (gfc_free_statement): Likewise. * trans-openmp.c (gfc_trans_omp_clauses): Handle bind clause. (gfc_trans_omp_do, gfc_trans_omp_parallel_do, gfc_trans_omp_distribute, gfc_trans_omp_teams, gfc_trans_omp_target, gfc_trans_omp_directive): Handle loop directive. (gfc_split_omp_clauses): Likewise; fix firstprivate/lastprivate and (in_)reduction for taskloop. * trans.c (trans_code): Handle omp loop directive. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/pr99928-3.f90: Add 'default(none)', following C/C++ version of the patch. * gfortran.dg/gomp/loop-1.f90: New test. * gfortran.dg/gomp/loop-2.f90: New test. * gfortran.dg/gomp/pr99928-1.f90: New test; based on C/C++ test. * gfortran.dg/gomp/pr99928-11.f90: Likewise. * gfortran.dg/gomp/pr99928-2.f90: Likewise. * gfortran.dg/gomp/pr99928-4.f90: Likewise. * gfortran.dg/gomp/pr99928-5.f90: Likewise. * gfortran.dg/gomp/pr99928-6.f90: Likewise. * gfortran.dg/gomp/pr99928-8.f90: Likewise. * gfortran.dg/goacc/omp.f95: Use 'acc kernels loops' instead of 'acc loops' to hide unrelated bug for now. * gfortran.dg/goacc/omp-fixed.f: Likewise --- gcc/fortran/trans-openmp.c | 117 ++++++++++++++++++++++++++++++++++++++------- 1 file changed, 99 insertions(+), 18 deletions(-) (limited to 'gcc/fortran/trans-openmp.c') diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 2917d3d..1e22cdb 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -4195,6 +4195,25 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, OMP_CLAUSE_GANG_STATIC_EXPR (c) = arg; } } + if (clauses->bind != OMP_BIND_UNSET) + { + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_BIND); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + switch (clauses->bind) + { + case OMP_BIND_TEAMS: + OMP_CLAUSE_BIND_KIND (c) = OMP_CLAUSE_BIND_TEAMS; + break; + case OMP_BIND_PARALLEL: + OMP_CLAUSE_BIND_KIND (c) = OMP_CLAUSE_BIND_PARALLEL; + break; + case OMP_BIND_THREAD: + OMP_CLAUSE_BIND_KIND (c) = OMP_CLAUSE_BIND_THREAD; + break; + default: + gcc_unreachable (); + } + } return nreverse (omp_clauses); } @@ -5083,6 +5102,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, case EXEC_OMP_SIMD: stmt = make_node (OMP_SIMD); break; case EXEC_OMP_DO: stmt = make_node (OMP_FOR); break; case EXEC_OMP_DISTRIBUTE: stmt = make_node (OMP_DISTRIBUTE); break; + case EXEC_OMP_LOOP: stmt = make_node (OMP_LOOP); break; case EXEC_OMP_TASKLOOP: stmt = make_node (OMP_TASKLOOP); break; case EXEC_OACC_LOOP: stmt = make_node (OACC_LOOP); break; default: gcc_unreachable (); @@ -5343,6 +5363,7 @@ gfc_split_omp_clauses (gfc_code *code, gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM]) { int mask = 0, innermost = 0; + bool is_loop = false; memset (clausesa, 0, GFC_OMP_SPLIT_NUM * sizeof (gfc_omp_clauses)); switch (code->op) { @@ -5363,6 +5384,7 @@ gfc_split_omp_clauses (gfc_code *code, innermost = GFC_OMP_SPLIT_SIMD; break; case EXEC_OMP_DO: + case EXEC_OMP_LOOP: innermost = GFC_OMP_SPLIT_DO; break; case EXEC_OMP_DO_SIMD: @@ -5373,6 +5395,7 @@ gfc_split_omp_clauses (gfc_code *code, innermost = GFC_OMP_SPLIT_PARALLEL; break; case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_LOOP: mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO; innermost = GFC_OMP_SPLIT_DO; break; @@ -5399,6 +5422,7 @@ gfc_split_omp_clauses (gfc_code *code, innermost = GFC_OMP_SPLIT_PARALLEL; break; case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_LOOP: mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO; innermost = GFC_OMP_SPLIT_DO; break; @@ -5435,6 +5459,10 @@ gfc_split_omp_clauses (gfc_code *code, | GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD; innermost = GFC_OMP_SPLIT_SIMD; break; + case EXEC_OMP_TARGET_TEAMS_LOOP: + mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DO; + innermost = GFC_OMP_SPLIT_DO; + break; case EXEC_OMP_MASTER_TASKLOOP: case EXEC_OMP_TASKLOOP: innermost = GFC_OMP_SPLIT_TASKLOOP; @@ -5465,6 +5493,10 @@ gfc_split_omp_clauses (gfc_code *code, mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD; innermost = GFC_OMP_SPLIT_SIMD; break; + case EXEC_OMP_TEAMS_LOOP: + mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DO; + innermost = GFC_OMP_SPLIT_DO; + break; default: gcc_unreachable (); } @@ -5473,6 +5505,18 @@ gfc_split_omp_clauses (gfc_code *code, clausesa[innermost] = *code->ext.omp_clauses; return; } + /* Loops are similar to DO but still a bit different. */ + switch (code->op) + { + case EXEC_OMP_LOOP: + case EXEC_OMP_PARALLEL_LOOP: + case EXEC_OMP_TEAMS_LOOP: + case EXEC_OMP_TARGET_PARALLEL_LOOP: + case EXEC_OMP_TARGET_TEAMS_LOOP: + is_loop = true; + default: + break; + } if (code->ext.omp_clauses != NULL) { if (mask & GFC_OMP_MASK_TARGET) @@ -5540,7 +5584,7 @@ gfc_split_omp_clauses (gfc_code *code, clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr = code->ext.omp_clauses->if_expr; } - if (mask & GFC_OMP_MASK_DO) + if ((mask & GFC_OMP_MASK_DO) && !is_loop) { /* First the clauses that are unique to some constructs. */ clausesa[GFC_OMP_SPLIT_DO].ordered @@ -5560,6 +5604,11 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->chunk_size; clausesa[GFC_OMP_SPLIT_DO].nowait = code->ext.omp_clauses->nowait; + } + if (mask & GFC_OMP_MASK_DO) + { + clausesa[GFC_OMP_SPLIT_DO].bind + = code->ext.omp_clauses->bind; /* Duplicate collapse. */ clausesa[GFC_OMP_SPLIT_DO].collapse = code->ext.omp_clauses->collapse; @@ -5621,7 +5670,7 @@ gfc_split_omp_clauses (gfc_code *code, it is enough to put it on the innermost one. For !$ omp parallel do put it on parallel though, as that's what we did for OpenMP 3.1. */ - clausesa[innermost == GFC_OMP_SPLIT_DO + clausesa[innermost == GFC_OMP_SPLIT_DO && !is_loop ? (int) GFC_OMP_SPLIT_PARALLEL : innermost].lists[OMP_LIST_PRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_PRIVATE]; @@ -5637,19 +5686,25 @@ gfc_split_omp_clauses (gfc_code *code, else if (mask & GFC_OMP_MASK_DISTRIBUTE) clausesa[GFC_OMP_SPLIT_DISTRIBUTE].lists[OMP_LIST_FIRSTPRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; + if (mask & GFC_OMP_MASK_TASKLOOP) + clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_FIRSTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; if (mask & GFC_OMP_MASK_PARALLEL) clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_FIRSTPRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; - else if (mask & GFC_OMP_MASK_DO) + else if ((mask & GFC_OMP_MASK_DO) && !is_loop) clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_FIRSTPRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; - /* Lastprivate is allowed on distribute, do and simd. + /* Lastprivate is allowed on distribute, do, simd, taskloop and loop. In parallel do{, simd} we actually want to put it on parallel rather than do. */ if (mask & GFC_OMP_MASK_DISTRIBUTE) clausesa[GFC_OMP_SPLIT_DISTRIBUTE].lists[OMP_LIST_LASTPRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; - if (mask & GFC_OMP_MASK_PARALLEL) + if (mask & GFC_OMP_MASK_TASKLOOP) + clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_LASTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; + if ((mask & GFC_OMP_MASK_PARALLEL) && !is_loop) clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_LASTPRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; else if (mask & GFC_OMP_MASK_DO) @@ -5658,17 +5713,25 @@ gfc_split_omp_clauses (gfc_code *code, if (mask & GFC_OMP_MASK_SIMD) clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_LASTPRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; - /* Reduction is allowed on simd, do, parallel and teams. - Duplicate it on all of them, but omit on do if - parallel is present; additionally, inscan applies to do/simd only. */ + /* Reduction is allowed on simd, do, parallel, teams, taskloop, and loop. + Duplicate it on all of them, but + - omit on do if parallel is present; + - omit on task and parallel if loop is present; + additionally, inscan applies to do/simd only. */ for (int i = OMP_LIST_REDUCTION; i <= OMP_LIST_REDUCTION_TASK; i++) { - if (mask & GFC_OMP_MASK_TEAMS + if (mask & GFC_OMP_MASK_TASKLOOP && i != OMP_LIST_REDUCTION_INSCAN) + clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[i] + = code->ext.omp_clauses->lists[i]; + if (mask & GFC_OMP_MASK_TEAMS + && i != OMP_LIST_REDUCTION_INSCAN + && !is_loop) clausesa[GFC_OMP_SPLIT_TEAMS].lists[i] = code->ext.omp_clauses->lists[i]; if (mask & GFC_OMP_MASK_PARALLEL - && i != OMP_LIST_REDUCTION_INSCAN) + && i != OMP_LIST_REDUCTION_INSCAN + && !is_loop) clausesa[GFC_OMP_SPLIT_PARALLEL].lists[i] = code->ext.omp_clauses->lists[i]; else if (mask & GFC_OMP_MASK_DO) @@ -5689,8 +5752,9 @@ gfc_split_omp_clauses (gfc_code *code, clausesa[innermost].lists[OMP_LIST_LINEAR] = code->ext.omp_clauses->lists[OMP_LIST_LINEAR]; } - if ((mask & (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) - == (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) + if (((mask & (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) + == (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) + && !is_loop) clausesa[GFC_OMP_SPLIT_DO].nowait = true; } @@ -5740,7 +5804,7 @@ gfc_trans_omp_do_simd (gfc_code *code, stmtblock_t *pblock, } static tree -gfc_trans_omp_parallel_do (gfc_code *code, stmtblock_t *pblock, +gfc_trans_omp_parallel_do (gfc_code *code, bool is_loop, stmtblock_t *pblock, gfc_omp_clauses *clausesa) { stmtblock_t block, *new_pblock = pblock; @@ -5768,8 +5832,9 @@ gfc_trans_omp_parallel_do (gfc_code *code, stmtblock_t *pblock, else pushlevel (); } - stmt = gfc_trans_omp_do (code, EXEC_OMP_DO, new_pblock, - &clausesa[GFC_OMP_SPLIT_DO], omp_clauses); + stmt = gfc_trans_omp_do (code, is_loop ? EXEC_OMP_LOOP : EXEC_OMP_DO, + new_pblock, &clausesa[GFC_OMP_SPLIT_DO], + omp_clauses); if (pblock == NULL) { if (TREE_CODE (stmt) != BIND_EXPR) @@ -6006,7 +6071,7 @@ gfc_trans_omp_distribute (gfc_code *code, gfc_omp_clauses *clausesa) case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: - stmt = gfc_trans_omp_parallel_do (code, &block, clausesa); + stmt = gfc_trans_omp_parallel_do (code, false, &block, clausesa); if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); else @@ -6083,6 +6148,12 @@ gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa, &clausesa[GFC_OMP_SPLIT_DISTRIBUTE], NULL); break; + case EXEC_OMP_TARGET_TEAMS_LOOP: + case EXEC_OMP_TEAMS_LOOP: + stmt = gfc_trans_omp_do (code, EXEC_OMP_LOOP, NULL, + &clausesa[GFC_OMP_SPLIT_DO], + NULL); + break; default: stmt = gfc_trans_omp_distribute (code, clausesa); break; @@ -6140,7 +6211,11 @@ gfc_trans_omp_target (gfc_code *code) } break; case EXEC_OMP_TARGET_PARALLEL_DO: - stmt = gfc_trans_omp_parallel_do (code, &block, clausesa); + case EXEC_OMP_TARGET_PARALLEL_LOOP: + stmt = gfc_trans_omp_parallel_do (code, + (code->op + == EXEC_OMP_TARGET_PARALLEL_LOOP), + &block, clausesa); if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); else @@ -6611,6 +6686,7 @@ gfc_trans_omp_directive (gfc_code *code) return gfc_trans_omp_depobj (code); case EXEC_OMP_DISTRIBUTE: case EXEC_OMP_DO: + case EXEC_OMP_LOOP: case EXEC_OMP_SIMD: case EXEC_OMP_TASKLOOP: return gfc_trans_omp_do (code, code->op, NULL, code->ext.omp_clauses, @@ -6633,7 +6709,9 @@ gfc_trans_omp_directive (gfc_code *code) case EXEC_OMP_PARALLEL: return gfc_trans_omp_parallel (code); case EXEC_OMP_PARALLEL_DO: - return gfc_trans_omp_parallel_do (code, NULL, NULL); + return gfc_trans_omp_parallel_do (code, false, NULL, NULL); + case EXEC_OMP_PARALLEL_LOOP: + return gfc_trans_omp_parallel_do (code, true, NULL, NULL); case EXEC_OMP_PARALLEL_DO_SIMD: return gfc_trans_omp_parallel_do_simd (code, NULL, NULL); case EXEC_OMP_PARALLEL_MASTER: @@ -6652,12 +6730,14 @@ gfc_trans_omp_directive (gfc_code *code) case EXEC_OMP_TARGET_PARALLEL: case EXEC_OMP_TARGET_PARALLEL_DO: case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_PARALLEL_LOOP: case EXEC_OMP_TARGET_SIMD: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_TEAMS_LOOP: return gfc_trans_omp_target (code); case EXEC_OMP_TARGET_DATA: return gfc_trans_omp_target_data (code); @@ -6682,6 +6762,7 @@ gfc_trans_omp_directive (gfc_code *code) case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TEAMS_LOOP: return gfc_trans_omp_teams (code, NULL, NULL_TREE); case EXEC_OMP_WORKSHARE: return gfc_trans_omp_workshare (code, code->ext.omp_clauses); -- cgit v1.1 From 245517470d6948a40cead9f5c312b8d79ac5c491 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Tue, 8 Jun 2021 09:51:09 +0200 Subject: Fortran/OpenMP: Fix clause splitting for target/parallel/teams [PR99928] PR middle-end/99928 gcc/fortran/ChangeLog: * trans-openmp.c (gfc_add_clause_implicitly): New. (gfc_split_omp_clauses): Use it. (gfc_free_split_omp_clauses): New. (gfc_trans_omp_do_simd, gfc_trans_omp_parallel_do, gfc_trans_omp_parallel_do_simd, gfc_trans_omp_distribute, gfc_trans_omp_teams, gfc_trans_omp_target, gfc_trans_omp_taskloop, gfc_trans_omp_master_taskloop, gfc_trans_omp_parallel_master): Use it. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/openmp-simd-6.f90: Update scan-tree-dump. * gfortran.dg/gomp/scan-5.f90: Likewise. * gfortran.dg/gomp/loop-1.f90: Likewise; remove xfail. * gfortran.dg/gomp/pr99928-1.f90: Remove xfail. * gfortran.dg/gomp/pr99928-2.f90: Likewise. * gfortran.dg/gomp/pr99928-3.f90: Likewise. * gfortran.dg/gomp/pr99928-8.f90: Likewise. --- gcc/fortran/trans-openmp.c | 187 ++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 184 insertions(+), 3 deletions(-) (limited to 'gcc/fortran/trans-openmp.c') diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 1e22cdb..c8c61a5 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -5358,6 +5358,147 @@ enum GFC_OMP_MASK_TASKLOOP = (1 << GFC_OMP_SPLIT_TASKLOOP) }; +/* If a var is in lastprivate/firstprivate/reduction but not in a + data mapping/sharing clause, add it to 'map(tofrom:' if is_target + and to 'shared' otherwise. */ +static void +gfc_add_clause_implicitly (gfc_omp_clauses *clauses_out, + gfc_omp_clauses *clauses_in, + bool is_target, bool is_parallel_do) +{ + int clauselist_to_add = is_target ? OMP_LIST_MAP : OMP_LIST_SHARED; + gfc_omp_namelist *tail = NULL; + for (int i = 0; i < 5; ++i) + { + gfc_omp_namelist *n; + switch (i) + { + case 0: n = clauses_in->lists[OMP_LIST_FIRSTPRIVATE]; break; + case 1: n = clauses_in->lists[OMP_LIST_LASTPRIVATE]; break; + case 2: n = clauses_in->lists[OMP_LIST_REDUCTION]; break; + case 3: n = clauses_in->lists[OMP_LIST_REDUCTION_INSCAN]; break; + case 4: n = clauses_in->lists[OMP_LIST_REDUCTION_TASK]; break; + default: gcc_unreachable (); + } + for (; n != NULL; n = n->next) + { + gfc_omp_namelist *n2, **n_firstp = NULL, **n_lastp = NULL; + for (int j = 0; j < 6; ++j) + { + gfc_omp_namelist **n2ref = NULL, *prev2 = NULL; + switch (j) + { + case 0: + n2ref = &clauses_out->lists[clauselist_to_add]; + break; + case 1: + n2ref = &clauses_out->lists[OMP_LIST_FIRSTPRIVATE]; + break; + case 2: + if (is_target) + n2ref = &clauses_in->lists[OMP_LIST_LASTPRIVATE]; + else + n2ref = &clauses_out->lists[OMP_LIST_LASTPRIVATE]; + break; + case 3: n2ref = &clauses_out->lists[OMP_LIST_REDUCTION]; break; + case 4: + n2ref = &clauses_out->lists[OMP_LIST_REDUCTION_INSCAN]; + break; + case 5: + n2ref = &clauses_out->lists[OMP_LIST_REDUCTION_TASK]; + break; + default: gcc_unreachable (); + } + for (n2 = *n2ref; n2 != NULL; prev2 = n2, n2 = n2->next) + if (n2->sym == n->sym) + break; + if (n2) + { + if (j == 0 /* clauselist_to_add */) + break; /* Already present. */ + if (j == 1 /* OMP_LIST_FIRSTPRIVATE */) + { + n_firstp = prev2 ? &prev2->next : n2ref; + continue; + } + if (j == 2 /* OMP_LIST_LASTPRIVATE */) + { + n_lastp = prev2 ? &prev2->next : n2ref; + continue; + } + break; + } + } + if (n_firstp && n_lastp) + { + /* For parallel do, GCC puts firstprivatee/lastprivate + on the parallel. */ + if (is_parallel_do) + continue; + *n_firstp = (*n_firstp)->next; + if (!is_target) + *n_lastp = (*n_lastp)->next; + } + else if (is_target && n_lastp) + ; + else if (n2 || n_firstp || n_lastp) + continue; + if (clauses_out->lists[clauselist_to_add] + && (clauses_out->lists[clauselist_to_add] + == clauses_in->lists[clauselist_to_add])) + { + gfc_omp_namelist *p = NULL; + for (n2 = clauses_in->lists[clauselist_to_add]; n2; n2 = n2->next) + { + if (p) + { + p->next = gfc_get_omp_namelist (); + p = p->next; + } + else + { + p = gfc_get_omp_namelist (); + clauses_out->lists[clauselist_to_add] = p; + } + *p = *n2; + } + } + if (!tail) + { + tail = clauses_out->lists[clauselist_to_add]; + for (; tail && tail->next; tail = tail->next) + ; + } + n2 = gfc_get_omp_namelist (); + n2->where = n->where; + n2->sym = n->sym; + if (is_target) + n2->u.map_op = OMP_MAP_TOFROM; + if (tail) + { + tail->next = n2; + tail = n2; + } + else + clauses_out->lists[clauselist_to_add] = n2; + } + } +} + +static void +gfc_free_split_omp_clauses (gfc_code *code, gfc_omp_clauses *clausesa) +{ + for (int i = 0; i < GFC_OMP_SPLIT_NUM; ++i) + for (int j = 0; j < OMP_LIST_NUM; ++j) + if (clausesa[i].lists[j] && clausesa[i].lists[j] != code->ext.omp_clauses->lists[j]) + for (gfc_omp_namelist *n = clausesa[i].lists[j]; n;) + { + gfc_omp_namelist *p = n; + n = n->next; + free (p); + } +} + static void gfc_split_omp_clauses (gfc_code *code, gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM]) @@ -5689,7 +5830,8 @@ gfc_split_omp_clauses (gfc_code *code, if (mask & GFC_OMP_MASK_TASKLOOP) clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_FIRSTPRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; - if (mask & GFC_OMP_MASK_PARALLEL) + if ((mask & GFC_OMP_MASK_PARALLEL) + && !(mask & GFC_OMP_MASK_TASKLOOP)) clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_FIRSTPRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; else if ((mask & GFC_OMP_MASK_DO) && !is_loop) @@ -5704,7 +5846,8 @@ gfc_split_omp_clauses (gfc_code *code, if (mask & GFC_OMP_MASK_TASKLOOP) clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_LASTPRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; - if ((mask & GFC_OMP_MASK_PARALLEL) && !is_loop) + if ((mask & GFC_OMP_MASK_PARALLEL) && !is_loop + && !(mask & GFC_OMP_MASK_TASKLOOP)) clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_LASTPRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; else if (mask & GFC_OMP_MASK_DO) @@ -5731,6 +5874,7 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->lists[i]; if (mask & GFC_OMP_MASK_PARALLEL && i != OMP_LIST_REDUCTION_INSCAN + && !(mask & GFC_OMP_MASK_TASKLOOP) && !is_loop) clausesa[GFC_OMP_SPLIT_PARALLEL].lists[i] = code->ext.omp_clauses->lists[i]; @@ -5752,6 +5896,18 @@ gfc_split_omp_clauses (gfc_code *code, clausesa[innermost].lists[OMP_LIST_LINEAR] = code->ext.omp_clauses->lists[OMP_LIST_LINEAR]; } + /* Propagate firstprivate/lastprivate/reduction vars to + shared (parallel, teams) and map-tofrom (target). */ + if (mask & GFC_OMP_MASK_TARGET) + gfc_add_clause_implicitly (&clausesa[GFC_OMP_SPLIT_TARGET], + code->ext.omp_clauses, true, false); + if ((mask & GFC_OMP_MASK_PARALLEL) && innermost != GFC_OMP_MASK_PARALLEL) + gfc_add_clause_implicitly (&clausesa[GFC_OMP_SPLIT_PARALLEL], + code->ext.omp_clauses, false, + mask & GFC_OMP_MASK_DO); + if (mask & GFC_OMP_MASK_TEAMS && innermost != GFC_OMP_MASK_TEAMS) + gfc_add_clause_implicitly (&clausesa[GFC_OMP_SPLIT_TEAMS], + code->ext.omp_clauses, false, false); if (((mask & (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) == (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) && !is_loop) @@ -5765,6 +5921,7 @@ gfc_trans_omp_do_simd (gfc_code *code, stmtblock_t *pblock, stmtblock_t block; gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM]; tree stmt, body, omp_do_clauses = NULL_TREE; + bool free_clausesa = false; if (pblock == NULL) gfc_start_block (&block); @@ -5775,6 +5932,7 @@ gfc_trans_omp_do_simd (gfc_code *code, stmtblock_t *pblock, { clausesa = clausesa_buf; gfc_split_omp_clauses (code, clausesa); + free_clausesa = true; } if (flag_openmp) omp_do_clauses @@ -5800,6 +5958,8 @@ gfc_trans_omp_do_simd (gfc_code *code, stmtblock_t *pblock, else stmt = body; gfc_add_expr_to_block (&block, stmt); + if (free_clausesa) + gfc_free_split_omp_clauses (code, clausesa); return gfc_finish_block (&block); } @@ -5810,6 +5970,7 @@ gfc_trans_omp_parallel_do (gfc_code *code, bool is_loop, stmtblock_t *pblock, stmtblock_t block, *new_pblock = pblock; gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM]; tree stmt, omp_clauses = NULL_TREE; + bool free_clausesa = false; if (pblock == NULL) gfc_start_block (&block); @@ -5820,6 +5981,7 @@ gfc_trans_omp_parallel_do (gfc_code *code, bool is_loop, stmtblock_t *pblock, { clausesa = clausesa_buf; gfc_split_omp_clauses (code, clausesa); + free_clausesa = true; } omp_clauses = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_PARALLEL], @@ -5848,6 +6010,8 @@ gfc_trans_omp_parallel_do (gfc_code *code, bool is_loop, stmtblock_t *pblock, void_type_node, stmt, omp_clauses); OMP_PARALLEL_COMBINED (stmt) = 1; gfc_add_expr_to_block (&block, stmt); + if (free_clausesa) + gfc_free_split_omp_clauses (code, clausesa); return gfc_finish_block (&block); } @@ -5858,6 +6022,7 @@ gfc_trans_omp_parallel_do_simd (gfc_code *code, stmtblock_t *pblock, stmtblock_t block; gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM]; tree stmt, omp_clauses = NULL_TREE; + bool free_clausesa = false; if (pblock == NULL) gfc_start_block (&block); @@ -5868,6 +6033,7 @@ gfc_trans_omp_parallel_do_simd (gfc_code *code, stmtblock_t *pblock, { clausesa = clausesa_buf; gfc_split_omp_clauses (code, clausesa); + free_clausesa = true; } if (flag_openmp) omp_clauses @@ -5892,6 +6058,8 @@ gfc_trans_omp_parallel_do_simd (gfc_code *code, stmtblock_t *pblock, OMP_PARALLEL_COMBINED (stmt) = 1; } gfc_add_expr_to_block (&block, stmt); + if (free_clausesa) + gfc_free_split_omp_clauses (code, clausesa); return gfc_finish_block (&block); } @@ -6049,12 +6217,14 @@ gfc_trans_omp_distribute (gfc_code *code, gfc_omp_clauses *clausesa) stmtblock_t block; gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM]; tree stmt, omp_clauses = NULL_TREE; + bool free_clausesa = false; gfc_start_block (&block); if (clausesa == NULL) { clausesa = clausesa_buf; gfc_split_omp_clauses (code, clausesa); + free_clausesa = true; } if (flag_openmp) omp_clauses @@ -6108,6 +6278,8 @@ gfc_trans_omp_distribute (gfc_code *code, gfc_omp_clauses *clausesa) stmt = distribute; } gfc_add_expr_to_block (&block, stmt); + if (free_clausesa) + gfc_free_split_omp_clauses (code, clausesa); return gfc_finish_block (&block); } @@ -6118,13 +6290,14 @@ gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa, stmtblock_t block; gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM]; tree stmt; - bool combined = true; + bool combined = true, free_clausesa = false; gfc_start_block (&block); if (clausesa == NULL) { clausesa = clausesa_buf; gfc_split_omp_clauses (code, clausesa); + free_clausesa = true; } if (flag_openmp) { @@ -6167,6 +6340,8 @@ gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa, OMP_TEAMS_COMBINED (stmt) = 1; } gfc_add_expr_to_block (&block, stmt); + if (free_clausesa) + gfc_free_split_omp_clauses (code, clausesa); return gfc_finish_block (&block); } @@ -6276,6 +6451,7 @@ gfc_trans_omp_target (gfc_code *code) cfun->has_omp_target = true; } gfc_add_expr_to_block (&block, stmt); + gfc_free_split_omp_clauses (code, clausesa); return gfc_finish_block (&block); } @@ -6318,6 +6494,7 @@ gfc_trans_omp_taskloop (gfc_code *code, gfc_exec_op op) stmt = taskloop; } gfc_add_expr_to_block (&block, stmt); + gfc_free_split_omp_clauses (code, clausesa); return gfc_finish_block (&block); } @@ -6341,6 +6518,8 @@ gfc_trans_omp_master_taskloop (gfc_code *code, gfc_exec_op op) op != code->op ? &clausesa[GFC_OMP_SPLIT_TASKLOOP] : code->ext.omp_clauses, NULL); + if (op != code->op) + gfc_free_split_omp_clauses (code, clausesa); } if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); @@ -6367,6 +6546,8 @@ gfc_trans_omp_parallel_master (gfc_code *code) ? code->ext.omp_clauses : &clausesa[GFC_OMP_SPLIT_PARALLEL], code->loc); + if (code->op != EXEC_OMP_PARALLEL_MASTER) + gfc_free_split_omp_clauses (code, clausesa); pushlevel (); if (code->op == EXEC_OMP_PARALLEL_MASTER) stmt = gfc_trans_omp_master (code); -- cgit v1.1 From d4d38135b3137f1d3148138340e67bdcd7ea8216 Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Wed, 9 Jun 2021 10:48:41 +0200 Subject: openmp: Gimplify OMP_CLAUSE_SIZE during gfc_omp_finish_clause [PR100965] As the testcase shows, we need to gimplify OMP_CLAUSE_SIZE, so that we don't end up with SAVE_EXPR or anything similar non-gimple in it. 2021-06-08 Jakub Jelinek PR fortran/100965 * trans-openmp.c (gfc_omp_finish_clause): Gimplify OMP_CLAUSE_SIZE. * gfortran.dg/gomp/pr100965.f90: New test. --- gcc/fortran/trans-openmp.c | 3 +++ 1 file changed, 3 insertions(+) (limited to 'gcc/fortran/trans-openmp.c') diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index c8c61a5..f466ab6 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -1639,6 +1639,9 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc) OMP_CLAUSE_SIZE (c) = DECL_P (decl) ? DECL_SIZE_UNIT (decl) : TYPE_SIZE_UNIT (TREE_TYPE (decl)); + if (gimplify_expr (&OMP_CLAUSE_SIZE (c), pre_p, + NULL, is_gimple_val, fb_rvalue) == GS_ERROR) + OMP_CLAUSE_SIZE (c) = size_int (0); if (c2) { OMP_CLAUSE_CHAIN (c2) = OMP_CLAUSE_CHAIN (last); -- cgit v1.1 From 1de31913d20a467b78904c0e96efd5fbd6facd2c Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Tue, 15 Jun 2021 16:06:38 +0200 Subject: Fortran/OpenMP: Extend defaultmap clause for OpenMP 5 [PR92568] PR fortran/92568 gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_clauses): Update for defaultmap. * f95-lang.c (LANG_HOOKS_OMP_ALLOCATABLE_P, LANG_HOOKS_OMP_SCALAR_TARGET_P): New. * gfortran.h (enum gfc_omp_defaultmap, enum gfc_omp_defaultmap_category): New. * openmp.c (gfc_match_omp_clauses): Update defaultmap matching. * trans-decl.c (gfc_finish_decl_attrs): Set GFC_DECL_SCALAR_TARGET. * trans-openmp.c (gfc_omp_allocatable_p, gfc_omp_scalar_target_p): New. (gfc_omp_scalar_p): Take 'ptr_alloc_ok' argument. (gfc_trans_omp_clauses, gfc_split_omp_clauses): Update for defaultmap changes. * trans.h (gfc_omp_scalar_p): Update prototype. (gfc_omp_allocatable_p, gfc_omp_scalar_target_p): New. (struct lang_decl): Add scalar_target. (GFC_DECL_SCALAR_TARGET, GFC_DECL_GET_SCALAR_TARGET): New. gcc/ChangeLog: * gimplify.c (enum gimplify_defaultmap_kind): Add GDMK_SCALAR_TARGET. (struct gimplify_omp_ctx): Extend defaultmap array by one. (new_omp_context): Init defaultmap[GDMK_SCALAR_TARGET]. (omp_notice_variable): Update type classification for Fortran. (gimplify_scan_omp_clauses): Update calls for new argument; handle GDMK_SCALAR_TARGET; for Fortran, GDMK_POINTER avoid GOVD_MAP_0LEN_ARRAY. * langhooks-def.h (lhd_omp_scalar_p): Add 'ptr_ok' argument. * langhooks.c (lhd_omp_scalar_p): Likewise. (LANG_HOOKS_OMP_ALLOCATABLE_P, LANG_HOOKS_OMP_SCALAR_TARGET_P): New. (LANG_HOOKS_DECLS): Add them. * langhooks.h (struct lang_hooks_for_decls): Add new hooks, update omp_scalar_p pointer type to include the new bool argument. libgomp/ChangeLog: * testsuite/libgomp.fortran/defaultmap-8.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/pr99928-1.f90: Uncomment 'defaultmap(none)'. * gfortran.dg/gomp/pr99928-2.f90: Uncomment 'defaultmap(none)'. * gfortran.dg/gomp/pr99928-3.f90: Uncomment 'defaultmap(none)'. * gfortran.dg/gomp/pr99928-4.f90: Uncomment 'defaultmap(none)'. * gfortran.dg/gomp/pr99928-5.f90: Uncomment 'defaultmap(none)'. * gfortran.dg/gomp/pr99928-6.f90: Uncomment 'defaultmap(none)'. * gfortran.dg/gomp/pr99928-8.f90: Uncomment 'defaultmap(none)'. * gfortran.dg/gomp/defaultmap-1.f90: New test. * gfortran.dg/gomp/defaultmap-2.f90: New test. * gfortran.dg/gomp/defaultmap-3.f90: New test. * gfortran.dg/gomp/defaultmap-4.f90: New test. * gfortran.dg/gomp/defaultmap-5.f90: New test. * gfortran.dg/gomp/defaultmap-6.f90: New test. * gfortran.dg/gomp/defaultmap-7.f90: New test. --- gcc/fortran/trans-openmp.c | 97 ++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 89 insertions(+), 8 deletions(-) (limited to 'gcc/fortran/trans-openmp.c') diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index f466ab6..ce1991e 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -393,6 +393,28 @@ gfc_is_unlimited_polymorphic_nonptr (tree type) return true; } +/* Return true if the DECL is for an allocatable array or scalar. */ + +bool +gfc_omp_allocatable_p (tree decl) +{ + if (!DECL_P (decl)) + return false; + + if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)) + return true; + + tree type = TREE_TYPE (decl); + if (gfc_omp_privatize_by_reference (decl)) + type = TREE_TYPE (type); + + if (GFC_DESCRIPTOR_TYPE_P (type) + && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE) + return true; + + return false; +} + /* Return true if DECL in private clause needs OMP_CLAUSE_PRIVATE_OUTER_REF on the private clause. */ @@ -1663,10 +1685,11 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc) /* Return true if DECL is a scalar variable (for the purpose of - implicit firstprivatization). */ + implicit firstprivatization/mapping). Only if 'ptr_alloc_ok.' + is true, allocatables and pointers are permitted. */ bool -gfc_omp_scalar_p (tree decl) +gfc_omp_scalar_p (tree decl, bool ptr_alloc_ok) { tree type = TREE_TYPE (decl); if (TREE_CODE (type) == REFERENCE_TYPE) @@ -1675,7 +1698,11 @@ gfc_omp_scalar_p (tree decl) { if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl) || GFC_DECL_GET_SCALAR_POINTER (decl)) - type = TREE_TYPE (type); + { + if (!ptr_alloc_ok) + return false; + type = TREE_TYPE (type); + } if (GFC_ARRAY_TYPE_P (type) || GFC_CLASS_TYPE_P (type)) return false; @@ -1691,6 +1718,17 @@ gfc_omp_scalar_p (tree decl) } +/* Return true if DECL is a scalar with target attribute but does not have the + allocatable (or pointer) attribute (for the purpose of implicit mapping). */ + +bool +gfc_omp_scalar_target_p (tree decl) +{ + return (DECL_P (decl) && GFC_DECL_GET_SCALAR_TARGET (decl) + && gfc_omp_scalar_p (decl, false)); +} + + /* Return true if DECL's DECL_VALUE_EXPR (if any) should be disregarded in OpenMP construct, because it is going to be remapped during OpenMP lowering. SHARED is true if DECL @@ -4036,13 +4074,55 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NOGROUP); omp_clauses = gfc_trans_add_clause (c, omp_clauses); } - if (clauses->defaultmap) + + for (int i = 0; i < OMP_DEFAULTMAP_CAT_NUM; i++) { + if (clauses->defaultmap[i] == OMP_DEFAULTMAP_UNSET) + continue; + enum omp_clause_defaultmap_kind behavior, category; + switch ((gfc_omp_defaultmap_category) i) + { + case OMP_DEFAULTMAP_CAT_UNCATEGORIZED: + category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_UNSPECIFIED; + break; + case OMP_DEFAULTMAP_CAT_SCALAR: + category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_SCALAR; + break; + case OMP_DEFAULTMAP_CAT_AGGREGATE: + category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_AGGREGATE; + break; + case OMP_DEFAULTMAP_CAT_ALLOCATABLE: + category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_ALLOCATABLE; + break; + case OMP_DEFAULTMAP_CAT_POINTER: + category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_POINTER; + break; + default: gcc_unreachable (); + } + switch (clauses->defaultmap[i]) + { + case OMP_DEFAULTMAP_ALLOC: + behavior = OMP_CLAUSE_DEFAULTMAP_ALLOC; + break; + case OMP_DEFAULTMAP_TO: behavior = OMP_CLAUSE_DEFAULTMAP_TO; break; + case OMP_DEFAULTMAP_FROM: behavior = OMP_CLAUSE_DEFAULTMAP_FROM; break; + case OMP_DEFAULTMAP_TOFROM: + behavior = OMP_CLAUSE_DEFAULTMAP_TOFROM; + break; + case OMP_DEFAULTMAP_FIRSTPRIVATE: + behavior = OMP_CLAUSE_DEFAULTMAP_FIRSTPRIVATE; + break; + case OMP_DEFAULTMAP_NONE: behavior = OMP_CLAUSE_DEFAULTMAP_NONE; break; + case OMP_DEFAULTMAP_DEFAULT: + behavior = OMP_CLAUSE_DEFAULTMAP_DEFAULT; + break; + default: gcc_unreachable (); + } c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEFAULTMAP); - OMP_CLAUSE_DEFAULTMAP_SET_KIND (c, OMP_CLAUSE_DEFAULTMAP_TOFROM, - OMP_CLAUSE_DEFAULTMAP_CATEGORY_SCALAR); + OMP_CLAUSE_DEFAULTMAP_SET_KIND (c, behavior, category); omp_clauses = gfc_trans_add_clause (c, omp_clauses); } + if (clauses->depend_source) { c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEPEND); @@ -5672,8 +5752,9 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->lists[OMP_LIST_IS_DEVICE_PTR]; clausesa[GFC_OMP_SPLIT_TARGET].device = code->ext.omp_clauses->device; - clausesa[GFC_OMP_SPLIT_TARGET].defaultmap - = code->ext.omp_clauses->defaultmap; + for (int i = 0; i < OMP_DEFAULTMAP_CAT_NUM; i++) + clausesa[GFC_OMP_SPLIT_TARGET].defaultmap[i] + = code->ext.omp_clauses->defaultmap[i]; clausesa[GFC_OMP_SPLIT_TARGET].if_exprs[OMP_IF_TARGET] = code->ext.omp_clauses->if_exprs[OMP_IF_TARGET]; /* And this is copied to all. */ -- cgit v1.1 From d5e69948beb61fb320d9ca703faff84d6f608545 Mon Sep 17 00:00:00 2001 From: Martin Sebor Date: Mon, 28 Jun 2021 14:47:21 -0600 Subject: fortran: Add support for per-location warning groups. gcc/fortran/ChangeLog: * trans-array.c (trans_array_constructor): Replace direct uses of TREE_NO_WARNING with warning_suppressed_p, and suppress_warning. * trans-decl.c (gfc_build_qualified_array): Same. (gfc_build_dummy_array_decl): Same. (generate_local_decl): Same. (gfc_generate_function_code): Same. * trans-openmp.c (gfc_omp_clause_default_ctor): Same. (gfc_omp_clause_copy_ctor): Same. * trans-types.c (get_dtype_type_node): Same. (gfc_get_desc_dim_type): Same. (gfc_get_array_descriptor_base): Same. (gfc_get_caf_vector_type): Same. (gfc_get_caf_reference_type): Same. * trans.c (gfc_create_var_np): Same. --- gcc/fortran/trans-openmp.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/trans-openmp.c') diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index ce1991e..ace4faf 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -785,7 +785,7 @@ gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer) else_b)); /* Avoid -W*uninitialized warnings. */ if (DECL_P (decl)) - TREE_NO_WARNING (decl) = 1; + suppress_warning (decl, OPT_Wuninitialized); } else gfc_add_expr_to_block (&block, then_b); @@ -970,7 +970,7 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src) void_type_node, cond, then_b, else_b)); /* Avoid -W*uninitialized warnings. */ if (DECL_P (dest)) - TREE_NO_WARNING (dest) = 1; + suppress_warning (dest, OPT_Wuninitialized); return gfc_finish_block (&block); } -- cgit v1.1 From a61f6afbee370785cf091fe46e2e022748528307 Mon Sep 17 00:00:00 2001 From: Thomas Schwinge Date: Wed, 21 Jul 2021 18:30:00 +0200 Subject: OpenACC 'nohost' clause Do not "compile a version of this procedure for the host". gcc/ * tree-core.h (omp_clause_code): Add 'OMP_CLAUSE_NOHOST'. * tree.c (omp_clause_num_ops, omp_clause_code_name, walk_tree_1): Handle it. * tree-pretty-print.c (dump_omp_clause): Likewise. * omp-general.c (oacc_verify_routine_clauses): Likewise. * gimplify.c (gimplify_scan_omp_clauses) (gimplify_adjust_omp_clauses): Likewise. * tree-nested.c (convert_nonlocal_omp_clauses) (convert_local_omp_clauses): Likewise. * omp-low.c (scan_sharing_clauses): Likewise. * omp-offload.c (execute_oacc_device_lower): Update. gcc/c-family/ * c-pragma.h (pragma_omp_clause): Add 'PRAGMA_OACC_CLAUSE_NOHOST'. gcc/c/ * c-parser.c (c_parser_omp_clause_name): Handle 'nohost'. (c_parser_oacc_all_clauses): Handle 'PRAGMA_OACC_CLAUSE_NOHOST'. (OACC_ROUTINE_CLAUSE_MASK): Add 'PRAGMA_OACC_CLAUSE_NOHOST'. * c-typeck.c (c_finish_omp_clauses): Handle 'OMP_CLAUSE_NOHOST'. gcc/cp/ * parser.c (cp_parser_omp_clause_name): Handle 'nohost'. (cp_parser_oacc_all_clauses): Handle 'PRAGMA_OACC_CLAUSE_NOHOST'. (OACC_ROUTINE_CLAUSE_MASK): Add 'PRAGMA_OACC_CLAUSE_NOHOST'. * pt.c (tsubst_omp_clauses): Handle 'OMP_CLAUSE_NOHOST'. * semantics.c (finish_omp_clauses): Likewise. gcc/fortran/ * dump-parse-tree.c (show_attr): Update. * gfortran.h (symbol_attribute): Add 'oacc_routine_nohost' member. (gfc_omp_clauses): Add 'nohost' member. * module.c (ab_attribute): Add 'AB_OACC_ROUTINE_NOHOST'. (attr_bits, mio_symbol_attribute): Update. * openmp.c (omp_mask2): Add 'OMP_CLAUSE_NOHOST'. (gfc_match_omp_clauses): Handle 'OMP_CLAUSE_NOHOST'. (OACC_ROUTINE_CLAUSES): Add 'OMP_CLAUSE_NOHOST'. (gfc_match_oacc_routine): Update. * trans-decl.c (add_attributes_to_decl): Update. * trans-openmp.c (gfc_trans_omp_clauses): Likewise. gcc/testsuite/ * c-c++-common/goacc/classify-routine-nohost.c: New file. * c-c++-common/goacc/classify-routine.c: Update. * c-c++-common/goacc/routine-2.c: Likewise. * c-c++-common/goacc/routine-nohost-1.c: New file. * c-c++-common/goacc/routine-nohost-2.c: Likewise. * g++.dg/goacc/template.C: Update. * gfortran.dg/goacc/classify-routine-nohost.f95: New file. * gfortran.dg/goacc/classify-routine.f95: Update. * gfortran.dg/goacc/pure-elemental-procedures-2.f90: Likewise. * gfortran.dg/goacc/routine-6.f90: Likewise. * gfortran.dg/goacc/routine-intrinsic-2.f: Likewise. * gfortran.dg/goacc/routine-module-1.f90: Likewise. * gfortran.dg/goacc/routine-module-2.f90: Likewise. * gfortran.dg/goacc/routine-module-3.f90: Likewise. * gfortran.dg/goacc/routine-module-mod-1.f90: Likewise. * gfortran.dg/goacc/routine-multiple-directives-1.f90: Likewise. * gfortran.dg/goacc/routine-multiple-directives-2.f90: Likewise. libgomp/ * testsuite/libgomp.oacc-c-c++-common/routine-nohost-1.c: New file. * testsuite/libgomp.oacc-c-c++-common/routine-nohost-2.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/routine-nohost-2_2.c: Likewise. * testsuite/libgomp.oacc-fortran/routine-nohost-1.f90: Likewise. Co-Authored-By: Joseph Myers Co-Authored-By: Cesar Philippidis --- gcc/fortran/trans-openmp.c | 2 ++ 1 file changed, 2 insertions(+) (limited to 'gcc/fortran/trans-openmp.c') diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index ace4faf..ac3f5f3 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -4297,6 +4297,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, gcc_unreachable (); } } + /* OpenACC 'nohost' clauses cannot appear here. */ + gcc_checking_assert (!clauses->nohost); return nreverse (omp_clauses); } -- cgit v1.1 From 432de08498142d2266c0fb05f2c555a7f1e10ddd Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Thu, 12 Aug 2021 15:48:28 +0200 Subject: OpenMP 5.1: Add proc-bind 'primary' support In OpenMP 5.1 "master thread" was changed to "primary thread" and the proc_bind clause and the OMP_PROC_BIND environment variable now take 'primary' as argument as alias for 'master', while the latter is deprecated. This commit accepts 'primary' and adds the named constant omp_proc_bind_primary and changes 'master thread' in the documentation; however, given that not even OpenMP 5.0 is fully supported, omp_display_env and the dumps currently still output 'master' and there is no deprecation warning when using the 'master' in the proc_bind clause. gcc/c/ChangeLog: * c-parser.c (c_parser_omp_clause_proc_bind): Accept 'primary' as alias for 'master'. gcc/cp/ChangeLog: * parser.c (cp_parser_omp_clause_proc_bind): Accept 'primary' as alias for 'master'. gcc/fortran/ChangeLog: * gfortran.h (gfc_omp_proc_bind_kind): Add OMP_PROC_BIND_PRIMARY. * dump-parse-tree.c (show_omp_clauses): Add TODO comment to change 'master' to 'primary' in proc_bind for OpenMP 5.1. * intrinsic.texi (OMP_LIB): Mention OpenMP 5.1; add omp_proc_bind_primary. * openmp.c (gfc_match_omp_clauses): Accept 'primary' as alias for 'master'. * trans-openmp.c (gfc_trans_omp_clauses): Handle OMP_PROC_BIND_PRIMARY. gcc/ChangeLog: * tree-core.h (omp_clause_proc_bind_kind): Add OMP_CLAUSE_PROC_BIND_PRIMARY. * tree-pretty-print.c (dump_omp_clause): Add TODO comment to change 'master' to 'primary' in proc_bind for OpenMP 5.1. libgomp/ChangeLog: * env.c (parse_bind_var): Accept 'primary' as alias for 'master'. (omp_display_env): Add TODO comment to change 'master' to 'primary' in proc_bind for OpenMP 5.1. * libgomp.texi: Change 'master thread' to 'primary thread' in line with OpenMP 5.1. (omp_get_proc_bind): Add omp_proc_bind_primary and note that omp_proc_bind_master is an alias of it. (OMP_PROC_BIND): Mention 'PRIMARY'. * omp.h.in (__GOMP_DEPRECATED_5_1): Define. (omp_proc_bind_primary): Add. (omp_proc_bind_master): Deprecate for OpenMP 5.1. * omp_lib.f90.in (omp_proc_bind_primary): Add. (omp_proc_bind_master): Deprecate for OpenMP 5.1. * omp_lib.h.in (omp_proc_bind_primary): Add. * testsuite/libgomp.c/affinity-1.c: Check that 'primary' works and is identical to 'master'. gcc/testsuite/ChangeLog: * c-c++-common/gomp/pr61486-2.c: Duplicate one proc_bind(master) testcase and test proc_bind(primary) instead. * gfortran.dg/gomp/affinity-1.f90: Likewise. --- gcc/fortran/trans-openmp.c | 3 +++ 1 file changed, 3 insertions(+) (limited to 'gcc/fortran/trans-openmp.c') diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index ac3f5f3..3d3b35e 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -3865,6 +3865,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_PROC_BIND); switch (clauses->proc_bind) { + case OMP_PROC_BIND_PRIMARY: + OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_PRIMARY; + break; case OMP_PROC_BIND_MASTER: OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_MASTER; break; -- cgit v1.1 From 53d5b59cb3b417ab8293702aacc75a9bbb3ead78 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Mon, 16 Aug 2021 09:26:26 +0200 Subject: Fortran/OpenMP: Add support for OpenMP 5.1 masked construct Commit r12-2891-gd0befed793b94f3f407be44e6f69f81a02f5f073 added C/C++ support for the masked construct. This patch extends it to Fortran. gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_clauses): Handle 'filter' clause. (show_omp_node, show_code_node): Handle (combined) omp masked construct. * frontend-passes.c (gfc_code_walker): Likewise. * gfortran.h (enum gfc_statement): Add ST_OMP_*_MASKED*. (enum gfc_exec_op): Add EXEC_OMP_*_MASKED*. * match.h (gfc_match_omp_masked, gfc_match_omp_masked_taskloop, gfc_match_omp_masked_taskloop_simd, gfc_match_omp_parallel_masked, gfc_match_omp_parallel_masked_taskloop, gfc_match_omp_parallel_masked_taskloop_simd): New prototypes. * openmp.c (enum omp_mask1): Add OMP_CLAUSE_FILTER. (gfc_match_omp_clauses): Match it. (OMP_MASKED_CLAUSES, gfc_match_omp_parallel_masked, gfc_match_omp_parallel_masked_taskloop, gfc_match_omp_parallel_masked_taskloop_simd, gfc_match_omp_masked, gfc_match_omp_masked_taskloop, gfc_match_omp_masked_taskloop_simd): New. (resolve_omp_clauses): Resolve filter clause. (gfc_resolve_omp_parallel_blocks, resolve_omp_do, omp_code_to_statement, gfc_resolve_omp_directive): Handle omp masked constructs. * parse.c (decode_omp_directive, case_exec_markers, gfc_ascii_statement, parse_omp_do, parse_omp_structured_block, parse_executable): Likewise. * resolve.c (gfc_resolve_blocks, gfc_resolve_code): Likewise. * st.c (gfc_free_statement): Likewise. * trans-openmp.c (gfc_trans_omp_clauses): Handle filter clause. (GFC_OMP_SPLIT_MASKED, GFC_OMP_MASK_MASKED): New enum values. (gfc_trans_omp_masked): New. (gfc_split_omp_clauses): Handle combined masked directives. (gfc_trans_omp_master_taskloop): Rename to ... (gfc_trans_omp_master_masked_taskloop): ... this; handle also combined masked directives. (gfc_trans_omp_parallel_master): Rename to ... (gfc_trans_omp_parallel_master_masked): ... this; handle combined masked directives. (gfc_trans_omp_directive): Handle EXEC_OMP_*_MASKED*. * trans.c (trans_code): Likewise. libgomp/ChangeLog: * testsuite/libgomp.fortran/masked-1.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/masked-1.f90: New test. * gfortran.dg/gomp/masked-2.f90: New test. * gfortran.dg/gomp/masked-3.f90: New test. * gfortran.dg/gomp/masked-combined-1.f90: New test. * gfortran.dg/gomp/masked-combined-2.f90: New test. --- gcc/fortran/trans-openmp.c | 176 +++++++++++++++++++++++++++++++++++++-------- 1 file changed, 147 insertions(+), 29 deletions(-) (limited to 'gcc/fortran/trans-openmp.c') diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 3d3b35e..623c21f 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -4047,6 +4047,21 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, omp_clauses = gfc_trans_add_clause (c, omp_clauses); } + if (clauses->filter) + { + tree filter; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->filter); + gfc_add_block_to_block (block, &se.pre); + filter = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_FILTER); + OMP_CLAUSE_FILTER_EXPR (c) = filter; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + if (clauses->hint) { tree hint; @@ -5390,6 +5405,26 @@ gfc_trans_omp_master (gfc_code *code) } static tree +gfc_trans_omp_masked (gfc_code *code, gfc_omp_clauses *clauses) +{ + stmtblock_t block; + tree body = gfc_trans_code (code->block->next); + if (IS_EMPTY_STMT (body)) + return body; + if (!clauses) + clauses = code->ext.omp_clauses; + gfc_start_block (&block); + tree omp_clauses = gfc_trans_omp_clauses (&block, clauses, code->loc); + tree stmt = make_node (OMP_MASKED); + TREE_TYPE (stmt) = void_type_node; + OMP_MASKED_BODY (stmt) = body; + OMP_MASKED_CLAUSES (stmt) = omp_clauses; + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + + +static tree gfc_trans_omp_ordered (gfc_code *code) { if (!flag_openmp) @@ -5432,6 +5467,7 @@ enum GFC_OMP_SPLIT_TEAMS, GFC_OMP_SPLIT_TARGET, GFC_OMP_SPLIT_TASKLOOP, + GFC_OMP_SPLIT_MASKED, GFC_OMP_SPLIT_NUM }; @@ -5443,7 +5479,8 @@ enum GFC_OMP_MASK_DISTRIBUTE = (1 << GFC_OMP_SPLIT_DISTRIBUTE), GFC_OMP_MASK_TEAMS = (1 << GFC_OMP_SPLIT_TEAMS), GFC_OMP_MASK_TARGET = (1 << GFC_OMP_SPLIT_TARGET), - GFC_OMP_MASK_TASKLOOP = (1 << GFC_OMP_SPLIT_TASKLOOP) + GFC_OMP_MASK_TASKLOOP = (1 << GFC_OMP_SPLIT_TASKLOOP), + GFC_OMP_MASK_MASKED = (1 << GFC_OMP_SPLIT_MASKED) }; /* If a var is in lastprivate/firstprivate/reduction but not in a @@ -5632,10 +5669,24 @@ gfc_split_omp_clauses (gfc_code *code, mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD; innermost = GFC_OMP_SPLIT_SIMD; break; + case EXEC_OMP_PARALLEL_MASKED: + mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_MASKED; + innermost = GFC_OMP_SPLIT_MASKED; + break; + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + mask = (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_MASKED + | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD); + innermost = GFC_OMP_SPLIT_TASKLOOP; + break; case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD; innermost = GFC_OMP_SPLIT_TASKLOOP; break; + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: + mask = (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_MASKED + | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD); + innermost = GFC_OMP_SPLIT_SIMD; + break; case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD; innermost = GFC_OMP_SPLIT_SIMD; @@ -5692,10 +5743,18 @@ gfc_split_omp_clauses (gfc_code *code, mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DO; innermost = GFC_OMP_SPLIT_DO; break; + case EXEC_OMP_MASKED_TASKLOOP: + mask = GFC_OMP_SPLIT_MASKED | GFC_OMP_SPLIT_TASKLOOP; + innermost = GFC_OMP_SPLIT_TASKLOOP; + break; case EXEC_OMP_MASTER_TASKLOOP: case EXEC_OMP_TASKLOOP: innermost = GFC_OMP_SPLIT_TASKLOOP; break; + case EXEC_OMP_MASKED_TASKLOOP_SIMD: + mask = GFC_OMP_MASK_MASKED | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; case EXEC_OMP_MASTER_TASKLOOP_SIMD: case EXEC_OMP_TASKLOOP_SIMD: mask = GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD; @@ -5814,6 +5873,8 @@ gfc_split_omp_clauses (gfc_code *code, clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr = code->ext.omp_clauses->if_expr; } + if (mask & GFC_OMP_MASK_MASKED) + clausesa[GFC_OMP_SPLIT_MASKED].filter = code->ext.omp_clauses->filter; if ((mask & GFC_OMP_MASK_DO) && !is_loop) { /* First the clauses that are unique to some constructs. */ @@ -5896,16 +5957,18 @@ gfc_split_omp_clauses (gfc_code *code, clausesa[GFC_OMP_SPLIT_TASKLOOP].collapse = code->ext.omp_clauses->collapse; } - /* Private clause is supported on all constructs, - it is enough to put it on the innermost one. For + /* Private clause is supported on all constructs but master/masked, + it is enough to put it on the innermost one except for master/masked. For !$ omp parallel do put it on parallel though, as that's what we did for OpenMP 3.1. */ - clausesa[innermost == GFC_OMP_SPLIT_DO && !is_loop + clausesa[((innermost == GFC_OMP_SPLIT_DO && !is_loop) + || code->op == EXEC_OMP_PARALLEL_MASTER + || code->op == EXEC_OMP_PARALLEL_MASKED) ? (int) GFC_OMP_SPLIT_PARALLEL : innermost].lists[OMP_LIST_PRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_PRIVATE]; /* Firstprivate clause is supported on all constructs but - simd. Put it on the outermost of those and duplicate + simd and masked/master. Put it on the outermost of those and duplicate on parallel and teams. */ if (mask & GFC_OMP_MASK_TARGET) clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_FIRSTPRIVATE] @@ -6588,43 +6651,66 @@ gfc_trans_omp_taskloop (gfc_code *code, gfc_exec_op op) } static tree -gfc_trans_omp_master_taskloop (gfc_code *code, gfc_exec_op op) +gfc_trans_omp_master_masked_taskloop (gfc_code *code, gfc_exec_op op) { + gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM]; stmtblock_t block; tree stmt; - gfc_start_block (&block); + if (op != EXEC_OMP_MASTER_TASKLOOP_SIMD + && code->op != EXEC_OMP_MASTER_TASKLOOP) + gfc_split_omp_clauses (code, clausesa); + pushlevel (); - if (op == EXEC_OMP_MASTER_TASKLOOP_SIMD) + if (op == EXEC_OMP_MASKED_TASKLOOP_SIMD + || op == EXEC_OMP_MASTER_TASKLOOP_SIMD) stmt = gfc_trans_omp_taskloop (code, EXEC_OMP_TASKLOOP_SIMD); else { - gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM]; - gcc_assert (op == EXEC_OMP_MASTER_TASKLOOP); - if (op != code->op) - gfc_split_omp_clauses (code, clausesa); + gcc_assert (op == EXEC_OMP_MASKED_TASKLOOP + || op == EXEC_OMP_MASTER_TASKLOOP); stmt = gfc_trans_omp_do (code, EXEC_OMP_TASKLOOP, NULL, - op != code->op + code->op != EXEC_OMP_MASTER_TASKLOOP ? &clausesa[GFC_OMP_SPLIT_TASKLOOP] : code->ext.omp_clauses, NULL); - if (op != code->op) - gfc_free_split_omp_clauses (code, clausesa); } if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); else poplevel (0, 0); - stmt = build1_v (OMP_MASTER, stmt); - gfc_add_expr_to_block (&block, stmt); + gfc_start_block (&block); + if (op == EXEC_OMP_MASKED_TASKLOOP || op == EXEC_OMP_MASKED_TASKLOOP_SIMD) + { + tree clauses = gfc_trans_omp_clauses (&block, + &clausesa[GFC_OMP_SPLIT_MASKED], + code->loc); + tree msk = make_node (OMP_MASKED); + TREE_TYPE (msk) = void_type_node; + OMP_MASKED_BODY (msk) = stmt; + OMP_MASKED_CLAUSES (msk) = clauses; + OMP_MASKED_COMBINED (msk) = 1; + gfc_add_expr_to_block (&block, msk); + } + else + { + gcc_assert (op == EXEC_OMP_MASTER_TASKLOOP + || op == EXEC_OMP_MASTER_TASKLOOP_SIMD); + stmt = build1_v (OMP_MASTER, stmt); + gfc_add_expr_to_block (&block, stmt); + } + if (op != EXEC_OMP_MASTER_TASKLOOP_SIMD + && code->op != EXEC_OMP_MASTER_TASKLOOP) + gfc_free_split_omp_clauses (code, clausesa); return gfc_finish_block (&block); } static tree -gfc_trans_omp_parallel_master (gfc_code *code) +gfc_trans_omp_parallel_master_masked (gfc_code *code) { stmtblock_t block; tree stmt, omp_clauses; gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM]; + bool parallel_combined = false; if (code->op != EXEC_OMP_PARALLEL_MASTER) gfc_split_omp_clauses (code, clausesa); @@ -6635,19 +6721,33 @@ gfc_trans_omp_parallel_master (gfc_code *code) ? code->ext.omp_clauses : &clausesa[GFC_OMP_SPLIT_PARALLEL], code->loc); - if (code->op != EXEC_OMP_PARALLEL_MASTER) - gfc_free_split_omp_clauses (code, clausesa); pushlevel (); if (code->op == EXEC_OMP_PARALLEL_MASTER) stmt = gfc_trans_omp_master (code); + else if (code->op == EXEC_OMP_PARALLEL_MASKED) + stmt = gfc_trans_omp_masked (code, &clausesa[GFC_OMP_SPLIT_MASKED]); else { - gcc_assert (code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP - || code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD); - gfc_exec_op op = (code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP - ? EXEC_OMP_MASTER_TASKLOOP - : EXEC_OMP_MASTER_TASKLOOP_SIMD); - stmt = gfc_trans_omp_master_taskloop (code, op); + gfc_exec_op op; + switch (code->op) + { + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + op = EXEC_OMP_MASKED_TASKLOOP; + break; + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: + op = EXEC_OMP_MASKED_TASKLOOP_SIMD; + break; + case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: + op = EXEC_OMP_MASTER_TASKLOOP; + break; + case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: + op = EXEC_OMP_MASTER_TASKLOOP_SIMD; + break; + default: + gcc_unreachable (); + } + stmt = gfc_trans_omp_master_masked_taskloop (code, op); + parallel_combined = true; } if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); @@ -6655,8 +6755,19 @@ gfc_trans_omp_parallel_master (gfc_code *code) poplevel (0, 0); stmt = build2_loc (gfc_get_location (&code->loc), OMP_PARALLEL, void_type_node, stmt, omp_clauses); - OMP_PARALLEL_COMBINED (stmt) = 1; + /* masked does have just filter clause, but during gimplification + isn't represented by a gimplification omp context, so for + !$omp parallel masked don't set OMP_PARALLEL_COMBINED, + so that + !$omp parallel masked + !$omp taskloop simd lastprivate (x) + isn't confused with + !$omp parallel masked taskloop simd lastprivate (x) */ + if (parallel_combined) + OMP_PARALLEL_COMBINED (stmt) = 1; gfc_add_expr_to_block (&block, stmt); + if (code->op != EXEC_OMP_PARALLEL_MASTER) + gfc_free_split_omp_clauses (code, clausesa); return gfc_finish_block (&block); } @@ -6969,11 +7080,15 @@ gfc_trans_omp_directive (gfc_code *code) return gfc_trans_omp_do_simd (code, NULL, NULL, NULL_TREE); case EXEC_OMP_FLUSH: return gfc_trans_omp_flush (code); + case EXEC_OMP_MASKED: + return gfc_trans_omp_masked (code, NULL); case EXEC_OMP_MASTER: return gfc_trans_omp_master (code); + case EXEC_OMP_MASKED_TASKLOOP: + case EXEC_OMP_MASKED_TASKLOOP_SIMD: case EXEC_OMP_MASTER_TASKLOOP: case EXEC_OMP_MASTER_TASKLOOP_SIMD: - return gfc_trans_omp_master_taskloop (code, code->op); + return gfc_trans_omp_master_masked_taskloop (code, code->op); case EXEC_OMP_ORDERED: return gfc_trans_omp_ordered (code); case EXEC_OMP_PARALLEL: @@ -6984,10 +7099,13 @@ gfc_trans_omp_directive (gfc_code *code) return gfc_trans_omp_parallel_do (code, true, NULL, NULL); case EXEC_OMP_PARALLEL_DO_SIMD: return gfc_trans_omp_parallel_do_simd (code, NULL, NULL); + case EXEC_OMP_PARALLEL_MASKED: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: case EXEC_OMP_PARALLEL_MASTER: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: - return gfc_trans_omp_parallel_master (code); + return gfc_trans_omp_parallel_master_masked (code); case EXEC_OMP_PARALLEL_SECTIONS: return gfc_trans_omp_parallel_sections (code); case EXEC_OMP_PARALLEL_WORKSHARE: -- cgit v1.1 From f8d535f3fec81c1cc84e22df5500e693544ec65b Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Tue, 17 Aug 2021 15:50:11 +0200 Subject: Fortran: Implement OpenMP 5.1 scope construct Fortran version to commit e45483c7c4badc4bf2d6ced22360ce1ab172967f, which implemented OpenMP's scope construct for C and C++. Most testcases are based on the C testcases; it also contains some testcases which existed previously but had no Fortran equivalent. gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_node, show_code_node): Handle EXEC_OMP_SCOPE. * gfortran.h (enum gfc_statement): Add ST_OMP_(END_)SCOPE. (enum gfc_exec_op): Add EXEC_OMP_SCOPE. * match.h (gfc_match_omp_scope): New. * openmp.c (OMP_SCOPE_CLAUSES): Define (gfc_match_omp_scope): New. (gfc_match_omp_cancellation_point, gfc_match_omp_end_nowait): Improve error diagnostic. (omp_code_to_statement): Handle ST_OMP_SCOPE. (gfc_resolve_omp_directive): Handle EXEC_OMP_SCOPE. * parse.c (decode_omp_directive, next_statement, gfc_ascii_statement, parse_omp_structured_block, parse_executable): Handle OpenMP's scope construct. * resolve.c (gfc_resolve_blocks): Likewise * st.c (gfc_free_statement): Likewise * trans-openmp.c (gfc_trans_omp_scope): New. (gfc_trans_omp_directive): Call it. * trans.c (trans_code): handle EXEC_OMP_SCOPE. libgomp/ChangeLog: * testsuite/libgomp.fortran/scope-1.f90: New test. * testsuite/libgomp.fortran/task-reduction-16.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/scan-1.f90: * gfortran.dg/gomp/cancel-1.f90: New test. * gfortran.dg/gomp/cancel-4.f90: New test. * gfortran.dg/gomp/loop-4.f90: New test. * gfortran.dg/gomp/nesting-1.f90: New test. * gfortran.dg/gomp/nesting-2.f90: New test. * gfortran.dg/gomp/nesting-3.f90: New test. * gfortran.dg/gomp/nowait-1.f90: New test. * gfortran.dg/gomp/reduction-task-1.f90: New test. * gfortran.dg/gomp/reduction-task-2.f90: New test. * gfortran.dg/gomp/reduction-task-2a.f90: New test. * gfortran.dg/gomp/reduction-task-3.f90: New test. * gfortran.dg/gomp/scope-1.f90: New test. * gfortran.dg/gomp/scope-2.f90: New test. --- gcc/fortran/trans-openmp.c | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) (limited to 'gcc/fortran/trans-openmp.c') diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 623c21f..e0a0014 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -6265,6 +6265,24 @@ gfc_trans_omp_parallel_workshare (gfc_code *code) } static tree +gfc_trans_omp_scope (gfc_code *code) +{ + stmtblock_t block; + tree body = gfc_trans_code (code->block->next); + if (IS_EMPTY_STMT (body)) + return body; + gfc_start_block (&block); + tree omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses, + code->loc); + tree stmt = make_node (OMP_SCOPE); + TREE_TYPE (stmt) = void_type_node; + OMP_SCOPE_BODY (stmt) = body; + OMP_SCOPE_CLAUSES (stmt) = omp_clauses; + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree gfc_trans_omp_sections (gfc_code *code, gfc_omp_clauses *clauses) { stmtblock_t block, body; @@ -7110,6 +7128,8 @@ gfc_trans_omp_directive (gfc_code *code) return gfc_trans_omp_parallel_sections (code); case EXEC_OMP_PARALLEL_WORKSHARE: return gfc_trans_omp_parallel_workshare (code); + case EXEC_OMP_SCOPE: + return gfc_trans_omp_scope (code); case EXEC_OMP_SECTIONS: return gfc_trans_omp_sections (code, code->ext.omp_clauses); case EXEC_OMP_SINGLE: -- cgit v1.1 From 77167196fe8cf840a69913e7739d39ae0df2b074 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 20 Aug 2021 12:12:51 +0200 Subject: Fortran: Add OpenMP's error directive Fortran part to the C/C++ implementation of commit r12-3040-g0d973c0a0d90a0a302e7eda1a4d9709be3c5b102 gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_clauses): Handle 'at', 'severity' and 'message' clauses. (show_omp_node, show_code_node): Handle EXEC_OMP_ERROR. * gfortran.h (gfc_statement): Add ST_OMP_ERROR. (gfc_omp_severity_type, gfc_omp_at_type): New. (gfc_omp_clauses): Add 'at', 'severity' and 'message' clause; use more bitfields + ENUM_BITFIELD. (gfc_exec_op): Add EXEC_OMP_ERROR. * match.h (gfc_match_omp_error): New. * openmp.c (enum omp_mask1): Add OMP_CLAUSE_(AT,SEVERITY,MESSAGE). (gfc_match_omp_clauses): Handle new clauses. (OMP_ERROR_CLAUSES, gfc_match_omp_error): New. (resolve_omp_clauses): Resolve new clauses. (omp_code_to_statement, gfc_resolve_omp_directive): Handle EXEC_OMP_ERROR. * parse.c (decode_omp_directive, next_statement, gfc_ascii_statement): Handle 'omp error'. * resolve.c (gfc_resolve_blocks): Likewise. * st.c (gfc_free_statement): Likewise. * trans-openmp.c (gfc_trans_omp_error): Likewise. (gfc_trans_omp_directive): Likewise. * trans.c (trans_code): Likewise. libgomp/ChangeLog: * testsuite/libgomp.fortran/error-1.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/error-1.f90: New test. * gfortran.dg/gomp/error-2.f90: New test. * gfortran.dg/gomp/error-3.f90: New test. --- gcc/fortran/trans-openmp.c | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) (limited to 'gcc/fortran/trans-openmp.c') diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index e0a0014..91888f3 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -5369,6 +5369,38 @@ gfc_trans_omp_depobj (gfc_code *code) } static tree +gfc_trans_omp_error (gfc_code *code) +{ + stmtblock_t block; + gfc_se se; + tree len, message; + bool fatal = code->ext.omp_clauses->severity == OMP_SEVERITY_FATAL; + tree fndecl = builtin_decl_explicit (fatal ? BUILT_IN_GOMP_ERROR + : BUILT_IN_GOMP_WARNING); + gfc_start_block (&block); + gfc_init_se (&se, NULL ); + if (!code->ext.omp_clauses->message) + { + message = null_pointer_node; + len = build_int_cst (size_type_node, 0); + } + else + { + gfc_conv_expr (&se, code->ext.omp_clauses->message); + message = se.expr; + if (!POINTER_TYPE_P (TREE_TYPE (message))) + /* To ensure an ARRAY_TYPE is not passed as such. */ + message = gfc_build_addr_expr (NULL, message); + len = se.string_length; + } + gfc_add_block_to_block (&block, &se.pre); + gfc_add_expr_to_block (&block, build_call_expr_loc (input_location, fndecl, + 2, message, len)); + gfc_add_block_to_block (&block, &se.post); + return gfc_finish_block (&block); +} + +static tree gfc_trans_omp_flush (gfc_code *code) { tree call; @@ -7096,6 +7128,8 @@ gfc_trans_omp_directive (gfc_code *code) return gfc_trans_omp_distribute (code, NULL); case EXEC_OMP_DO_SIMD: return gfc_trans_omp_do_simd (code, NULL, NULL, NULL_TREE); + case EXEC_OMP_ERROR: + return gfc_trans_omp_error (code); case EXEC_OMP_FLUSH: return gfc_trans_omp_flush (code); case EXEC_OMP_MASKED: -- cgit v1.1 From d4de7e32eff0a6363defa50b052d7a30548b6552 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Mon, 23 Aug 2021 15:13:30 +0200 Subject: Fortran/OpenMP: strict modifier on grainsize/num_tasks This patch adds support for the 'strict' modifier on grainsize/num_tasks clauses, an OpenMP 5.1 feature supported in C/C++ since commit r12-3066-g3bc75533d1f87f0617be6c1af98804f9127ec637 gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_clauses): Handle 'strict' modifier on grainsize/num_tasks * gfortran.h (gfc_omp_clauses): Add grainsize_strict and num_tasks_strict. * trans-openmp.c (gfc_trans_omp_clauses, gfc_split_omp_clauses): Handle 'strict' modifier on grainsize/num_tasks. * openmp.c (gfc_match_omp_clauses): Likewise. libgomp/ChangeLog: * testsuite/libgomp.fortran/taskloop-4-a.f90: New test. * testsuite/libgomp.fortran/taskloop-4.f90: New test. * testsuite/libgomp.fortran/taskloop-5-a.f90: New test. * testsuite/libgomp.fortran/taskloop-5.f90: New test. --- gcc/fortran/trans-openmp.c | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'gcc/fortran/trans-openmp.c') diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 91888f3..40d2fd2 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -3998,6 +3998,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_GRAINSIZE); OMP_CLAUSE_GRAINSIZE_EXPR (c) = grainsize; + if (clauses->grainsize_strict) + OMP_CLAUSE_GRAINSIZE_STRICT (c) = 1; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -4013,6 +4015,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_TASKS); OMP_CLAUSE_NUM_TASKS_EXPR (c) = num_tasks; + if (clauses->num_tasks_strict) + OMP_CLAUSE_NUM_TASKS_STRICT (c) = 1; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -5964,8 +5968,12 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->nogroup; clausesa[GFC_OMP_SPLIT_TASKLOOP].grainsize = code->ext.omp_clauses->grainsize; + clausesa[GFC_OMP_SPLIT_TASKLOOP].grainsize_strict + = code->ext.omp_clauses->grainsize_strict; clausesa[GFC_OMP_SPLIT_TASKLOOP].num_tasks = code->ext.omp_clauses->num_tasks; + clausesa[GFC_OMP_SPLIT_TASKLOOP].num_tasks_strict + = code->ext.omp_clauses->num_tasks_strict; clausesa[GFC_OMP_SPLIT_TASKLOOP].priority = code->ext.omp_clauses->priority; clausesa[GFC_OMP_SPLIT_TASKLOOP].final_expr -- cgit v1.1 From 03be3cfeef7b3811acb6c4a8da2fc5c1e25d3e4c Mon Sep 17 00:00:00 2001 From: Marcel Vollweiler Date: Tue, 31 Aug 2021 06:09:40 -0700 Subject: Add support for device-modifiers for 'omp target device'. 'device_num' and 'ancestor' are now parsed on target device constructs for C, C++, and Fortran (see OpenMP specification 5.0, p. 170). When 'ancestor' is used, then 'sorry, not supported' is output. Moreover, the restrictions for 'ancestor' are implemented (see OpenMP specification 5.0, p. 174f). gcc/c/ChangeLog: * c-parser.c (c_parser_omp_clause_device): Parse device-modifiers 'device_num' and 'ancestor' in 'target device' clauses. gcc/cp/ChangeLog: * parser.c (cp_parser_omp_clause_device): Parse device-modifiers 'device_num' and 'ancestor' in 'target device' clauses. * semantics.c (finish_omp_clauses): Error handling. Constant device ids must evaluate to '1' if 'ancestor' is used. gcc/fortran/ChangeLog: * gfortran.h: Add variable for 'ancestor' in struct gfc_omp_clauses. * openmp.c (gfc_match_omp_clauses): Parse device-modifiers 'device_num' and 'ancestor' in 'target device' clauses. * trans-openmp.c (gfc_trans_omp_clauses): Set OMP_CLAUSE_DEVICE_ANCESTOR. gcc/ChangeLog: * gimplify.c (gimplify_scan_omp_clauses): Error handling. 'ancestor' only allowed on target constructs and only with particular other clauses. * omp-expand.c (expand_omp_target): Output of 'sorry, not supported' if 'ancestor' is used. * omp-low.c (check_omp_nesting_restrictions): Error handling. No nested OpenMP structs when 'ancestor' is used. (scan_omp_1_stmt): No usage of OpenMP runtime routines in a target region when 'ancestor' is used. * tree-pretty-print.c (dump_omp_clause): Append 'ancestor'. * tree.h (OMP_CLAUSE_DEVICE_ANCESTOR): Define macro. gcc/testsuite/ChangeLog: * c-c++-common/gomp/target-device-1.c: New test. * c-c++-common/gomp/target-device-2.c: New test. * c-c++-common/gomp/target-device-ancestor-1.c: New test. * c-c++-common/gomp/target-device-ancestor-2.c: New test. * c-c++-common/gomp/target-device-ancestor-3.c: New test. * c-c++-common/gomp/target-device-ancestor-4.c: New test. * gfortran.dg/gomp/target-device-1.f90: New test. * gfortran.dg/gomp/target-device-2.f90: New test. * gfortran.dg/gomp/target-device-ancestor-1.f90: New test. * gfortran.dg/gomp/target-device-ancestor-2.f90: New test. * gfortran.dg/gomp/target-device-ancestor-3.f90: New test. * gfortran.dg/gomp/target-device-ancestor-4.f90: New test. --- gcc/fortran/trans-openmp.c | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'gcc/fortran/trans-openmp.c') diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 40d2fd2..6f9b0e3 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -3950,6 +3950,10 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEVICE); OMP_CLAUSE_DEVICE_ID (c) = device; + + if (clauses->ancestor) + OMP_CLAUSE_DEVICE_ANCESTOR (c) = 1; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); } -- cgit v1.1 From ba1cc6956b956eb5b92c45af79a8b1fe426ec4d3 Mon Sep 17 00:00:00 2001 From: Marcel Vollweiler Date: Tue, 7 Sep 2021 03:46:28 -0700 Subject: C, C++, Fortran, OpenMP: Add support for 'flush seq_cst' construct. This patch adds support for the 'seq_cst' memory order clause on the 'flush' directive which was introduced in OpenMP 5.1. gcc/c-family/ChangeLog: * c-omp.c (c_finish_omp_flush): Handle MEMMODEL_SEQ_CST. gcc/c/ChangeLog: * c-parser.c (c_parser_omp_flush): Parse 'seq_cst' clause on 'flush' directive. gcc/cp/ChangeLog: * parser.c (cp_parser_omp_flush): Parse 'seq_cst' clause on 'flush' directive. * semantics.c (finish_omp_flush): Handle MEMMODEL_SEQ_CST. gcc/fortran/ChangeLog: * openmp.c (gfc_match_omp_flush): Parse 'seq_cst' clause on 'flush' directive. * trans-openmp.c (gfc_trans_omp_flush): Handle OMP_MEMORDER_SEQ_CST. gcc/testsuite/ChangeLog: * c-c++-common/gomp/flush-1.c: Add test case for 'seq_cst'. * c-c++-common/gomp/flush-2.c: Add test case for 'seq_cst'. * g++.dg/gomp/attrs-1.C: Adapt test to handle all flush clauses. * g++.dg/gomp/attrs-2.C: Adapt test to handle all flush clauses. * gfortran.dg/gomp/flush-1.f90: Add test case for 'seq_cst'. * gfortran.dg/gomp/flush-2.f90: Add test case for 'seq_cst'. --- gcc/fortran/trans-openmp.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'gcc/fortran/trans-openmp.c') diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 6f9b0e3..e55e0c8 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -5413,7 +5413,8 @@ gfc_trans_omp_flush (gfc_code *code) { tree call; if (!code->ext.omp_clauses - || code->ext.omp_clauses->memorder == OMP_MEMORDER_UNSET) + || code->ext.omp_clauses->memorder == OMP_MEMORDER_UNSET + || code->ext.omp_clauses->memorder == OMP_MEMORDER_SEQ_CST) { call = builtin_decl_explicit (BUILT_IN_SYNC_SYNCHRONIZE); call = build_call_expr_loc (input_location, call, 0); -- cgit v1.1