OpenMP: Handle descriptors in target's firstprivate [PR104949]

For allocatable/pointer arrays, a firstprivate to a device
not only needs to privatize the descriptor but also the actual
data. This is implemented as:
  firstprivate(x) firstprivate(x.data) attach(x [bias: &x.data-&x)
where the address of x in device memory is saved in hostaddrs[i]
by libgomp and the middle end actually passes hostaddrs[i]' to
attach.

As side effect, has_device_addr(array_desc) had to be changed:
before, it was converted to firstprivate in the front end; now
it is handled in omp-low.cc as has_device_addr requires a shallow
firstprivate (not touching the data pointer) while the normal
firstprivate requires (now) a deep firstprivate.

gcc/fortran/ChangeLog:

	PR fortran/104949
	* f95-lang.cc (LANG_HOOKS_OMP_ARRAY_SIZE): Redefine.
	* trans-openmp.cc (gfc_omp_array_size): New.
	(gfc_trans_omp_variable_list): Never turn has_device_addr
	to firstprivate.
	* trans.h (gfc_omp_array_size): New.

gcc/ChangeLog:

	PR fortran/104949
	* langhooks-def.h (lhd_omp_array_size): New.
	(LANG_HOOKS_OMP_ARRAY_SIZE): Define.
	(LANG_HOOKS_DECLS): Add it.
	* langhooks.cc (lhd_omp_array_size): New.
	* langhooks.h (struct lang_hooks_for_decls): Add hook.
	* omp-low.cc (scan_sharing_clauses, lower_omp_target):
	Handle GOMP_MAP_FIRSTPRIVATE for array descriptors.

libgomp/ChangeLog:

	PR fortran/104949
	* target.c (gomp_map_vars_internal, copy_firstprivate_data):
	Support attach for GOMP_MAP_FIRSTPRIVATE.
	* testsuite/libgomp.fortran/target-firstprivate-1.f90: New test.
	* testsuite/libgomp.fortran/target-firstprivate-2.f90: New test.
	* testsuite/libgomp.fortran/target-firstprivate-3.f90: New test.

1 files changed, 43 insertions, 10 deletions

diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index e1907a4..bfd24f9 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -169,6 +169,48 @@ gfc_omp_array_data (tree decl, bool type_only)
   return decl;
 }
 
+/* Return the byte-size of the passed array descriptor. */
+
+tree
+gfc_omp_array_size (tree decl, gimple_seq *pre_p)
+{
+  stmtblock_t block;
+  if (POINTER_TYPE_P (TREE_TYPE (decl)))
+    decl = build_fold_indirect_ref (decl);
+  tree type = TREE_TYPE (decl);
+  gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+  bool allocatable = (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE
+		      || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER
+		      || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT);
+  gfc_init_block (&block);
+  tree size = gfc_full_array_size (&block, decl,
+				   GFC_TYPE_ARRAY_RANK (TREE_TYPE (decl)));
+  size = fold_convert (size_type_node, size);
+  tree elemsz = gfc_get_element_type (TREE_TYPE (decl));
+  if (TREE_CODE (elemsz) == ARRAY_TYPE && TYPE_STRING_FLAG (elemsz))
+    elemsz = gfc_conv_descriptor_elem_len (decl);
+  else
+    elemsz = TYPE_SIZE_UNIT (elemsz);
+  size = fold_build2 (MULT_EXPR, size_type_node, size, elemsz);
+  if (!allocatable)
+    gimplify_and_add (gfc_finish_block (&block), pre_p);
+  else
+    {
+      tree var = create_tmp_var (size_type_node);
+      gfc_add_expr_to_block (&block, build2 (MODIFY_EXPR, sizetype, var, size));
+      tree tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+				  gfc_conv_descriptor_data_get (decl),
+				  null_pointer_node);
+      tmp = build3_loc (input_location, COND_EXPR, void_type_node, tmp,
+			gfc_finish_block (&block),
+			build2 (MODIFY_EXPR, sizetype, var, size_zero_node));
+      gimplify_and_add (tmp, pre_p);
+      size = var;
+    }
+  return size;
+}
+
+
 /* True if OpenMP should privatize what this DECL points to rather
    than the DECL itself.  */
 
@@ -1922,16 +1964,7 @@ gfc_trans_omp_variable_list (enum omp_clause_code code,
 	if (t != error_mark_node)
 	  {
 	    tree node;
-	    /* For HAS_DEVICE_ADDR of an array descriptor, firstprivatize the
-	       descriptor such that the bounds are available; its data component
-	       is unmodified; it is handled as device address inside target. */
-	    if (code == OMP_CLAUSE_HAS_DEVICE_ADDR
-		&& (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (t))
-		    || (POINTER_TYPE_P (TREE_TYPE (t))
-			&& GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (t))))))
-	      node = build_omp_clause (input_location, OMP_CLAUSE_FIRSTPRIVATE);
-	    else
-	      node = build_omp_clause (input_location, code);
+	    node = build_omp_clause (input_location, code);
 	    OMP_CLAUSE_DECL (node) = t;
 	    list = gfc_trans_add_clause (node, list);