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.

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;