openmp: Add support for allocator and align modifiers on allocate clauses

As the allocate-2.c testcase shows, this change isn't 100% backwards compatible,
one could have allocate and/or align functions that return an OpenMP allocator
handle and previously it would call those functions and now would use those
names as keywords for the modifiers.  But it allows specify extra alignment
requirements for the allocations.

2021-09-22  Jakub Jelinek  <jakub@redhat.com>

gcc/
	* tree.h (OMP_CLAUSE_ALLOCATE_ALIGN): Define.
	* tree.c (omp_clause_num_ops): Change number of OMP_CLAUSE_ALLOCATE
	arguments from 2 to 3.
	* tree-pretty-print.c (dump_omp_clause): Print allocator() around
	allocate clause allocator and print align if present.
	* omp-low.c (scan_sharing_clauses): Force allocate_map entry even
	for omp_default_mem_alloc if align modifier is present.  If align
	modifier is present, use TREE_LIST to encode both allocator and
	align.
	(lower_private_allocate, lower_rec_input_clauses, create_task_copyfn):
	Handle align modifier on allocator clause if present.
gcc/c-family/
	* c-omp.c (c_omp_split_clauses): Copy over OMP_CLAUSE_ALLOCATE_ALIGN.
gcc/c/
	* c-parser.c (c_parser_omp_clause_allocate): Parse allocate clause
	modifiers.
gcc/cp/
	* parser.c (cp_parser_omp_clause_allocate): Parse allocate clause
	modifiers.
	* semantics.c (finish_omp_clauses) <OMP_CLAUSE_ALLOCATE>: Perform
	semantic analysis of OMP_CLAUSE_ALLOCATE_ALIGN.
	* pt.c (tsubst_omp_clauses) <case OMP_CLAUSE_ALLOCATE>: Handle
	also OMP_CLAUSE_ALLOCATE_ALIGN.
gcc/testsuite/
	* c-c++-common/gomp/allocate-6.c: New test.
	* c-c++-common/gomp/allocate-7.c: New test.
	* g++.dg/gomp/allocate-4.C: New test.
libgomp/
	* testsuite/libgomp.c-c++-common/allocate-2.c: New test.
	* testsuite/libgomp.c-c++-common/allocate-3.c: New test.

3 files changed, 114 insertions, 7 deletions

diff --git a/gcc/cp/parser.c b/gcc/cp/parser.c
index 62908da..26d925c 100644
--- a/gcc/cp/parser.c
+++ b/gcc/cp/parser.c
@@ -38337,13 +38337,21 @@ cp_parser_omp_clause_aligned (cp_parser *parser, tree list)
 
 /* OpenMP 5.0:
    allocate ( variable-list )
-   allocate ( expression : variable-list )  */
+   allocate ( expression : variable-list )
+
+   OpenMP 5.1:
+   allocate ( allocator-modifier : variable-list )
+   allocate ( allocator-modifier , allocator-modifier : variable-list )
+
+   allocator-modifier:
+   allocator ( expression )
+   align ( expression )  */
 
 static tree
 cp_parser_omp_clause_allocate (cp_parser *parser, tree list)
 {
-  tree nlist, c, allocator = NULL_TREE;
-  bool colon;
+  tree nlist, c, allocator = NULL_TREE, align = NULL_TREE;
+  bool colon, has_modifiers = false;
 
   matching_parens parens;
   if (!parens.require_open (parser))
@@ -38352,7 +38360,51 @@ cp_parser_omp_clause_allocate (cp_parser *parser, tree list)
   cp_parser_parse_tentatively (parser);
   bool saved_colon_corrects_to_scope_p = parser->colon_corrects_to_scope_p;
   parser->colon_corrects_to_scope_p = false;
-  allocator = cp_parser_assignment_expression (parser);
+  for (int mod = 0; mod < 2; mod++)
+    if (cp_lexer_next_token_is (parser->lexer, CPP_NAME)
+	&& cp_lexer_nth_token_is (parser->lexer, 2, CPP_OPEN_PAREN))
+      {
+	tree id = cp_lexer_peek_token (parser->lexer)->u.value;
+	const char *p = IDENTIFIER_POINTER (id);
+	if (strcmp (p, "allocator") != 0 && strcmp (p, "align") != 0)
+	  break;
+	cp_lexer_consume_token (parser->lexer);
+	matching_parens parens2;
+	if (!parens2.require_open (parser))
+	  break;
+	if (strcmp (p, "allocator") == 0)
+	  {
+	    if (allocator != NULL_TREE)
+	      break;
+	    allocator = cp_parser_assignment_expression (parser);
+	  }
+	else
+	  {
+	    if (align != NULL_TREE)
+	      break;
+	    align = cp_parser_assignment_expression (parser);
+	  }
+	if (!parens2.require_close (parser))
+	  break;
+	if (cp_lexer_next_token_is (parser->lexer, CPP_COLON))
+	  {
+	    has_modifiers = true;
+	    break;
+	  }
+	if (mod != 0 || cp_lexer_next_token_is_not (parser->lexer, CPP_COMMA))
+	  break;
+	cp_lexer_consume_token (parser->lexer);
+      }
+    else
+      break;
+  if (!has_modifiers)
+    {
+      cp_parser_abort_tentative_parse (parser);
+      align = NULL_TREE;
+      allocator = NULL_TREE;
+      cp_parser_parse_tentatively (parser);
+      allocator = cp_parser_assignment_expression (parser);
+    }
   parser->colon_corrects_to_scope_p = saved_colon_corrects_to_scope_p;
   if (cp_lexer_next_token_is (parser->lexer, CPP_COLON))
     {
@@ -38360,18 +38412,25 @@ cp_parser_omp_clause_allocate (cp_parser *parser, tree list)
       cp_lexer_consume_token (parser->lexer);
       if (allocator == error_mark_node)
 	allocator = NULL_TREE;
+      if (align == error_mark_node)
+	align = NULL_TREE;
     }
   else
     {
       cp_parser_abort_tentative_parse (parser);
       allocator = NULL_TREE;
+      align = NULL_TREE;
     }
 
   nlist = cp_parser_omp_var_list_no_open (parser, OMP_CLAUSE_ALLOCATE, list,
 					  &colon);
 
-  for (c = nlist; c != list; c = OMP_CLAUSE_CHAIN (c))
-    OMP_CLAUSE_ALLOCATE_ALLOCATOR (c) = allocator;
+  if (allocator || align)
+    for (c = nlist; c != list; c = OMP_CLAUSE_CHAIN (c))
+      {
+	OMP_CLAUSE_ALLOCATE_ALLOCATOR (c) = allocator;
+	OMP_CLAUSE_ALLOCATE_ALIGN (c) = align;
+      }
 
   return nlist;
 }
