OpenMP: declare variant's append_args + dispatch interop fixes

For 'omp dispatch interop(obj)', call omp_get_interop_int to
obtain the device number. Add new error if no device clause is
present if multiple interop-clause list items exist.

Update some vars and continue after appending interop args
instead of restarting to ensure that adjust_args updates
are actually performed.

gcc/ChangeLog:

	* builtin-types.def (BT_FN_PTRMODE_PTR_INT_PTR): Add.
	* gimplify.cc (gimplify_call_expr): Add error for multiple
	list items to the OpenMP interop clause if no device clause;
	continue instead of restarting after append_args handling.
	(gimplify_omp_dispatch): Extract device number from the
	single interop-clause list item.
	* omp-builtins.def (BUILT_IN_OMP_GET_INTEROP_INT): Add.

gcc/fortran/ChangeLog:

	* types.def (BT_FN_PTRMODE_PTR_INT_PTR): Add.

gcc/testsuite/ChangeLog:

	* c-c++-common/gomp/append-args-1.c: Update dg-*.
	* c-c++-common/gomp/append-args-3.c: Extend testcase.
	* c-c++-common/gomp/dispatch-11.c: Update dg-*.
	* c-c++-common/gomp/dispatch-12.c: Update dg-*.
	* g++.dg/gomp/append-args-1.C: Update dg-*.

gcc/builtin-types.def

@@ -695,6 +695,8 @@ DEF_FUNCTION_TYPE_3 (BT_FN_STRING_STRING_CONST_STRING_SIZE,
 		     BT_STRING, BT_STRING, BT_CONST_STRING, BT_SIZE)
 DEF_FUNCTION_TYPE_3 (BT_FN_INT_CONST_STRING_CONST_STRING_SIZE,
 		     BT_INT, BT_CONST_STRING, BT_CONST_STRING, BT_SIZE)
+DEF_FUNCTION_TYPE_3 (BT_FN_PTRMODE_PTR_INT_PTR,
+		     BT_PTRMODE, BT_PTR, BT_INT, BT_PTR)
 DEF_FUNCTION_TYPE_3 (BT_FN_PTR_PTR_CONST_PTR_SIZE,
 		     BT_PTR, BT_PTR, BT_CONST_PTR, BT_SIZE)
 DEF_FUNCTION_TYPE_3 (BT_FN_VOID_PTR_CONST_PTR_SIZE,

gcc/fortran/types.def

@@ -133,6 +133,8 @@ DEF_FUNCTION_TYPE_3 (BT_FN_BOOL_VPTR_I8_I8, BT_BOOL, BT_VOLATILE_PTR,
                      BT_I8, BT_I8)
 DEF_FUNCTION_TYPE_3 (BT_FN_BOOL_VPTR_I16_I16, BT_BOOL, BT_VOLATILE_PTR,
                      BT_I16, BT_I16)
+DEF_FUNCTION_TYPE_3 (BT_FN_PTRMODE_PTR_INT_PTR,
+		     BT_PTRMODE, BT_PTR, BT_INT, BT_PTR)
 DEF_FUNCTION_TYPE_3 (BT_FN_I1_VPTR_I1_I1, BT_I1, BT_VOLATILE_PTR, BT_I1, BT_I1)
 DEF_FUNCTION_TYPE_3 (BT_FN_I2_VPTR_I2_I2, BT_I2, BT_VOLATILE_PTR, BT_I2, BT_I2)
 DEF_FUNCTION_TYPE_3 (BT_FN_I4_VPTR_I4_I4, BT_I4, BT_VOLATILE_PTR, BT_I4, BT_I4)

gcc/gimplify.cc

@@ -4121,7 +4121,6 @@ gimplify_call_expr (tree *expr_p, gimple_seq *pre_p, bool want_value)
       && EXPR_P (CALL_EXPR_FN (*expr_p))
       && DECL_P (TREE_OPERAND (CALL_EXPR_FN (*expr_p), 0)))
     {
-      tree fndecl = TREE_OPERAND (CALL_EXPR_FN (*expr_p), 0);
       if (variant_substituted_p)
 	dispatch_adjust_args_list
 	  = lookup_attribute ("omp declare variant variant args",
@@ -4154,8 +4153,9 @@ gimplify_call_expr (tree *expr_p, gimple_seq *pre_p, bool want_value)
 	  error_at (OMP_CLAUSE_LOCATION (dispatch_interop),
 		    "unexpected %<interop%> clause as invoked procedure %qD is "
 		    "not variant substituted", fndecl);
-	      inform (DECL_SOURCE_LOCATION (fndecl),
-		      "%qD declared here", fndecl);
+	  inform (DECL_SOURCE_LOCATION (fndecl),
+		  "%qD declared here", fndecl);
+	  dispatch_interop = NULL_TREE;
 	}
       else if (dispatch_interop)
 	{
@@ -4175,9 +4175,15 @@ gimplify_call_expr (tree *expr_p, gimple_seq *pre_p, bool want_value)
 		      "%<declare variant%> candidate %qD declared here",
 		      fndecl);
 	    }
