https://gcc.gnu.org/g:3269a722b7a03613e9c4e2862bc5088c4a17cc11
commit r15-4298-g3269a722b7a03613e9c4e2862bc5088c4a17cc11
Author: Tobias Burnus <tbur...@baylibre.com>
Date: Sun Oct 13 10:18:31 2024 +0200
Fortran: Use OpenACC's acc_on_device builtin, fix OpenMP'
__builtin_is_initial_device
It turned out that 'if (omp_is_initial_device() .eqv. true)' gave an ICE
due to comparing 'int' with 'logical(4)'. When digging deeper, it also
turned out that when the procedure pointer is needed, the builtin cannot
be used, either. (Follow up to r15-2799-gf1bfba3a9b3f31 )
Extend the code to also use the builtin acc_on_device with OpenACC,
which was previously only used in C/C++. Additionally, fix folding
when offloading is not enabled.
Fixes additionally the BT_BOOL data type, which was 'char'/integer(1)
instead of bool, backing the booleaness; use bool_type_node as the rest
of GCC.
gcc/fortran/ChangeLog:
* gfortran.h (gfc_option_t): Add disable_acc_on_device.
* options.cc (gfc_handle_option): Handle -fno-builtin-acc_on_device.
* trans-decl.cc (gfc_get_extern_function_decl): Move
__builtin_omp_is_initial_device handling to ...
* trans-expr.cc (get_builtin_fn): ... this new function.
(conv_function_val): Call it.
(update_builtin_function): New.
(gfc_conv_procedure_call): Call it.
* types.def (BT_BOOL): Fix type by using bool_type_node.
gcc/ChangeLog:
* gimple-fold.cc (gimple_fold_builtin_acc_on_device): Also fold
when offloading is not configured.
libgomp/ChangeLog:
* libgomp.texi (TR13): Fix minor typos.
(omp_is_initial_device): Improve wording.
(acc_on_device): Note how to disable the builtin.
* testsuite/libgomp.oacc-fortran/acc_on_device-1-1.f90: Remove TODO.
* testsuite/libgomp.oacc-fortran/acc_on_device-1-2.f: Likewise.
Add -fno-builtin-acc_on_device.
* testsuite/libgomp.oacc-fortran/acc_on_device-1-3.f: Likewise.
* testsuite/libgomp.oacc-c-c++-common/routine-nohost-1.c: Update
dg- as !offloading_enabled now compile-time expands acc_on_device.
* testsuite/libgomp.fortran/target-is-initial-device-3.f90: New
test.
* testsuite/libgomp.oacc-fortran/acc_on_device-2.f90: New test.
Diff:
---
gcc/fortran/gfortran.h | 3 +-
gcc/fortran/options.cc | 5 +-
gcc/fortran/trans-decl.cc | 9 ----
gcc/fortran/trans-expr.cc | 58 +++++++++++++++++++---
gcc/fortran/types.def | 3 +-
gcc/gimple-fold.cc | 2 +-
libgomp/libgomp.texi | 18 ++++---
.../libgomp.fortran/target-is-initial-device-3.f90 | 50 +++++++++++++++++++
.../libgomp.oacc-c-c++-common/routine-nohost-1.c | 3 +-
.../libgomp.oacc-fortran/acc_on_device-1-1.f90 | 5 --
.../libgomp.oacc-fortran/acc_on_device-1-2.f | 7 +--
.../libgomp.oacc-fortran/acc_on_device-1-3.f | 7 +--
.../libgomp.oacc-fortran/acc_on_device-2.f90 | 40 +++++++++++++++
13 files changed, 164 insertions(+), 46 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 286c93baa74d..7aa9b1312fee 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3204,7 +3204,8 @@ typedef struct
int flag_init_logical;
int flag_init_character;
char flag_init_character_value;
- int disable_omp_is_initial_device;
+ bool disable_omp_is_initial_device;
+ bool disable_acc_on_device;
int fpe;
int fpe_summary;
diff --git a/gcc/fortran/options.cc b/gcc/fortran/options.cc
index d998d0e61170..a55f1f36f3f9 100644
--- a/gcc/fortran/options.cc
+++ b/gcc/fortran/options.cc
@@ -868,11 +868,14 @@ gfc_handle_option (size_t scode, const char *arg,
HOST_WIDE_INT value,
break;
case OPT_fbuiltin_:
- /* We only handle -fno-builtin-omp_is_initial_device. */
+ /* We only handle -fno-builtin-omp_is_initial_device
+ and -fno-builtin-acc_on_device. */
if (value)
return false; /* Not supported. */
if (!strcmp ("omp_is_initial_device", arg))
gfc_option.disable_omp_is_initial_device = true;
+ else if (!strcmp ("acc_on_device", arg))
+ gfc_option.disable_acc_on_device = true;
else
warning (0, "command-line option %<-fno-builtin-%s%> is not valid for "
"Fortran", arg);
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 2586c6d7a79c..56b6202510e8 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -2231,15 +2231,6 @@ gfc_get_extern_function_decl (gfc_symbol * sym,
gfc_actual_arglist *actual_args,
to know that. */
gcc_assert (!(sym->attr.entry || sym->attr.entry_master));
- if (!gfc_option.disable_omp_is_initial_device
- && flag_openmp && sym->attr.function && sym->ts.type == BT_LOGICAL
- && !strcmp (sym->name, "omp_is_initial_device"))
- {
- sym->backend_decl
- = builtin_decl_explicit (BUILT_IN_OMP_IS_INITIAL_DEVICE);
- return sym->backend_decl;
- }
-
if (sym->attr.proc_pointer)
return get_proc_pointer_decl (sym);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 9f223a1314a6..8094171eb275 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -4381,13 +4381,51 @@ conv_base_obj_fcn_val (gfc_se * se, tree base_object,
gfc_expr * expr)
se->expr = build_fold_addr_expr_loc (input_location, se->expr);
}
+static tree
+get_builtin_fn (gfc_symbol * sym)
+{
+ if (!gfc_option.disable_omp_is_initial_device
+ && flag_openmp && sym->attr.function && sym->ts.type == BT_LOGICAL
+ && !strcmp (sym->name, "omp_is_initial_device"))
+ return builtin_decl_explicit (BUILT_IN_OMP_IS_INITIAL_DEVICE);
+
+ if (!gfc_option.disable_acc_on_device
+ && flag_openacc && sym->attr.function && sym->ts.type == BT_LOGICAL
+ && !strcmp (sym->name, "acc_on_device_h"))
+ return builtin_decl_explicit (BUILT_IN_ACC_ON_DEVICE);
+
+ return NULL_TREE;
+}
+
+static tree
+update_builtin_function (tree fn_call, gfc_symbol *sym)
+{
+ tree fn = TREE_OPERAND (CALL_EXPR_FN (fn_call), 0);
+
+ if (DECL_FUNCTION_CODE (fn) == BUILT_IN_OMP_IS_INITIAL_DEVICE)
+ /* In Fortran omp_is_initial_device returns logical(4)
+ but the builtin uses 'int'. */
+ return fold_convert (TREE_TYPE (TREE_TYPE (sym->backend_decl)), fn_call);
+
+ else if (DECL_FUNCTION_CODE (fn) == BUILT_IN_ACC_ON_DEVICE)
+ {
+ /* Likewise for the return type; additionally, the argument it a
+ call-by-value int, Fortran has a by-reference 'integer(4)'. */
+ tree arg = build_fold_indirect_ref_loc (input_location,
+ CALL_EXPR_ARG (fn_call, 0));
+ CALL_EXPR_ARG (fn_call, 0) = fold_convert (integer_type_node, arg);
+ return fold_convert (TREE_TYPE (TREE_TYPE (sym->backend_decl)), fn_call);
+ }
+ return fn_call;
+}
static void
-conv_function_val (gfc_se * se, gfc_symbol * sym, gfc_expr * expr,
- gfc_actual_arglist *actual_args)
+conv_function_val (gfc_se * se, bool *is_builtin, gfc_symbol * sym,
+ gfc_expr * expr, gfc_actual_arglist *actual_args)
{
tree tmp;
+ *is_builtin = false;
if (gfc_is_proc_ptr_comp (expr))
tmp = get_proc_ptr_comp (expr);
else if (sym->attr.dummy)
@@ -4404,9 +4442,13 @@ conv_function_val (gfc_se * se, gfc_symbol * sym,
gfc_expr * expr,
if (!sym->backend_decl)
sym->backend_decl = gfc_get_extern_function_decl (sym, actual_args);
- TREE_USED (sym->backend_decl) = 1;
-
- tmp = sym->backend_decl;
+ if ((tmp = get_builtin_fn (sym)) != NULL_TREE)
+ *is_builtin = true;
+ else
+ {
+ TREE_USED (sym->backend_decl) = 1;
+ tmp = sym->backend_decl;
+ }
if (sym->attr.cray_pointee)
{
@@ -6324,6 +6366,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
gfc_actual_arglist *arg;
int has_alternate_specifier = 0;
bool need_interface_mapping;
+ bool is_builtin;
bool callee_alloc;
bool ulim_copy;
gfc_typespec ts;
@@ -8164,7 +8207,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
/* Generate the actual call. */
if (base_object == NULL_TREE)
- conv_function_val (se, sym, expr, args);
+ conv_function_val (se, &is_builtin, sym, expr, args);
else
conv_base_obj_fcn_val (se, base_object, expr);
@@ -8189,6 +8232,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
fntype = TREE_TYPE (TREE_TYPE (se->expr));
se->expr = build_call_vec (TREE_TYPE (fntype), se->expr, arglist);
+ if (is_builtin)
+ se->expr = update_builtin_function (se->expr, sym);
+
/* Allocatable scalar function results must be freed and nullified
after use. This necessitates the creation of a temporary to
hold the result to prevent duplicate calls. */
diff --git a/gcc/fortran/types.def b/gcc/fortran/types.def
index 390cc9542f75..aa61750ec596 100644
--- a/gcc/fortran/types.def
+++ b/gcc/fortran/types.def
@@ -45,8 +45,7 @@ along with GCC; see the file COPYING3. If not see
the type pointed to. */
DEF_PRIMITIVE_TYPE (BT_VOID, void_type_node)
-DEF_PRIMITIVE_TYPE (BT_BOOL,
- (*lang_hooks.types.type_for_size) (BOOL_TYPE_SIZE, 1))
+DEF_PRIMITIVE_TYPE (BT_BOOL, boolean_type_node)
DEF_PRIMITIVE_TYPE (BT_INT, integer_type_node)
DEF_PRIMITIVE_TYPE (BT_UINT, unsigned_type_node)
DEF_PRIMITIVE_TYPE (BT_LONG, long_integer_type_node)
diff --git a/gcc/gimple-fold.cc b/gcc/gimple-fold.cc
index 942de7720fd2..9a84483f9bff 100644
--- a/gcc/gimple-fold.cc
+++ b/gcc/gimple-fold.cc
@@ -4190,7 +4190,7 @@ static bool
gimple_fold_builtin_acc_on_device (gimple_stmt_iterator *gsi, tree arg0)
{
/* Defer folding until we know which compiler we're in. */
- if (symtab->state != EXPANSION)
+ if (ENABLE_OFFLOADING && symtab->state != EXPANSION)
return false;
unsigned val_host = GOMP_DEVICE_HOST;
diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi
index cc44efdd9371..6860963f3683 100644
--- a/libgomp/libgomp.texi
+++ b/libgomp/libgomp.texi
@@ -547,7 +547,7 @@ Technical Report (TR) 13 is the third preview for OpenMP
6.0.
@item @code{no_openmp_constructs} assumptions clause @tab N @tab
@item Restriction for @code{ordered} regarding loop-transforming directives
@tab N @tab
-@item @code{apply} code to loop-transforming constructs @tab N @tab
+@item @code{apply} clause to loop-transforming constructs @tab N @tab
@item Non-constant values in the @code{sizes} clause @tab N @tab
@item @code{fuse} loop-transformation construct @tab N @tab
@item @code{interchange} loop-transformation construct @tab N @tab
@@ -573,7 +573,7 @@ Technical Report (TR) 13 is the third preview for OpenMP
6.0.
@item New @code{priority} clause to @code{target}, @code{target_enter_data},
@code{target_data}, @code{target_exit_data} and @code{target_update}
@tab N @tab
-@item New @code{device_type} clause to the @code{target} directive.
+@item New @code{device_type} clause to the @code{target} directive
@tab N @tab
@item @code{target_data} as composite construct @tab N @tab
@item @code{nowait} clause with reverse-offload @code{target} directives
@@ -584,7 +584,7 @@ Technical Report (TR) 13 is the third preview for OpenMP
6.0.
@item @code{memscope} clause to @code{atomic} and @code{flush} @tab N @tab
@item New @code{transparent} clause for multi-generational task-dependence
graphs
@tab N @tab
-@item The @code{cancel} construct new completes tasks with unfulfilled events
+@item The @code{cancel} construct now completes tasks with unfulfilled events
@tab N @tab
@item @code{omp_fulfill_event} routine was restricted regarding fulfillment of
event variables @tab N @tab
@@ -622,7 +622,7 @@ Technical Report (TR) 13 is the third preview for OpenMP
6.0.
@item @code{ompt_get_buffer_limits} OMPT routine @tab N @tab
@end multitable
-@unnumberedsubsec Deprecated features, unless listed above.
+@unnumberedsubsec Deprecated features, unless listed above
@multitable @columnfractions .60 .10 .25
@item Deprecation of omitting the optional white space to separate adjacent
keywords in the directive-name in Fortran (fixed and free source form)
@@ -1915,9 +1915,9 @@ This function returns @code{true} if currently running on
the host device,
@code{false} otherwise. Here, @code{true} and @code{false} represent
their language-specific counterparts.
-Note that in GCC this value is already folded to a constant in the compiler;
-compile with @option{-fno-builtin-omp_is_initial_device} if a run-time function
-is desired.
+Note that in GCC this function call is already folded to a constant in the
+compiler; compile with @option{-fno-builtin-omp_is_initial_device} if a
+run-time function is desired.
@item @emph{C/C++}:
@multitable @columnfractions .20 .80
@@ -4886,6 +4886,10 @@ In Fortran, @code{true} is returned. If the program is
not executing
on the specified device type C/C++ returns zero, while Fortran
returns @code{false}.
+Note that in GCC, depending on @var{devicetype}, the function call might
+be folded to a constant in the compiler; compile with
+@option{-fno-builtin-acc_on_device} if a run-time function is desired.
+
@item @emph{C/C++}:
@multitable @columnfractions .20 .80
@item @emph{Prototype}: @tab @code{acc_on_device(acc_device_t devicetype);}
diff --git a/libgomp/testsuite/libgomp.fortran/target-is-initial-device-3.f90
b/libgomp/testsuite/libgomp.fortran/target-is-initial-device-3.f90
new file mode 100644
index 000000000000..3ce24f1757dd
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-is-initial-device-3.f90
@@ -0,0 +1,50 @@
+! { dg-additional-options "-fdump-tree-original" }
+!
+! Check that EXPR_EQ works with __builtin_omp_is_initial_device,
+! which returns an 'int' while Fortran uses 'logical(4)'.
+!
+! Check that 'call ff (omp_is_initial_device)' accesses the library
+! function and not the builtin.
+!
+! { dg-final { scan-tree-dump-times "__builtin_omp_is_initial_device \\(\\)"
14 "original" } } */
+! { dg-final { scan-tree-dump "ff \\(omp_is_initial_device\\);" "original" } }
*/
+!
+program main
+ use omp_lib, only: omp_is_initial_device
+ implicit none (type, external)
+
+ logical(1) :: t1
+ logical(2) :: f2
+ t1 = .true.
+ f2 = .false.
+
+ if (omp_is_initial_device () .eqv. .true.) then
+ else
+ stop 1
+ end if
+ if (omp_is_initial_device () .neqv. .true.) stop 2
+ if (omp_is_initial_device () .eqv. .false.) stop 3
+ if (omp_is_initial_device () .neqv. .false.) then
+ else
+ stop 4
+ end if
+
+ if (omp_is_initial_device () .neqv. .true._1) stop 5
+ if (omp_is_initial_device () .eqv. .false._1) stop 6
+ if (omp_is_initial_device () .neqv. .true._2) stop 7
+ if (omp_is_initial_device () .eqv. .false._2) stop 8
+ if (omp_is_initial_device () .neqv. .true._4) stop 9
+ if (omp_is_initial_device () .eqv. .false._4) stop 10
+ if (omp_is_initial_device () .neqv. .true._8) stop 11
+ if (omp_is_initial_device () .eqv. .false._8) stop 12
+
+ if (omp_is_initial_device () .neqv. t1) stop 13
+ if (omp_is_initial_device () .eqv. f2) stop 14
+
+ call ff (omp_is_initial_device)
+contains
+ subroutine ff(xx)
+ procedure (omp_is_initial_device) :: xx
+ if (.not. xx ()) stop 15
+ end
+end
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/routine-nohost-1.c
b/libgomp/testsuite/libgomp.oacc-c-c++-common/routine-nohost-1.c
index 7dc7459e5fe1..e64711b536bb 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/routine-nohost-1.c
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/routine-nohost-1.c
@@ -36,8 +36,7 @@ static int fact_nohost(int n)
return fact(n);
}
-/* { dg-final { scan-tree-dump-times {(?n)^OpenACC routine 'fact_nohost' has
'nohost' clause\.$} 1 oaccloops { target c } } }
- { dg-final { scan-tree-dump-times {(?n)^OpenACC routine 'int
fact_nohost\(int\)' has 'nohost' clause\.$} 1 oaccloops { target { c++ && { !
offloading_enabled } } } } }
+/* { dg-final { scan-tree-dump-times {(?n)^OpenACC routine 'fact_nohost' has
'nohost' clause\.$} 1 oaccloops { target { c && offloading_enabled } } } }
{ dg-final { scan-tree-dump-times {(?n)^OpenACC routine
'fact_nohost\(int\)' has 'nohost' clause\.$} 1 oaccloops { target { c++ &&
offloading_enabled } } } }
TODO See PR101551 for 'offloading_enabled' differences. */
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-1.f90
b/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-1.f90
index cd599e5d0e3a..89748204f05a 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-1.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-1.f90
@@ -7,11 +7,6 @@
! { dg-additional-options "-foffload=--param=openacc-privatization=noisy" }
! for testing/documenting aspects of that functionality.
-! TODO: Have to disable the acc_on_device builtin for we want to test the
-! libgomp library function? The command line option
-! '-fno-builtin-acc_on_device' is valid for C/C++/ObjC/ObjC++ but not for
-! Fortran.
-
use openacc
implicit none
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-2.f
b/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-2.f
index eb3daba01885..e31e0fc715bd 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-2.f
+++ b/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-2.f
@@ -1,5 +1,5 @@
! { dg-do run }
-! { dg-additional-options "-cpp" }
+! { dg-additional-options "-cpp -fno-builtin-acc_on_device" }
! { dg-additional-options "-fopt-info-all-omp" }
! { dg-additional-options "--param=openacc-privatization=noisy" }
@@ -7,11 +7,6 @@
! { dg-additional-options "-foffload=--param=openacc-privatization=noisy" }
! for testing/documenting aspects of that functionality.
-! TODO: Have to disable the acc_on_device builtin for we want to test
-! the libgomp library function? The command line option
-! '-fno-builtin-acc_on_device' is valid for C/C++/ObjC/ObjC++ but not
-! for Fortran.
-
USE OPENACC
IMPLICIT NONE
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-3.f
b/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-3.f
index 5f500c194813..0595be241f8f 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-3.f
+++ b/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-3.f
@@ -1,5 +1,5 @@
! { dg-do run }
-! { dg-additional-options "-cpp" }
+! { dg-additional-options "-cpp -fno-builtin-acc_on_device" }
! { dg-additional-options "-fopt-info-all-omp" }
! { dg-additional-options "--param=openacc-privatization=noisy" }
@@ -7,11 +7,6 @@
! { dg-additional-options "-foffload=--param=openacc-privatization=noisy" }
! for testing/documenting aspects of that functionality.
-! TODO: Have to disable the acc_on_device builtin for we want to test
-! the libgomp library function? The command line option
-! '-fno-builtin-acc_on_device' is valid for C/C++/ObjC/ObjC++ but not
-! for Fortran.
-
IMPLICIT NONE
INCLUDE "openacc_lib.h"
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-2.f90
b/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-2.f90
new file mode 100644
index 000000000000..39d4357dd55d
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-2.f90
@@ -0,0 +1,40 @@
+! { dg-do link }
+
+! Check whether 'acc_on_device()' is properly compile-time optimized. */
+
+! { dg-additional-options "-fdump-tree-gimple -fdump-tree-optimized" }
+! { dg-additional-options -foffload-options=-fdump-tree-optimized { target {
offload_device_nvptx || offload_target_amdgcn } } }
+
+! { dg-final { scan-tree-dump-times "acc_on_device" 1 "gimple" } }
+
+! { dg-final { scan-tree-dump-not "acc_on_device" "optimized" } }
+
+! { dg-final { only_for_offload_target amdgcn-amdhsa
scan-offload-tree-dump-not "acc_on_device" "optimized" { target
offload_target_amdgcn } } }
+! { dg-final { only_for_offload_target nvptx-none scan-offload-tree-dump-not
"acc_on_device" "optimized" { target offload_target_nvptx } } }
+
+
+module m
+ integer :: xxxx
+ !$acc declare device_resident(xxxx)
+contains
+ subroutine set_var
+ !$acc routine
+ use openacc
+ implicit none (type, external)
+ if (acc_on_device(acc_device_host)) then
+ xxxx = 1234
+ else
+ xxxx = 4242
+ end if
+ end
+end module m
+
+
+program main
+ use m
+ call set_var
+ !$acc serial
+ ! { dg-warning "using 'vector_length \\(32\\)', ignoring 1" "" { target
openacc_nvidia_accel_selected } .-1 }
+ call set_var
+ !$acc end serial
+end
