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.
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;
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);
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);
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)
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)
{
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;
/* 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);
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. */
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)
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;
@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
@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
@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
@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)
@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
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);}
--- /dev/null
+! { 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
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. */
! { 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
! { 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" }
! { 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
! { 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" }
! { 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"
--- /dev/null
+! { 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
projects / thirdparty / gcc.git / commitdiff