-	  /* FIXME: obtain the device_number from 1st 'interop' clause item.  */
 	}
-      if (dispatch_append_args && (nappend != ninterop || !dispatch_device_num))
+      if (dispatch_interop && !dispatch_device_num)
+	{
+	  gcc_checking_assert (ninterop > 1);
+	  error_at (OMP_CLAUSE_LOCATION (dispatch_interop),
+		    "the %<device%> clause must be present if the %<interop%> "
+		    "clause has more than one list item");
+	}
+      if (dispatch_append_args && nappend != ninterop)
 	{
 	  sorry_at (OMP_CLAUSE_LOCATION (dispatch_append_args),
 		    "%<append_args%> clause not yet supported for %qD", fndecl);
@@ -4220,6 +4226,12 @@ gimplify_call_expr (tree *expr_p, gimple_seq *pre_p, bool want_value)
 	  CALL_FROM_THUNK_P (*expr_p) = CALL_FROM_THUNK_P (call);
 	  SET_EXPR_LOCATION (*expr_p, EXPR_LOCATION (call));
 	  CALL_EXPR_VA_ARG_PACK (*expr_p) = CALL_EXPR_VA_ARG_PACK (call);
+	  ret = gimplify_expr (&CALL_EXPR_FN (*expr_p), pre_p, NULL,
+			       is_gimple_call_addr, fb_rvalue);
+	  if (ret == GS_ERROR)
+	    return GS_ERROR;
+	  nargs = call_expr_nargs (*expr_p);
+	  fndecl = get_callee_fndecl (*expr_p);
 
 	  /* Mark as already processed.  */
 	  if (dispatch_interop)
@@ -4230,9 +4242,6 @@ gimplify_call_expr (tree *expr_p, gimple_seq *pre_p, bool want_value)
 	      TREE_CHAIN (t) = gimplify_omp_ctxp->clauses;
 	      gimplify_omp_ctxp->clauses = t;
 	    }
-
-	  /* Re-run.  */
-	  return GS_OK;
 	}
     }
 
@@ -4257,9 +4266,6 @@ gimplify_call_expr (tree *expr_p, gimple_seq *pre_p, bool want_value)
 
 		  if (arg_types != NULL_TREE)
 		    {
-		      for (int param_idx = 0; param_idx < i; param_idx++)
-			arg_types = TREE_CHAIN (arg_types);
-
 		      bool need_device_ptr = false;
 		      bool need_device_addr = false;
 		      for (int need_addr = 0; need_addr <= 1; need_addr++)
@@ -18357,11 +18363,42 @@ gimplify_omp_dispatch (tree *expr_p, gimple_seq *pre_p)
   // If device clause, adjust ICV
   tree device
     = omp_find_clause (OMP_DISPATCH_CLAUSES (expr), OMP_CLAUSE_DEVICE);
+  // If no device clause exists but an interop clause with a single list
+  // item, use it to obtain the device number.
+  if (device)
+    device = OMP_CLAUSE_DEVICE_ID (device);
+  else
+    {
+      tree first_interop_obj
+	= omp_find_clause (OMP_DISPATCH_CLAUSES (expr), OMP_CLAUSE_INTEROP);
+      if (first_interop_obj)
+	for (tree c = TREE_CHAIN (first_interop_obj); c; c = TREE_CHAIN (c))
+	  if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_INTEROP)
+	    {
+	      first_interop_obj = NULL_TREE;
+	      break;
+	    }
+      if (first_interop_obj)
+	{
+	  device = create_tmp_var (integer_type_node);
+	  tree c = build_omp_clause (OMP_CLAUSE_LOCATION (first_interop_obj),
+				     OMP_CLAUSE_DEVICE);
+	  OMP_CLAUSE_DEVICE_ID (c) = device;
+	  TREE_CHAIN (c) = TREE_CHAIN (first_interop_obj);
+	  TREE_CHAIN (first_interop_obj) = c;
+	  first_interop_obj = OMP_CLAUSE_DECL (first_interop_obj);
+	  /* device = omp_get_interop_int (obj, omp_ipr_device_num, NULL);  */
+	  tree fn = builtin_decl_explicit (BUILT_IN_OMP_GET_INTEROP_INT);
+	  fn = build_call_expr (fn, 3, first_interop_obj,
+				build_int_cst (integer_type_node, -5),
+				null_pointer_node);
+	  gimplify_assign (device, fold_convert (integer_type_node, fn), &body);
+	}
+    }
   tree saved_device_icv = NULL_TREE;
   if (device
-      && (TREE_CODE (OMP_CLAUSE_DEVICE_ID (device)) != INTEGER_CST
-	  || !wi::eq_p (wi::to_wide (OMP_CLAUSE_DEVICE_ID (device)),
-			-1 /* omp_initial_device */)))
+      && (TREE_CODE (device) != INTEGER_CST
+	  || !wi::eq_p (wi::to_wide (device), -1 /* omp_initial_device */)))
     {
       // Save current default-device-var ICV
       saved_device_icv = create_tmp_var (integer_type_node);
@@ -18372,7 +18409,7 @@ gimplify_omp_dispatch (tree *expr_p, gimple_seq *pre_p)
 
       // Set default device
       fn = builtin_decl_explicit (BUILT_IN_OMP_SET_DEFAULT_DEVICE);
-      call = gimple_build_call (fn, 1, OMP_CLAUSE_DEVICE_ID (device));
+      call = gimple_build_call (fn, 1, device);
       gimplify_seq_add_stmt (&body, call);
     }
 

