From patchwork Wed Nov 6 15:04:40 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 1190512 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-512613-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="AqO/n+1e"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 477VQT0phZz9sPF for ; Thu, 7 Nov 2019 02:12:48 +1100 (AEDT) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:to:cc :from:subject:message-id:date:mime-version:content-type; q=dns; s=default; b=doS2OYkwUwhUxw8dLFNlJd04X+vEDsWT+GW28sPeGR8tfbeW5i SJHCfk5wjb2qxHpHBeO4IXZxbbTkbMnqtIWuru7Hfwug5Jlw3QBf/RdFwOiufkD3 QNS6atzP7weGqN7yy5R64sBsnN3FL6ciLP6pm1Dqt85BXb4eHcxabchvk= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:to:cc :from:subject:message-id:date:mime-version:content-type; s= default; bh=nE909nVEGThVhIp0OxOXlvlOYN0=; b=AqO/n+1eai+iDIu2xdif u2ui68v45djigU+53yBR1bsmHwMAwGHAHfX/LcCDh1zcwiMuAwGjUXvTQz/YhXGn Iv9qLuptzPHu/fEJwTJSex4V4k0tCnW9tOjmpF1Fl3Y9Ka6xChaOg51qzosHA5EF XvcP1Aw1BfPUr5wfB4xST4Q= Received: (qmail 103650 invoked by alias); 6 Nov 2019 15:05:25 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 103633 invoked by uid 89); 6 Nov 2019 15:05:24 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-21.3 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_SHORT, SPF_PASS autolearn=ham version=3.3.1 spammy=sk:constru, sk:CONSTRU, attr.value, UD:optional X-HELO: esa3.mentor.iphmx.com Received: from esa3.mentor.iphmx.com (HELO esa3.mentor.iphmx.com) (68.232.137.180) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 06 Nov 2019 15:05:21 +0000 IronPort-SDR: 4yr4vN6X3hI0pJt3NZa7XqwLnCh/g8fw6kGzq9gG4Be+FXSa4AMnGJWaqCgAwJ2MEwteoGCo5E TLjwSLX+r/obJeceDn3H/kYVhcxtL4Nrzx8v4D88osTvIZzaE710wrOz4KSxa8NAh7z7KnqinE EIdN2lUaepS64Mb9/rxKuXnhKAD9AGwEoRloRbwgLyJ0jKW8PzGiO2zxqzJXJOagT12sUAMucc YbteRfOk+MXwkifYUFckD6GSP/Lm6xG0IOaoMX/Tb+nc2SX+fVilAA2H1+mXcoit2QCcLIeRzk TVU= Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa3.mentor.iphmx.com with ESMTP; 06 Nov 2019 07:04:48 -0800 IronPort-SDR: 1BQfA/PreZGkfdORv9dTSO2xMk7+tABxEaLIhfJUV1uNBLDclGV9Jym5sJs64msrmfui9KY3gE EK9+K9R3vc2ezVQRTw1pTJNnlV/qGZXgL5RjF1Lp7nUNrPAiKg9U8hKum/IjLZkonL+JmFXi2X 1nZoTrbW9AY6Ju629FDttFn6Ghmj2Iil/ktiN83YE5dEXPwkXEkobQW2K7ZXUqbjLBVFlJXpVR Ho+OY9clqHAtTwbnWE+0dBUNBciGemuQMMz8clGwSv0wUzp6w/b7qqU5biS1Sjj+83L3HM01eQ KGE= To: Jakub Jelinek , gcc-patches , fortran CC: Thomas Schwinge From: Tobias Burnus Subject: [Patch][OpenMP][Fortran] Support absent optional args with use_device_{ptr, addr} (+ OpenACC's use_device clause) Message-ID: <1927b111-292c-4586-6052-feee72099ab1@codesourcery.com> Date: Wed, 6 Nov 2019 16:04:40 +0100 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101 Thunderbird/68.2.0 MIME-Version: 1.0 X-IsSubscribed: yes This patch is based on Kwok's patch, posted as (4/5) at https://gcc.gnu.org/ml/gcc-patches/2019-07/msg00964.html – which is targeting OpenACC's use_device* – but it also applies to OpenMP use_device_{ptr,addr}. I added an OpenMP test case. It showed that for arguments with value attribute and for assumed-shape array, one needs to do more — as the decl cannot be directly used for the is-argument-present check. (For 'value', a hidden boolean '_' + arg-name is passed in addition; for assumed-shape arrays, the array descriptor "x" is replaced by the local variable "x.0" (with "x.0 = x->data") and the original decl "x" is in GFC_DECL_SAVED_DESCRIPTOR. Especially for assumed-shape arrays, the new decl cannot be used unconditionally as it is uninitialized when the argument is absent.) Bootstrapped and regtested on x86_64-gnu-linux without offloading + with nvptx. OK? Cheers, Tobias *The OpenACC test cases are in 5/5 and depend on some other changes. Submission of {1,missing one line of 2,3,5}/5 is planned next. PPS: For fully absent-optional support, mapping needs to be handled for OpenACC (see Kwok's …/5 patches) and OpenMP (which is quite different on FE level) – and OpenMP also needs changes for the share clauses.] 2019-11-06 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-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-2.f90: New. gcc/fortran/f95-lang.c | 4 ++-- gcc/fortran/trans-decl.c | 3 +-- gcc/fortran/trans-openmp.c | 62 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++----- 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 | 98 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++---------------------- libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90 | 33 +++++++++++++++++++++++++++++++++ 10 files changed, 191 insertions(+), 44 deletions(-) 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 ffa61111316..80ef45d892e 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2691,9 +2691,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-openmp.c b/gcc/fortran/trans-openmp.c index 14a3c3e4284..3b82eaf8051 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -58,19 +58,71 @@ 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) + 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..deb4e7996e8 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 also_value) { - return lang_hooks.decls.omp_is_optional_argument (decl); + return lang_hooks.decls.omp_check_optional_argument (decl, also_value); } /* Return true if DECL is a reference type. */ diff --git a/gcc/omp-general.h b/gcc/omp-general.h index fe5c25b08ab..1cf007e3371 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 also_value); 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..ba39ccc390c 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); } @@ -12005,7 +12005,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); @@ -12018,7 +12018,30 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) var = fold_convert (TREE_TYPE (x), var); } } - gimplify_assign (x, var, &ilist); + if (omp_check_optional_argument (ovar, true)) + { + 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); + tree present = omp_check_optional_argument (ovar, true); + 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); @@ -12168,6 +12191,9 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) case OMP_CLAUSE_USE_DEVICE_ADDR: case OMP_CLAUSE_IS_DEVICE_PTR: var = OMP_CLAUSE_DECL (c); + tree new_var; + gimple_seq assign_body; + assign_body = NULL; bool is_array_data; is_array_data = lang_hooks.decls.omp_array_data (var, true) != NULL; @@ -12183,32 +12209,32 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) bool is_ref = omp_is_reference (var); /* 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 +12243,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 +12253,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 +12278,47 @@ 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); } } 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)); } + if (omp_check_optional_argument (OMP_CLAUSE_DECL (c), true)) + { + 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); + tree present = omp_check_optional_argument (OMP_CLAUSE_DECL (c), + true); + 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/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