diff mbox series

[COMMITTED,V3,2/6] OpenMP: C front end support for imperfectly-nested loops

Message ID 20230825194714.627157-3-sandra@codesourcery.com
State New
Headers show
Series Support for imperfectly-nested loops | expand

Commit Message

Sandra Loosemore Aug. 25, 2023, 7:47 p.m. UTC
OpenMP 5.0 removed the restriction that multiple collapsed loops must
be perfectly nested, allowing "intervening code" (including nested
BLOCKs) before or after each nested loop.  In GCC this code is moved
into the inner loop body by the respective front ends.

This patch changes the C front end to use recursive descent parsing
on nested loops within an "omp for" construct, rather than an iterative
approach, in order to preserve proper nesting of compound statements.

New common C/C++ testcases are in a separate patch.

gcc/c-family/ChangeLog
	* c-common.h (c_omp_check_loop_binding_exprs): Declare.
	* c-omp.cc: Include tree-iterator.h.
	(find_binding_in_body): New.
	(check_loop_binding_expr_r): New.
	(LOCATION_OR): New.
	(check_looop_binding_expr): New.
	(c_omp_check_loop_binding_exprs): New.

gcc/c/ChangeLog
	* c-parser.cc (struct c_parser): Add omp_for_parse_state field.
	(struct omp_for_parse_data): New.
	(check_omp_intervening_code): New.
	(add_structured_block_stmt): New.
	(c_parser_compound_statement_nostart): Recognize intervening code,
	nested loops, and other things that need special handling in
	OpenMP loop constructs.
	(c_parser_while_statement): Error on loop in intervening code.
	(c_parser_do_statement): Likewise.
	(c_parser_for_statement): Likewise.
	(c_parser_postfix_expression_after_primary): Error on calls to
	the OpenMP runtime in intervening code.
	(c_parser_pragma): Error on OpenMP pragmas in intervening code.
	(c_parser_omp_loop_nest): New.
	(c_parser_omp_for_loop): Rewrite to use recursive descent, calling
	c_parser_omp_loop_nest to do the heavy lifting.

gcc/ChangeLog
	* omp-api.h: New.
	* omp-general.cc (omp_runtime_api_procname): New.
	(omp_runtime_api_call): Moved here from omp-low.cc, and make
	non-static.
	* omp-general.h: Include omp-api.h.
	* omp-low.cc (omp_runtime_api_call): Delete this copy.

gcc/testsuite/ChangeLog
	* c-c++-common/goacc/collapse-1.c: Update for new C error behavior.
	* c-c++-common/goacc/tile-2.c: Likewise.
	* gcc.dg/gomp/collapse-1.c: Likewise.
---
 gcc/c-family/c-common.h                       |   1 +
 gcc/c-family/c-omp.cc                         | 151 +++
 gcc/c/c-parser.cc                             | 860 +++++++++++++-----
 gcc/omp-api.h                                 |  32 +
 gcc/omp-general.cc                            | 134 +++
 gcc/omp-general.h                             |   1 +
 gcc/omp-low.cc                                | 129 ---
 gcc/testsuite/c-c++-common/goacc/collapse-1.c |  16 +-
 gcc/testsuite/c-c++-common/goacc/tile-2.c     |   4 +-
 gcc/testsuite/gcc.dg/gomp/collapse-1.c        |  10 +-
 10 files changed, 942 insertions(+), 396 deletions(-)
 create mode 100644 gcc/omp-api.h
diff mbox series

Patch