gcc/omp-builtins.def

@@ -86,6 +86,8 @@ DEF_GOMP_BUILTIN (BUILT_IN_OMP_GET_DEFAULT_DEVICE, "omp_get_default_device",
 		  BT_FN_INT, ATTR_NOTHROW_LEAF_LIST)
 DEF_GOMP_BUILTIN (BUILT_IN_OMP_SET_DEFAULT_DEVICE, "omp_set_default_device",
 		  BT_FN_INT, ATTR_NOTHROW_LEAF_LIST)
+DEF_GOMP_BUILTIN (BUILT_IN_OMP_GET_INTEROP_INT, "omp_get_interop_int",
+		  BT_FN_PTRMODE_PTR_INT_PTR, ATTR_NOTHROW_LEAF_LIST)
 
 DEF_GOMP_BUILTIN (BUILT_IN_GOMP_ATOMIC_START, "GOMP_atomic_start",
 		  BT_FN_VOID, ATTR_NOTHROW_LEAF_LIST)

gcc/testsuite/c-c++-common/gomp/append-args-1.c

@@ -71,9 +71,8 @@ test (int *a, int *b)
 
   #pragma omp dispatch interop (obj2)
     base3 (5, 1, 2, 3);
-  /* { dg-note "required by 'dispatch' construct" "" { target *-*-* } .-2 }  */
 
-  #pragma omp dispatch interop (obj2, obj1)
+  #pragma omp dispatch interop (obj2, obj1) /* { dg-error "the 'device' clause must be present if the 'interop' clause has more than one list item" } */
     base3 (5, 1, 2, 3);
   /* { dg-error "number of list items in 'interop' clause \\(2\\) exceeds the number of 'append_args' items \\(1\\) for 'declare variant' candidate 'repl3'" "" { target c } .-2 } */
   /* { dg-error "number of list items in 'interop' clause \\(2\\) exceeds the number of 'append_args' items \\(1\\) for 'declare variant' candidate 'void repl3\\(int, omp_interop_t, \\.\\.\\.\\)'" "" { target c++ } .-3 } */

gcc/testsuite/c-c++-common/gomp/append-args-3.c

@@ -17,41 +17,86 @@ void g(int, const char *, omp_interop_t, omp_interop_t);
 #pragma omp declare variant(g) match(construct={dispatch}) append_args(interop(target),interop(targetsync))
 void f(int x, const char *y);
 
