From a2c26c50310a336361d8129ecdd43d3001d6cb3a Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Mon, 11 Nov 2019 09:19:29 +0000 Subject: [PATCH] Fortran] Support absent optional args with use_device_{ptr,addr} 2019-11-11 Tobias Burnus Kwok Cheung Yeung gcc/ * langhooks-def.h (LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT): Renamed from LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT; update define. (LANG_HOOKS_DECLS): Rename also here. * langhooks.h (lang_hooks_for_decls): Rename omp_is_optional_argument to omp_check_optional_argument; take additional bool argument. * omp-general.h (omp_check_optional_argument): Likewise. * omp-general.h (omp_check_optional_argument): Likewise. * omp-low.c (lower_omp_target): Update calls; handle absent Fortran optional arguments with USE_DEVICE_ADDR/USE_DEVICE_PTR. gcc/fortran/ * trans-expr.c (gfc_conv_expr_present): Check for DECL_ARTIFICIAL for the VALUE hidden argument avoiding -fallow-underscore issues. * trans-decl.c (create_function_arglist): Also set GFC_DECL_OPTIONAL_ARGUMENT for per-value arguments. * f95-lang.c (LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT): Renamed from LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT; point to gfc_omp_check_optional_argument. * trans.h (gfc_omp_check_optional_argument): Subsitutes gfc_omp_is_optional_argument declaration. * trans-openmp.c (gfc_omp_is_optional_argument): Make static. (gfc_omp_check_optional_argument): New function. libgomp/ * testsuite/libgomp.fortran/use_device_ptr-optional-1.f90: Extend. * testsuite/libgomp.fortran/use_device_ptr-optional-2.f90: New. Co-Authored-By: Kwok Cheung Yeung From-SVN: r278046 --- gcc/ChangeLog | 14 ++ gcc/fortran/ChangeLog | 15 +++ gcc/fortran/f95-lang.c | 4 +- gcc/fortran/trans-decl.c | 3 +- gcc/fortran/trans-expr.c | 3 +- gcc/fortran/trans-openmp.c | 63 ++++++++- gcc/fortran/trans.h | 2 +- gcc/langhooks-def.h | 4 +- gcc/langhooks.h | 13 +- gcc/omp-general.c | 14 +- gcc/omp-general.h | 2 +- gcc/omp-low.c | 120 ++++++++++++++---- libgomp/ChangeLog | 6 + .../use_device_ptr-optional-1.f90 | 22 ++++ .../use_device_ptr-optional-2.f90 | 33 +++++ 15 files changed, 270 insertions(+), 48 deletions(-) create mode 100644 libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90 diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 1b0145fbc78..2c2c456e217 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,17 @@ +2019-11-11 Tobias Burnus + Kwok Cheung Yeung + + * langhooks-def.h (LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT): + Renamed from LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT; update define. + (LANG_HOOKS_DECLS): Rename also here. + * langhooks.h (lang_hooks_for_decls): Rename + omp_is_optional_argument to omp_check_optional_argument; take + additional bool argument. + * omp-general.h (omp_check_optional_argument): Likewise. + * omp-general.h (omp_check_optional_argument): Likewise. + * omp-low.c (lower_omp_target): Update calls; handle absent + Fortran optional arguments with USE_DEVICE_ADDR/USE_DEVICE_PTR. + 2019-11-11 H.J. Lu PR target/87833 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 2031688474b..0a8efedb6e6 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,18 @@ +2019-11-11 Tobias Burnus + Kwok Cheung Yeung + + * trans-expr.c (gfc_conv_expr_present): Check for DECL_ARTIFICIAL + for the VALUE hidden argument avoiding -fallow-underscore issues. + * trans-decl.c (create_function_arglist): Also set + GFC_DECL_OPTIONAL_ARGUMENT for per-value arguments. + * f95-lang.c (LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT): + Renamed from LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT; point + to gfc_omp_check_optional_argument. + * trans.h (gfc_omp_check_optional_argument): Subsitutes + gfc_omp_is_optional_argument declaration. + * trans-openmp.c (gfc_omp_is_optional_argument): Make static. + (gfc_omp_check_optional_argument): New function. + 2019-11-10 Janne Blomqvist PR fortran/91413 diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c index 0684c3b99cf..c7b592dbfe2 100644 --- a/gcc/fortran/f95-lang.c +++ b/gcc/fortran/f95-lang.c @@ -115,7 +115,7 @@ static const struct attribute_spec gfc_attribute_table[] = #undef LANG_HOOKS_INIT_TS #undef LANG_HOOKS_OMP_ARRAY_DATA #undef LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR -#undef LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT +#undef LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT #undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE #undef LANG_HOOKS_OMP_PREDETERMINED_SHARING #undef LANG_HOOKS_OMP_REPORT_DECL @@ -150,7 +150,7 @@ static const struct attribute_spec gfc_attribute_table[] = #define LANG_HOOKS_INIT_TS gfc_init_ts #define LANG_HOOKS_OMP_ARRAY_DATA gfc_omp_array_data #define LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR gfc_omp_is_allocatable_or_ptr -#define LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT gfc_omp_is_optional_argument +#define LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT gfc_omp_check_optional_argument #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE gfc_omp_privatize_by_reference #define LANG_HOOKS_OMP_PREDETERMINED_SHARING gfc_omp_predetermined_sharing #define LANG_HOOKS_OMP_REPORT_DECL gfc_omp_report_decl diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 76e1c7a8453..e7424477427 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2692,9 +2692,8 @@ create_function_arglist (gfc_symbol * sym) && (!f->sym->attr.proc_pointer && f->sym->attr.flavor != FL_PROCEDURE)) DECL_BY_REFERENCE (parm) = 1; - if (f->sym->attr.optional && !f->sym->attr.value) + if (f->sym->attr.optional) { - /* With value, the argument is passed as is. */ gfc_allocate_lang_decl (parm); GFC_DECL_OPTIONAL_ARGUMENT (parm) = 1; } diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index f800faaa4e5..63559384c1e 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1725,7 +1725,8 @@ gfc_conv_expr_present (gfc_symbol * sym) /* Walk function argument list to find hidden arg. */ cond = DECL_ARGUMENTS (DECL_CONTEXT (decl)); for ( ; cond != NULL_TREE; cond = TREE_CHAIN (cond)) - if (DECL_NAME (cond) == tree_name) + if (DECL_NAME (cond) == tree_name + && DECL_ARTIFICIAL (cond)) break; gcc_assert (cond); diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 14a3c3e4284..dee7cc26a7d 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -58,19 +58,72 @@ gfc_omp_is_allocatable_or_ptr (const_tree decl) || GFC_DECL_GET_SCALAR_ALLOCATABLE (decl))); } -/* True if OpenMP should treat this DECL as an optional argument; note: for - arguments with VALUE attribute, the DECL is identical to nonoptional - arguments; hence, we return false here. To check whether the variable is - present, use the DECL which is passed as hidden argument. */ +/* True if the argument is an optional argument; except that false is also + returned for arguments with the value attribute (nonpointers) and for + assumed-shape variables (decl is a local variable containing arg->data). */ -bool +static bool gfc_omp_is_optional_argument (const_tree decl) { return (TREE_CODE (decl) == PARM_DECL && DECL_LANG_SPECIFIC (decl) + && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE && GFC_DECL_OPTIONAL_ARGUMENT (decl)); } +/* Check whether this DECL belongs to a Fortran optional argument. + With 'for_present_check' set to false, decls which are optional parameters + themselve are returned as tree - or a NULL_TREE otherwise. Those decls are + always pointers. With 'for_present_check' set to true, the decl for checking + whether an argument is present is returned; for arguments with value + attribute this is the hidden argument and of BOOLEAN_TYPE. If the decl is + unrelated to optional arguments, NULL_TREE is returned. */ + +tree +gfc_omp_check_optional_argument (tree decl, bool for_present_check) +{ + if (!for_present_check) + return gfc_omp_is_optional_argument (decl) ? decl : NULL_TREE; + + if (!DECL_LANG_SPECIFIC (decl)) + return NULL_TREE; + + /* For assumed-shape arrays, a local decl with arg->data is used. */ + if (TREE_CODE (decl) != PARM_DECL + && (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)) + || GFC_ARRAY_TYPE_P (TREE_TYPE (decl)))) + decl = GFC_DECL_SAVED_DESCRIPTOR (decl); + + if (TREE_CODE (decl) != PARM_DECL + || !DECL_LANG_SPECIFIC (decl) + || !GFC_DECL_OPTIONAL_ARGUMENT (decl)) + return NULL_TREE; + + /* For VALUE, the scalar variable is passed as is but a hidden argument + denotes the value. Cf. trans-expr.c. */ + if (TREE_CODE (TREE_TYPE (decl)) != POINTER_TYPE) + { + char name[GFC_MAX_SYMBOL_LEN + 2]; + tree tree_name; + + name[0] = '_'; + strcpy (&name[1], IDENTIFIER_POINTER (DECL_NAME (decl))); + tree_name = get_identifier (name); + + /* Walk function argument list to find the hidden arg. */ + decl = DECL_ARGUMENTS (DECL_CONTEXT (decl)); + for ( ; decl != NULL_TREE; decl = TREE_CHAIN (decl)) + if (DECL_NAME (decl) == tree_name + && DECL_ARTIFICIAL (decl)) + break; + + gcc_assert (decl); + return decl; + } + + return decl; +} + /* Returns tree with NULL if it is not an array descriptor and with the tree to access the 'data' component otherwise. With type_only = true, it returns the diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 364efe51d7c..359c7a2561a 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -787,7 +787,7 @@ bool gfc_get_array_descr_info (const_tree, struct array_descr_info *); /* In trans-openmp.c */ bool gfc_omp_is_allocatable_or_ptr (const_tree); -bool gfc_omp_is_optional_argument (const_tree); +tree gfc_omp_check_optional_argument (tree, bool); tree gfc_omp_array_data (tree, bool); bool gfc_omp_privatize_by_reference (const_tree); enum omp_clause_default_kind gfc_omp_predetermined_sharing (tree); diff --git a/gcc/langhooks-def.h b/gcc/langhooks-def.h index 2d3ad9a0a76..4002f281ddd 100644 --- a/gcc/langhooks-def.h +++ b/gcc/langhooks-def.h @@ -241,7 +241,7 @@ extern tree lhd_unit_size_without_reusable_padding (tree); #define LANG_HOOKS_DECL_OK_FOR_SIBCALL lhd_decl_ok_for_sibcall #define LANG_HOOKS_OMP_ARRAY_DATA hook_tree_tree_bool_null #define LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR hook_bool_const_tree_false -#define LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT hook_bool_const_tree_false +#define LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT hook_tree_tree_bool_null #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE hook_bool_const_tree_false #define LANG_HOOKS_OMP_PREDETERMINED_SHARING lhd_omp_predetermined_sharing #define LANG_HOOKS_OMP_REPORT_DECL lhd_pass_through_t @@ -269,7 +269,7 @@ extern tree lhd_unit_size_without_reusable_padding (tree); LANG_HOOKS_DECL_OK_FOR_SIBCALL, \ LANG_HOOKS_OMP_ARRAY_DATA, \ LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR, \ - LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT, \ + LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT, \ LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE, \ LANG_HOOKS_OMP_PREDETERMINED_SHARING, \ LANG_HOOKS_OMP_REPORT_DECL, \ diff --git a/gcc/langhooks.h b/gcc/langhooks.h index 39d3608b5f8..0e451c15ffc 100644 --- a/gcc/langhooks.h +++ b/gcc/langhooks.h @@ -235,11 +235,14 @@ struct lang_hooks_for_decls allocatable or pointer attribute. */ bool (*omp_is_allocatable_or_ptr) (const_tree); - /* True if OpenMP should treat DECL as a Fortran optional argument; note: for - arguments with VALUE attribute, the DECL is identical to nonoptional - arguments; hence, we return false here. To check whether the variable is - present, use the DECL which is passed as hidden argument. */ - bool (*omp_is_optional_argument) (const_tree); + /* Check whether this DECL belongs to a Fortran optional argument. + With 'for_present_check' set to false, decls which are optional parameters + themselve are returned as tree - or a NULL_TREE otherwise. Those decls are + always pointers. With 'for_present_check' set to true, the decl for + checking whether an argument is present is returned; for arguments with + value attribute this is the hidden argument and of BOOLEAN_TYPE. If the + decl is unrelated to optional arguments, NULL_TREE is returned. */ + tree (*omp_check_optional_argument) (tree, bool); /* True if OpenMP should privatize what this DECL points to rather than the DECL itself. */ diff --git a/gcc/omp-general.c b/gcc/omp-general.c index 72a0f20feee..fd074a36b23 100644 --- a/gcc/omp-general.c +++ b/gcc/omp-general.c @@ -63,12 +63,18 @@ omp_is_allocatable_or_ptr (tree decl) return lang_hooks.decls.omp_is_allocatable_or_ptr (decl); } -/* Return true if DECL is a Fortran optional argument. */ +/* Check whether this DECL belongs to a Fortran optional argument. + With 'for_present_check' set to false, decls which are optional parameters + themselve are returned as tree - or a NULL_TREE otherwise. Those decls are + always pointers. With 'for_present_check' set to true, the decl for checking + whether an argument is present is returned; for arguments with value + attribute this is the hidden argument and of BOOLEAN_TYPE. If the decl is + unrelated to optional arguments, NULL_TREE is returned. */ -bool -omp_is_optional_argument (tree decl) +tree +omp_check_optional_argument (tree decl, bool for_present_check) { - return lang_hooks.decls.omp_is_optional_argument (decl); + return lang_hooks.decls.omp_check_optional_argument (decl, for_present_check); } /* Return true if DECL is a reference type. */ diff --git a/gcc/omp-general.h b/gcc/omp-general.h index fe5c25b08ab..500c93941a2 100644 --- a/gcc/omp-general.h +++ b/gcc/omp-general.h @@ -74,7 +74,7 @@ struct omp_for_data extern tree omp_find_clause (tree clauses, enum omp_clause_code kind); extern bool omp_is_allocatable_or_ptr (tree decl); -extern bool omp_is_optional_argument (tree decl); +extern tree omp_check_optional_argument (tree decl, bool for_present_check); extern bool omp_is_reference (tree decl); extern void omp_adjust_for_condition (location_t loc, enum tree_code *cond_code, tree *n2, tree v, tree step); diff --git a/gcc/omp-low.c b/gcc/omp-low.c index fa76ceba33c..e232d7aa62d 100644 --- a/gcc/omp-low.c +++ b/gcc/omp-low.c @@ -11796,12 +11796,12 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FROM || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_TO) && (omp_is_allocatable_or_ptr (var) - && omp_is_optional_argument (var))) + && omp_check_optional_argument (var, false))) var = build_fold_indirect_ref (var); else if ((OMP_CLAUSE_CODE (c) != OMP_CLAUSE_FROM && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_TO) || (!omp_is_allocatable_or_ptr (var) - && !omp_is_optional_argument (var))) + && !omp_check_optional_argument (var, false))) var = build_fold_addr_expr (var); gimplify_assign (x, var, &ilist); } @@ -11975,6 +11975,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) case OMP_CLAUSE_USE_DEVICE_PTR: case OMP_CLAUSE_USE_DEVICE_ADDR: case OMP_CLAUSE_IS_DEVICE_PTR: + bool do_optional_check; + do_optional_check = false; ovar = OMP_CLAUSE_DECL (c); var = lookup_decl_in_outer_ctx (ovar, ctx); @@ -11996,7 +11998,10 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) } type = TREE_TYPE (ovar); if (lang_hooks.decls.omp_array_data (ovar, true)) - var = lang_hooks.decls.omp_array_data (ovar, false); + { + var = lang_hooks.decls.omp_array_data (ovar, false); + do_optional_check = true; + } else if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR && !omp_is_reference (ovar) && !omp_is_allocatable_or_ptr (ovar)) @@ -12005,7 +12010,7 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) else { if (omp_is_reference (ovar) - || omp_is_optional_argument (ovar) + || omp_check_optional_argument (ovar, false) || omp_is_allocatable_or_ptr (ovar)) { type = TREE_TYPE (type); @@ -12014,11 +12019,39 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) && !omp_is_allocatable_or_ptr (ovar)) || (omp_is_reference (ovar) && omp_is_allocatable_or_ptr (ovar)))) - var = build_simple_mem_ref (var); + { + var = build_simple_mem_ref (var); + do_optional_check = true; + } var = fold_convert (TREE_TYPE (x), var); } } - gimplify_assign (x, var, &ilist); + tree present; + present = (do_optional_check + ? omp_check_optional_argument (ovar, true) : NULL_TREE); + if (present) + { + tree null_label = create_artificial_label (UNKNOWN_LOCATION); + tree notnull_label = create_artificial_label (UNKNOWN_LOCATION); + tree opt_arg_label = create_artificial_label (UNKNOWN_LOCATION); + tree new_x = unshare_expr (x); + gimplify_expr (&present, &ilist, NULL, is_gimple_val, + fb_rvalue); + gcond *cond = gimple_build_cond_from_tree (present, + notnull_label, + null_label); + gimple_seq_add_stmt (&ilist, cond); + gimple_seq_add_stmt (&ilist, gimple_build_label (null_label)); + gimplify_assign (new_x, null_pointer_node, &ilist); + gimple_seq_add_stmt (&ilist, gimple_build_goto (opt_arg_label)); + gimple_seq_add_stmt (&ilist, + gimple_build_label (notnull_label)); + gimplify_assign (x, var, &ilist); + gimple_seq_add_stmt (&ilist, + gimple_build_label (opt_arg_label)); + } + else + gimplify_assign (x, var, &ilist); s = size_int (0); purpose = size_int (map_idx++); CONSTRUCTOR_APPEND_ELT (vsize, purpose, s); @@ -12167,8 +12200,13 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) case OMP_CLAUSE_USE_DEVICE_PTR: case OMP_CLAUSE_USE_DEVICE_ADDR: case OMP_CLAUSE_IS_DEVICE_PTR: - var = OMP_CLAUSE_DECL (c); + tree new_var; + gimple_seq assign_body; bool is_array_data; + bool do_optional_check; + assign_body = NULL; + do_optional_check = false; + var = OMP_CLAUSE_DECL (c); is_array_data = lang_hooks.decls.omp_array_data (var, true) != NULL; if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_IS_DEVICE_PTR) @@ -12181,34 +12219,35 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) if (is_array_data) { bool is_ref = omp_is_reference (var); + do_optional_check = true; /* First, we copy the descriptor data from the host; then we update its data to point to the target address. */ - tree new_var = lookup_decl (var, ctx); + new_var = lookup_decl (var, ctx); new_var = DECL_VALUE_EXPR (new_var); tree v = new_var; if (is_ref) { var = build_fold_indirect_ref (var); - gimplify_expr (&var, &new_body, NULL, is_gimple_val, + gimplify_expr (&var, &assign_body, NULL, is_gimple_val, fb_rvalue); v = create_tmp_var_raw (TREE_TYPE (var), get_name (var)); gimple_add_tmp_var (v); TREE_ADDRESSABLE (v) = 1; - gimple_seq_add_stmt (&new_body, + gimple_seq_add_stmt (&assign_body, gimple_build_assign (v, var)); tree rhs = build_fold_addr_expr (v); - gimple_seq_add_stmt (&new_body, + gimple_seq_add_stmt (&assign_body, gimple_build_assign (new_var, rhs)); } else - gimple_seq_add_stmt (&new_body, + gimple_seq_add_stmt (&assign_body, gimple_build_assign (new_var, var)); tree v2 = lang_hooks.decls.omp_array_data (unshare_expr (v), false); gcc_assert (v2); - gimplify_expr (&x, &new_body, NULL, is_gimple_val, fb_rvalue); - gimple_seq_add_stmt (&new_body, + gimplify_expr (&x, &assign_body, NULL, is_gimple_val, fb_rvalue); + gimple_seq_add_stmt (&assign_body, gimple_build_assign (v2, x)); } else if (is_variable_sized (var)) @@ -12217,9 +12256,9 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) gcc_assert (TREE_CODE (pvar) == INDIRECT_REF); pvar = TREE_OPERAND (pvar, 0); gcc_assert (DECL_P (pvar)); - tree new_var = lookup_decl (pvar, ctx); - gimplify_expr (&x, &new_body, NULL, is_gimple_val, fb_rvalue); - gimple_seq_add_stmt (&new_body, + new_var = lookup_decl (pvar, ctx); + gimplify_expr (&x, &assign_body, NULL, is_gimple_val, fb_rvalue); + gimple_seq_add_stmt (&assign_body, gimple_build_assign (new_var, x)); } else if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR @@ -12227,19 +12266,19 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) && !omp_is_allocatable_or_ptr (var)) || TREE_CODE (TREE_TYPE (var)) == ARRAY_TYPE) { - tree new_var = lookup_decl (var, ctx); + new_var = lookup_decl (var, ctx); new_var = DECL_VALUE_EXPR (new_var); gcc_assert (TREE_CODE (new_var) == MEM_REF); new_var = TREE_OPERAND (new_var, 0); gcc_assert (DECL_P (new_var)); - gimplify_expr (&x, &new_body, NULL, is_gimple_val, fb_rvalue); - gimple_seq_add_stmt (&new_body, + gimplify_expr (&x, &assign_body, NULL, is_gimple_val, fb_rvalue); + gimple_seq_add_stmt (&assign_body, gimple_build_assign (new_var, x)); } else { tree type = TREE_TYPE (var); - tree new_var = lookup_decl (var, ctx); + new_var = lookup_decl (var, ctx); if (omp_is_reference (var)) { type = TREE_TYPE (type); @@ -12252,19 +12291,50 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) gimple_add_tmp_var (v); TREE_ADDRESSABLE (v) = 1; x = fold_convert (type, x); - gimplify_expr (&x, &new_body, NULL, is_gimple_val, + gimplify_expr (&x, &assign_body, NULL, is_gimple_val, fb_rvalue); - gimple_seq_add_stmt (&new_body, + gimple_seq_add_stmt (&assign_body, gimple_build_assign (v, x)); x = build_fold_addr_expr (v); + do_optional_check = true; } } new_var = DECL_VALUE_EXPR (new_var); x = fold_convert (TREE_TYPE (new_var), x); - gimplify_expr (&x, &new_body, NULL, is_gimple_val, fb_rvalue); - gimple_seq_add_stmt (&new_body, + gimplify_expr (&x, &assign_body, NULL, is_gimple_val, fb_rvalue); + gimple_seq_add_stmt (&assign_body, gimple_build_assign (new_var, x)); } + tree present; + present = (do_optional_check + ? omp_check_optional_argument (OMP_CLAUSE_DECL (c), true) + : NULL_TREE); + if (present) + { + tree null_label = create_artificial_label (UNKNOWN_LOCATION); + tree notnull_label = create_artificial_label (UNKNOWN_LOCATION); + tree opt_arg_label = create_artificial_label (UNKNOWN_LOCATION); + glabel *null_glabel = gimple_build_label (null_label); + glabel *notnull_glabel = gimple_build_label (notnull_label); + ggoto *opt_arg_ggoto = gimple_build_goto (opt_arg_label); + gimplify_expr (&x, &new_body, NULL, is_gimple_val, + fb_rvalue); + gimplify_expr (&present, &new_body, NULL, is_gimple_val, + fb_rvalue); + gcond *cond = gimple_build_cond_from_tree (present, + notnull_label, + null_label); + gimple_seq_add_stmt (&new_body, cond); + gimple_seq_add_stmt (&new_body, null_glabel); + gimplify_assign (new_var, null_pointer_node, &new_body); + gimple_seq_add_stmt (&new_body, opt_arg_ggoto); + gimple_seq_add_stmt (&new_body, notnull_glabel); + gimple_seq_add_seq (&new_body, assign_body); + gimple_seq_add_stmt (&new_body, + gimple_build_label (opt_arg_label)); + } + else + gimple_seq_add_seq (&new_body, assign_body); break; } /* Handle GOMP_MAP_FIRSTPRIVATE_{POINTER,REFERENCE} in second pass, diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog index 1fc8c471b6f..2f60d606a88 100644 --- a/libgomp/ChangeLog +++ b/libgomp/ChangeLog @@ -1,3 +1,9 @@ +2019-11-11 Tobias Burnus + Kwok Cheung Yeung + + * testsuite/libgomp.fortran/use_device_ptr-optional-1.f90: Extend. + * testsuite/libgomp.fortran/use_device_ptr-optional-2.f90: New. + 2019-11-11 Thomas Schwinge * testsuite/libgomp.fortran/target9.f90: Specify 'dg-do run'. diff --git a/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-1.f90 b/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-1.f90 index ac69df559c9..e92ee8bf573 100644 --- a/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-1.f90 +++ b/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-1.f90 @@ -11,6 +11,9 @@ program test_it ptr_null => null() call bar(ptr_null) + + call foo_absent() + call bar_absent() contains subroutine foo(ii) integer, pointer, optional :: ii @@ -34,4 +37,23 @@ contains if (associated(jj)) stop 8 !$omp end target data end subroutine bar + + subroutine foo_absent(ii) + integer, pointer, optional :: ii + + if (present(ii)) STOP 31 + !$omp target data map(to:ixx) use_device_ptr(ii) + if (present(ii)) STOP 32 + !$omp end target data + end subroutine foo_absent + + ! For bar, it is assumed that a NULL ptr on the host maps to NULL on the device + subroutine bar_absent(jj) + integer, pointer, optional :: jj + + if (present(jj)) STOP 41 + !$omp target data map(to:ixx) use_device_ptr(jj) + if (present(jj)) STOP 42 + !$omp end target data + end subroutine bar_absent end program test_it diff --git a/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90 b/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90 new file mode 100644 index 00000000000..41abf17eede --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90 @@ -0,0 +1,33 @@ +! Check whether absent optional arguments are properly +! handled with use_device_{addr,ptr}. +program main + implicit none (type, external) + call foo() +contains + subroutine foo(v, w, x, y, z) + integer, target, optional, value :: v + integer, target, optional :: w + integer, target, optional :: x(:) + integer, target, optional, allocatable :: y + integer, target, optional, allocatable :: z(:) + integer :: d + + !$omp target data map(d) use_device_addr(v, w, x, y, z) + if(present(v)) stop 1 + if(present(w)) stop 2 + if(present(x)) stop 3 + if(present(y)) stop 4 + if(present(z)) stop 5 + !$omp end target data + +! Using 'v' in use_device_ptr gives an ICE +! TODO: Find out what the OpenMP spec permits for use_device_ptr + + !$omp target data map(d) use_device_ptr(w, x, y, z) + if(present(w)) stop 6 + if(present(x)) stop 7 + if(present(y)) stop 8 + if(present(z)) stop 9 + !$omp end target data + end subroutine foo +end program main -- 2.30.2