OpenMP: Add uses_allocators support

This adds middle end support for uses_allocators, wires Fortran to use it and
add C/C++ parsing support.

gcc/ChangeLog:

	* builtin-types.def (BT_FN_VOID_PTRMODE): Add.
	(BT_FN_PTRMODE_PTRMODE_INT_PTR): Add.
	* gimplify.cc (gimplify_bind_expr): Diagnose missing
	uses_allocators clause.
	(gimplify_scan_omp_clauses, gimplify_adjust_omp_clauses,
	gimplify_omp_workshare): Handle uses_allocators.
	* omp-builtins.def (BUILT_IN_OMP_INIT_ALLOCATOR,
	BUILT_IN_OMP_DESTROY_ALLOCATOR): Add.
	* omp-low.cc (scan_sharing_clauses): Handle OMP_CLAUSE_USES_ALLOCATORS
	and OMP_CLAUSE_USES_ALLOCATORS_ALLOCATOR clauses.
	* tree-core.h (enum omp_clause_code): Add OMP_CLAUSE_USES_ALLOCATORS.
	* tree.cc (omp_clause_num_ops, omp_clause_code_name): Likewise.
	* tree-pretty-print.cc (dump_omp_clause): Handle it.
	* tree.h (OMP_CLAUSE_USES_ALLOCATORS_ALLOCATOR,
	OMP_CLAUSE_USES_ALLOCATORS_MEMSPACE,
	OMP_CLAUSE_USES_ALLOCATORS_TRAITS): New.

gcc/c-family/ChangeLog:

	* c-omp.cc (c_omp_split_clauses): Hande uses_allocators.
	* c-pragma.h (enum pragma_omp_clause): Add
	PRAGMA_OMP_CLAUSE_USES_ALLOCATORS.

gcc/c/ChangeLog:

	* c-parser.cc (c_parser_omp_clause_uses_allocators): New.
	(c_parser_omp_clause_name, c_parser_omp_all_clauses,
	OMP_TARGET_CLAUSE_MASK): Handle uses_allocators.
	* c-typeck.cc (c_finish_omp_clauses): Likewise.

gcc/cp/ChangeLog:

	* parser.cc (cp_parser_omp_clause_uses_allocators): New.
	(cp_parser_omp_clause_name, cp_parser_omp_all_clauses,
	OMP_TARGET_CLAUSE_MASK): Handle uses_allocators.
	* semantics.cc (finish_omp_clauses): Likewise.

gcc/fortran/ChangeLog:

	* trans-array.cc (gfc_conv_array_initializer): Set PURPOSE
	when building constructor for get_initialized_tmp_var.
	* trans-openmp.cc (gfc_trans_omp_clauses): Handle uses_allocators.
	* types.def (BT_FN_VOID_PTRMODE, BT_FN_PTRMODE_PTRMODE_INT_PTR): Add.

libgomp/ChangeLog:

	* testsuite/libgomp.c++/c++.exp (check_effective_target_c,
	check_effective_target_c++): Add.
	* testsuite/libgomp.c/c.exp (check_effective_target_c,
	check_effective_target_c++): Add.
	* testsuite/libgomp.fortran/uses_allocators_2.f90: Remove 'sorry'.
	* testsuite/libgomp.c-c++-common/uses_allocators-1.c: New test.
	* testsuite/libgomp.c-c++-common/uses_allocators-2.c: New test.
	* testsuite/libgomp.c-c++-common/uses_allocators-3.c: New test.
	* testsuite/libgomp.c-c++-common/uses_allocators-4.c: New test.
	* testsuite/libgomp.fortran/uses_allocators_3.f90: New test.
	* testsuite/libgomp.fortran/uses_allocators_4.f90: New test.
	* testsuite/libgomp.fortran/uses_allocators_5.f90: New test.
	* testsuite/libgomp.fortran/uses_allocators_6.f90: New test.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/allocate-1.f90: Add uses_allocators.
	* gfortran.dg/gomp/scope-6.f90: Update dg-scan-tree-dump.
	* c-c++-common/gomp/uses_allocators-1.c: New test.
	* c-c++-common/gomp/uses_allocators-2.c: New test.
	* gfortran.dg/gomp/uses_allocators-1.f90: New test.

2 files changed, 320 insertions, 1 deletions

diff --git a/gcc/c/c-parser.cc b/gcc/c/c-parser.cc
index 372a15c..b163ab8 100644
--- a/gcc/c/c-parser.cc
+++ b/gcc/c/c-parser.cc
@@ -16244,6 +16244,8 @@ c_parser_omp_clause_name (c_parser *parser)
 	    result = PRAGMA_OMP_CLAUSE_USE_DEVICE_ADDR;
 	  else if (!strcmp ("use_device_ptr", p))
 	    result = PRAGMA_OMP_CLAUSE_USE_DEVICE_PTR;