+void g1(int, const char *, omp_interop_t);
+#pragma omp declare variant(g1) match(construct={dispatch}) append_args(interop(target,targetsync))
+void f1(int x, const char *y);
+
+void g2(int, const char *, omp_interop_t);
+#pragma omp declare variant(g2) match(construct={dispatch}) append_args(interop(target,targetsync)) adjust_args(need_device_ptr: y)
+void f2(int x, const char *y);
+
 void foo()
 {
   omp_interop_t obj1;  /* { dg-note "'obj1' was declared here" }  */
   omp_interop_t obj2 = omp_interop_none;
+  omp_interop_t obj5 = omp_interop_none;
+  omp_interop_t obj6 = omp_interop_none;
+  const char *cp = 0L;
+
   #pragma omp dispatch device(9) novariants(1)
      f(2, "abc");
   #pragma omp dispatch device(5) interop(obj1,obj2)
      f(3, "cde");  /* { dg-warning "'obj1' is used uninitialized \\\[-Wuninitialized\\\]" }  */
+  #pragma omp dispatch interop(obj5)
+     f1(4, "fgh");
+  #pragma omp dispatch interop(obj6)
+     f2(5, cp);
 }
 
 
 void varvar(int, int, omp_interop_t, omp_interop_t, ...);
 #pragma omp declare variant(varvar) match(construct={dispatch}) append_args(interop(target),interop(targetsync))
 void varbase(int x, int y, ...);
 
+void varvar1(int, int, omp_interop_t, ...);
+#pragma omp declare variant(varvar1) match(construct={dispatch}) append_args(interop(target,targetsync))
+void varbase1(int x, int y, ...);
+
+void varvar2(int, int *, omp_interop_t, ...);
+#pragma omp declare variant(varvar2) match(construct={dispatch}) append_args(interop(target,targetsync)) adjust_args(need_device_ptr: y)
+void varbase2(int x, int *y, ...);
+
+
 void bar()
 {
   omp_interop_t obj3 = omp_interop_none;
   omp_interop_t obj4;  /* { dg-note "'obj4' was declared here" } */
+  omp_interop_t obj7 = omp_interop_none;
+  omp_interop_t obj8 = omp_interop_none;
+  int *itr = 0L;
+
   #pragma omp dispatch device(3) nocontext(1)
      varbase(10, 11, 101, 202, 303);
   #pragma omp dispatch device(7) interop(obj3,obj4)
      varbase(20, 21, 111, 222, 333);  /* { dg-warning "'obj4' is used uninitialized \\\[-Wuninitialized\\\]" }  */
+  #pragma omp dispatch interop(obj7)
+     varbase1(40, 31, 911, 922, 933);
+  #pragma omp dispatch interop(obj8)
+     varbase2(49, itr, 919, 929, 939);
 }
 
-/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_default_device \\(\\);" 4 "gimple" } }  */
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_default_device \\(\\);" 8 "gimple" } }  */
 
 /* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(9\\);" 1 "gimple" } }  */
 /* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(5\\);" 1 "gimple" } }  */
 /* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(3\\);" 1 "gimple" } }  */
 /* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(7\\);" 1 "gimple" } }  */
 
-/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(D\.\[0-9\]+\\);" 4 "gimple" } }  */
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_interop_int \\(obj5, -5, 0B\\);" 1 "gimple" } }  */
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_interop_int \\(obj6, -5, 0B\\);" 1 "gimple" } }  */
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_interop_int \\(obj7, -5, 0B\\);" 1 "gimple" } }  */
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_interop_int \\(obj8, -5, 0B\\);" 1 "gimple" } }  */
+
+/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(D\.\[0-9\]+\\);" 12 "gimple" } }  */
 
 /* { dg-final { scan-tree-dump-times "f \\(2, \"abc\"\\);" 1 "gimple" } }  */
 /* { dg-final { scan-tree-dump-times "g \\(3, \"cde\", obj1, obj2\\);" 1 "gimple" } }  */
+/* { dg-final { scan-tree-dump-times "g1 \\(4, \"fgh\", obj5\\);" 1 "gimple" } }  */
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(cp, D\.\[0-9\]+\\);" 1 "gimple" } }  */
+/* { dg-final { scan-tree-dump-times "g2 \\(5, D\.\[0-9\]+, obj6\\);" 1 "gimple" } }  */
+
 /* { dg-final { scan-tree-dump-times "varbase \\(10, 11, 101, 202, 303\\);" 1 "gimple" } }  */
 /* { dg-final { scan-tree-dump-times "varvar \\(20, 21, obj3, obj4, 111, 222, 333\\);" 1 "gimple" } }  */
+/* { dg-final { scan-tree-dump-times "varvar1 \\(40, 31, obj7, 911, 922, 933\\);" 1 "gimple" } }  */
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(itr, D\.\[0-9\]+\\);" 1 "gimple" } }  */
+/* { dg-final { scan-tree-dump-times "varvar2 \\(49, D\.\[0-9\]+, obj8, 919, 929, 939\\);" 1 "gimple" } }  */