diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/gfortran.h | 3 | ||||
| -rw-r--r-- | gcc/fortran/options.cc | 5 | ||||
| -rw-r--r-- | gcc/fortran/trans-decl.cc | 9 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.cc | 58 | ||||
| -rw-r--r-- | gcc/fortran/types.def | 3 | ||||
| -rw-r--r-- | gcc/gimple-fold.cc | 2 |
6 files changed, 60 insertions, 20 deletions
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; |