diff --git a/gcc/cp/pt.c b/gcc/cp/pt.c
index 048bbc4..28ba32f4 100644
--- a/gcc/cp/pt.c
+++ b/gcc/cp/pt.c
@@ -17489,6 +17489,13 @@ tsubst_omp_clauses (tree clauses, enum c_omp_region_type ort,
 	  break;
 	case OMP_CLAUSE_GANG:
 	case OMP_CLAUSE_ALIGNED:
+	  OMP_CLAUSE_DECL (nc)
+	    = tsubst_omp_clause_decl (OMP_CLAUSE_DECL (oc), args, complain,
+				      in_decl, NULL);
+	  OMP_CLAUSE_OPERAND (nc, 1)
+	    = tsubst_expr (OMP_CLAUSE_OPERAND (oc, 1), args, complain,
+			   in_decl, /*integral_constant_expression_p=*/false);
+	  break;
 	case OMP_CLAUSE_ALLOCATE:
 	  OMP_CLAUSE_DECL (nc)
 	    = tsubst_omp_clause_decl (OMP_CLAUSE_DECL (oc), args, complain,
@@ -17496,6 +17503,9 @@ tsubst_omp_clauses (tree clauses, enum c_omp_region_type ort,
 	  OMP_CLAUSE_OPERAND (nc, 1)
 	    = tsubst_expr (OMP_CLAUSE_OPERAND (oc, 1), args, complain,
 			   in_decl, /*integral_constant_expression_p=*/false);
+	  OMP_CLAUSE_OPERAND (nc, 2)
+	    = tsubst_expr (OMP_CLAUSE_OPERAND (oc, 2), args, complain,
+			   in_decl, /*integral_constant_expression_p=*/false);
 	  break;
 	case OMP_CLAUSE_LINEAR:
 	  OMP_CLAUSE_DECL (nc)
diff --git a/gcc/cp/semantics.c b/gcc/cp/semantics.c
index 35a7b9f..0d8e5fd 100644
--- a/gcc/cp/semantics.c
+++ b/gcc/cp/semantics.c
@@ -7527,7 +7527,44 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
 	      bitmap_set_bit (&aligned_head, DECL_UID (t));
 	      allocate_seen = true;
 	    }
-	  tree allocator;
+	  tree allocator, align;
+	  align = OMP_CLAUSE_ALLOCATE_ALIGN (c);
+	  if (error_operand_p (align))
+	    {
+	      remove = true;
+	      break;
+	    }
+	  if (align)
+	    {
+	      if (!type_dependent_expression_p (align)
+		  && !INTEGRAL_TYPE_P (TREE_TYPE (align)))
+		{
+		  error_at (OMP_CLAUSE_LOCATION (c),
+			    "%<allocate%> clause %<align%> modifier "
+			    "argument needs to be positive constant "
+			    "power of two integer expression");
+		  remove = true;
+		}
+	      else
+		{
+		  align = mark_rvalue_use (align);
+		  if (!processing_template_decl)
+		    {
+		      align = maybe_constant_value (align);
+		      if (TREE_CODE (align) != INTEGER_CST
+			  || !tree_fits_uhwi_p (align)
+			  || !integer_pow2p (align))
+			{
+			  error_at (OMP_CLAUSE_LOCATION (c),
+				    "%<allocate%> clause %<align%> modifier "
+				    "argument needs to be positive constant "
+				    "power of two integer expression");
+			  remove = true;
+			}
+		    }
+		}
+	      OMP_CLAUSE_ALLOCATE_ALIGN (c) = align;
+	    }
 	  allocator = OMP_CLAUSE_ALLOCATE_ALLOCATOR (c);
 	  if (error_operand_p (allocator))
 	    {
@@ -7552,6 +7589,7 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
 			"type %qT rather than %<omp_allocator_handle_t%>",
 			TREE_TYPE (allocator));
 	      remove = true;
+	      break;
 	    }
 	  else
 	    {