From: Julian Brown Date: Wed, 20 Feb 2019 13:21:15 +0000 (-0800) Subject: Support Fortran 2003 class pointers in OpenACC X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=5031a0790d1c95001eac4e487101e08c4af3382b;p=thirdparty%2Fgcc.git Support Fortran 2003 class pointers in OpenACC gcc/ * gimplify.c (insert_struct_comp_map): Handle GOMP_MAP_ATTACH_DETACH. (gimplify_scan_omp_clauses): Separate out handling of OACC_ENTER_DATA and OACC_EXIT_DATA. Remove GOMP_MAP_POINTER and GOMP_MAP_TO_PSET mappings, apart from those following GOMP_MAP_DECLARE_{,DE}ALLOCATE. Handle GOMP_MAP_ATTACH_DETACH. * tree-pretty-print.c (dump_omp_clause): Support GOMP_MAP_ATTACH_DETACH. Print "bias" not "len" for attach/detach clause types. include/ * gomp-constants.h (gomp_map_kind): Add GOMP_MAP_ATTACH_DETACH. gcc/c/ * c-typeck.c (handle_omp_array_sections): Use GOMP_MAP_ATTACH_DETACH for OpenACC attach/detach operations. gcc/cp/ * semantics.c (handle_omp_array_sections): Likewise. (finish_omp_clauses): Handle GOMP_MAP_ATTACH_DETACH. gcc/fortran/ * openmp.c (resolve_oacc_data_clauses): Allow polymorphic allocatable variables. * trans-expr.c (gfc_conv_component_ref, conv_parent_component_reference): Make global. (gfc_auto_dereference_var): New function, broken out of... (gfc_conv_variable): ...here. Call outlined function instead. * trans-openmp.c (gfc_trans_omp_array_section): New function, broken out of... (gfc_trans_omp_clauses): ...here. Separate out OpenACC derived type/polymorphic class pointer handling. Call above outlined function. * trans.h (gfc_conv_component_ref, conv_parent_component_references, gfc_auto_dereference_var): Add prototypes. gcc/testsuite/ * c-c++-common/goacc/mdc-1.c: Update clause matching patterns. libgomp/ * oacc-parallel.c (GOACC_enter_exit_data): Fix optional arguments for changes to clause stripping in enter data/exit data directives. * testsuite/libgomp.oacc-fortran/class-ptr-param.f95: New test. * testsuite/libgomp.oacc-fortran/classtypes-1.f95: New test. * testsuite/libgomp.oacc-fortran/classtypes-2.f95: New test. * testsuite/libgomp.oacc-fortran/derivedtype-1.f95: New test. * testsuite/libgomp.oacc-fortran/derivedtype-2.f95: New test. * testsuite/libgomp.oacc-fortran/multidim-slice.f95: New test. (cherry picked from openacc-gcc-9-branch commit 3c260613f2e74d6639c4dbd43b018b6640ae8454) --- diff --git a/gcc/ChangeLog.omp b/gcc/ChangeLog.omp index 15c9c0844134..455f67f5eae6 100644 --- a/gcc/ChangeLog.omp +++ b/gcc/ChangeLog.omp @@ -1,3 +1,13 @@ +2019-07-10 Julian Brown + + * gimplify.c (insert_struct_comp_map): Handle GOMP_MAP_ATTACH_DETACH. + (gimplify_scan_omp_clauses): Separate out handling of OACC_ENTER_DATA + and OACC_EXIT_DATA. Remove GOMP_MAP_POINTER and GOMP_MAP_TO_PSET + mappings, apart from those following GOMP_MAP_DECLARE_{,DE}ALLOCATE. + Handle GOMP_MAP_ATTACH_DETACH. + * tree-pretty-print.c (dump_omp_clause): Support GOMP_MAP_ATTACH_DETACH. + Print "bias" not "len" for attach/detach clause types. + 2019-05-28 Julian Brown * omp-low.c (mark_oacc_gangprivate): Add CTX parameter. Use to look up diff --git a/gcc/c/ChangeLog.omp b/gcc/c/ChangeLog.omp index c9341355d1a9..e5ac8c4be69d 100644 --- a/gcc/c/ChangeLog.omp +++ b/gcc/c/ChangeLog.omp @@ -1,3 +1,8 @@ +2019-07-10 Julian Brown + + * c-typeck.c (handle_omp_array_sections): Use GOMP_MAP_ATTACH_DETACH + for OpenACC attach/detach operations. + 2018-12-19 Julian Brown Maciej W. Rozycki diff --git a/gcc/c/c-typeck.c b/gcc/c/c-typeck.c index 2acd12d849f7..8a56478f7cba 100644 --- a/gcc/c/c-typeck.c +++ b/gcc/c/c-typeck.c @@ -13451,7 +13451,11 @@ handle_omp_array_sections (tree c, enum c_omp_region_type ort) if (ort != C_ORT_OMP && ort != C_ORT_ACC) OMP_CLAUSE_SET_MAP_KIND (c2, GOMP_MAP_POINTER); else if (TREE_CODE (t) == COMPONENT_REF) - OMP_CLAUSE_SET_MAP_KIND (c2, GOMP_MAP_ALWAYS_POINTER); + { + gomp_map_kind k = (ort == C_ORT_ACC) ? GOMP_MAP_ATTACH_DETACH + : GOMP_MAP_ALWAYS_POINTER; + OMP_CLAUSE_SET_MAP_KIND (c2, k); + } else OMP_CLAUSE_SET_MAP_KIND (c2, GOMP_MAP_FIRSTPRIVATE_POINTER); if (OMP_CLAUSE_MAP_KIND (c2) != GOMP_MAP_FIRSTPRIVATE_POINTER diff --git a/gcc/cp/ChangeLog.omp b/gcc/cp/ChangeLog.omp index 8306bd04bc32..00ee6b4e4694 100644 --- a/gcc/cp/ChangeLog.omp +++ b/gcc/cp/ChangeLog.omp @@ -1,3 +1,8 @@ +2019-07-10 Julian Brown + + * semantics.c (handle_omp_array_sections): Likewise. + (finish_omp_clauses): Handle GOMP_MAP_ATTACH_DETACH. + 2019-07-09 Andrew Stubbs Backport from mainline: diff --git a/gcc/cp/semantics.c b/gcc/cp/semantics.c index b8fa0c795bed..d5b256df8fff 100644 --- a/gcc/cp/semantics.c +++ b/gcc/cp/semantics.c @@ -5261,12 +5261,18 @@ handle_omp_array_sections (tree c, enum c_omp_region_type ort) if ((ort & C_ORT_OMP_DECLARE_SIMD) != C_ORT_OMP && ort != C_ORT_ACC) OMP_CLAUSE_SET_MAP_KIND (c2, GOMP_MAP_POINTER); else if (TREE_CODE (t) == COMPONENT_REF) - OMP_CLAUSE_SET_MAP_KIND (c2, GOMP_MAP_ALWAYS_POINTER); + { + gomp_map_kind k = (ort == C_ORT_ACC) ? GOMP_MAP_ATTACH_DETACH + : GOMP_MAP_ALWAYS_POINTER; + OMP_CLAUSE_SET_MAP_KIND (c2, k); + } else if (REFERENCE_REF_P (t) && TREE_CODE (TREE_OPERAND (t, 0)) == COMPONENT_REF) { t = TREE_OPERAND (t, 0); - OMP_CLAUSE_SET_MAP_KIND (c2, GOMP_MAP_ALWAYS_POINTER); + gomp_map_kind k = (ort == C_ORT_ACC) ? GOMP_MAP_ATTACH_DETACH + : GOMP_MAP_ALWAYS_POINTER; + OMP_CLAUSE_SET_MAP_KIND (c2, k); } else OMP_CLAUSE_SET_MAP_KIND (c2, GOMP_MAP_FIRSTPRIVATE_POINTER); @@ -7300,7 +7306,8 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort) break; if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP && (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_POINTER - || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_ALWAYS_POINTER)) + || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_ALWAYS_POINTER + || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_ATTACH_DETACH)) break; if (DECL_P (t)) error_at (OMP_CLAUSE_LOCATION (c), @@ -7439,7 +7446,12 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort) tree c2 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP); if (TREE_CODE (t) == COMPONENT_REF) - OMP_CLAUSE_SET_MAP_KIND (c2, GOMP_MAP_ALWAYS_POINTER); + { + gomp_map_kind k + = (ort == C_ORT_ACC) ? GOMP_MAP_ATTACH_DETACH + : GOMP_MAP_ALWAYS_POINTER; + OMP_CLAUSE_SET_MAP_KIND (c2, k); + } else OMP_CLAUSE_SET_MAP_KIND (c2, GOMP_MAP_FIRSTPRIVATE_REFERENCE); diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp index 02349239674c..c44a5ebdb3bb 100644 --- a/gcc/fortran/ChangeLog.omp +++ b/gcc/fortran/ChangeLog.omp @@ -1,3 +1,18 @@ +2019-07-10 Julian Brown + + * openmp.c (resolve_oacc_data_clauses): Allow polymorphic allocatable + variables. + * trans-expr.c (gfc_conv_component_ref, + conv_parent_component_reference): Make global. + (gfc_auto_dereference_var): New function, broken out of... + (gfc_conv_variable): ...here. Call outlined function instead. + * trans-openmp.c (gfc_trans_omp_array_section): New function, broken out + of... + (gfc_trans_omp_clauses): ...here. Separate out OpenACC derived + type/polymorphic class pointer handling. Call above outlined function. + * trans.h (gfc_conv_component_ref, conv_parent_component_references, + gfc_auto_dereference_var): Add prototypes. + 2019-05-19 Julian Brown * trans-openmp.c (gfc_omp_finish_clause): Guard addition of clauses for diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 679f99714b01..adf8d4240f7c 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -3931,12 +3931,6 @@ check_array_not_assumed (gfc_symbol *sym, locus loc, const char *name) static void resolve_oacc_data_clauses (gfc_symbol *sym, locus loc, const char *name) { - if ((sym->ts.type == BT_ASSUMED && sym->attr.allocatable) - || (sym->ts.type == BT_CLASS && CLASS_DATA (sym) - && CLASS_DATA (sym)->attr.allocatable)) - gfc_error ("ALLOCATABLE object %qs of polymorphic type " - "in %s clause at %L", sym->name, name, &loc); - check_symbol_not_pointer (sym, loc, name); check_array_not_assumed (sym, loc, name); } diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 21535acb989c..7dc5ada9b6bd 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2403,7 +2403,7 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind, /* Convert a derived type component reference. */ -static void +void gfc_conv_component_ref (gfc_se * se, gfc_ref * ref) { gfc_component *c; @@ -2493,7 +2493,7 @@ gfc_conv_component_ref (gfc_se * se, gfc_ref * ref) /* This function deals with component references to components of the parent type for derived type extensions. */ -static void +void conv_parent_component_references (gfc_se * se, gfc_ref * ref) { gfc_component *c; @@ -2559,6 +2559,95 @@ conv_inquiry (gfc_se * se, gfc_ref * ref, gfc_expr *expr, gfc_typespec *ts) se->expr = res; } +/* Transparently dereference VAR if it is a pointer, reference, etc. + according to Fortran semantics. */ + +tree +gfc_auto_dereference_var (location_t loc, gfc_symbol *sym, tree var, + bool descriptor_only_p, bool is_classarray) +{ + /* Characters are entirely different from other types, they are treated + separately. */ + if (sym->ts.type == BT_CHARACTER) + { + /* Dereference character pointer dummy arguments + or results. */ + if ((sym->attr.pointer || sym->attr.allocatable) + && (sym->attr.dummy + || sym->attr.function + || sym->attr.result)) + var = build_fold_indirect_ref_loc (input_location, var); + } + else if (!sym->attr.value) + { + /* Dereference temporaries for class array dummy arguments. */ + if (sym->attr.dummy && is_classarray + && GFC_ARRAY_TYPE_P (TREE_TYPE (var))) + { + if (!descriptor_only_p) + var = GFC_DECL_SAVED_DESCRIPTOR (var); + + var = build_fold_indirect_ref_loc (input_location, var); + } + + /* Dereference non-character scalar dummy arguments. */ + if (sym->attr.dummy && !sym->attr.dimension + && !(sym->attr.codimension && sym->attr.allocatable) + && (sym->ts.type != BT_CLASS + || (!CLASS_DATA (sym)->attr.dimension + && !(CLASS_DATA (sym)->attr.codimension + && CLASS_DATA (sym)->attr.allocatable)))) + var = build_fold_indirect_ref_loc (input_location, var); + + /* Dereference scalar hidden result. */ + if (flag_f2c && sym->ts.type == BT_COMPLEX + && (sym->attr.function || sym->attr.result) + && !sym->attr.dimension && !sym->attr.pointer + && !sym->attr.always_explicit) + var = build_fold_indirect_ref_loc (input_location, var); + + /* Dereference non-character, non-class pointer variables. + These must be dummies, results, or scalars. */ + if (!is_classarray + && (sym->attr.pointer || sym->attr.allocatable + || gfc_is_associate_pointer (sym) + || (sym->as && sym->as->type == AS_ASSUMED_RANK)) + && (sym->attr.dummy + || sym->attr.function + || sym->attr.result + || (!sym->attr.dimension + && (!sym->attr.codimension || !sym->attr.allocatable)))) + var = build_fold_indirect_ref_loc (input_location, var); + /* Now treat the class array pointer variables accordingly. */ + else if (sym->ts.type == BT_CLASS + && sym->attr.dummy + && (CLASS_DATA (sym)->attr.dimension + || CLASS_DATA (sym)->attr.codimension) + && ((CLASS_DATA (sym)->as + && CLASS_DATA (sym)->as->type == AS_ASSUMED_RANK) + || CLASS_DATA (sym)->attr.allocatable + || CLASS_DATA (sym)->attr.class_pointer)) + var = build_fold_indirect_ref_loc (input_location, var); + /* And the case where a non-dummy, non-result, non-function, + non-allotable and non-pointer classarray is present. This case was + previously covered by the first if, but with introducing the + condition !is_classarray there, that case has to be covered + explicitly. */ + else if (sym->ts.type == BT_CLASS + && !sym->attr.dummy + && !sym->attr.function + && !sym->attr.result + && (CLASS_DATA (sym)->attr.dimension + || CLASS_DATA (sym)->attr.codimension) + && (sym->assoc + || !CLASS_DATA (sym)->attr.allocatable) + && !CLASS_DATA (sym)->attr.class_pointer) + var = build_fold_indirect_ref_loc (input_location, var); + } + + return var; +} + /* Return the contents of a variable. Also handles reference/pointer variables (all Fortran pointer references are implicit). */ @@ -2665,94 +2754,9 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr) return; } - - /* Dereference the expression, where needed. Since characters - are entirely different from other types, they are treated - separately. */ - if (sym->ts.type == BT_CHARACTER) - { - /* Dereference character pointer dummy arguments - or results. */ - if ((sym->attr.pointer || sym->attr.allocatable) - && (sym->attr.dummy - || sym->attr.function - || sym->attr.result)) - se->expr = build_fold_indirect_ref_loc (input_location, - se->expr); - - } - else if (!sym->attr.value) - { - /* Dereference temporaries for class array dummy arguments. */ - if (sym->attr.dummy && is_classarray - && GFC_ARRAY_TYPE_P (TREE_TYPE (se->expr))) - { - if (!se->descriptor_only) - se->expr = GFC_DECL_SAVED_DESCRIPTOR (se->expr); - - se->expr = build_fold_indirect_ref_loc (input_location, - se->expr); - } - - /* Dereference non-character scalar dummy arguments. */ - if (sym->attr.dummy && !sym->attr.dimension - && !(sym->attr.codimension && sym->attr.allocatable) - && (sym->ts.type != BT_CLASS - || (!CLASS_DATA (sym)->attr.dimension - && !(CLASS_DATA (sym)->attr.codimension - && CLASS_DATA (sym)->attr.allocatable)))) - se->expr = build_fold_indirect_ref_loc (input_location, - se->expr); - - /* Dereference scalar hidden result. */ - if (flag_f2c && sym->ts.type == BT_COMPLEX - && (sym->attr.function || sym->attr.result) - && !sym->attr.dimension && !sym->attr.pointer - && !sym->attr.always_explicit) - se->expr = build_fold_indirect_ref_loc (input_location, - se->expr); - - /* Dereference non-character, non-class pointer variables. - These must be dummies, results, or scalars. */ - if (!is_classarray - && (sym->attr.pointer || sym->attr.allocatable - || gfc_is_associate_pointer (sym) - || (sym->as && sym->as->type == AS_ASSUMED_RANK)) - && (sym->attr.dummy - || sym->attr.function - || sym->attr.result - || (!sym->attr.dimension - && (!sym->attr.codimension || !sym->attr.allocatable)))) - se->expr = build_fold_indirect_ref_loc (input_location, - se->expr); - /* Now treat the class array pointer variables accordingly. */ - else if (sym->ts.type == BT_CLASS - && sym->attr.dummy - && (CLASS_DATA (sym)->attr.dimension - || CLASS_DATA (sym)->attr.codimension) - && ((CLASS_DATA (sym)->as - && CLASS_DATA (sym)->as->type == AS_ASSUMED_RANK) - || CLASS_DATA (sym)->attr.allocatable - || CLASS_DATA (sym)->attr.class_pointer)) - se->expr = build_fold_indirect_ref_loc (input_location, - se->expr); - /* And the case where a non-dummy, non-result, non-function, - non-allotable and non-pointer classarray is present. This case was - previously covered by the first if, but with introducing the - condition !is_classarray there, that case has to be covered - explicitly. */ - else if (sym->ts.type == BT_CLASS - && !sym->attr.dummy - && !sym->attr.function - && !sym->attr.result - && (CLASS_DATA (sym)->attr.dimension - || CLASS_DATA (sym)->attr.codimension) - && (sym->assoc - || !CLASS_DATA (sym)->attr.allocatable) - && !CLASS_DATA (sym)->attr.class_pointer) - se->expr = build_fold_indirect_ref_loc (input_location, - se->expr); - } + /* Dereference the expression, where needed. */ + se->expr = gfc_auto_dereference_var (input_location, sym, se->expr, + se->descriptor_only, is_classarray); ref = expr->ref; } diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index b0dc2d799fec..d5ae0b717df2 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -1937,6 +1937,92 @@ gfc_convert_expr_to_tree (stmtblock_t *block, gfc_expr *expr) static vec *doacross_steps; + +/* Translate an array section or array element. */ + +static void +gfc_trans_omp_array_section (stmtblock_t *block, gfc_omp_namelist *n, + tree decl, bool element, gomp_map_kind ptr_kind, + tree node, tree &node2, tree &node3, tree &node4) +{ + gfc_se se; + tree ptr, ptr2; + + gfc_init_se (&se, NULL); + + if (element) + { + gfc_conv_expr_reference (&se, n->expr); + gfc_add_block_to_block (block, &se.pre); + ptr = se.expr; + OMP_CLAUSE_SIZE (node) + = TYPE_SIZE_UNIT (TREE_TYPE (ptr)); + } + else + { + gfc_conv_expr_descriptor (&se, n->expr); + ptr = gfc_conv_array_data (se.expr); + tree type = TREE_TYPE (se.expr); + gfc_add_block_to_block (block, &se.pre); + OMP_CLAUSE_SIZE (node) = gfc_full_array_size (block, se.expr, + GFC_TYPE_ARRAY_RANK (type)); + tree elemsz = TYPE_SIZE_UNIT (gfc_get_element_type (type)); + elemsz = fold_convert (gfc_array_index_type, elemsz); + OMP_CLAUSE_SIZE (node) = fold_build2 (MULT_EXPR, gfc_array_index_type, + OMP_CLAUSE_SIZE (node), elemsz); + } + gfc_add_block_to_block (block, &se.post); + ptr = fold_convert (build_pointer_type (char_type_node), ptr); + OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr); + + if (POINTER_TYPE_P (TREE_TYPE (decl)) + && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (decl))) + && ptr_kind == GOMP_MAP_POINTER) + { + node4 = build_omp_clause (input_location, + OMP_CLAUSE_MAP); + OMP_CLAUSE_SET_MAP_KIND (node4, GOMP_MAP_POINTER); + OMP_CLAUSE_DECL (node4) = decl; + OMP_CLAUSE_SIZE (node4) = size_int (0); + decl = build_fold_indirect_ref (decl); + } + ptr = fold_convert (sizetype, ptr); + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))) + { + tree type = TREE_TYPE (decl); + ptr2 = gfc_conv_descriptor_data_get (decl); + node2 = build_omp_clause (input_location, + OMP_CLAUSE_MAP); + OMP_CLAUSE_SET_MAP_KIND (node2, GOMP_MAP_TO_PSET); + OMP_CLAUSE_DECL (node2) = decl; + OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type); + node3 = build_omp_clause (input_location, + OMP_CLAUSE_MAP); + OMP_CLAUSE_SET_MAP_KIND (node3, ptr_kind); + OMP_CLAUSE_DECL (node3) + = gfc_conv_descriptor_data_get (decl); + if (ptr_kind == GOMP_MAP_ATTACH_DETACH) + STRIP_NOPS (OMP_CLAUSE_DECL (node3)); + } + else + { + if (TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE) + ptr2 = build_fold_addr_expr (decl); + else + { + gcc_assert (POINTER_TYPE_P (TREE_TYPE (decl))); + ptr2 = decl; + } + node3 = build_omp_clause (input_location, + OMP_CLAUSE_MAP); + OMP_CLAUSE_SET_MAP_KIND (node3, ptr_kind); + OMP_CLAUSE_DECL (node3) = decl; + } + ptr2 = fold_convert (sizetype, ptr2); + OMP_CLAUSE_SIZE (node3) + = fold_build2 (MINUS_EXPR, sizetype, ptr, ptr2); +} + static tree gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, locus where, bool declare_simd = false) @@ -2255,51 +2341,54 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if (DECL_P (decl)) TREE_ADDRESSABLE (decl) = 1; - gfc_ref *ref = n->expr ? n->expr->ref : NULL; - symbol_attribute *sym_attr = &n->sym->attr; - gomp_map_kind ptr_map_kind = GOMP_MAP_POINTER; - - if (ref && n->sym->ts.type == BT_DERIVED) - { - if (gfc_omp_privatize_by_reference (decl)) - decl = build_fold_indirect_ref (decl); - - for (; ref && ref->type == REF_COMPONENT; ref = ref->next) - { - tree field = ref->u.c.component->backend_decl; - gcc_assert (field && TREE_CODE (field) == FIELD_DECL); - decl = fold_build3 (COMPONENT_REF, TREE_TYPE (field), - decl, field, NULL_TREE); - sym_attr = &ref->u.c.component->attr; - } - - ptr_map_kind = GOMP_MAP_ALWAYS_POINTER; - } - - if (ref == NULL || ref->u.ar.type == AR_FULL) + if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL) { - tree field = decl; - - while (TREE_CODE (field) == COMPONENT_REF) - field = TREE_OPERAND (field, 1); - if (POINTER_TYPE_P (TREE_TYPE (decl)) && n->u.map_op == OMP_MAP_FORCE_DEVICEPTR) { OMP_CLAUSE_DECL (node) = decl; goto finalize_map_clause; } + else if (n->sym->ts.type == BT_CLASS) + { + tree type = TREE_TYPE (decl); + if (n->sym->attr.optional) + sorry ("optional class parameter"); + if (POINTER_TYPE_P (type)) + { + node4 = build_omp_clause (input_location, + OMP_CLAUSE_MAP); + OMP_CLAUSE_SET_MAP_KIND (node4, GOMP_MAP_POINTER); + OMP_CLAUSE_DECL (node4) = decl; + OMP_CLAUSE_SIZE (node4) = size_int (0); + decl = build_fold_indirect_ref (decl); + } + tree ptr = gfc_class_data_get (decl); + ptr = build_fold_indirect_ref (ptr); + OMP_CLAUSE_DECL (node) = ptr; + OMP_CLAUSE_SIZE (node) = gfc_class_vtab_size_get (decl); + node2 = build_omp_clause (input_location, OMP_CLAUSE_MAP); + OMP_CLAUSE_SET_MAP_KIND (node2, GOMP_MAP_TO_PSET); + OMP_CLAUSE_DECL (node2) = decl; + OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type); + node3 = build_omp_clause (input_location, OMP_CLAUSE_MAP); + OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_ATTACH_DETACH); + OMP_CLAUSE_DECL (node3) = gfc_class_data_get (decl); + OMP_CLAUSE_SIZE (node3) = size_int (0); + goto finalize_map_clause; + } else if (POINTER_TYPE_P (TREE_TYPE (decl)) - && (gfc_omp_privatize_by_reference (decl) - || GFC_DECL_GET_SCALAR_POINTER (field) - || GFC_DECL_GET_SCALAR_ALLOCATABLE (field) - || GFC_DECL_CRAY_POINTEE (field) - || GFC_DESCRIPTOR_TYPE_P - (TREE_TYPE (TREE_TYPE (field))))) + && (gfc_omp_privatize_by_reference (decl) + || GFC_DECL_GET_SCALAR_POINTER (decl) + || GFC_DECL_GET_SCALAR_ALLOCATABLE (decl) + || GFC_DECL_CRAY_POINTEE (decl) + || GFC_DESCRIPTOR_TYPE_P + (TREE_TYPE (TREE_TYPE (decl))) + || n->sym->ts.type == BT_DERIVED)) { tree orig_decl = decl; enum gomp_map_kind gmk = GOMP_MAP_POINTER; - if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field) + if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl) && n->sym->attr.oacc_declare_create) { if (clauses->update_allocatable) @@ -2319,7 +2408,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, { node3 = build_omp_clause (input_location, OMP_CLAUSE_MAP); - OMP_CLAUSE_SET_MAP_KIND (node3, ptr_map_kind); + OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_POINTER); OMP_CLAUSE_DECL (node3) = decl; OMP_CLAUSE_SIZE (node3) = size_int (0); decl = build_fold_indirect_ref (decl); @@ -2332,7 +2421,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, tree type = TREE_TYPE (decl); tree ptr; - if (sym_attr->optional) + if (n->sym->attr.optional) ptr = gfc_build_conditional_assign_expr ( block, TREE_OPERAND (decl, 0), @@ -2352,22 +2441,20 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type); node3 = build_omp_clause (input_location, OMP_CLAUSE_MAP); - OMP_CLAUSE_SET_MAP_KIND (node3, ptr_map_kind); + OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_POINTER); OMP_CLAUSE_DECL (node3) = gfc_conv_descriptor_data_get (decl); - if (ptr_map_kind == GOMP_MAP_ALWAYS_POINTER) - STRIP_NOPS (OMP_CLAUSE_DECL (node3)); OMP_CLAUSE_SIZE (node3) = size_int (0); /* We have to check for n->sym->attr.dimension because of scalar coarrays. */ - if ((sym_attr->pointer || sym_attr->optional) - && sym_attr->dimension) + if ((n->sym->attr.pointer || n->sym->attr.optional) + && n->sym->attr.dimension) { stmtblock_t cond_block; tree size = gfc_create_var (gfc_array_index_type, NULL); - tree cond = sym_attr->optional + tree cond = n->sym->attr.optional ? TREE_OPERAND (decl, 0) : gfc_conv_descriptor_data_get (decl); @@ -2387,11 +2474,11 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, OMP_CLAUSE_SIZE (node) = size; } - else if (sym_attr->dimension) + else if (n->sym->attr.dimension) OMP_CLAUSE_SIZE (node) = gfc_full_array_size (block, decl, GFC_TYPE_ARRAY_RANK (type)); - if (sym_attr->dimension) + if (n->sym->attr.dimension) { tree elemsz = TYPE_SIZE_UNIT (gfc_get_element_type (type)); @@ -2404,88 +2491,161 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, else OMP_CLAUSE_DECL (node) = decl; } - else if (ref) + else if (n->expr + && n->expr->expr_type == EXPR_VARIABLE + && n->expr->ref->type == REF_COMPONENT) { - tree ptr, ptr2; - gfc_init_se (&se, NULL); - if (ref->u.ar.type == AR_ELEMENT) - { - gfc_conv_expr_reference (&se, n->expr); - gfc_add_block_to_block (block, &se.pre); - ptr = se.expr; - OMP_CLAUSE_SIZE (node) - = TYPE_SIZE_UNIT (TREE_TYPE (ptr)); - } + gfc_ref *lastcomp; + + for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next) + if (ref->type == REF_COMPONENT) + lastcomp = ref; + + symbol_attribute sym_attr; + + if (lastcomp->u.c.component->ts.type == BT_CLASS) + sym_attr = CLASS_DATA (lastcomp->u.c.component)->attr; else + sym_attr = lastcomp->u.c.component->attr; + + gfc_init_se (&se, NULL); + + if (!sym_attr.dimension + && lastcomp->u.c.component->ts.type != BT_CLASS + && lastcomp->u.c.component->ts.type != BT_DERIVED) { - gfc_conv_expr_descriptor (&se, n->expr); - ptr = gfc_conv_array_data (se.expr); - tree type = TREE_TYPE (se.expr); + /* Last component is a scalar. */ + gfc_conv_expr (&se, n->expr); gfc_add_block_to_block (block, &se.pre); - OMP_CLAUSE_SIZE (node) - = gfc_full_array_size (block, se.expr, - GFC_TYPE_ARRAY_RANK (type)); - tree elemsz - = TYPE_SIZE_UNIT (gfc_get_element_type (type)); - elemsz = fold_convert (gfc_array_index_type, elemsz); - OMP_CLAUSE_SIZE (node) - = fold_build2 (MULT_EXPR, gfc_array_index_type, - OMP_CLAUSE_SIZE (node), elemsz); + OMP_CLAUSE_DECL (node) = se.expr; + gfc_add_block_to_block (block, &se.post); + goto finalize_map_clause; } - gfc_add_block_to_block (block, &se.post); - ptr = fold_convert (build_pointer_type (char_type_node), - ptr); - OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr); - if (POINTER_TYPE_P (TREE_TYPE (decl)) - && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (decl)))) + se.expr + = gfc_auto_dereference_var (input_location, n->sym, + decl); + + for (gfc_ref *ref = n->expr->ref; + ref && ref != lastcomp->next; + ref = ref->next) { - node4 = build_omp_clause (input_location, - OMP_CLAUSE_MAP); - OMP_CLAUSE_SET_MAP_KIND (node4, ptr_map_kind); - OMP_CLAUSE_DECL (node4) = decl; - OMP_CLAUSE_SIZE (node4) = size_int (0); - decl = build_fold_indirect_ref (decl); + if (ref->type == REF_COMPONENT) + { + if (ref->u.c.sym->attr.extension) + conv_parent_component_references (&se, ref); + + gfc_conv_component_ref (&se, ref); + } + else + sorry ("unhandled derived-type component"); } - ptr = fold_convert (sizetype, ptr); - if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))) + + tree inner = se.expr; + + /* Last component is a derived type or class pointer. */ + if (lastcomp->u.c.component->ts.type == BT_DERIVED + || lastcomp->u.c.component->ts.type == BT_CLASS) { - tree type = TREE_TYPE (decl); - ptr2 = gfc_conv_descriptor_data_get (decl); - node2 = build_omp_clause (input_location, - OMP_CLAUSE_MAP); - OMP_CLAUSE_SET_MAP_KIND (node2, GOMP_MAP_TO_PSET); - OMP_CLAUSE_DECL (node2) = decl; - OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type); - node3 = build_omp_clause (input_location, - OMP_CLAUSE_MAP); - OMP_CLAUSE_SET_MAP_KIND (node3, ptr_map_kind); - OMP_CLAUSE_DECL (node3) - = gfc_conv_descriptor_data_get (decl); - if (ptr_map_kind == GOMP_MAP_ALWAYS_POINTER) - STRIP_NOPS (OMP_CLAUSE_DECL (node3)); + if (sym_attr.allocatable || sym_attr.pointer) + { + tree data, size; + + if (lastcomp->u.c.component->ts.type == BT_CLASS) + { + data = gfc_class_data_get (inner); + size = gfc_class_vtab_size_get (inner); + } + else /* BT_DERIVED. */ + { + data = inner; + size = TYPE_SIZE_UNIT (TREE_TYPE (inner)); + } + + OMP_CLAUSE_DECL (node) + = build_fold_indirect_ref (data); + OMP_CLAUSE_SIZE (node) = size; + node2 = build_omp_clause (input_location, + OMP_CLAUSE_MAP); + OMP_CLAUSE_SET_MAP_KIND (node2, + GOMP_MAP_ATTACH_DETACH); + OMP_CLAUSE_DECL (node2) = data; + OMP_CLAUSE_SIZE (node2) = size_int (0); + } + else + { + OMP_CLAUSE_DECL (node) = decl; + OMP_CLAUSE_SIZE (node) + = TYPE_SIZE_UNIT (TREE_TYPE (decl)); + } } - else + else if (lastcomp->next + && lastcomp->next->type == REF_ARRAY + && lastcomp->next->u.ar.type == AR_FULL) { - if (TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE) - ptr2 = build_fold_addr_expr (decl); - else + /* Just pass the (auto-dereferenced) decl through for + bare attach and detach clauses. */ + if (n->u.map_op == OMP_MAP_ATTACH + || n->u.map_op == OMP_MAP_DETACH) { - gcc_assert (POINTER_TYPE_P (TREE_TYPE (decl))); - ptr2 = decl; + OMP_CLAUSE_DECL (node) = inner; + OMP_CLAUSE_SIZE (node) = size_zero_node; + goto finalize_map_clause; } - node3 = build_omp_clause (input_location, - OMP_CLAUSE_MAP); - OMP_CLAUSE_SET_MAP_KIND (node3, ptr_map_kind); - OMP_CLAUSE_DECL (node3) = decl; + + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (inner))) + { + tree type = TREE_TYPE (inner); + tree ptr = gfc_conv_descriptor_data_get (inner); + ptr = build_fold_indirect_ref (ptr); + OMP_CLAUSE_DECL (node) = ptr; + node2 = build_omp_clause (input_location, + OMP_CLAUSE_MAP); + OMP_CLAUSE_SET_MAP_KIND (node2, GOMP_MAP_TO_PSET); + OMP_CLAUSE_DECL (node2) = inner; + OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type); + node3 = build_omp_clause (input_location, + OMP_CLAUSE_MAP); + OMP_CLAUSE_SET_MAP_KIND (node3, + GOMP_MAP_ATTACH_DETACH); + OMP_CLAUSE_DECL (node3) + = gfc_conv_descriptor_data_get (inner); + STRIP_NOPS (OMP_CLAUSE_DECL (node3)); + OMP_CLAUSE_SIZE (node3) = size_int (0); + int rank = GFC_TYPE_ARRAY_RANK (type); + OMP_CLAUSE_SIZE (node) + = gfc_full_array_size (block, inner, rank); + tree elemsz + = TYPE_SIZE_UNIT (gfc_get_element_type (type)); + elemsz = fold_convert (gfc_array_index_type, elemsz); + OMP_CLAUSE_SIZE (node) + = fold_build2 (MULT_EXPR, gfc_array_index_type, + OMP_CLAUSE_SIZE (node), elemsz); + } + else + OMP_CLAUSE_DECL (node) = inner; + } + else /* An array element or section. */ + { + bool element + = (lastcomp->next + && lastcomp->next->type == REF_ARRAY + && lastcomp->next->u.ar.type == AR_ELEMENT); + + gfc_trans_omp_array_section (block, n, inner, element, + GOMP_MAP_ATTACH_DETACH, + node, node2, node3, node4); } - ptr2 = fold_convert (sizetype, ptr2); - OMP_CLAUSE_SIZE (node3) - = fold_build2 (MINUS_EXPR, sizetype, ptr, ptr2); - finalize_map_clause:; } - else - gcc_unreachable (); + else /* An array element or array section. */ + { + bool element = n->expr->ref->u.ar.type == AR_ELEMENT; + gfc_trans_omp_array_section (block, n, decl, element, + GOMP_MAP_POINTER, node, node2, + node3, node4); + } + + finalize_map_clause: switch (n->u.map_op) { case OMP_MAP_ALLOC: diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index cb8c1af37992..794600a1e61c 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -546,6 +546,15 @@ tree gfc_conv_expr_present (gfc_symbol *); /* Convert a missing, dummy argument into a null or zero. */ void gfc_conv_missing_dummy (gfc_se *, gfc_expr *, gfc_typespec, int); +/* Lowering of component references. */ +void gfc_conv_component_ref (gfc_se * se, gfc_ref * ref); +void conv_parent_component_references (gfc_se * se, gfc_ref * ref); + +/* Automatically dereference var. */ +tree gfc_auto_dereference_var (location_t, gfc_symbol *, tree, + bool desc_only = false, + bool is_classarray = false); + /* Generate code to allocate a string temporary. */ tree gfc_conv_string_tmp (gfc_se *, tree, tree); /* Get the string length variable belonging to an expression. */ diff --git a/gcc/gimplify.c b/gcc/gimplify.c index 56d707d735d6..60e04ff83539 100644 --- a/gcc/gimplify.c +++ b/gcc/gimplify.c @@ -8126,8 +8126,10 @@ insert_struct_comp_map (enum tree_code code, tree c, tree struct_node, GOMP_MAP_ALWAYS_POINTER though, i.e. a GOMP_MAP_TO_PSET. */ if (OMP_CLAUSE_CHAIN (prev_node) != c && OMP_CLAUSE_CODE (OMP_CLAUSE_CHAIN (prev_node)) == OMP_CLAUSE_MAP - && (OMP_CLAUSE_MAP_KIND (OMP_CLAUSE_CHAIN (prev_node)) - == GOMP_MAP_ALWAYS_POINTER)) + && ((OMP_CLAUSE_MAP_KIND (OMP_CLAUSE_CHAIN (prev_node)) + == GOMP_MAP_ALWAYS_POINTER) + || (OMP_CLAUSE_MAP_KIND (OMP_CLAUSE_CHAIN (prev_node)) + == GOMP_MAP_ATTACH_DETACH))) { tree c4 = OMP_CLAUSE_CHAIN (prev_node); tree c3 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP); @@ -8673,8 +8675,6 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, case OMP_TARGET_DATA: case OMP_TARGET_ENTER_DATA: case OMP_TARGET_EXIT_DATA: - case OACC_ENTER_DATA: - case OACC_EXIT_DATA: case OACC_HOST_DATA: if (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_FIRSTPRIVATE_POINTER || (OMP_CLAUSE_MAP_KIND (c) @@ -8683,6 +8683,21 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, mapped, but not the pointer to it. */ remove = true; break; + case OACC_ENTER_DATA: + case OACC_EXIT_DATA: + if ((OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_POINTER + || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_TO_PSET + || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_FIRSTPRIVATE_POINTER + || (OMP_CLAUSE_MAP_KIND (c) + == GOMP_MAP_FIRSTPRIVATE_REFERENCE)) + && !(prev_list_p + && OMP_CLAUSE_CODE (*prev_list_p) == OMP_CLAUSE_MAP + && ((OMP_CLAUSE_MAP_KIND (*prev_list_p) + == GOMP_MAP_DECLARE_ALLOCATE) + || (OMP_CLAUSE_MAP_KIND (*prev_list_p) + == GOMP_MAP_DECLARE_DEALLOCATE)))) + remove = true; + break; default: break; } @@ -8770,7 +8785,7 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, tree decl_ref = NULL_TREE; if ((region_type & ORT_ACC) != 0 && TREE_CODE (*pd) == COMPONENT_REF - && OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_ALWAYS_POINTER + && OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_ATTACH_DETACH && code != OACC_UPDATE) { while (TREE_CODE (decl) == COMPONENT_REF) @@ -8812,7 +8827,14 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, mapped as a FIRSTPRIVATE_POINTER. */ OMP_CLAUSE_SET_MAP_KIND (c, k); flags = GOVD_MAP | GOVD_SEEN | GOVD_EXPLICIT; + tree next_clause = OMP_CLAUSE_CHAIN (c); if (k == GOMP_MAP_ATTACH + && code != OACC_ENTER_DATA + && (!next_clause + || (OMP_CLAUSE_CODE (next_clause) != OMP_CLAUSE_MAP) + || (OMP_CLAUSE_MAP_KIND (next_clause) + != GOMP_MAP_POINTER) + || OMP_CLAUSE_DECL (next_clause) != decl) && (!struct_deref_set || !struct_deref_set->contains (decl))) { @@ -8848,6 +8870,13 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, } goto do_add_decl; } + /* An "attach/detach" operation on an update directive should + behave as a GOMP_MAP_ALWAYS_POINTER. Beware that + unlike attach or detach map kinds, GOMP_MAP_ALWAYS_POINTER + depends on the previous mapping. */ + if (code == OACC_UPDATE + && OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_ATTACH_DETACH) + OMP_CLAUSE_SET_MAP_KIND (c, GOMP_MAP_ALWAYS_POINTER); if (gimplify_expr (pd, pre_p, NULL, is_gimple_lvalue, fb_lvalue) == GS_ERROR) { @@ -8856,6 +8885,8 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, } if (DECL_P (decl) && OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_TO_PSET + && OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_ATTACH + && OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_DETACH && code != OACC_UPDATE) { if (error_operand_p (decl)) @@ -8877,7 +8908,8 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, break; } - if (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_ALWAYS_POINTER) + if (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_ALWAYS_POINTER + || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_ATTACH_DETACH) { /* Error recovery. */ if (prev_list_p == NULL) @@ -8909,12 +8941,14 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, = splay_tree_lookup (ctx->variables, (splay_tree_key)decl); bool ptr = (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_ALWAYS_POINTER); + bool attach_detach = (OMP_CLAUSE_MAP_KIND (c) + == GOMP_MAP_ATTACH_DETACH); bool attach = OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_ATTACH || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_DETACH; bool has_attachments = false; /* For OpenACC, pointers in structs should trigger an attach action. */ - if (ptr && (region_type & ORT_ACC) != 0) + if (attach_detach && (region_type & ORT_ACC) != 0) { /* Turning a GOMP_MAP_ALWAYS_POINTER clause into a GOMP_MAP_ATTACH clause after we have detected a case @@ -8946,7 +8980,7 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, if (struct_map_to_clause == NULL) struct_map_to_clause = new hash_map; struct_map_to_clause->put (decl, l); - if (ptr) + if (ptr || attach_detach) { insert_struct_comp_map (code, c, l, *prev_list_p, NULL); @@ -8972,7 +9006,9 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, OMP_CLAUSE_CHAIN (l) = c2; } flags = GOVD_MAP | GOVD_EXPLICIT; - if (GOMP_MAP_ALWAYS_P (OMP_CLAUSE_MAP_KIND (c)) || ptr) + if (GOMP_MAP_ALWAYS_P (OMP_CLAUSE_MAP_KIND (c)) + || ptr + || attach_detach) flags |= GOVD_SEEN; if (has_attachments) flags |= GOVD_MAP_HAS_ATTACHMENTS; @@ -8982,7 +9018,9 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, { tree *osc = struct_map_to_clause->get (decl); tree *sc = NULL, *scp = NULL; - if (GOMP_MAP_ALWAYS_P (OMP_CLAUSE_MAP_KIND (c)) || ptr) + if (GOMP_MAP_ALWAYS_P (OMP_CLAUSE_MAP_KIND (c)) + || ptr + || attach_detach) n->value |= GOVD_SEEN; sc = &OMP_CLAUSE_CHAIN (*osc); if (*sc != c @@ -8992,7 +9030,7 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, /* Here "prev_list_p" is the end of the inserted alloc/release nodes after the struct node, OSC. */ for (; *sc != c; sc = &OMP_CLAUSE_CHAIN (*sc)) - if (ptr && sc == prev_list_p) + if ((ptr || attach_detach) && sc == prev_list_p) break; else if (TREE_CODE (OMP_CLAUSE_DECL (*sc)) != COMPONENT_REF @@ -9041,7 +9079,7 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, } if (same_decl_offset_lt) { - if (ptr) + if (ptr || attach_detach) scp = sc; else break; @@ -9053,7 +9091,7 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, OMP_CLAUSE_SIZE (*osc) = size_binop (PLUS_EXPR, OMP_CLAUSE_SIZE (*osc), size_one_node); - if (ptr) + if (ptr || attach_detach) { tree cl = insert_struct_comp_map (code, c, NULL, *prev_list_p, scp); @@ -9083,11 +9121,14 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, } if (!remove && OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_ALWAYS_POINTER + && OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_ATTACH_DETACH && OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_TO_PSET && OMP_CLAUSE_CHAIN (c) && OMP_CLAUSE_CODE (OMP_CLAUSE_CHAIN (c)) == OMP_CLAUSE_MAP && ((OMP_CLAUSE_MAP_KIND (OMP_CLAUSE_CHAIN (c)) == GOMP_MAP_ALWAYS_POINTER) + || (OMP_CLAUSE_MAP_KIND (OMP_CLAUSE_CHAIN (c)) + == GOMP_MAP_ATTACH_DETACH) || (OMP_CLAUSE_MAP_KIND (OMP_CLAUSE_CHAIN (c)) == GOMP_MAP_TO_PSET))) prev_list_p = list_p; diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp index deddcc50ce15..8295fe61ba71 100644 --- a/gcc/testsuite/ChangeLog.omp +++ b/gcc/testsuite/ChangeLog.omp @@ -1,3 +1,7 @@ +2019-07-10 Julian Brown + + * c-c++-common/goacc/mdc-1.c: Update clause matching patterns. + 2019-07-09 Andrew Stubbs Backport from mainline: diff --git a/gcc/testsuite/c-c++-common/goacc/mdc-1.c b/gcc/testsuite/c-c++-common/goacc/mdc-1.c index b8d03a088ecd..6c6a81ea73a5 100644 --- a/gcc/testsuite/c-c++-common/goacc/mdc-1.c +++ b/gcc/testsuite/c-c++-common/goacc/mdc-1.c @@ -43,13 +43,13 @@ t1 () } /* { dg-final { scan-tree-dump-times "pragma omp target oacc_enter_exit_data map.to:s .len: 32.." 1 "omplower" } } */ -/* { dg-final { scan-tree-dump-times "pragma omp target oacc_data map.tofrom:.z .len: 40.. map.struct:s .len: 1.. map.alloc:s.a .len: 8.. map.tofrom:._1 .len: 40.. map.attach:s.a .len: 0.." 1 "omplower" } } */ -/* { dg-final { scan-tree-dump-times "pragma omp target oacc_parallel map.force_present:s .len: 32.. map.attach:s.e .len: 8.." 1 "omplower" } } */ -/* { dg-final { scan-tree-dump-times "pragma omp target oacc_enter_exit_data map.attach:a .len: 8.." 1 "omplower" } } */ -/* { dg-final { scan-tree-dump-times "pragma omp target oacc_enter_exit_data map.detach:a .len: 8.." 1 "omplower" } } */ +/* { dg-final { scan-tree-dump-times "pragma omp target oacc_data map.tofrom:.z .len: 40.. map.struct:s .len: 1.. map.alloc:s.a .len: 8.. map.tofrom:._1 .len: 40.. map.attach:s.a .bias: 0.." 1 "omplower" } } */ +/* { dg-final { scan-tree-dump-times "pragma omp target oacc_parallel map.attach:s.e .bias: 8.. map.tofrom:s .len: 32" 1 "omplower" } } */ +/* { dg-final { scan-tree-dump-times "pragma omp target oacc_enter_exit_data map.attach:a .bias: 8.." 1 "omplower" } } */ +/* { dg-final { scan-tree-dump-times "pragma omp target oacc_enter_exit_data map.detach:a .bias: 8.." 1 "omplower" } } */ /* { dg-final { scan-tree-dump-times "pragma omp target oacc_enter_exit_data map.to:a .len: 8.." 1 "omplower" } } */ -/* { dg-final { scan-tree-dump-times "pragma omp target oacc_enter_exit_data map.force_present:s .len: 32.. map.detach:s.e .len: 8.." 1 "omplower" } } */ -/* { dg-final { scan-tree-dump-times "pragma omp target oacc_data map.force_present:s .len: 32.. map.attach:s.e .len: 8.." 1 "omplower" } } */ +/* { dg-final { scan-tree-dump-times "pragma omp target oacc_enter_exit_data map.detach:s.e .bias: 8.." 1 "omplower" } } */ +/* { dg-final { scan-tree-dump-times "pragma omp target oacc_data map.attach:s.e .bias: 8.." 1 "omplower" } } */ /* { dg-final { scan-tree-dump-times "pragma omp target oacc_enter_exit_data map.release:a .len: 8.." 1 "omplower" } } */ -/* { dg-final { scan-tree-dump-times "pragma omp target oacc_enter_exit_data finalize map.force_detach:a .len: 8.." 1 "omplower" } } */ -/* { dg-final { scan-tree-dump-times "pragma omp target oacc_enter_exit_data finalize map.force_present:s .len: 32.. map.force_detach:s.a .len: 8.." 1 "omplower" } } */ +/* { dg-final { scan-tree-dump-times "pragma omp target oacc_enter_exit_data finalize map.force_detach:a .bias: 8.." 1 "omplower" } } */ +/* { dg-final { scan-tree-dump-times "pragma omp target oacc_enter_exit_data finalize map.force_detach:s.a .bias: 8.." 1 "omplower" } } */ diff --git a/gcc/tree-pretty-print.c b/gcc/tree-pretty-print.c index d6171f09f0ea..3a170794688c 100644 --- a/gcc/tree-pretty-print.c +++ b/gcc/tree-pretty-print.c @@ -871,6 +871,9 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags) case GOMP_MAP_FORCE_DETACH: pp_string (pp, "force_detach"); break; + case GOMP_MAP_ATTACH_DETACH: + pp_string (pp, "attach_detach"); + break; default: gcc_unreachable (); } @@ -896,6 +899,12 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags) gcc_assert (TREE_CODE (OMP_CLAUSE_SIZE (clause)) == TREE_LIST); pp_string (pp, " [dimensions: "); break; + case GOMP_MAP_ATTACH: + case GOMP_MAP_DETACH: + case GOMP_MAP_FORCE_DETACH: + case GOMP_MAP_ATTACH_DETACH: + pp_string (pp, " [bias: "); + break; default: pp_string (pp, " [len: "); break; diff --git a/include/ChangeLog.omp b/include/ChangeLog.omp index 2cbb9919f600..e0584385f434 100644 --- a/include/ChangeLog.omp +++ b/include/ChangeLog.omp @@ -1,3 +1,7 @@ +2019-07-10 Julian Brown + + * gomp-constants.h (gomp_map_kind): Add GOMP_MAP_ATTACH_DETACH. + 2018-12-20 Maciej W. Rozycki * gomp-constants.h (GOMP_DEVICE_CURRENT): New macro. diff --git a/include/gomp-constants.h b/include/gomp-constants.h index 5634babd8402..22f9520524de 100644 --- a/include/gomp-constants.h +++ b/include/gomp-constants.h @@ -171,7 +171,11 @@ enum gomp_map_kind /* Do not map, but pointer assign a pointer instead. */ GOMP_MAP_FIRSTPRIVATE_POINTER = (GOMP_MAP_LAST | 1), /* Do not map, but pointer assign a reference instead. */ - GOMP_MAP_FIRSTPRIVATE_REFERENCE = (GOMP_MAP_LAST | 2) + GOMP_MAP_FIRSTPRIVATE_REFERENCE = (GOMP_MAP_LAST | 2), + /* An attach or detach operation. Rewritten to the appropriate type during + gimplification, depending on directive (i.e. "enter data" or + parallel/kernels region vs. "exit data"). */ + GOMP_MAP_ATTACH_DETACH = (GOMP_MAP_LAST | 3) }; #define GOMP_MAP_COPY_TO_P(X) \ diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp index b3bcb3113f14..1d88bd54cd2b 100644 --- a/libgomp/ChangeLog.omp +++ b/libgomp/ChangeLog.omp @@ -1,3 +1,14 @@ +2019-07-10 Julian Brown + + * oacc-parallel.c (GOACC_enter_exit_data): Fix optional arguments for + changes to clause stripping in enter data/exit data directives. + * testsuite/libgomp.oacc-fortran/class-ptr-param.f95: New test. + * testsuite/libgomp.oacc-fortran/classtypes-1.f95: New test. + * testsuite/libgomp.oacc-fortran/classtypes-2.f95: New test. + * testsuite/libgomp.oacc-fortran/derivedtype-1.f95: New test. + * testsuite/libgomp.oacc-fortran/derivedtype-2.f95: New test. + * testsuite/libgomp.oacc-fortran/multidim-slice.f95: New test. + 2019-05-28 Julian Brown * testsuite/libgomp.oacc-fortran/gangprivate-attrib-2.f90: New test. diff --git a/libgomp/oacc-parallel.c b/libgomp/oacc-parallel.c index b949599a8d00..86063417bffb 100644 --- a/libgomp/oacc-parallel.c +++ b/libgomp/oacc-parallel.c @@ -550,7 +550,8 @@ GOACC_enter_exit_data (int flags_m, size_t mapnum, break; case GOMP_MAP_TO: case GOMP_MAP_FORCE_TO: - acc_copyin_async (hostaddrs[i], sizes[i], async); + if (hostaddrs[i]) + acc_copyin_async (hostaddrs[i], sizes[i], async); break; case GOMP_MAP_STRUCT: { diff --git a/libgomp/testsuite/libgomp.oacc-fortran/class-ptr-param.f95 b/libgomp/testsuite/libgomp.oacc-fortran/class-ptr-param.f95 new file mode 100644 index 000000000000..80147337c9d7 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/class-ptr-param.f95 @@ -0,0 +1,34 @@ +! { dg-do run } + +module typemod + +type mytype + integer :: a +end type mytype + +contains + +subroutine mysub(c) + implicit none + + class(mytype), allocatable :: c + +!$acc parallel copy(c) + c%a = 5 +!$acc end parallel +end subroutine mysub + +end module typemod + +program main + use typemod + implicit none + + class(mytype), allocatable :: myvar + allocate(mytype :: myvar) + + myvar%a = 0 + call mysub(myvar) + + if (myvar%a .ne. 5) stop 1 +end program main diff --git a/libgomp/testsuite/libgomp.oacc-fortran/classtypes-1.f95 b/libgomp/testsuite/libgomp.oacc-fortran/classtypes-1.f95 new file mode 100644 index 000000000000..f16f42fc3af2 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/classtypes-1.f95 @@ -0,0 +1,48 @@ +! { dg-do run } + +module typemod + +type :: typeimpl + real, pointer :: p(:) => null() +end type typeimpl + +type :: basictype + class(typeimpl), pointer :: p => null() +end type basictype + +type, extends(basictype) :: regulartype + character :: void +end type regulartype + +end module typemod + +program main + use typemod + implicit none + type(regulartype), pointer :: myvar + integer :: i + real :: j, k + + allocate(myvar) + allocate(myvar%p) + allocate(myvar%p%p(1:100)) + + do i=1,100 + myvar%p%p(i) = -1.0 + end do + +!$acc enter data copyin(myvar, myvar%p) create(myvar%p%p) + +!$acc parallel loop present(myvar%p%p) + do i=1,100 + myvar%p%p(i) = i * 2 + end do +!$acc end parallel loop + +!$acc exit data copyout(myvar%p%p) delete(myvar, myvar%p) + + do i=1,100 + if (myvar%p%p(i) .ne. i * 2) stop 1 + end do + +end program main diff --git a/libgomp/testsuite/libgomp.oacc-fortran/classtypes-2.f95 b/libgomp/testsuite/libgomp.oacc-fortran/classtypes-2.f95 new file mode 100644 index 000000000000..ad80ec2a0ef1 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/classtypes-2.f95 @@ -0,0 +1,106 @@ +! { dg-do run } + +module wrapper_mod + +type compute + integer, allocatable :: block(:,:) +contains + procedure :: initialize +end type compute + +type, extends(compute) :: cpu_compute + integer :: blocksize +contains + procedure :: setblocksize +end type cpu_compute + +type, extends(compute) :: gpu_compute + integer :: numgangs + integer :: numworkers + integer :: vectorsize + integer, allocatable :: gpu_block(:,:) +contains + procedure :: setdims +end type gpu_compute + +contains + +subroutine initialize(c, length, width) + implicit none + class(compute) :: c + integer :: length + integer :: width + integer :: i + integer :: j + + allocate (c%block(length, width)) + + do i=1,length + do j=1, width + c%block(i,j) = i + j + end do + end do +end subroutine initialize + +subroutine setdims(c, g, w, v) + implicit none + class(gpu_compute) :: c + integer :: g + integer :: w + integer :: v + c%numgangs = g + c%numworkers = w + c%vectorsize = v +end subroutine setdims + +subroutine setblocksize(c, bs) + implicit none + class(cpu_compute) :: c + integer :: bs + c%blocksize = bs +end subroutine setblocksize + +end module wrapper_mod + +program main + use wrapper_mod + implicit none + class(compute), allocatable, target :: mycomp + integer :: i, j + + allocate(gpu_compute::mycomp) + + call mycomp%initialize(1024,1024) + + !$acc enter data copyin(mycomp) + + select type (mycomp) + type is (cpu_compute) + call mycomp%setblocksize(32) + type is (gpu_compute) + call mycomp%setdims(32,32,32) + allocate(mycomp%gpu_block(1024,1024)) + !$acc update device(mycomp) + !$acc parallel copyin(mycomp%block) copyout(mycomp%gpu_block) + !$acc loop gang worker vector collapse(2) + do i=1,1024 + do j=1,1024 + mycomp%gpu_block(i,j) = mycomp%block(i,j) + 1 + end do + end do + !$acc end parallel + end select + + !$acc exit data copyout(mycomp) + + select type (g => mycomp) + type is (gpu_compute) + do i = 1, 1024 + do j = 1, 1024 + if (g%gpu_block(i,j) .ne. i + j + 1) stop 1 + end do + end do + end select + + deallocate(mycomp) +end program main diff --git a/libgomp/testsuite/libgomp.oacc-fortran/derivedtype-1.f95 b/libgomp/testsuite/libgomp.oacc-fortran/derivedtype-1.f95 new file mode 100644 index 000000000000..75ce48ddca28 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/derivedtype-1.f95 @@ -0,0 +1,30 @@ +! { dg-do run } + +program main + implicit none + + type mytype + integer :: a, b, c + end type mytype + + type(mytype) :: myvar + integer :: i + + myvar%a = 0 + myvar%b = 0 + myvar%c = 0 + +!$acc enter data copyin(myvar) + +!$acc parallel present(myvar) + myvar%a = 1 + myvar%b = 2 + myvar%c = 3 +!$acc end parallel + +!$acc exit data copyout(myvar) + + if (myvar%a .ne. 1) stop 1 + if (myvar%b .ne. 2) stop 2 + if (myvar%c .ne. 3) stop 3 +end program main diff --git a/libgomp/testsuite/libgomp.oacc-fortran/derivedtype-2.f95 b/libgomp/testsuite/libgomp.oacc-fortran/derivedtype-2.f95 new file mode 100644 index 000000000000..3088b832957a --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/derivedtype-2.f95 @@ -0,0 +1,41 @@ +! { dg-do run } + +program main + implicit none + + type tnest + integer :: ia, ib, ic + end type tnest + + type mytype + type(tnest) :: nest + integer :: a, b, c + end type mytype + + type(mytype) :: myvar + integer :: i + + myvar%a = 0 + myvar%b = 0 + myvar%c = 0 + myvar%nest%ia = 0 + myvar%nest%ib = 0 + myvar%nest%ic = 0 + +!$acc enter data copyin(myvar%nest) + +!$acc parallel present(myvar%nest) + myvar%nest%ia = 4 + myvar%nest%ib = 5 + myvar%nest%ic = 6 +!$acc end parallel + +!$acc exit data copyout(myvar%nest) + + if (myvar%a .ne. 0) stop 1 + if (myvar%b .ne. 0) stop 2 + if (myvar%c .ne. 0) stop 3 + if (myvar%nest%ia .ne. 4) stop 4 + if (myvar%nest%ib .ne. 5) stop 5 + if (myvar%nest%ic .ne. 6) stop 6 +end program main diff --git a/libgomp/testsuite/libgomp.oacc-fortran/multidim-slice.f95 b/libgomp/testsuite/libgomp.oacc-fortran/multidim-slice.f95 new file mode 100644 index 000000000000..a9b40eeab4ca --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/multidim-slice.f95 @@ -0,0 +1,50 @@ +! { dg-do run } + +program main + implicit none + real, allocatable :: myarr(:,:,:,:,:) + integer i, j, k, l, m + + allocate(myarr(1:10,1:10,1:10,1:10,1:10)) + + do i=1,10 + do j=1,10 + do k=1,10 + do l=1,10 + do m=1,10 + myarr(m,l,k,j,i) = i+j+k+l+m + end do + end do + end do + end do + end do + + do i=1,10 + !$acc data copy(myarr(:,:,:,:,i)) + !$acc parallel loop collapse(4) present(myarr(:,:,:,:,i)) + do j=1,10 + do k=1,10 + do l=1,10 + do m=1,10 + myarr(m,l,k,j,i) = myarr(m,l,k,j,i) + 1 + end do + end do + end do + end do + !$acc end parallel loop + !$acc end data + end do + + do i=1,10 + do j=1,10 + do k=1,10 + do l=1,10 + do m=1,10 + if (myarr(m,l,k,j,i) .ne. i+j+k+l+m+1) stop 1 + end do + end do + end do + end do + end do + +end program main