diff --git a/gcc/c-family/c-common.h b/gcc/c-family/c-common.h
index 78fc5248ba6..732cb4eff64 100644
--- a/gcc/c-family/c-common.h
+++ b/gcc/c-family/c-common.h
@@ -1299,6 +1299,7 @@  extern tree c_finish_omp_for (location_t, enum tree_code, tree, tree, tree,
 extern bool c_omp_check_loop_iv (tree, tree, walk_tree_lh);
 extern bool c_omp_check_loop_iv_exprs (location_t, enum tree_code, tree, int,
 				       tree, tree, tree, walk_tree_lh);
+extern bool c_omp_check_loop_binding_exprs (tree, vec<tree> *);
 extern tree c_finish_oacc_wait (location_t, tree, tree);
 extern tree c_oacc_split_loop_clauses (tree, tree *, bool);
 extern void c_omp_split_clauses (location_t, enum tree_code, omp_clause_mask,
diff --git a/gcc/c-family/c-omp.cc b/gcc/c-family/c-omp.cc
index 4faddb00bbc..9b7d7f789e3 100644
--- a/gcc/c-family/c-omp.cc
+++ b/gcc/c-family/c-omp.cc
@@ -36,6 +36,7 @@  along with GCC; see the file COPYING3.  If not see
 #include "gimplify.h"
 #include "langhooks.h"
 #include "bitmap.h"
+#include "tree-iterator.h"
 
 
 /* Complete a #pragma oacc wait construct.  LOC is the location of
@@ -1728,6 +1729,156 @@  c_omp_check_loop_iv_exprs (location_t stmt_loc, enum tree_code code,
   return !data.fail;
 }
 
+
+/* Helper function for c_omp_check_loop_binding_exprs: look for a binding
+   of DECL in BODY.  Only traverse things that might be containers for
+   intervening code in an OMP loop.  Returns the BIND_EXPR or DECL_EXPR
+   if found, otherwise null.  */
+
+static tree
+find_binding_in_body (tree decl, tree body)
+{
+  if (!body)
+    return NULL_TREE;
+
+  switch (TREE_CODE (body))
+    {
+    case BIND_EXPR:
+      for (tree b = BIND_EXPR_VARS (body); b; b = DECL_CHAIN (b))
+	if (b == decl)
+	  return body;
+      return find_binding_in_body (decl, BIND_EXPR_BODY (body));
+
+    case DECL_EXPR:
+      if (DECL_EXPR_DECL (body) == decl)
+	return body;
+      return NULL_TREE;
+
+    case STATEMENT_LIST:
+      for (tree_stmt_iterator si = tsi_start (body); !tsi_end_p (si);
+	   tsi_next (&si))
+	{
+	  tree b = find_binding_in_body (decl, tsi_stmt (si));
+	  if (b)
+	    return b;
+	}
+      return NULL_TREE;
+
+    case OMP_STRUCTURED_BLOCK:
+      return find_binding_in_body (decl, OMP_BODY (body));
+
+    default:
+      return NULL_TREE;
+    }
+}
+
+/* Traversal function for check_loop_binding_expr, to diagnose
+   errors when a binding made in intervening code is referenced outside
+   of the loop.  Returns non-null if such a reference is found.  DATA points
+   to the tree containing the loop body.  */
+
+static tree
+check_loop_binding_expr_r (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED,
+			   void *data)
+{
+  tree body = *(tree *)data;
+
+  if (DECL_P (*tp) && find_binding_in_body (*tp, body))
+    return *tp;
+  return NULL_TREE;
+}
+
+/* Helper macro used below.  */
+
+#define LOCATION_OR(loc1, loc2) \
+  ((loc1) != UNKNOWN_LOCATION ? (loc1) : (loc2))
+
+/* Check a single expression EXPR for references to variables bound in
+   intervening code in BODY.  Return true if ok, otherwise give an error
+   referencing CONTEXT and return false.  Use LOC for the error message
+   if EXPR doesn't have one.  */
+static bool
+check_loop_binding_expr (tree expr, tree body, const char *context,
+			 location_t loc)
+{
+  tree bad = walk_tree (&expr, check_loop_binding_expr_r, (void *)&body, NULL);
+
+  if (bad)
+    {
+      location_t eloc = EXPR_LOCATION (expr);
+      error_at (LOCATION_OR (eloc, loc),
+		"variable %qD used %s is bound "
+		"in intervening code", bad, context);
+      return false;
+    }
+  return true;
+}
+
+/* STMT is an OMP_FOR construct.  Check all of the iteration variable,
+   initializer, end condition, and increment for bindings inside the
+   loop body.  If ORIG_INITS is provided, check those elements too.
+   Return true if OK, false otherwise.  */
+bool
+c_omp_check_loop_binding_exprs (tree stmt, vec<tree> *orig_inits)
+{
+  bool ok = true;
+  location_t loc = EXPR_LOCATION (stmt);
+  tree body = OMP_FOR_BODY (stmt);
+  int orig_init_length = orig_inits ? orig_inits->length () : 0;
+
+  for (int i = 1; i < TREE_VEC_LENGTH (OMP_FOR_INIT (stmt)); i++)
+    {
+      tree init = TREE_VEC_ELT (OMP_FOR_INIT (stmt), i);
+      tree cond = TREE_VEC_ELT (OMP_FOR_COND (stmt), i);
+      tree incr = TREE_VEC_ELT (OMP_FOR_INCR (stmt), i);
+      gcc_assert (TREE_CODE (init) == MODIFY_EXPR);
+      tree decl = TREE_OPERAND (init, 0);
+      tree orig_init = i < orig_init_length ? (*orig_inits)[i] : NULL_TREE;
+      tree e;
+      location_t eloc;
+
+      e = TREE_OPERAND (init, 1);
+      eloc = LOCATION_OR (EXPR_LOCATION (init), loc);
+      if (!check_loop_binding_expr (decl, body, "as loop variable", eloc))
+	ok = false;
+      if (!check_loop_binding_expr (e, body, "in initializer", eloc))
+	ok = false;
+      if (orig_init
+	  && !check_loop_binding_expr (orig_init, body,
+				       "in initializer", eloc))
+	ok = false;
+
+      /* INCR and/or COND may be null if this is a template with a
+	 class iterator.  */
+      if (cond)
+	{
+	  eloc = LOCATION_OR (EXPR_LOCATION (cond), loc);
+	  if (COMPARISON_CLASS_P (cond) && TREE_OPERAND (cond, 0) == decl)
+	    e = TREE_OPERAND (cond, 1);
+	  else if (COMPARISON_CLASS_P (cond) && TREE_OPERAND (cond, 1) == decl)
+	    e = TREE_OPERAND (cond, 0);
+	  else
+	    e = cond;
+	  if (!check_loop_binding_expr (e, body, "in end test", eloc))
+	    ok = false;
+	}
+
+      if (incr)
+	{
+	  eloc = LOCATION_OR (EXPR_LOCATION (incr), loc);
+	  /* INCR should be either a MODIFY_EXPR or pre/post
+	     increment/decrement.  We don't have to check the latter
+	     since there are no operands besides the iteration variable.  */
+	  if (TREE_CODE (incr) == MODIFY_EXPR
+	      && !check_loop_binding_expr (TREE_OPERAND (incr, 1), body,
+					   "in increment expression", eloc))
+	    ok = false;
+	}
+    }
+
+  return ok;
+}
+
 /* This function splits clauses for OpenACC combined loop
    constructs.  OpenACC combined loop constructs are:
    #pragma acc kernels loop
diff --git a/gcc/c/c-parser.cc b/gcc/c/c-parser.cc
index 4a4820d792c..f6022d1367f 100644
--- a/gcc/c/c-parser.cc
+++ b/gcc/c/c-parser.cc
@@ -249,6 +249,10 @@  struct GTY(()) c_parser {
 
   /* Location of the last consumed token.  */
   location_t last_token_location;
+
+  /* Holds state for parsing collapsed OMP_FOR loops.  Managed by
+     c_parser_omp_for_loop.  */
+  struct omp_for_parse_data * GTY((skip)) omp_for_parse_state;
 };
 
 /* Return a pointer to the Nth token in PARSERs tokens_buf.  */
@@ -1525,6 +1529,44 @@  struct oacc_routine_data {
 /* Used for parsing objc foreach statements.  */
 static tree objc_foreach_break_label, objc_foreach_continue_label;
 
+/* Used for parsing OMP for loops.
+
+   Some notes on flags used for context:
+   parser->omp_for_parse_state is non-null anywhere inside the OMP FOR
+   construct, except for the final-loop-body.
+   The want_nested_loop flag is true if inside a {} sequence where
+   a loop-nest (or another {} sequence containing a loop-nest) is expected,
+   but has not yet been seen.  It's false when parsing intervening code
+   statements or their substatements that cannot contain a loop-nest.
+   The in_intervening_code flag is true when parsing any intervening code,
+   including substatements, and whether or not want_nested_loop is true.
+
+   And, about error handling:
+   The saw_intervening_code flag is set if the loop is not perfectly
+   nested, even in the usual case where this is not an error.
+   perfect_nesting_fail is set if an error has been diagnosed because an
+   imperfectly-nested loop was found where a perfectly-nested one is
+   required (we diagnose this only once).
+   fail is set if any kind of structural error in the loop nest
+   has been found and diagnosed.
+  */
+struct omp_for_parse_data {
+  enum tree_code code;
+  tree declv, condv, incrv, initv;
+  tree pre_body;
+  tree bindings;
+  int count;	/* Expected nesting depth.  */
+  int depth;	/* Current nesting depth.  */
+  location_t for_loc;
+  bool ordered : 1;
+  bool inscan : 1;
+  bool want_nested_loop : 1;
+  bool in_intervening_code : 1;
+  bool saw_intervening_code: 1;
+  bool perfect_nesting_fail : 1;
+  bool fail : 1;
+};
+
 static bool c_parser_nth_token_starts_std_attributes (c_parser *,
 						      unsigned int);
 static tree c_parser_std_attribute_specifier_sequence (c_parser *);
@@ -1618,6 +1660,7 @@  static void c_parser_omp_threadprivate (c_parser *);
 static void c_parser_omp_barrier (c_parser *);
 static void c_parser_omp_depobj (c_parser *);
 static void c_parser_omp_flush (c_parser *);
+static tree c_parser_omp_loop_nest (c_parser *, bool *);
 static tree c_parser_omp_for_loop (location_t, c_parser *, enum tree_code,
 				   tree, tree *, bool *);
 static void c_parser_omp_taskwait (c_parser *);
@@ -6155,6 +6198,68 @@  c_parser_compound_statement (c_parser *parser, location_t *endlocp)
   return c_end_compound_stmt (brace_loc, stmt, true);
 }
 
+/* Diagnose errors related to imperfectly nested loops in an OMP
+   loop construct.  This function is called when such code is seen.
+   Only issue one such diagnostic no matter how much invalid
+   intervening code there is in the loop.
+   FIXME: maybe the location associated with the diagnostic should
+   be the current parser token instead of the location of the outer loop
+   nest.  */
+
+static void
+check_omp_intervening_code (c_parser *parser)
+{
+  struct omp_for_parse_data *omp_for_parse_state = parser->omp_for_parse_state;
+  gcc_assert (omp_for_parse_state);
+
+  if (!omp_for_parse_state->in_intervening_code)
+    return;
+  omp_for_parse_state->saw_intervening_code = true;
+
+  /* Only diagnose errors related to perfect nesting once.  */
+  if (!omp_for_parse_state->perfect_nesting_fail)
+    {
+
+      /* OpenACC does not (yet) permit intervening code, in
+	 addition to situations forbidden by the OpenMP spec.  */
+      if (omp_for_parse_state->code == OACC_LOOP)
+	{
+	  error_at (omp_for_parse_state->for_loc,
+		    "inner loops must be perfectly nested in "
+		    "%<#pragma acc loop%>");
+	  omp_for_parse_state->perfect_nesting_fail = true;
+	}
+      else if (omp_for_parse_state->ordered)
+	{
+	  error_at (omp_for_parse_state->for_loc,
+		    "inner loops must be perfectly nested with "
+		    "%<ordered%> clause");
+	  omp_for_parse_state->perfect_nesting_fail = true;
+	}
+      else if (omp_for_parse_state->inscan)
+	{
+	  error_at (omp_for_parse_state->for_loc,
+		    "inner loops must be perfectly nested with "
+		    "%<reduction%> %<inscan%> clause");
+	  omp_for_parse_state->perfect_nesting_fail = true;
+	}
+      /* TODO: Also reject loops with TILE directive.  */
+      if (omp_for_parse_state->perfect_nesting_fail)
+	omp_for_parse_state->fail = true;
+    }
+}
+
+/* Helper function for below:  wrap an OMP_STRUCTURED_BLOCK around SL
+   and add the statement to the current list.  If SL is an empty statement
+   list, do nothing.  */
+static void
+add_structured_block_stmt (tree sl)
+{
+  if (TREE_CODE (sl) != STATEMENT_LIST
+      || !tsi_end_p (tsi_start (sl)))
+    add_stmt (build1 (OMP_STRUCTURED_BLOCK, void_type_node, sl));
+}
+
 /* Parse a compound statement except for the opening brace.  This is
    used for parsing both compound statements and statement expressions
    (which follow different paths to handling the opening).  */
@@ -6166,6 +6271,12 @@  c_parser_compound_statement_nostart (c_parser *parser)
   bool last_label = false;
   bool save_valid_for_pragma = valid_location_for_stdc_pragma_p ();
   location_t label_loc = UNKNOWN_LOCATION;  /* Quiet warning.  */
+  struct omp_for_parse_data *omp_for_parse_state
+    = parser->omp_for_parse_state;
+  bool in_omp_loop_block
+    = omp_for_parse_state ? omp_for_parse_state->want_nested_loop : false;
+  tree sl = NULL_TREE;
+
   if (c_parser_next_token_is (parser, CPP_CLOSE_BRACE))
     {
       location_t endloc = c_parser_peek_token (parser)->location;
@@ -6173,12 +6284,20 @@  c_parser_compound_statement_nostart (c_parser *parser)
       c_parser_consume_token (parser);
       return endloc;
     }
+
+  /* If we're parsing a {} sequence in an OMP_FOR body, start a
+     statement list for intervening code.  */
+  if (in_omp_loop_block)
+    sl = push_stmt_list ();
+
   mark_valid_location_for_stdc_pragma (true);
   if (c_parser_next_token_is_keyword (parser, RID_LABEL))
     {
       /* Read zero or more forward-declarations for labels that nested
 	 functions can jump to.  */
       mark_valid_location_for_stdc_pragma (false);
+      if (in_omp_loop_block)
+	check_omp_intervening_code (parser);
       while (c_parser_next_token_is_keyword (parser, RID_LABEL))
 	{
 	  label_loc = c_parser_peek_token (parser)->location;
@@ -6220,6 +6339,76 @@  c_parser_compound_statement_nostart (c_parser *parser)
     {
       location_t loc = c_parser_peek_token (parser)->location;
       loc = expansion_point_location_if_in_system_header (loc);
+
+      bool want_nested_loop = (omp_for_parse_state
+			       ? omp_for_parse_state->want_nested_loop
+			       : false);
+
+      /* First take care of special cases for OpenMP "canonical loop
+	 nest form", that do not allow standard attributes, labels, or
+	 __extension__ before the nested statement.  */
+      if (in_omp_loop_block && !last_label)
+	{
+	  if (want_nested_loop
+	      && c_parser_next_token_is_keyword (parser, RID_FOR))
+	    {
+	      /* Found the next nested loop.  If there were intervening
+		 code statements collected before now, wrap them in an
+		 OMP_STRUCTURED_BLOCK node, and start a new structured
+		 block to hold statements that may come after the FOR.  */
+	      gcc_assert (sl);
+	      add_structured_block_stmt (pop_stmt_list (sl));
+	      omp_for_parse_state->depth++;
+	      add_stmt (c_parser_omp_loop_nest (parser, NULL));
+	      omp_for_parse_state->depth--;
+	      sl = push_stmt_list ();
+	      parser->error = false;
+	      continue;
+	    }
+	  else if (want_nested_loop
+		   && c_parser_next_token_is (parser, CPP_OPEN_BRACE))
+	    {
+	      /* If this nested compound statement contains the nested loop,
+		 we need to separate the other statements in the current
+		 statement into separate blocks of intervening code.  If
+		 there's no nested loop, it's all part of the same
+		 chunk of intervening code.  */
+	      tree pre_sl = pop_stmt_list (sl);
+	      tree nested_sl = push_stmt_list ();
+	      mark_valid_location_for_stdc_pragma (false);
+	      c_parser_statement_after_labels (parser, NULL);
+	      nested_sl = pop_stmt_list (nested_sl);
+	      if (omp_for_parse_state->want_nested_loop)
+		{
+		  /* This block didn't contain a loop-nest, so it's
+		     all part of the same chunk of intervening code.  */
+		  check_omp_intervening_code (parser);
+		  sl = push_stmt_list ();
+		  add_stmt (pre_sl);
+		  add_stmt (nested_sl);
+		}
+	      else
+		{
+		  /* It contains the nested loop.  */
+		  add_structured_block_stmt (pre_sl);
+		  add_stmt (nested_sl);
+		  sl = push_stmt_list ();
+		}
+	      parser->error = false;
+	      continue;
+	    }
+	  else if (c_parser_next_token_is (parser, CPP_SEMICOLON))
+	    {
+	      /* Prior to implementing the OpenMP 5.1 syntax for canonical
+		 loop form, GCC used to accept an empty statements that
+		 would now be flagged as intervening code.  Continue to
+		 do that, as an extension.  */
+	      /* FIXME:  Maybe issue a warning or something here?  */
+	      c_parser_consume_token (parser);
+	      continue;
+	    }
+	}
+
       /* Standard attributes may start a label, statement or declaration.  */
       bool have_std_attrs
 	= c_parser_nth_token_starts_std_attributes (parser, 1);
@@ -6238,6 +6427,8 @@  c_parser_compound_statement_nostart (c_parser *parser)
 	  last_label = true;
 	  last_stmt = false;
 	  mark_valid_location_for_stdc_pragma (false);
+	  if (in_omp_loop_block)
+	    check_omp_intervening_code (parser);
 	  c_parser_label (parser, std_attrs);
 	}
       else if (c_parser_next_tokens_start_declaration (parser)
@@ -6248,7 +6439,13 @@  c_parser_compound_statement_nostart (c_parser *parser)
 	    pedwarn_c11 (c_parser_peek_token (parser)->location, OPT_Wpedantic,
 			 "a label can only be part of a statement and "
 			 "a declaration is not a statement");
-
+	  /* It's unlikely we'll see a nested loop in a declaration in
+	     intervening code in an OMP loop, but disallow it anyway.  */
+	  if (in_omp_loop_block)
+	    {
+	      check_omp_intervening_code (parser);
+	      omp_for_parse_state->want_nested_loop = false;
+	    }
 	  mark_valid_location_for_stdc_pragma (false);
 	  bool fallthru_attr_p = false;
 	  c_parser_declaration_or_fndef (parser, true, !have_std_attrs,
@@ -6256,6 +6453,8 @@  c_parser_compound_statement_nostart (c_parser *parser)
 					 NULL, have_std_attrs, std_attrs,
 					 NULL, &fallthru_attr_p);
 
+	  if (in_omp_loop_block)
+	      omp_for_parse_state->want_nested_loop = want_nested_loop;
 	  if (last_stmt && !fallthru_attr_p)
 	    pedwarn_c90 (loc, OPT_Wdeclaration_after_statement,
 			 "ISO C90 forbids mixed declarations and code");
@@ -6283,9 +6482,18 @@  c_parser_compound_statement_nostart (c_parser *parser)
 	      ext = disable_extension_diagnostics ();
 	      c_parser_consume_token (parser);
 	      last_label = false;
+	      /* It's unlikely we'll see a nested loop in a declaration in
+		 intervening code in an OMP loop, but disallow it anyway.  */
+	      if (in_omp_loop_block)
+		{
+		  check_omp_intervening_code (parser);
+		  omp_for_parse_state->want_nested_loop = false;
+		}
 	      mark_valid_location_for_stdc_pragma (false);
 	      c_parser_declaration_or_fndef (parser, true, true, true, true,
 					     true);
+	      if (in_omp_loop_block)
+		omp_for_parse_state->want_nested_loop = want_nested_loop;
 	      /* Following the old parser, __extension__ does not
 		 disable this diagnostic.  */
 	      restore_extension_diagnostics (ext);
@@ -6306,10 +6514,19 @@  c_parser_compound_statement_nostart (c_parser *parser)
 	     syntactically.  This ensures that the user doesn't put them
 	     places that would turn into syntax errors if the directive
 	     were ignored.  */
+	  if (omp_for_parse_state)
+	    omp_for_parse_state->want_nested_loop = false;
 	  if (c_parser_pragma (parser,
 			       last_label ? pragma_stmt : pragma_compound,
 			       NULL))
-	    last_label = false, last_stmt = true;
+	    {
+	      last_label = false;
+	      last_stmt = true;
+	      if (omp_for_parse_state)
+		check_omp_intervening_code (parser);
+	    }
+	  if (omp_for_parse_state)
+	      omp_for_parse_state->want_nested_loop = want_nested_loop;
 	}
       else if (c_parser_next_token_is (parser, CPP_EOF))
 	{
@@ -6339,7 +6556,20 @@  c_parser_compound_statement_nostart (c_parser *parser)
 	  last_label = false;
 	  last_stmt = true;
 	  mark_valid_location_for_stdc_pragma (false);
-	  c_parser_statement_after_labels (parser, NULL);
+	  if (!omp_for_parse_state)
+	    c_parser_statement_after_labels (parser, NULL);
+	  else
+	    {
+	      /* In canonical loop nest form, nested loops can only appear
+		 directly, or in a directly nested compound statement.  We
+		 already took care of those cases above, so now we have
+		 something else.  This statement and everything inside
+		 it must be intervening code.  */
+	      omp_for_parse_state->want_nested_loop = false;
+	      check_omp_intervening_code (parser);
+	      c_parser_statement_after_labels (parser, NULL);
+	      omp_for_parse_state->want_nested_loop = want_nested_loop;
+	    }
 	}
 
       parser->error = false;
@@ -6348,8 +6578,21 @@  c_parser_compound_statement_nostart (c_parser *parser)
     pedwarn_c11 (label_loc, OPT_Wpedantic, "label at end of compound statement");
   location_t endloc = c_parser_peek_token (parser)->location;
   c_parser_consume_token (parser);
+
   /* Restore the value we started with.  */
   mark_valid_location_for_stdc_pragma (save_valid_for_pragma);
+
+  /* Package leftover intervening code, or the whole contents of the
+     compound statement if we were looking for a nested loop in an OMP_FOR
+     construct and didn't find one.  */
+  if (sl)
+    {
+      sl = pop_stmt_list (sl);
+      if (omp_for_parse_state->want_nested_loop)
+	add_stmt (sl);
+      else
+	add_structured_block_stmt (sl);
+    }
   return endloc;
 }
 
@@ -7181,6 +7424,14 @@  c_parser_while_statement (c_parser *parser, bool ivdep, unsigned short unroll,
   gcc_assert (c_parser_next_token_is_keyword (parser, RID_WHILE));
   token_indent_info while_tinfo
     = get_token_indent_info (c_parser_peek_token (parser));
+
+  if (parser->omp_for_parse_state)
+    {
+      error_at (c_parser_peek_token (parser)->location,
+		"loop not permitted in intervening code in OpenMP loop body");
+      parser->omp_for_parse_state->fail = true;
+    }
+
   c_parser_consume_token (parser);
   block = c_begin_compound_stmt (flag_isoc99);
   loc = c_parser_peek_token (parser)->location;
@@ -7238,6 +7489,14 @@  c_parser_do_statement (c_parser *parser, bool ivdep, unsigned short unroll,
   unsigned char save_in_statement;
   location_t loc;
   gcc_assert (c_parser_next_token_is_keyword (parser, RID_DO));
+
+  if (parser->omp_for_parse_state)
+    {
+      error_at (c_parser_peek_token (parser)->location,
+		"loop not permitted in intervening code in OpenMP loop body");
+      parser->omp_for_parse_state->fail = true;
+    }
+
   c_parser_consume_token (parser);
   if (c_parser_next_token_is (parser, CPP_SEMICOLON))
     warning_at (c_parser_peek_token (parser)->location,
@@ -7349,6 +7608,14 @@  c_parser_for_statement (c_parser *parser, bool ivdep, unsigned short unroll,
   gcc_assert (c_parser_next_token_is_keyword (parser, RID_FOR));
   token_indent_info for_tinfo
     = get_token_indent_info (c_parser_peek_token (parser));
+
+  if (parser->omp_for_parse_state)
+    {
+      error_at (for_loc,
+		"loop not permitted in intervening code in OpenMP loop body");
+      parser->omp_for_parse_state->fail = true;
+    }
+
   c_parser_consume_token (parser);
   /* Open a compound statement in Objective-C as well, just in case this is
      as foreach expression.  */
@@ -11303,6 +11570,14 @@  c_parser_postfix_expression_after_primary (c_parser *parser,
 		  && fndecl_built_in_p (expr.value, BUILT_IN_NORMAL)
 		  && vec_safe_length (exprlist) == 1)
 		warn_for_abs (expr_loc, expr.value, (*exprlist)[0]);
+	      if (parser->omp_for_parse_state
+		  && parser->omp_for_parse_state->in_intervening_code
+		  && omp_runtime_api_call (expr.value))
+		{
+		  error_at (expr_loc, "calls to the OpenMP runtime API are "
+				      "not permitted in intervening code");
+		  parser->omp_for_parse_state->fail = true;
+		}
 	    }
 
 	  start = expr.get_start ();
@@ -13147,6 +13422,17 @@  c_parser_pragma (c_parser *parser, enum pragma_context context, bool *if_p)
   input_location = c_parser_peek_token (parser)->location;
   id = c_parser_peek_token (parser)->pragma_kind;
   gcc_assert (id != PRAGMA_NONE);
+  if (parser->omp_for_parse_state
+      && parser->omp_for_parse_state->in_intervening_code
+      && id >= PRAGMA_OMP__START_
+      && id <= PRAGMA_OMP__LAST_)
+    {
+      error_at (input_location,
+		"intervening code must not contain OpenMP directives");
+      parser->omp_for_parse_state->fail = true;
+      c_parser_skip_until_found (parser, CPP_PRAGMA_EOL, NULL);
+      return false;
+    }
 
   switch (id)
     {
@@ -20362,6 +20648,274 @@  c_parser_omp_scan_loop_body (c_parser *parser, bool open_brace_parsed)
 			     "expected %<}%>");
 }
 
+
+/* This function parses a single level of a loop nest, invoking itself
+   recursively if necessary.
+
+   loop-nest :: for (...) loop-body
+   loop-body :: loop-nest
+	     |  { [intervening-code] loop-body [intervening-code] }
+	     |  final-loop-body
+   intervening-code :: structured-block-sequence
+   final-loop-body :: structured-block
+
+   For a collapsed loop nest, only a single OMP_FOR is built, pulling out
+   all the iterator information from the inner loops into the
+   parser->omp_for_parse_state structure.
+
+   The iterator decl, init, cond, and incr are stored in vectors.
+
+   Initialization code for iterator variables is collected into
+   parser->omp_for_parse_state->pre_body and ends up inserted directly
+   into the OMP_FOR structure.  */
+
+static tree
+c_parser_omp_loop_nest (c_parser *parser, bool *if_p)
+{
+  tree decl, cond, incr, init;
+  tree body = NULL_TREE;
+  matching_parens parens;
+  bool moreloops;
+  unsigned char save_in_statement;
+  tree loop_scope;
+  location_t loc;
+  struct omp_for_parse_data *omp_for_parse_state
+    = parser->omp_for_parse_state;
+  gcc_assert (omp_for_parse_state);
+  int depth = omp_for_parse_state->depth;
+
+  /* We have already matched the FOR token but not consumed it yet.  */
+  loc = c_parser_peek_token (parser)->location;
+  gcc_assert (c_parser_next_token_is_keyword (parser, RID_FOR));
+  c_parser_consume_token (parser);
+
+  /* Forbid break/continue in the loop initializer, condition, and
+     increment expressions.  */
+  save_in_statement = in_statement;
+  in_statement = IN_OMP_BLOCK;
+
+  /* We are not in intervening code now.  */
+  omp_for_parse_state->in_intervening_code = false;
+
+  if (!parens.require_open (parser))
+    {
+      omp_for_parse_state->fail = true;
+      return NULL_TREE;
+    }
+
+  /* An implicit scope block surrounds each level of FOR loop, for
+     declarations of iteration variables at this loop depth.  */
+  loop_scope = c_begin_compound_stmt (true);
+
+  /* Parse the initialization declaration or expression.  */
+  if (c_parser_next_tokens_start_declaration (parser))
+    {
+      /* This is a declaration, which must be added to the pre_body code.  */
+      tree this_pre_body = push_stmt_list ();
+      c_in_omp_for = true;
+      c_parser_declaration_or_fndef (parser, true, true, true, true, true);
+      c_in_omp_for = false;
+      this_pre_body = pop_stmt_list (this_pre_body);
+      append_to_statement_list_force (this_pre_body,
+				      &(omp_for_parse_state->pre_body));
+      decl = check_for_loop_decls (omp_for_parse_state->for_loc, flag_isoc99);
+      if (decl == NULL)
+	goto error_init;
+      if (DECL_INITIAL (decl) == error_mark_node)
+	decl = error_mark_node;
+      init = decl;
+    }
+  else if (c_parser_next_token_is (parser, CPP_NAME)
+	   && c_parser_peek_2nd_token (parser)->type == CPP_EQ)
+    {
+      struct c_expr decl_exp;
+      struct c_expr init_exp;
+      location_t init_loc;
+
+      decl_exp = c_parser_postfix_expression (parser);
+      decl = decl_exp.value;
+
+      c_parser_require (parser, CPP_EQ, "expected %<=%>");
+
+      init_loc = c_parser_peek_token (parser)->location;
+      init_exp = c_parser_expr_no_commas (parser, NULL);
+      init_exp = default_function_array_read_conversion (init_loc,
+							 init_exp);
+      c_in_omp_for = true;
+      init = build_modify_expr (init_loc, decl, decl_exp.original_type,
+				NOP_EXPR, init_loc, init_exp.value,
+				init_exp.original_type);
+      c_in_omp_for = false;
+      init = c_process_expr_stmt (init_loc, init);
+
+      c_parser_skip_until_found (parser, CPP_SEMICOLON, "expected %<;%>");
+    }
+  else
+    {
+    error_init:
+      c_parser_error (parser,
+		      "expected iteration declaration or initialization");
+      c_parser_skip_until_found (parser, CPP_CLOSE_PAREN,
+				 "expected %<)%>");
+      omp_for_parse_state->fail = true;
+      goto parse_next;
+    }
+
+  /* Parse the loop condition.  */
+  cond = NULL_TREE;
+  if (c_parser_next_token_is_not (parser, CPP_SEMICOLON))
+    {
+      location_t cond_loc = c_parser_peek_token (parser)->location;
+      c_in_omp_for = true;
+      struct c_expr cond_expr
+	= c_parser_binary_expression (parser, NULL, NULL_TREE);
+      c_in_omp_for = false;
+
+      cond = cond_expr.value;
+      cond = c_objc_common_truthvalue_conversion (cond_loc, cond);
+      switch (cond_expr.original_code)
+	{
+	case GT_EXPR:
+	case GE_EXPR:
+	case LT_EXPR:
+	case LE_EXPR:
+	  break;
+	case NE_EXPR:
+	  if (omp_for_parse_state->code != OACC_LOOP)
+	    break;
+	  /* FALLTHRU.  */
+	default:
+	  /* Can't be cond = error_mark_node, because we want to preserve
+	     the location until c_finish_omp_for.  */
+	  cond = build1 (NOP_EXPR, boolean_type_node, error_mark_node);
+	  break;
+	}
+      protected_set_expr_location (cond, cond_loc);
+    }
+  c_parser_skip_until_found (parser, CPP_SEMICOLON, "expected %<;%>");
+
+  /* Parse the increment expression.  */
+  incr = NULL_TREE;
+  if (c_parser_next_token_is_not (parser, CPP_CLOSE_PAREN))
+    {
+      location_t incr_loc = c_parser_peek_token (parser)->location;
+
+      incr = c_process_expr_stmt (incr_loc,
+				  c_parser_expression (parser).value);
+    }
+  parens.skip_until_found_close (parser);
+
+  if (decl == NULL || decl == error_mark_node || init == error_mark_node)
+    omp_for_parse_state->fail = true;
+  else
+    {
+      TREE_VEC_ELT (omp_for_parse_state->declv, depth) = decl;
+      TREE_VEC_ELT (omp_for_parse_state->initv, depth) = init;
+      TREE_VEC_ELT (omp_for_parse_state->condv, depth) = cond;
+      TREE_VEC_ELT (omp_for_parse_state->incrv, depth) = incr;
+    }
+
+parse_next:
+  moreloops = depth < omp_for_parse_state->count - 1;
+  omp_for_parse_state->want_nested_loop = moreloops;
+  if (moreloops && c_parser_next_token_is_keyword (parser, RID_FOR))
+    {
+      omp_for_parse_state->depth++;
+      body = c_parser_omp_loop_nest (parser, if_p);
+      omp_for_parse_state->depth--;
+    }
+  else if (moreloops && c_parser_next_token_is (parser, CPP_OPEN_BRACE))
+    {
+      /* This is the open brace in the loop-body grammar production.  Rather
+	 than trying to special-case braces, just parse it as a compound
+	 statement and handle the nested loop-body case there.  Note that
+	 when we see a further open brace inside the compound statement
+	 loop-body, we don't know whether it is the start of intervening
+	 code that is a compound statement, or a level of braces
+	 surrounding a nested loop-body.  Use the WANT_NESTED_LOOP state
+	 bit to ensure we have only one nested loop at each level.  */
+      omp_for_parse_state->in_intervening_code = true;
+      body = c_parser_compound_statement (parser, NULL);
+      omp_for_parse_state->in_intervening_code = false;
+      if (omp_for_parse_state->want_nested_loop)
+	{
+	  /* We have already parsed the whole loop body and not found a
+	     nested loop.  */
+	  error_at (omp_for_parse_state->for_loc,
+		    "not enough nested loops");
+	  omp_for_parse_state->fail = true;
+	}
+      if_p = NULL;
+    }
+  else
+    {
+      /* This is the final-loop-body case in the grammar: we have
+	 something that is not a FOR and not an open brace.  */
+      if (moreloops)
+	{
+	  /* If we were expecting a nested loop, give an error and mark
+	     that parsing has failed, and try to recover by parsing the
+	     body as regular code without further collapsing.  */
+	  error_at (omp_for_parse_state->for_loc,
+		    "not enough nested loops");
+	  omp_for_parse_state->fail = true;
+	}
+      in_statement = IN_OMP_FOR;
+      parser->omp_for_parse_state = NULL;
+      body = push_stmt_list ();
+      if (omp_for_parse_state->inscan)
+	c_parser_omp_scan_loop_body (parser, false);
+      else
+	add_stmt (c_parser_c99_block_statement (parser, if_p));
+      body = pop_stmt_list (body);
+      parser->omp_for_parse_state = omp_for_parse_state;
+    }
+  in_statement = save_in_statement;
+  omp_for_parse_state->want_nested_loop = false;
+  omp_for_parse_state->in_intervening_code = true;
+
+  /* Pop and return the implicit scope surrounding this level of loop.
+     If the iteration variable at this depth was bound in the for loop,
+     pull out and save the binding.  Later in c_parser_omp_for_loop,
+     these bindings will be moved to the scope surrounding the entire
+     OMP_FOR.  That keeps the gimplifier happy later on, and meanwhile
+     we have already resolved all references to the iteration variable
+     in its true scope.  */
+  add_stmt (body);
+  body = c_end_compound_stmt (loc, loop_scope, true);
+  if (decl && TREE_CODE (body) == BIND_EXPR)
+    {
+      tree t = BIND_EXPR_VARS (body);
+      tree prev = NULL_TREE, next = NULL_TREE;
+      while (t)
+	{
+	  next = DECL_CHAIN (t);
+	  if (t == decl)
+	    {
+	      if (prev)
+		DECL_CHAIN (prev) = next;
+	      else
+		{
+		  BIND_EXPR_VARS (body) = next;
+		  BLOCK_VARS (BIND_EXPR_BLOCK (body)) = next;
+		}
+	      DECL_CHAIN (t) = omp_for_parse_state->bindings;
+	      omp_for_parse_state->bindings = t;
+	      break;
+	    }
+	  else
+	    {
+	      prev = t;
+	      t = next;
+	    }
+	}
+      if (BIND_EXPR_VARS (body) == NULL_TREE)
+	body = BIND_EXPR_BODY (body);
+    }
+
+  return body;
+}
+
 /* Parse the restricted form of loop statements allowed by OpenACC and OpenMP.
    The real trick here is to determine the loop control variable early
    so that we can push a new decl if necessary to make it private.
@@ -20372,17 +20926,14 @@  static tree
 c_parser_omp_for_loop (location_t loc, c_parser *parser, enum tree_code code,
 		       tree clauses, tree *cclauses, bool *if_p)
 {
-  tree decl, cond, incr, body, init, stmt, cl;
-  unsigned char save_in_statement;
-  tree declv, condv, incrv, initv, ret = NULL_TREE;
-  tree pre_body = NULL_TREE, this_pre_body;
+  tree body, stmt, cl;
+  tree ret = NULL_TREE;
   tree ordered_cl = NULL_TREE;
-  bool fail = false, open_brace_parsed = false;
-  int i, collapse = 1, ordered = 0, count, nbraces = 0;
-  location_t for_loc;
+  int i, collapse = 1, ordered = 0, count;
   bool tiling = false;
   bool inscan = false;
-  vec<tree, va_gc> *for_block = make_tree_vector ();
+  struct omp_for_parse_data data;
+  struct omp_for_parse_data *save_data = parser->omp_for_parse_state;
 
   for (cl = clauses; cl; cl = OMP_CLAUSE_CHAIN (cl))
     if (OMP_CLAUSE_CODE (cl) == OMP_CLAUSE_COLLAPSE)
@@ -20415,250 +20966,62 @@  c_parser_omp_for_loop (location_t loc, c_parser *parser, enum tree_code code,
   gcc_assert (tiling || (collapse >= 1 && ordered >= 0));
   count = ordered ? ordered : collapse;
 
-  declv = make_tree_vec (count);
-  initv = make_tree_vec (count);
-  condv = make_tree_vec (count);
-  incrv = make_tree_vec (count);
-
   if (!c_parser_next_token_is_keyword (parser, RID_FOR))
     {
       c_parser_error (parser, "for statement expected");
       return NULL;
     }
-  for_loc = c_parser_peek_token (parser)->location;
-  c_parser_consume_token (parser);
-
-  /* Forbid break/continue in the loop initializer, condition, and
-     increment expressions.  */
-  save_in_statement = in_statement;
-  in_statement = IN_OMP_BLOCK;
-
-  for (i = 0; i < count; i++)
-    {
-      int bracecount = 0;
-
-      matching_parens parens;
-      if (!parens.require_open (parser))
-	goto pop_scopes;
-
-      /* Parse the initialization declaration or expression.  */
-      if (c_parser_next_tokens_start_declaration (parser))
-	{
-	  if (i > 0)
-	    vec_safe_push (for_block, c_begin_compound_stmt (true));
-	  this_pre_body = push_stmt_list ();
-	  c_in_omp_for = true;
-	  c_parser_declaration_or_fndef (parser, true, true, true, true, true);
-	  c_in_omp_for = false;
-	  if (this_pre_body)
-	    {
-	      this_pre_body = pop_stmt_list (this_pre_body);
-	      if (pre_body)
-		{
-		  tree t = pre_body;   
-		  pre_body = push_stmt_list ();
-		  add_stmt (t);
-		  add_stmt (this_pre_body);
-		  pre_body = pop_stmt_list (pre_body);
-		}
-	      else
-		pre_body = this_pre_body;
-	    }
-	  decl = check_for_loop_decls (for_loc, flag_isoc99);
-	  if (decl == NULL)
-	    goto error_init;
-	  if (DECL_INITIAL (decl) == error_mark_node)
-	    decl = error_mark_node;
-	  init = decl;
-	}
-      else if (c_parser_next_token_is (parser, CPP_NAME)
-	       && c_parser_peek_2nd_token (parser)->type == CPP_EQ)
-	{
-	  struct c_expr decl_exp;
-	  struct c_expr init_exp;
-	  location_t init_loc;
-
-	  decl_exp = c_parser_postfix_expression (parser);
-	  decl = decl_exp.value;
-
-	  c_parser_require (parser, CPP_EQ, "expected %<=%>");
-
-	  init_loc = c_parser_peek_token (parser)->location;
-	  init_exp = c_parser_expr_no_commas (parser, NULL);
-	  init_exp = default_function_array_read_conversion (init_loc,
-							     init_exp);
-	  c_in_omp_for = true;
-	  init = build_modify_expr (init_loc, decl, decl_exp.original_type,
-				    NOP_EXPR, init_loc, init_exp.value,
-				    init_exp.original_type);
-	  c_in_omp_for = false;
-	  init = c_process_expr_stmt (init_loc, init);
-
-	  c_parser_skip_until_found (parser, CPP_SEMICOLON, "expected %<;%>");
-	}
-      else
-	{
-	error_init:
-	  c_parser_error (parser,
-			  "expected iteration declaration or initialization");
-	  c_parser_skip_until_found (parser, CPP_CLOSE_PAREN,
-				     "expected %<)%>");
-	  fail = true;
-	  goto parse_next;
-	}
-
-      /* Parse the loop condition.  */
-      cond = NULL_TREE;
-      if (c_parser_next_token_is_not (parser, CPP_SEMICOLON))
-	{
-	  location_t cond_loc = c_parser_peek_token (parser)->location;
-	  c_in_omp_for = true;
-	  struct c_expr cond_expr
-	    = c_parser_binary_expression (parser, NULL, NULL_TREE);
-          c_in_omp_for = false;
-
-	  cond = cond_expr.value;
-	  cond = c_objc_common_truthvalue_conversion (cond_loc, cond);
-	  switch (cond_expr.original_code)
-	    {
-	    case GT_EXPR:
-	    case GE_EXPR:
-	    case LT_EXPR:
-	    case LE_EXPR:
-	      break;
-	    case NE_EXPR:
-	      if (code != OACC_LOOP)
-		break;
-	      /* FALLTHRU.  */
-	    default:
-	      /* Can't be cond = error_mark_node, because we want to preserve
-		 the location until c_finish_omp_for.  */
-	      cond = build1 (NOP_EXPR, boolean_type_node, error_mark_node);
-	      break;
-	    }
-	  protected_set_expr_location (cond, cond_loc);
-	}
-      c_parser_skip_until_found (parser, CPP_SEMICOLON, "expected %<;%>");
-
-      /* Parse the increment expression.  */
-      incr = NULL_TREE;
-      if (c_parser_next_token_is_not (parser, CPP_CLOSE_PAREN))
-	{
-	  location_t incr_loc = c_parser_peek_token (parser)->location;
-
-	  incr = c_process_expr_stmt (incr_loc,
-				      c_parser_expression (parser).value);
-	}
-      parens.skip_until_found_close (parser);
-
-      if (decl == NULL || decl == error_mark_node || init == error_mark_node)
-	fail = true;
-      else
-	{
-	  TREE_VEC_ELT (declv, i) = decl;
-	  TREE_VEC_ELT (initv, i) = init;
-	  TREE_VEC_ELT (condv, i) = cond;
-	  TREE_VEC_ELT (incrv, i) = incr;
-	}
-
-    parse_next:
-      if (i == count - 1)
-	break;
-
-      /* FIXME: OpenMP 3.0 draft isn't very clear on what exactly is allowed
-	 in between the collapsed for loops to be still considered perfectly
-	 nested.  Hopefully the final version clarifies this.
-	 For now handle (multiple) {'s and empty statements.  */
-      do
-	{
-	  if (c_parser_next_token_is_keyword (parser, RID_FOR))
-	    {
-	      c_parser_consume_token (parser);
-	      break;
-	    }
-	  else if (c_parser_next_token_is (parser, CPP_OPEN_BRACE))
-	    {
-	      c_parser_consume_token (parser);
-	      bracecount++;
-	    }
-	  else if (bracecount
-		   && c_parser_next_token_is (parser, CPP_SEMICOLON))
-	    c_parser_consume_token (parser);
-	  else
-	    {
-	      c_parser_error (parser, "not enough perfectly nested loops");
-	      if (bracecount)
-		{
-		  open_brace_parsed = true;
-		  bracecount--;
-		}
-	      fail = true;
-	      count = 0;
-	      break;
-	    }
-	}
-      while (1);
-
-      nbraces += bracecount;
-    }
-
-  if (nbraces)
-    if_p = NULL;
 
-  in_statement = IN_OMP_FOR;
-  body = push_stmt_list ();
-
-  if (inscan)
-    c_parser_omp_scan_loop_body (parser, open_brace_parsed);
-  else if (open_brace_parsed)
-    {
-      location_t here = c_parser_peek_token (parser)->location;
-      stmt = c_begin_compound_stmt (true);
-      c_parser_compound_statement_nostart (parser);
-      add_stmt (c_end_compound_stmt (here, stmt, true));
-    }
-  else
-    add_stmt (c_parser_c99_block_statement (parser, if_p));
-
-  body = pop_stmt_list (body);
-  in_statement = save_in_statement;
-
-  while (nbraces)
-    {
-      if (c_parser_next_token_is (parser, CPP_CLOSE_BRACE))
-	{
-	  c_parser_consume_token (parser);
-	  nbraces--;
-	}
-      else if (c_parser_next_token_is (parser, CPP_SEMICOLON))
-	c_parser_consume_token (parser);
-      else
-	{
-	  c_parser_error (parser, "collapsed loops not perfectly nested");
-	  while (nbraces)
-	    {
-	      location_t here = c_parser_peek_token (parser)->location;
-	      stmt = c_begin_compound_stmt (true);
-	      add_stmt (body);
-	      c_parser_compound_statement_nostart (parser);
-	      body = c_end_compound_stmt (here, stmt, true);
-	      nbraces--;
-	    }
-	  goto pop_scopes;
-	}
+  /* Initialize parse state for recursive descent.  */
+  data.declv = make_tree_vec (count);
+  data.initv = make_tree_vec (count);
+  data.condv = make_tree_vec (count);
+  data.incrv = make_tree_vec (count);
+  data.pre_body = NULL_TREE;;
+  data.bindings = NULL_TREE;
+  data.for_loc = c_parser_peek_token (parser)->location;
+  data.count = count;
+  data.depth = 0;
+  data.want_nested_loop = true;
+  data.ordered = ordered > 0;
+  data.in_intervening_code = false;
+  data.perfect_nesting_fail = false;
+  data.fail = false;
+  data.inscan = inscan;
+  data.saw_intervening_code = false;
+  data.code = code;
+  parser->omp_for_parse_state = &data;
+
+  body = c_parser_omp_loop_nest (parser, if_p);
+
+  /* Add saved bindings for iteration variables that were declared in
+     the nested for loop to the scope surrounding the entire loop.  */
+  for (tree t = data.bindings; t; )
+    {
+      tree n = TREE_CHAIN (t);
+      TREE_CHAIN (t) = NULL_TREE;
+      pushdecl (t);
+      t = n;
     }
 
   /* Only bother calling c_finish_omp_for if we haven't already generated
      an error from the initialization parsing.  */
-  if (!fail)
+  if (!data.fail)
     {
       c_in_omp_for = true;
-      stmt = c_finish_omp_for (loc, code, declv, NULL, initv, condv,
-			       incrv, body, pre_body, true);
+      stmt = c_finish_omp_for (loc, code, data.declv, NULL, data.initv,
+			       data.condv, data.incrv,
+			       body, data.pre_body, true);
       c_in_omp_for = false;
 
       /* Check for iterators appearing in lb, b or incr expressions.  */
-      if (stmt && !c_omp_check_loop_iv (stmt, declv, NULL))
+      if (stmt && !c_omp_check_loop_iv (stmt, data.declv, NULL))
+	stmt = NULL_TREE;
+
+      /* Check for errors involving lb/ub/incr expressions referencing
+	 variables declared in intervening code.  */
+      if (data.saw_intervening_code
+	  && !c_omp_check_loop_binding_exprs (stmt, NULL))
 	stmt = NULL_TREE;
 
       if (stmt)
@@ -20710,7 +21073,7 @@  c_parser_omp_for_loop (location_t loc, c_parser *parser, enum tree_code code,
 		else
 		  {
 		    for (i = 0; i < count; i++)
-		      if (TREE_VEC_ELT (declv, i) == OMP_CLAUSE_DECL (*c))
+		      if (TREE_VEC_ELT (data.declv, i) == OMP_CLAUSE_DECL (*c))
 			break;
 		    if (i == count)
 		      c = &OMP_CLAUSE_CHAIN (*c);
@@ -20723,7 +21086,8 @@  c_parser_omp_for_loop (location_t loc, c_parser *parser, enum tree_code code,
 		      }
 		    else
 		      {
-			/* Move lastprivate (decl) clause to OMP_FOR_CLAUSES.  */
+			/* Move lastprivate (decl) clause to
+			   OMP_FOR_CLAUSES.  */
 			tree l = *c;
 			*c = OMP_CLAUSE_CHAIN (*c);
 			if (code == OMP_SIMD)
@@ -20744,16 +21108,8 @@  c_parser_omp_for_loop (location_t loc, c_parser *parser, enum tree_code code,
 	}
       ret = stmt;
     }
-pop_scopes:
-  while (!for_block->is_empty ())
-    {
-      /* FIXME diagnostics: LOC below should be the actual location of
-	 this particular for block.  We need to build a list of
-	 locations to go along with FOR_BLOCK.  */
-      stmt = c_end_compound_stmt (loc, for_block->pop (), true);
-      add_stmt (stmt);
-    }
-  release_tree_vector (for_block);
+
+  parser->omp_for_parse_state = save_data;
   return ret;
 }
 
diff --git a/gcc/omp-api.h b/gcc/omp-api.h
new file mode 100644
index 00000000000..2a7ec7b72a6
--- /dev/null
+++ b/gcc/omp-api.h
@@ -0,0 +1,32 @@ 
+/* Functions for querying whether a function name is reserved by the
+   OpenMP API.  This is used for error checking.
+
+   Copyright (C) 2023 Free Software Foundation, Inc.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#ifndef GCC_OMP_API_H
+#define GCC_OMP_API_H
+
+#include "coretypes.h"
+
+/* In omp-general.cc, but declared in a separate header file for
+   convenience of the Fortran front end.  */
+extern bool omp_runtime_api_procname (const char *name);
+extern bool omp_runtime_api_call (const_tree fndecl);
+
+#endif
diff --git a/gcc/omp-general.cc b/gcc/omp-general.cc
index eefdcb54590..1e31014c454 100644
--- a/gcc/omp-general.cc
+++ b/gcc/omp-general.cc
@@ -3013,4 +3013,138 @@  omp_build_component_ref (tree obj, tree field)
   return ret;
 }
 
+/* Return true if NAME is the name of an omp_* runtime API call.  */
+bool
+omp_runtime_api_procname (const char *name)
+{
+  if (!startswith (name, "omp_"))
+    return false;
+
+  static const char *omp_runtime_apis[] =
+    {
+      /* This array has 3 sections.  First omp_* calls that don't
+	 have any suffixes.  */
+      "aligned_alloc",
+      "aligned_calloc",
+      "alloc",
+      "calloc",
+      "free",
+      "get_mapped_ptr",
+      "realloc",
+      "target_alloc",
+      "target_associate_ptr",
+      "target_disassociate_ptr",
+      "target_free",
+      "target_is_accessible",
+      "target_is_present",
+      "target_memcpy",
+      "target_memcpy_async",
+      "target_memcpy_rect",
+      "target_memcpy_rect_async",
+      NULL,
+      /* Now omp_* calls that are available as omp_* and omp_*_; however, the
+	 DECL_NAME is always omp_* without tailing underscore.  */
+      "capture_affinity",
+      "destroy_allocator",
+      "destroy_lock",
+      "destroy_nest_lock",
+      "display_affinity",
+      "fulfill_event",
+      "get_active_level",
+      "get_affinity_format",
+      "get_cancellation",
+      "get_default_allocator",
+      "get_default_device",
+      "get_device_num",
+      "get_dynamic",
+      "get_initial_device",
+      "get_level",
+      "get_max_active_levels",
+      "get_max_task_priority",
+      "get_max_teams",
+      "get_max_threads",
+      "get_nested",
+      "get_num_devices",
+      "get_num_places",
+      "get_num_procs",
+      "get_num_teams",
+      "get_num_threads",
+      "get_partition_num_places",
+      "get_place_num",
+      "get_proc_bind",
+      "get_supported_active_levels",
+      "get_team_num",
+      "get_teams_thread_limit",
+      "get_thread_limit",
+      "get_thread_num",
+      "get_wtick",
+      "get_wtime",
+      "in_explicit_task",
+      "in_final",
+      "in_parallel",
+      "init_lock",
+      "init_nest_lock",
+      "is_initial_device",
+      "pause_resource",
+      "pause_resource_all",
+      "set_affinity_format",
+      "set_default_allocator",
+      "set_lock",
+      "set_nest_lock",
+      "test_lock",
+      "test_nest_lock",
+      "unset_lock",
+      "unset_nest_lock",
+      NULL,
+      /* And finally calls available as omp_*, omp_*_ and omp_*_8_; however,
+	 as DECL_NAME only omp_* and omp_*_8 appear.  */
+      "display_env",
+      "get_ancestor_thread_num",
+      "init_allocator",
+      "get_partition_place_nums",
+      "get_place_num_procs",
+      "get_place_proc_ids",
+      "get_schedule",
+      "get_team_size",
+      "set_default_device",
+      "set_dynamic",
+      "set_max_active_levels",
+      "set_nested",
+      "set_num_teams",
+      "set_num_threads",
+      "set_schedule",
+      "set_teams_thread_limit"
+    };
+
+  int mode = 0;
+  for (unsigned i = 0; i < ARRAY_SIZE (omp_runtime_apis); i++)
+    {
+      if (omp_runtime_apis[i] == NULL)
+	{
+	  mode++;
+	  continue;
+	}
+      size_t len = strlen (omp_runtime_apis[i]);
+      if (strncmp (name + 4, omp_runtime_apis[i], len) == 0
+	  && (name[4 + len] == '\0'
+	      || (mode > 1 && strcmp (name + 4 + len, "_8") == 0)))
+	return true;
+    }
+  return false;
+}
+
+/* Return true if FNDECL is an omp_* runtime API call.  */
+
+bool
+omp_runtime_api_call (const_tree fndecl)
+{
+  tree declname = DECL_NAME (fndecl);
+  if (!declname
+      || (DECL_CONTEXT (fndecl) != NULL_TREE
+	  && TREE_CODE (DECL_CONTEXT (fndecl)) != TRANSLATION_UNIT_DECL)
+      || !TREE_PUBLIC (fndecl))
+    return false;
+  return omp_runtime_api_procname (IDENTIFIER_POINTER (declname));
+}
+
 #include "gt-omp-general.h"
diff --git a/gcc/omp-general.h b/gcc/omp-general.h
index 92717db1628..1a52bfdb56b 100644
--- a/gcc/omp-general.h
+++ b/gcc/omp-general.h
@@ -23,6 +23,7 @@  along with GCC; see the file COPYING3.  If not see
 #define GCC_OMP_GENERAL_H
 
 #include "gomp-constants.h"
+#include "omp-api.h"
 
 /*  Flags for an OpenACC loop.  */
 
diff --git a/gcc/omp-low.cc b/gcc/omp-low.cc
index 00e6fb07cb6..5d7c32dac39 100644
--- a/gcc/omp-low.cc
+++ b/gcc/omp-low.cc
@@ -4009,135 +4009,6 @@  setjmp_or_longjmp_p (const_tree fndecl)
   return !strcmp (name, "setjmp") || !strcmp (name, "longjmp");
 }
 
-/* Return true if FNDECL is an omp_* runtime API call.  */
-
-static bool
-omp_runtime_api_call (const_tree fndecl)
-{
-  tree declname = DECL_NAME (fndecl);
-  if (!declname
-      || (DECL_CONTEXT (fndecl) != NULL_TREE
-          && TREE_CODE (DECL_CONTEXT (fndecl)) != TRANSLATION_UNIT_DECL)
-      || !TREE_PUBLIC (fndecl))
-    return false;
-
-  const char *name = IDENTIFIER_POINTER (declname);
-  if (!startswith (name, "omp_"))
-    return false;
-
-  static const char *omp_runtime_apis[] =
-    {
-      /* This array has 3 sections.  First omp_* calls that don't
-	 have any suffixes.  */
-      "aligned_alloc",
-      "aligned_calloc",
-      "alloc",
-      "calloc",
-      "free",
-      "get_mapped_ptr",
-      "realloc",
-      "target_alloc",
-      "target_associate_ptr",
-      "target_disassociate_ptr",
-      "target_free",
-      "target_is_accessible",
-      "target_is_present",
-      "target_memcpy",
-      "target_memcpy_async",
-      "target_memcpy_rect",
-      "target_memcpy_rect_async",
-      NULL,
-      /* Now omp_* calls that are available as omp_* and omp_*_; however, the
-	 DECL_NAME is always omp_* without tailing underscore.  */
-      "capture_affinity",
-      "destroy_allocator",
-      "destroy_lock",
-      "destroy_nest_lock",
-      "display_affinity",
-      "fulfill_event",
-      "get_active_level",
-      "get_affinity_format",
-      "get_cancellation",
-      "get_default_allocator",
-      "get_default_device",
-      "get_device_num",
-      "get_dynamic",
-      "get_initial_device",
-      "get_level",
-      "get_max_active_levels",
-      "get_max_task_priority",
-      "get_max_teams",
-      "get_max_threads",
-      "get_nested",
-      "get_num_devices",
-      "get_num_places",
-      "get_num_procs",
-      "get_num_teams",
-      "get_num_threads",
-      "get_partition_num_places",
-      "get_place_num",
-      "get_proc_bind",
-      "get_supported_active_levels",
-      "get_team_num",
-      "get_teams_thread_limit",
-      "get_thread_limit",
-      "get_thread_num",
-      "get_wtick",
-      "get_wtime",
-      "in_explicit_task",
-      "in_final",
-      "in_parallel",
-      "init_lock",
-      "init_nest_lock",
-      "is_initial_device",
-      "pause_resource",
-      "pause_resource_all",
-      "set_affinity_format",
-      "set_default_allocator",
-      "set_lock",
-      "set_nest_lock",
-      "test_lock",
-      "test_nest_lock",
-      "unset_lock",
-      "unset_nest_lock",
-      NULL,
-      /* And finally calls available as omp_*, omp_*_ and omp_*_8_; however,
-	 as DECL_NAME only omp_* and omp_*_8 appear.  */
-      "display_env",
-      "get_ancestor_thread_num",
-      "init_allocator",
-      "get_partition_place_nums",
-      "get_place_num_procs",
-      "get_place_proc_ids",
-      "get_schedule",
-      "get_team_size",
-      "set_default_device",
-      "set_dynamic",
-      "set_max_active_levels",
-      "set_nested",
-      "set_num_teams",
-      "set_num_threads",
-      "set_schedule",
-      "set_teams_thread_limit"
-    };
-
-  int mode = 0;
-  for (unsigned i = 0; i < ARRAY_SIZE (omp_runtime_apis); i++)
-    {
-      if (omp_runtime_apis[i] == NULL)
-	{
-	  mode++;
-	  continue;
-	}
-      size_t len = strlen (omp_runtime_apis[i]);
-      if (strncmp (name + 4, omp_runtime_apis[i], len) == 0
-	  && (name[4 + len] == '\0'
-	      || (mode > 1 && strcmp (name + 4 + len, "_8") == 0)))
-	return true;
-    }
-  return false;
-}
-
 /* Helper function for scan_omp.
 
    Callback for walk_gimple_stmt used to scan for OMP directives in
diff --git a/gcc/testsuite/c-c++-common/goacc/collapse-1.c b/gcc/testsuite/c-c++-common/goacc/collapse-1.c
index 11b14383983..0feac8f8ddb 100644
--- a/gcc/testsuite/c-c++-common/goacc/collapse-1.c
+++ b/gcc/testsuite/c-c++-common/goacc/collapse-1.c
@@ -8,8 +8,8 @@  f1 (void)
 {
   #pragma acc parallel
   #pragma acc loop collapse (2)
-  for (i = 0; i < 5; i++)
-    ;					/* { dg-error "not enough perfectly nested" } */
+  for (i = 0; i < 5; i++)	/* { dg-error "not enough nested loops" } */
+    ;
   {
     for (j = 0; j < 5; j++)
       ;
@@ -38,9 +38,9 @@  f3 (void)
 {
   #pragma acc parallel
   #pragma acc loop collapse (2)
-  for (i = 0; i < 5; i++)
+  for (i = 0; i < 5; i++)	/* { dg-error "inner loops must be perfectly nested" } */
     {
-      int k = foo ();			/* { dg-error "not enough perfectly nested" } */
+      int k = foo ();
       {
 	{
 	  for (j = 0; j < 5; j++)
@@ -56,12 +56,12 @@  f4 (void)
 {
   #pragma acc parallel
   #pragma acc loop collapse (2)
-  for (i = 0; i < 5; i++)
+  for (i = 0; i < 5; i++)	/* { dg-error "inner loops must be perfectly nested" } */
     {
       {
 	for (j = 0; j < 5; j++)
 	  ;
-	foo ();				/* { dg-error "collapsed loops not perfectly nested before" } */
+	foo ();
       }
     }
 }
@@ -71,13 +71,13 @@  f5 (void)
 {
   #pragma acc parallel
   #pragma acc loop collapse (2)
-  for (i = 0; i < 5; i++)
+  for (i = 0; i < 5; i++)	/* { dg-error "inner loops must be perfectly nested" } */
     {
       {
 	for (j = 0; j < 5; j++)
 	  ;
       }
-      foo ();				/* { dg-error "collapsed loops not perfectly nested before" } */
+      foo ();
     }
 }
 
diff --git a/gcc/testsuite/c-c++-common/goacc/tile-2.c b/gcc/testsuite/c-c++-common/goacc/tile-2.c
index c8b240d225b..98abc903bdc 100644
--- a/gcc/testsuite/c-c++-common/goacc/tile-2.c
+++ b/gcc/testsuite/c-c++-common/goacc/tile-2.c
@@ -3,8 +3,8 @@  int main ()
 #pragma acc parallel
   {
 #pragma acc loop tile (*,*)
-    for (int ix = 0; ix < 30; ix++)
-      ; /* { dg-error "not enough" } */
+    for (int ix = 0; ix < 30; ix++) /* { dg-error "not enough" "" { target c } } */
+      ; /* { dg-error "not enough" "" { target c++ } } */
 
 #pragma acc loop tile (*,*)
     for (int ix = 0; ix < 30; ix++)
diff --git a/gcc/testsuite/gcc.dg/gomp/collapse-1.c b/gcc/testsuite/gcc.dg/gomp/collapse-1.c
index 89b76bb669c..16a102ff3fd 100644
--- a/gcc/testsuite/gcc.dg/gomp/collapse-1.c
+++ b/gcc/testsuite/gcc.dg/gomp/collapse-1.c
@@ -8,8 +8,8 @@  void
 f1 (void)
 {
   #pragma omp for collapse (2)
-  for (i = 0; i < 5; i++)
-    ;					/* { dg-error "not enough perfectly nested" } */
+  for (i = 0; i < 5; i++)	/* { dg-error "not enough nested loops" } */
+    ;
   {
     for (j = 0; j < 5; j++)
       ;
@@ -38,7 +38,7 @@  f3 (void)
   #pragma omp for collapse (2)
   for (i = 0; i < 5; i++)
     {
-      int k = foo ();			/* { dg-error "not enough perfectly nested" } */
+      int k = foo ();
       {
 	{
 	  for (j = 0; j < 5; j++)
@@ -58,7 +58,7 @@  f4 (void)
       {
 	for (j = 0; j < 5; j++)
 	  ;
-	foo ();				/* { dg-error "collapsed loops not perfectly nested before" } */
+	foo ();
       }
     }
 }
@@ -73,7 +73,7 @@  f5 (void)
 	for (j = 0; j < 5; j++)
 	  ;
       }
-      foo ();				/* { dg-error "collapsed loops not perfectly nested before" } */
+      foo ();
     }
 }