From 3269a722b7a03613e9c4e2862bc5088c4a17cc11 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Sun, 13 Oct 2024 10:18:31 +0200 Subject: 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. --- 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 +- 6 files changed, 60 insertions(+), 20 deletions(-) (limited to 'gcc') diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 286c93b..7aa9b13 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 d998d0e..a55f1f3 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 2586c6d..56b6202 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 9f223a1..8094171 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 390cc95..aa61750 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 942de77..9a84483 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; -- cgit v1.1