+	  else if (!strcmp ("uses_allocators", p))
+	    result = PRAGMA_OMP_CLAUSE_USES_ALLOCATORS;
 	  break;
 	case 'v':
 	  if (!strcmp ("vector", p))
@@ -19219,6 +19221,213 @@ c_parser_omp_clause_allocate (c_parser *parser, tree list)
   return nl;
 }
 
+/* OpenMP 5.0:
+   uses_allocators ( allocator-list )
+
+   allocator-list:
+   allocator
+   allocator , allocator-list
+   allocator ( traits-array )
+   allocator ( traits-array ) , allocator-list
+
+   OpenMP 5.2:
+
+   uses_allocators ( modifier : allocator-list )
+   uses_allocators ( modifier , modifier : allocator-list )
+
+   modifier:
+   traits ( traits-array )
+   memspace ( mem-space-handle )  */
+
+static tree
+c_parser_omp_clause_uses_allocators (c_parser *parser, tree list)
+{
+  location_t clause_loc = c_parser_peek_token (parser)->location;
+  tree t = NULL_TREE, nl = list;
+  matching_parens parens;
+  if (!parens.require_open (parser))
+    return list;
+
+  tree memspace_expr = NULL_TREE;
+  tree traits_var = NULL_TREE;
+
+  struct item_tok
+  {
+    location_t loc;
+    tree id;
+    item_tok (void) : loc (UNKNOWN_LOCATION), id (NULL_TREE) {}
+  };
+  struct item { item_tok name, arg; };
+  auto_vec<item> *modifiers = NULL, *allocators = NULL;
+  auto_vec<item> *cur_list = new auto_vec<item> (4);
+
+  while (true)
+    {
+      item it;
+
+      if (c_parser_next_token_is (parser, CPP_NAME))
+	{
+	  c_token *tok = c_parser_peek_token (parser);
+	  it.name.id = tok->value;
+	  it.name.loc = tok->location;
+	  c_parser_consume_token (parser);
+
+	  if (c_parser_next_token_is (parser, CPP_OPEN_PAREN))
+	    {
+	      matching_parens parens2;
+	      parens2.consume_open (parser);
+
+	      if (c_parser_next_token_is (parser, CPP_NAME))
+		{
+		  tok = c_parser_peek_token (parser);
+		  it.arg.id = tok->value;
+		  it.arg.loc = tok->location;
+		  c_parser_consume_token (parser);
+		}
+	      else
+		{
+		  c_parser_error (parser, "expected identifier");
+		  parens2.skip_until_found_close (parser);
+		  goto end;
+		}
+	      parens2.skip_until_found_close (parser);
+	    }
+	}
+
+      cur_list->safe_push (it);
+
+      if (c_parser_next_token_is (parser, CPP_COMMA))
+	c_parser_consume_token (parser);
+      else if (c_parser_next_token_is (parser, CPP_COLON))
+	{
+	  if (modifiers)
+	    {
+	      c_parser_error (parser, "expected %<)%>");
+	      goto end;
+	    }
+	  else
+	    {
+	      c_parser_consume_token (parser);
+	      modifiers = cur_list;
+	      cur_list = new auto_vec<item> (4);
+	    }
+	}
+      else if (c_parser_next_token_is (parser, CPP_CLOSE_PAREN))
+	{
+	  gcc_assert (allocators == NULL);
+	  allocators = cur_list;
+	  cur_list = NULL;
+	  break;
+	}
+      else
+	{
+	  c_parser_error (parser, "expected %<)%>");
+	  goto end;
+	}
+    }
+
+  if (modifiers)
+    for (unsigned i = 0; i < modifiers->length (); i++)
+      {
+	item& it = (*modifiers)[i];
+	const char *p = IDENTIFIER_POINTER (it.name.id);
+	int strcmp_traits = 1, strcmp_memspace = 1;
+
+	if ((strcmp_traits = strcmp ("traits", p)) == 0
+	    || (strcmp_memspace = strcmp ("memspace", p)) == 0)
+	  {
+	    if ((strcmp_traits == 0 && traits_var != NULL_TREE)
+		|| (strcmp_memspace == 0 && memspace_expr != NULL_TREE))
+	      {
+		error_at (it.name.loc, "duplicate %qs modifier", p);
+		goto end;
+	      }
+	    t = lookup_name (it.arg.id);
+	    if (t == NULL_TREE)
+	      {
+		undeclared_variable (it.arg.loc, it.arg.id);
+		t = error_mark_node;
+	      }
+	    else if (strcmp_memspace == 0)
+	      memspace_expr = t;
+	    else if (strcmp_traits == 0)
+	      traits_var = t;
+	    else
+	      gcc_unreachable ();
+	  }
+	else
+	  {
+	    error_at (it.name.loc, "unknown modifier %qE", it.name.id);
+	    goto end;
+	  }
+      }
+
+  if (allocators)
+    {
+      if (modifiers)
+	{
+	  if (allocators->length () > 1)
+	    {
+	      error_at ((*allocators)[1].name.loc,
+			"%<uses_allocators%> clause only accepts a single "
+			"allocator when using modifiers");
+	      goto end;
+	    }
+	  else if ((*allocators)[0].arg.id)
+	    {
+	      error_at ((*allocators)[0].arg.loc,
+			"legacy %<%E(%E)%> traits syntax not allowed in "
+			"%<uses_allocators%> clause when using modifiers",
+			(*allocators)[0].name.id, (*allocators)[0].arg.id);
+	      goto end;
+	    }
+	}
+
+      for (unsigned i = 0; i < allocators->length (); i++)
+	{
+	  item& it = (*allocators)[i];
+	  t = lookup_name (it.name.id);
+	  if (t == NULL_TREE)
+	    {
+	      undeclared_variable (it.name.loc, it.name.id);
+	      goto end;
+	    }
+	  else if (t != error_mark_node)
+	    {
+	      tree t2 = NULL_TREE;
+	      if (it.arg.id)
+		{
+		  t2 = lookup_name (it.arg.id);
+		  if (t2 == NULL_TREE)
+		    {
+		      undeclared_variable (it.arg.loc, it.arg.id);
+		      goto end;
+		    }
+		}
+	      else
+		t2 = traits_var;
+
+	      tree c = build_omp_clause (clause_loc,
+					 OMP_CLAUSE_USES_ALLOCATORS);
+	      OMP_CLAUSE_USES_ALLOCATORS_ALLOCATOR (c) = t;
+	      OMP_CLAUSE_USES_ALLOCATORS_MEMSPACE (c) = memspace_expr;
+	      OMP_CLAUSE_USES_ALLOCATORS_TRAITS (c) = t2;
+	      OMP_CLAUSE_CHAIN (c) = nl;
+	      nl = c;
+	    }
+	}
+    }
+ end:
+  if (cur_list)
+    delete cur_list;
+  if (modifiers)
+    delete modifiers;
+  if (allocators)
+    delete allocators;
+  parens.skip_until_found_close (parser);
+  return nl;
+}
+
 /* OpenMP 4.0:
    linear ( variable-list )
    linear ( variable-list : expression )
@@ -21403,6 +21612,10 @@ c_parser_omp_all_clauses (c_parser *parser, omp_clause_mask mask,
 	  clauses = c_parser_omp_clause_allocate (parser, clauses);
 	  c_name = "allocate";
 	  break;
+	case PRAGMA_OMP_CLAUSE_USES_ALLOCATORS:
+	  clauses = c_parser_omp_clause_uses_allocators (parser, clauses);
+	  c_name = "uses_allocators";
+	  break;
 	case PRAGMA_OMP_CLAUSE_LINEAR:
 	  clauses = c_parser_omp_clause_linear (parser, clauses);
 	  c_name = "linear";
@@ -26248,7 +26461,8 @@ c_parser_omp_target_exit_data (location_t loc, c_parser *parser,
 	| (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_IN_REDUCTION)	\
 	| (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_THREAD_LIMIT)	\
 	| (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_IS_DEVICE_PTR)\
-	| (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_HAS_DEVICE_ADDR))
+	| (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_HAS_DEVICE_ADDR)\
+	| (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_USES_ALLOCATORS))
 
 static bool
 c_parser_omp_target (c_parser *parser, enum pragma_context context, bool *if_p)
diff --git a/gcc/c/c-typeck.cc b/gcc/c/c-typeck.cc
index e390ad7..e8881f7 100644
--- a/gcc/c/c-typeck.cc
+++ b/gcc/c/c-typeck.cc
@@ -16773,6 +16773,111 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
 	      break;
 	    }
 	  gcc_unreachable ();
+
+	case OMP_CLAUSE_USES_ALLOCATORS:
+	  t = OMP_CLAUSE_USES_ALLOCATORS_ALLOCATOR (c);
+	  if ((VAR_P (t) || TREE_CODE (t) == PARM_DECL)
+	      && (bitmap_bit_p (&generic_head, DECL_UID (t))
+		  || bitmap_bit_p (&map_head, DECL_UID (t))
+		  || bitmap_bit_p (&firstprivate_head, DECL_UID (t))
+		  || bitmap_bit_p (&lastprivate_head, DECL_UID (t))))
+	    {
+	      error_at (OMP_CLAUSE_LOCATION (c),
+			"%qE appears more than once in data clauses", t);
+	      remove = true;
+	      break;
+	    }
+	  else
+	    bitmap_set_bit (&generic_head, DECL_UID (t));
+	  if (TREE_CODE (TREE_TYPE (t)) != ENUMERAL_TYPE
+	      || strcmp (IDENTIFIER_POINTER (TYPE_IDENTIFIER (TREE_TYPE (t))),
+			 "omp_allocator_handle_t") != 0)
+	    {
+	      error_at (OMP_CLAUSE_LOCATION (c),
+			"allocator must be of %<omp_allocator_handle_t%> type");
+	      remove = true;
+	      break;
+	    }
+	  if (TREE_CODE (t) == CONST_DECL)
+	    {
+	      /* Currently for pre-defined allocators in libgomp, we do not
+		 require additional init/fini inside target regions, so discard
+		 such clauses.  */
+	      remove = true;
+
+	      if (strcmp (IDENTIFIER_POINTER (DECL_NAME (t)),
+			  "omp_null_allocator") == 0)
+		{
+		  error_at (OMP_CLAUSE_LOCATION (c),
+			    "%<omp_null_allocator%> cannot be used in "
+			    "%<uses_allocators%> clause");
+		  break;
+		}
+
+	      if (OMP_CLAUSE_USES_ALLOCATORS_MEMSPACE (c)
+		  || OMP_CLAUSE_USES_ALLOCATORS_TRAITS (c))
+		{
+		  error_at (OMP_CLAUSE_LOCATION (c),
+			    "modifiers cannot be used with pre-defined "
+			    "allocators");
+		  break;
+		}
+	    }
+	  t = OMP_CLAUSE_USES_ALLOCATORS_MEMSPACE (c);
+	  if (t != NULL_TREE
+	      && (TREE_CODE (t) != CONST_DECL
+		  || TREE_CODE (TREE_TYPE (t)) != ENUMERAL_TYPE
+		  || strcmp (IDENTIFIER_POINTER (TYPE_IDENTIFIER (TREE_TYPE (t))),
+			     "omp_memspace_handle_t") != 0))
+	    {
+	      error_at (OMP_CLAUSE_LOCATION (c), "memspace modifier must be "
+			"constant enum of %<omp_memspace_handle_t%> type");
+	      remove = true;
+	      break;
+	    }
+	  t = OMP_CLAUSE_USES_ALLOCATORS_TRAITS (c);
+	  if (t != NULL_TREE)
+	    {
+	      bool type_err = false;
+
+	      if (TREE_CODE (TREE_TYPE (t)) != ARRAY_TYPE
+		  || DECL_SIZE (t) == NULL_TREE)
+		type_err = true;
+	      else
+		{
+		  tree elem_t = TREE_TYPE (TREE_TYPE (t));
+		  if (TREE_CODE (elem_t) != RECORD_TYPE
+		      || strcmp (IDENTIFIER_POINTER (TYPE_IDENTIFIER (elem_t)),
+				 "omp_alloctrait_t") != 0
+		      || !TYPE_READONLY (elem_t))
+		    type_err = true;
+		}
+	      if (type_err)
+		{
+		  if (TREE_CODE (t) != ERROR_MARK)
+		    error_at (OMP_CLAUSE_LOCATION (c), "traits array %qE must "
+			      "be of %<const omp_alloctrait_t []%> type", t);
+		  else
+		    error_at (OMP_CLAUSE_LOCATION (c), "traits array must "
+			      "be of %<const omp_alloctrait_t []%> type");
+		  remove = true;
+		}
+	      else
+		{
+		  tree cst_val = decl_constant_value_1 (t, true);
+		  if (cst_val == t)
+		    {
+		      error_at (OMP_CLAUSE_LOCATION (c), "traits array must be "
+				"of constant values");
+
+		      remove = true;
+		    }
+		}
+	    }
+	  if (remove)
+	    break;
+	  pc = &OMP_CLAUSE_CHAIN (c);
+	  continue;
 	case OMP_CLAUSE_DEPEND:
 	  depend_clause = c;
 	  /* FALLTHRU */