openmp, fortran: Add support for map iterators in OpenMP target construct (Fortran)

This adds support for iterators in map clauses within OpenMP
'target' constructs in Fortran.

Some special handling for struct field maps has been added to libgomp in
order to handle arrays of derived types.

gcc/fortran/

	* dump-parse-tree.cc (show_omp_namelist): Add iterator support for
	OMP_LIST_MAP.
	* match.cc (gfc_free_namelist): Free namespace for OMP_LIST_MAP.
	* openmp.cc (gfc_free_omp_clauses): Free namespace in namelist for
	OMP_LIST_MAP.
	(gfc_match_omp_clauses): Parse 'iterator' modifier for 'map' clause.
	(resolve_omp_clauses): Resolve iterators for OMP_LIST_MAP.
	* trans-openmp.cc: Include tree-ssa-loop-niter.h.
	(gfc_trans_omp_array_section): Add iterator argument.  Replace
	instances of iterator variables with the initial value when
	computing biases.
	(gfc_trans_omp_clauses): Handle iterators in OMP_LIST_MAP clauses.
	Add expressions to iter_block rather than block.  Do not apply
	iterators to firstprivate maps.  Pass iterator to
	gfc_trans_omp_array_section.

gcc/

	* gimplify.cc (compute_omp_iterator_count): Account for difference
	in loop boundaries in Fortran.
	(build_omp_iterator_loop): Change upper boundary condition for
	Fortran.  Insert block statements into innermost loop.
	(remove_unused_omp_iterator_vars): Copy block subblocks of old
	iterator to new iterator and remove original.
	(contains_vars_1): New.
	(contains_vars): New.
	(extract_base_bit_offset): Add iterator argument.  Remove iterator
	variables from base.  Do not set variable_offset if the offset
	does not contain any remaining variables.
	(omp_accumulate_sibling_list): Add iterator argument to
	extract_base_bit_offset.
	* tree-pretty-print.cc (dump_block_node): Ignore BLOCK_SUBBLOCKS
	containing iterator block statements.

gcc/testsuite/

	* gfortran.dg/gomp/target-map-iterators-1.f90: New.
	* gfortran.dg/gomp/target-map-iterators-2.f90: New.
	* gfortran.dg/gomp/target-map-iterators-3.f90: New.
	* gfortran.dg/gomp/target-map-iterators-4.f90: New.

libgomp/

	* target.c (kind_to_name): Handle GOMP_MAP_STRUCT and
	GOMP_MAP_STRUCT_UNORD.
	(gomp_add_map): New.
	(gomp_merge_iterator_maps): Expand fields of a struct mapping
	breadth-first.
	* testsuite/libgomp.fortran/target-map-iterators-1.f90: New.
	* testsuite/libgomp.fortran/target-map-iterators-2.f90: New.
	* testsuite/libgomp.fortran/target-map-iterators-3.f90: New.

Co-authored-by: Andrew Stubbs <ams@baylibre.com>

10 files changed, 314 insertions, 42 deletions

diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index 51cf7a6..531831a 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -1463,7 +1463,8 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
   for (; n; n = n->next)
     {
       gfc_current_ns = ns_curr;
-      if (list_type == OMP_LIST_AFFINITY || list_type == OMP_LIST_DEPEND)
+      if (list_type == OMP_LIST_AFFINITY || list_type == OMP_LIST_DEPEND
+	  || list_type == OMP_LIST_MAP)
 	{
 	  gfc_current_ns = n->u2.ns ? n->u2.ns : ns_curr;
 	  if (n->u2.ns != ns_iter)
@@ -1475,8 +1476,12 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
 		    fputs ("AFFINITY (", dumpfile);
 		  else if (n->u.depend_doacross_op == OMP_DOACROSS_SINK_FIRST)
 		    fputs ("DOACROSS (", dumpfile);
-		  else
+		  else if (list_type == OMP_LIST_DEPEND)
 		    fputs ("DEPEND (", dumpfile);
+		  else if (list_type == OMP_LIST_MAP)
+		    fputs ("MAP (", dumpfile);
+		  else
+		    gcc_unreachable ();
 		}
 	      if (n->u2.ns)
 		{
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 269e152..64f5e00 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -5881,7 +5881,8 @@ gfc_free_namelist (gfc_namelist *name)
 void
 gfc_free_omp_namelist (gfc_omp_namelist *name, int list)
 {
-  bool free_ns = (list == OMP_LIST_AFFINITY || list == OMP_LIST_DEPEND);
+  bool free_ns = (list == OMP_LIST_AFFINITY || list == OMP_LIST_DEPEND
+		  || list == OMP_LIST_MAP);
   bool free_mapper = (list == OMP_LIST_MAP
 		      || list == OMP_LIST_TO
 		      || list == OMP_LIST_FROM);
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index a658172..ad21e6a 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -3671,10 +3671,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	      int close_modifier = 0;
 	      int present_modifier = 0;
 	      int mapper_modifier = 0;
+	      int iterator_modifier = 0;
+	      gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns;
 	      locus second_always_locus = old_loc2;
 	      locus second_close_locus = old_loc2;
 	      locus second_mapper_locus = old_loc2;
 	      locus second_present_locus = old_loc2;
+	      locus second_iterator_locus = old_loc2;
 	      char mapper_id[GFC_MAX_SYMBOL_LEN + 1] = { '\0' };
 
 	      for (;;)
@@ -3705,6 +3708,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		      if (strcmp (mapper_id, "default") == 0)
 			mapper_id[0] = '\0';
 		    }
+		  else if (gfc_match_iterator (&ns_iter, true) == MATCH_YES)
+		    {
+		      if (iterator_modifier++ == 1)
+		      second_iterator_locus = current_locus;
+		    }
 		  else
 		    break;
 		  gfc_match (", ");
@@ -3768,11 +3776,20 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 			     &second_mapper_locus);
 		  break;
 		}
+	      if (iterator_modifier > 1)
+		{
+		  gfc_error ("too many %<iterator%> modifiers at %L",
+			     &second_iterator_locus);
+		  break;
+		}
 
 	      head = NULL;
-	      if (gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_MAP],
-					       false, NULL, &head,
-					       true, true) == MATCH_YES)
+	      if (ns_iter)
+		gfc_current_ns = ns_iter;
+	      m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_MAP],
+					       false, NULL, &head, true, true);
+	      gfc_current_ns = ns_curr;
+	      if (m == MATCH_YES)
 		{
 		  gfc_omp_namelist *n;
 		  for (n = *head; n; n = n->next)
@@ -3784,6 +3801,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 			  n->u3.udm->mapper_id
 			    = gfc_get_string ("%s", mapper_id);
 			}
+		      n->u2.ns = ns_iter;
+		      if (ns_iter)
+			ns_iter->refs++;
 		    }
 		  continue;
 		}
@@ -10136,7 +10156,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 			break;
 		      }
 		  }
-		if ((list == OMP_LIST_DEPEND || list == OMP_LIST_AFFINITY)
+		if ((list == OMP_LIST_DEPEND || list == OMP_LIST_AFFINITY
+		     || list == OMP_LIST_MAP)
 		    && n->u2.ns && !n->u2.ns->resolved)
 		  {
 		    n->u2.ns->resolved = 1;
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 2c2e3a3..9c2a77a 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -27,6 +27,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "gfortran.h"
 #include "basic-block.h"
 #include "tree-ssa.h"
+#include "tree-ssa-loop-niter.h"  /* for simplify_replace_tree.  */
 #include "function.h"
 #include "gimple.h"
 #include "gimple-expr.h"
@@ -3350,7 +3351,8 @@ static void
 gfc_trans_omp_array_section (stmtblock_t *block, toc_directive cd,
 			     gfc_omp_namelist *n, tree decl, bool element,
 			     gomp_map_kind ptr_kind, tree &node,
-			     tree &node2, tree &node3, tree &node4)
+			     tree &node2, tree &node3, tree &node4,
+			     tree iterator)
 {
   bool openmp = (cd < TOC_OPENACC);
   bool omp_exit_data = (cd == TOC_OPENMP_EXIT_DATA);
@@ -3517,6 +3519,13 @@ gfc_trans_omp_array_section (stmtblock_t *block, toc_directive cd,
       OMP_CLAUSE_DECL (node3) = decl;
     }
 
+  for (tree it = iterator; it; it = TREE_CHAIN (it))
+    {
+      ptr = simplify_replace_tree (ptr, TREE_VEC_ELT (it, 0),
+				   TREE_VEC_ELT (it, 1));
+      ptr2 = simplify_replace_tree (ptr2, TREE_VEC_ELT (it, 0),
+				    TREE_VEC_ELT (it, 1));
+    }
   ptr = fold_build2 (MINUS_EXPR, ptrdiff_type_node, ptr,
 		     fold_convert (ptrdiff_type_node, ptr2));
   if (!openmp)
@@ -4610,11 +4619,41 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 	    }
 	  break;
 	case OMP_LIST_MAP:
+	  iterator = NULL_TREE;
+	  prev = NULL;
+	  prev_clauses = omp_clauses;
 	  for (; n != NULL; n = n->next)
 	    {
 	      if (!n->sym->attr.referenced)
 		continue;
 
+	      if (iterator && prev->u2.ns != n->u2.ns)
+		{
+		  /* Finish previous iterator group.  */
+		  BLOCK_SUBBLOCKS (tree_block) = gfc_finish_block (&iter_block);
+		  TREE_VEC_ELT (iterator, 5) = tree_block;
+		  for (tree c = omp_clauses; c != prev_clauses;
+		       c = OMP_CLAUSE_CHAIN (c))
+		    if (OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_FIRSTPRIVATE_POINTER
+			&& OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_FIRSTPRIVATE_REFERENCE)
+		      OMP_CLAUSE_ITERATORS (c) = iterator;
+		  prev_clauses = omp_clauses;
+		  iterator = NULL_TREE;
+		}
+	      if (n->u2.ns && (!prev || prev->u2.ns != n->u2.ns))
+		{
+		  /* Start a new iterator group.  */
+		  gfc_init_block (&iter_block);
+		  tree_block = make_node (BLOCK);
+		  TREE_USED (tree_block) = 1;
+		  BLOCK_VARS (tree_block) = NULL_TREE;
+		  prev_clauses = omp_clauses;
+		  iterator = handle_iterator (n->u2.ns, block, tree_block);
+		}
+	      if (!iterator)
+		gfc_init_block (&iter_block);
+	      prev = n;
+
 	      /* We do not want to include allocatable vars in a synthetic
 		 "acc data" region created for "!$acc declare create" vars.
 		 Such variables are handled by augmenting allocate/deallocate
@@ -4856,7 +4895,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 						       TRUTH_NOT_EXPR,
 						       boolean_type_node,
 						       present);
-			  gfc_add_expr_to_block (block,
+			  gfc_add_expr_to_block (&iter_block,
 						 build3_loc (input_location,
 							     COND_EXPR,
 							     void_type_node,
@@ -4921,7 +4960,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		      tree type = TREE_TYPE (decl);
 		      tree ptr = gfc_conv_descriptor_data_get (decl);
 		      if (present)
-			ptr = gfc_build_cond_assign_expr (block, present, ptr,
+			ptr = gfc_build_cond_assign_expr (&iter_block,
+							  present, ptr,
 							  null_pointer_node);
 		      gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
 		      ptr = build_fold_indirect_ref (ptr);
@@ -4947,7 +4987,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			      ptr = gfc_conv_descriptor_data_get (decl);
 			      ptr = gfc_build_addr_expr (NULL, ptr);
 			      ptr = gfc_build_cond_assign_expr (
-				      block, present, ptr, null_pointer_node);
+				&iter_block, present, ptr, null_pointer_node);
 			      ptr = build_fold_indirect_ref (ptr);
 			      OMP_CLAUSE_DECL (node3) = ptr;
 			    }
@@ -5036,7 +5076,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 						    TRUTH_ANDIF_EXPR,
 						    boolean_type_node,
 						    present, cond);
-			  gfc_add_expr_to_block (block,
+			  gfc_add_expr_to_block (&iter_block,
 						 build3_loc (input_location,
 							     COND_EXPR,
 							     void_type_node,
@@ -5065,12 +5105,12 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			      tree cond = build3_loc (input_location, COND_EXPR,
 						      void_type_node, present,
 						      cond_body, NULL_TREE);
-			      gfc_add_expr_to_block (block, cond);
+			      gfc_add_expr_to_block (&iter_block, cond);
 			      OMP_CLAUSE_SIZE (node) = var;
 			    }
 			  else
 			    {
-			      gfc_add_block_to_block (block, &cond_block);
+			      gfc_add_block_to_block (&iter_block, &cond_block);
 			      OMP_CLAUSE_SIZE (node) = size;
 			    }
 			}
@@ -5082,8 +5122,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		      /* A single indirectref is handled by the middle end.  */
 		      gcc_assert (!POINTER_TYPE_P (TREE_TYPE (decl)));
 		      tree tmp = TREE_OPERAND (decl, 0);
-		      tmp = gfc_build_cond_assign_expr (block, present, tmp,
-							 null_pointer_node);
+		      tmp = gfc_build_cond_assign_expr (&iter_block,
+							present, tmp,
+							null_pointer_node);
 		      OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (tmp);
 		    }
 		  else
@@ -5116,7 +5157,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 							 size_type_node,
 							 cond, size,
 							 size_zero_node);
-		      size = gfc_evaluate_now (size, block);
+		      size = gfc_evaluate_now (size, &iter_block);
 		      OMP_CLAUSE_SIZE (node) = size;
 		    }
 		  if ((TREE_CODE (decl) != PARM_DECL
@@ -5132,7 +5173,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			tmp = DECL_P (decl) ? DECL_SIZE_UNIT (decl)
 					    : TYPE_SIZE_UNIT (TREE_TYPE (decl));
 		      tree var = gfc_create_var (TREE_TYPE (tmp), NULL);
-		      gfc_add_modify_loc (input_location, block, var, tmp);
+		      gfc_add_modify_loc (input_location, &iter_block,
+					  var, tmp);
 		      OMP_CLAUSE_SIZE (node) = var;
 		      gfc_allocate_lang_decl (var);
 		      if (TREE_CODE (decl) == INDIRECT_REF)
@@ -5162,8 +5204,10 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		      && !(POINTER_TYPE_P (type)
 			   && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (type))))
 		    k = GOMP_MAP_FIRSTPRIVATE_POINTER;
-		  gfc_trans_omp_array_section (block, cd, n, decl, element,
-					       k, node, node2, node3, node4);
+		  gfc_trans_omp_array_section (&iter_block,
+					       cd, n, decl, element,
+					       k, node, node2, node3, node4,
+					       iterator);
 		}
 	      else if (n->expr
 		       && n->expr->expr_type == EXPR_VARIABLE
@@ -5179,12 +5223,12 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		  gfc_init_se (&se, NULL);
 
 		  gfc_conv_expr (&se, n->expr);
-		  gfc_add_block_to_block (block, &se.pre);
+		  gfc_add_block_to_block (&iter_block, &se.pre);
 		  /* For BT_CHARACTER a pointer is returned.  */
 		  OMP_CLAUSE_DECL (node)
 		    = POINTER_TYPE_P (TREE_TYPE (se.expr))
 		      ? build_fold_indirect_ref (se.expr) : se.expr;
-		  gfc_add_block_to_block (block, &se.post);
+		  gfc_add_block_to_block (&iter_block, &se.post);
 		  if (pointer || allocatable)
 		    {
 		      /* If it's a bare attach/detach clause, we just want
@@ -5245,7 +5289,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 				   ? DECL_SIZE_UNIT (se.expr)
 				   : TYPE_SIZE_UNIT (TREE_TYPE (se.expr)));
 			  tree var = gfc_create_var (TREE_TYPE (tmp), NULL);
-			  gfc_add_modify_loc (input_location, block, var, tmp);
+			  gfc_add_modify_loc (input_location, &iter_block,
+					      var, tmp);
 			  OMP_CLAUSE_SIZE (node) = var;
 			  gfc_allocate_lang_decl (var);
 			  if (TREE_CODE (se.expr) == INDIRECT_REF)
@@ -5415,7 +5460,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			     to ensure that it is not gimplified + is a decl.  */
 			  tree tmp = OMP_CLAUSE_SIZE (node);
 			  tree var = gfc_create_var (TREE_TYPE (tmp), NULL);
-			  gfc_add_modify_loc (input_location, block, var, tmp);
+			  gfc_add_modify_loc (input_location, &iter_block,
+					      var, tmp);
 			  OMP_CLAUSE_SIZE (node) = var;
 			  gfc_allocate_lang_decl (var);
 			  if (TREE_CODE (inner) == INDIRECT_REF)
@@ -5463,7 +5509,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			  OMP_CLAUSE_DECL (node) = ptr;
 			  int rank = GFC_TYPE_ARRAY_RANK (type);
 			  OMP_CLAUSE_SIZE (node)
-			    = gfc_full_array_size (block, inner, rank);
+			    = gfc_full_array_size (&iter_block, inner, rank);
 			  tree elemsz
 			    = TYPE_SIZE_UNIT (gfc_get_element_type (type));
 			  map_kind = OMP_CLAUSE_MAP_KIND (node);
@@ -5524,7 +5570,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 				  tree tmp = OMP_CLAUSE_SIZE (node);
 				  tree var = gfc_create_var (TREE_TYPE (tmp),
 							     NULL);
-				  gfc_add_modify_loc (map_loc, block,
+				  gfc_add_modify_loc (map_loc, &iter_block,
 						      var, tmp);
 				  OMP_CLAUSE_SIZE (node) = var;
 				  gfc_allocate_lang_decl (var);
@@ -5622,9 +5668,10 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		      /* An array element or section.  */
 		      bool element = lastref->u.ar.type == AR_ELEMENT;
 		      gomp_map_kind kind = GOMP_MAP_ATTACH_DETACH;
-		      gfc_trans_omp_array_section (block, cd, n, inner, element,
+		      gfc_trans_omp_array_section (&iter_block,
+						   cd, n, inner, element,
 						   kind, node, node2, node3,
-						   node4);
+						   node4, iterator);
 		    }
 		  else
 		    gcc_unreachable ();
@@ -5634,6 +5681,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 
 	      finalize_map_clause:
 
+	      if (!iterator)
+		gfc_add_block_to_block (block, &iter_block);
+
 	      /* If we're processing an "omp declare mapper" directive, group
 		 together multiple nodes used for some given map clause using
 		 GOMP_MAP_MAPPING_GROUP.  These are then either flattened or
@@ -5706,6 +5756,17 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		    omp_clauses = gfc_trans_add_clause (node5, omp_clauses);
 		}
 	    }
+	  if (iterator)
+	    {
+	      /* Finish last iterator group.  */
+	      BLOCK_SUBBLOCKS (tree_block) = gfc_finish_block (&iter_block);
+	      TREE_VEC_ELT (iterator, 5) = tree_block;
+	      for (tree c = omp_clauses; c != prev_clauses;
+		   c = OMP_CLAUSE_CHAIN (c))
+		if (OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_FIRSTPRIVATE_POINTER
+		    && OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_FIRSTPRIVATE_REFERENCE)
+		  OMP_CLAUSE_ITERATORS (c) = iterator;
+	    }
 	  break;
 	case OMP_LIST_TO:
 	case OMP_LIST_FROM:
diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc
index 40f2fde..9164875 100644
--- a/gcc/gimplify.cc
+++ b/gcc/gimplify.cc
@@ -72,6 +72,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "tree-nested.h"
 #include "gcc-urlifier.h"
 #include "dwarf2out.h"
+#include "tree-ssa-loop-niter.h" /* For simplify_replace_tree.  */
 
 /* Identifier for a basic condition, mapping it to other basic conditions of
    its Boolean expression.  Basic conditions given the same uid (in the same
@@ -9762,10 +9763,17 @@ compute_omp_iterator_count (tree it, gimple_seq *pre_p)
 	endmbegin = fold_build2_loc (loc, POINTER_DIFF_EXPR, stype, end, begin);
       else
 	endmbegin = fold_build2_loc (loc, MINUS_EXPR, type, end, begin);
-      tree stepm1 = fold_build2_loc (loc, MINUS_EXPR, stype, step,
-				     build_int_cst (stype, 1));
-      tree stepp1 = fold_build2_loc (loc, PLUS_EXPR, stype, step,
-				     build_int_cst (stype, 1));
+      /* Account for iteration stopping on the end value in Fortran rather
+	 than before it.  */
+      tree stepm1 = step;
+      tree stepp1 = step;
+      if (!lang_GNU_Fortran ())
+	{
+	  stepm1 = fold_build2_loc (loc, MINUS_EXPR, stype, step,
+				    build_int_cst (stype, 1));
+	  stepp1 = fold_build2_loc (loc, PLUS_EXPR, stype, step,
+				    build_int_cst (stype, 1));
+	}
       tree pos = fold_build2_loc (loc, PLUS_EXPR, stype,
 				  unshare_expr (endmbegin), stepm1);
       pos = fold_build2_loc (loc, TRUNC_DIV_EXPR, stype, pos, step);
@@ -9777,10 +9785,11 @@ compute_omp_iterator_count (tree it, gimple_seq *pre_p)
 	}
       neg = fold_build2_loc (loc, TRUNC_DIV_EXPR, stype, neg, step);
       step = NULL_TREE;
-      tree cond = fold_build2_loc (loc, LT_EXPR, boolean_type_node, begin, end);
+      tree_code cmp_op = lang_GNU_Fortran () ? LE_EXPR : LT_EXPR;
+      tree cond = fold_build2_loc (loc, cmp_op, boolean_type_node, begin, end);
       pos = fold_build3_loc (loc, COND_EXPR, stype, cond, pos,
 			     build_int_cst (stype, 0));
-      cond = fold_build2_loc (loc, LT_EXPR, boolean_type_node, end, begin);
+      cond = fold_build2_loc (loc, cmp_op, boolean_type_node, end, begin);
       neg = fold_build3_loc (loc, COND_EXPR, stype, cond, neg,
 			     build_int_cst (stype, 0));
       tree osteptype = TREE_TYPE (orig_step);
@@ -9809,6 +9818,7 @@ build_omp_iterator_loop (tree it, gimple_seq *pre_p, tree *last_bind)
   if (*last_bind)
     gimplify_and_add (*last_bind, pre_p);
   tree block = TREE_VEC_ELT (it, 5);
+  tree block_stmts = lang_GNU_Fortran () ? BLOCK_SUBBLOCKS (block) : NULL_TREE;
   *last_bind = build3 (BIND_EXPR, void_type_node,
 		       BLOCK_VARS (block), NULL, block);
   TREE_SIDE_EFFECTS (*last_bind) = 1;
@@ -9820,6 +9830,7 @@ build_omp_iterator_loop (tree it, gimple_seq *pre_p, tree *last_bind)
       tree end = TREE_VEC_ELT (it, 2);
       tree step = TREE_VEC_ELT (it, 3);
       tree orig_step = TREE_VEC_ELT (it, 4);
+      block = TREE_VEC_ELT (it, 5);
       tree type = TREE_TYPE (var);
       location_t loc = DECL_SOURCE_LOCATION (var);
       /* Emit:
@@ -9830,9 +9841,9 @@ build_omp_iterator_loop (tree it, gimple_seq *pre_p, tree *last_bind)
 	 var = var + step;
 	 cond_label:
 	 if (orig_step > 0) {
-	   if (var < end) goto beg_label;
+	   if (var < end) goto beg_label;  // <= for Fortran
 	 } else {
-	   if (var > end) goto beg_label;
+	   if (var > end) goto beg_label;  // >= for Fortran
 	 }
 	 for each iterator, with inner iterators added to
 	 the ... above.  */
@@ -9858,10 +9869,12 @@ build_omp_iterator_loop (tree it, gimple_seq *pre_p, tree *last_bind)
       append_to_statement_list_force (tem, p);
       tem = build1 (LABEL_EXPR, void_type_node, cond_label);
       append_to_statement_list (tem, p);
-      tree cond = fold_build2_loc (loc, LT_EXPR, boolean_type_node, var, end);
+      tree cond = fold_build2_loc (loc, lang_GNU_Fortran () ? LE_EXPR : LT_EXPR,
+				   boolean_type_node, var, end);
       tree pos = fold_build3_loc (loc, COND_EXPR, void_type_node, cond,
 				  build_and_jump (&beg_label), void_node);
-      cond = fold_build2_loc (loc, GT_EXPR, boolean_type_node, var, end);
+      cond = fold_build2_loc (loc, lang_GNU_Fortran () ? GE_EXPR : GT_EXPR,
+			      boolean_type_node, var, end);
       tree neg = fold_build3_loc (loc, COND_EXPR, void_type_node, cond,
 				  build_and_jump (&beg_label), void_node);
       tree osteptype = TREE_TYPE (orig_step);
@@ -9870,6 +9883,11 @@ build_omp_iterator_loop (tree it, gimple_seq *pre_p, tree *last_bind)
       tem = fold_build3_loc (loc, COND_EXPR, void_type_node, cond, pos, neg);
       append_to_statement_list_force (tem, p);
       p = &BIND_EXPR_BODY (bind);
+      /* The Fortran front-end stashes statements into the BLOCK_SUBBLOCKS
+	 of the last element of the first iterator.  These should go into the
+	 body of the innermost loop.  */
+      if (!TREE_CHAIN (it))
+	append_to_statement_list_force (block_stmts, p);
     }
 
   return p;
@@ -10010,8 +10028,14 @@ remove_unused_omp_iterator_vars (tree *list_p)
 		  i++;
 		}
 	    }
+	  tree old_block = TREE_VEC_ELT (OMP_CLAUSE_ITERATORS (c), 5);
 	  tree new_block = make_node (BLOCK);
 	  BLOCK_VARS (new_block) = new_vars;
+	  if (BLOCK_SUBBLOCKS (old_block))
+	    {
+	      BLOCK_SUBBLOCKS (new_block) = BLOCK_SUBBLOCKS (old_block);
+	      BLOCK_SUBBLOCKS (old_block) = NULL_TREE;
+	    }
 	  TREE_VEC_ELT (new_iters, 5) = new_block;
 	  new_iterators.safe_push (new_iters);
 	  iter_vars.safe_push (vars.copy ());
@@ -10702,6 +10726,27 @@ build_omp_struct_comp_nodes (enum tree_code code, tree grp_start, tree grp_end,
   return c2;
 }
 
+/* Callback for walk_tree.  Return any VAR_DECLS found.  */
+
+static tree
+contains_vars_1 (tree* tp, int *, void *)
+{
+  tree t = *tp;
+
+  if (TREE_CODE (t) != VAR_DECL)
+    return NULL_TREE;
+
+  return t;
+}
+
+/* Return true if there are any variables present in EXPR.  */
+
+static bool
+contains_vars (tree expr)
+{
+  return walk_tree (&expr, contains_vars_1, NULL, NULL);
+}
+
 /* Strip ARRAY_REFS or an indirect ref off BASE, find the containing object,
    and set *BITPOSP and *POFFSETP to the bit offset of the access.
    If BASE_REF is non-NULL and the containing object is a reference, set
@@ -10712,7 +10757,8 @@ build_omp_struct_comp_nodes (enum tree_code code, tree grp_start, tree grp_end,
 static tree
 extract_base_bit_offset (tree base, poly_int64 *bitposp,
 			 poly_offset_int *poffsetp,
-			 bool *variable_offset)
+			 bool *variable_offset,
+			 tree iterator)
 {
   tree offset;
   poly_int64 bitsize, bitpos;
@@ -10722,6 +10768,19 @@ extract_base_bit_offset (tree base, poly_int64 *bitposp,
 
   STRIP_NOPS (base);
 
+  if (iterator)
+    {
+      /* Replace any iterator variables with constant zero.  This will give us
+	 the nominal offset and bit position of the first element, which is
+	 all we should need to lay out the mappings.  The actual locations
+	 of the iterated mappings are elsewhere.
+	 E.g. "array[i].field" gives "16" (say), not "i * 32 + 16".  */
+      tree it;
+      for (it = iterator; it; it = TREE_CHAIN (it))
+	base = simplify_replace_tree (base, TREE_VEC_ELT (it, 0),
+				      TREE_VEC_ELT (it, 1));
+    }
+
   base = get_inner_reference (base, &bitsize, &bitpos, &offset, &mode,
 			      &unsignedp, &reversep, &volatilep);
 
@@ -10736,6 +10795,8 @@ extract_base_bit_offset (tree base, poly_int64 *bitposp,
     {
       poffset = 0;
       *variable_offset = (offset != NULL_TREE);
+      if (iterator && *variable_offset)
+	*variable_offset = contains_vars (offset);
     }
 
   if (maybe_ne (bitpos, 0))
@@ -12527,8 +12588,11 @@ omp_accumulate_sibling_list (enum omp_region_type region_type,
     }
 
   bool variable_offset;
+  tree iterators = OMP_CLAUSE_HAS_ITERATORS (grp_end)
+		     ? OMP_CLAUSE_ITERATORS (grp_end) : NULL_TREE;
   tree base
-    = extract_base_bit_offset (ocd, &cbitpos, &coffset, &variable_offset);
+    = extract_base_bit_offset (ocd, &cbitpos, &coffset, &variable_offset,
+			       iterators);
 
   int base_token;
   for (base_token = addr_tokens.length () - 1; base_token >= 0; base_token--)
@@ -12861,8 +12925,12 @@ omp_accumulate_sibling_list (enum omp_region_type region_type,
 	      sc_decl = TREE_OPERAND (sc_decl, 0);
 
 	    bool variable_offset2;
+	    tree iterators2 = OMP_CLAUSE_HAS_ITERATORS (*sc)
+				? OMP_CLAUSE_ITERATORS (*sc) : NULL_TREE;
+
 	    tree base2 = extract_base_bit_offset (sc_decl, &bitpos, &offset,
-						  &variable_offset2);
+						  &variable_offset2,
+						  iterators2);
 	    if (!base2 || !operand_equal_p (base2, base, 0))
 	      break;
 	    if (scp)
diff --git a/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-1.f90 b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-1.f90
new file mode 100644
index 0000000..25abbaf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-1.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+program main
+  implicit none
+
+  integer, parameter :: DIM1 = 17
+  integer, parameter :: DIM2 = 39
+  type :: array_ptr
+    integer, pointer :: ptr(:)
+  end type
+  
+  type (array_ptr) :: x(DIM1), y(DIM1)
+
+  !$omp target map (iterator(i=1:DIM1), to: x(i)%ptr(:))
+  !$omp end target
+
+  !$omp target map (iterator(i=1:DIM1), to: x(i)%ptr(:), y(i)%ptr(:))
+  !$omp end target
+
+  !$omp target map (iterator(i=1:DIM1), to: x(i)%ptr(:) + 3) ! { dg-error "Syntax error in OpenMP variable list at .1." }
+  !$omp end target ! { dg-error "Unexpected \\\!\\\$OMP END TARGET statement at .1." }
+
+  !$omp target map(iterator(i=1:DIM1), iterator(j=1:DIM2), to: x(i)%ptr(j)) ! { dg-error "too many 'iterator' modifiers at .1." }
+  !$omp end target ! { dg-error "Unexpected \\\!\\\$OMP END TARGET statement at .1." }
+end program
diff --git a/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-2.f90 b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-2.f90
new file mode 100644
index 0000000..b4302aa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-2.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fdump-tree-gimple" }
+
+program main
+  implicit none
+
+  integer, parameter :: DIM = 40
+  type :: array_ptr
+    integer, pointer :: ptr(:)
+  end type
+  
+  type (array_ptr) :: x(DIM), y(DIM), z(DIM)
+
+  !$omp target map(iterator(i=1:10), to: x) ! { dg-warning "iterator variable .i. not used in clause expression" }
+    ! Add a reference to x to ensure that the 'to' clause does not get dropped.
+    x(1)%ptr(1) = 0
+  !$omp end target
+
+  !$omp target map(iterator(i2=1:10, j2=1:20), from: x(i2)) ! { dg-warning "iterator variable .j2. not used in clause expression" }
+  !$omp end target
+
+  !$omp target map(iterator(i3=1:10, j3=1:20, k3=1:30), to: x(i3+j3), y(j3+k3), z(k3+i3))
+  !$omp end target
+  ! { dg-warning "iterator variable .i3. not used in clause expression" "" { target *-*-* } .-2 }
+  ! { dg-warning "iterator variable .j3. not used in clause expression" "" { target *-*-* } .-3 }
+  ! { dg-warning "iterator variable .k3. not used in clause expression" "" { target *-*-* } .-4 }
+end program
+
+! { dg-final { scan-tree-dump-times "map\\\(to:x" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\\(iterator\\\(integer\\\(kind=4\\\) i2=1:10:1, loop_label=\[^\\\)\]+\\\):from:" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\\(iterator\\\(integer\\\(kind=4\\\) j3=1:20:1, integer\\\(kind=4\\\) i3=1:10:1, loop_label=\[^\\\)\]+\\\):to:" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\\(iterator\\\(integer\\\(kind=4\\\) k3=1:30:1, integer\\\(kind=4\\\) j3=1:20:1, loop_label=\[^\\\)\]+\\\):to:" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\\(iterator\\\(integer\\\(kind=4\\\) k3=1:30:1, integer\\\(kind=4\\\) i3=1:10:1, loop_label=\[^\\\)\]+\\\):to:" 1 "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-3.f90 b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-3.f90
new file mode 100644
index 0000000..7dad2a6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-3.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fdump-tree-gimple" }
+
+program main
+  implicit none
+
+  integer, parameter :: DIM1 = 17
+  integer, parameter :: DIM2 = 27
+  type :: ptr_t
+    integer, pointer :: ptr(:)
+  end type
+  
+  type (ptr_t) :: x(DIM1), y(DIM2)
+
+  !$omp target map(iterator(i=1:DIM1), to: x(i)%ptr(:)) map(iterator(i=1:DIM2), from: y(i)%ptr(:))
+  !$omp end target
+end program
+
+! { dg-final { scan-tree-dump-times "if \\(i <= 17\\) goto <D\\\.\[0-9\]+>; else goto <D\\\.\[0-9\]+>;" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "if \\(i <= 27\\) goto <D\\\.\[0-9\]+>; else goto <D\\\.\[0-9\]+>;" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\(iterator\\(integer\\(kind=4\\) i=1:17:1, loop_label=<D\\\.\[0-9\]+>, elems=omp_iter_data\\\.\[0-9\]+, index=D\\.\[0-9\]+\\):to:MEM <\[^>\]+> \\\[\\\(\[^ \]+ \\\*\\\)D\\\.\[0-9\]+\\\]" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\(iterator\\(integer\\(kind=4\\) i=1:27:1, loop_label=<D\\\.\[0-9\]+>, elems=omp_iter_data\\\.\[0-9\]+, index=D\\.\[0-9\]+\\):from:MEM <\[^>\]+> \\\[\\\(\[^ \]+ \\\*\\\)D\\\.\[0-9\]+\\\]" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\(iterator\\(integer\\(kind=4\\) i=1:17:1, loop_label=<D\\\.\[0-9\]+>, elems=omp_iter_data\\\.\[0-9\]+, index=D\\.\[0-9\]+\\):attach:x\\\[D\\\.\[0-9\]+\\\]\.ptr\.data" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\(iterator\\(integer\\(kind=4\\) i=1:27:1, loop_label=<D\\\.\[0-9\]+>, elems=omp_iter_data\\\.\[0-9\]+, index=D\\.\[0-9\]+\\):attach:y\\\[D\\\.\[0-9\]+\\\]\.ptr\.data" 1 "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-4.f90 b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-4.f90
new file mode 100644
index 0000000..804b686
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-4.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fdump-tree-gimple" }
+
+module m
+  !$omp declare target (baz)
+  interface
+    subroutine baz (x, p)
+      integer, intent(in) :: x
+      integer, pointer :: p(:)
+    end subroutine
+    integer function bar (x, i)
+      integer :: x, i
+    end function
+  end interface
+contains
+  subroutine foo (x, p)
+    integer :: x
+    integer, pointer :: p(:)
+
+    !$omp target map (iterator (i=1:4), to: p(bar (x, i)))
+      ! FIXME: These warnings are due to implicit clauses generated that do
+      ! not use the iterator variable i.
+      ! { dg-warning "iterator variable .i. not used in clause expression" "" { target *-*-* } .-3 }
+      call baz (x, p)
+    !$omp end target
+  end subroutine
+end module
+
+! { dg-final { scan-tree-dump "firstprivate\\\(x\\\)" "gimple" } }
+! { dg-final { scan-tree-dump-times "bar \\\(x, &" 2 "gimple" } }
+! { dg-final { scan-tree-dump "map\\\(iterator\\\(integer\\\(kind=4\\\) i=1:4:1, loop_label=" "gimple" } }
diff --git a/gcc/tree-pretty-print.cc b/gcc/tree-pretty-print.cc
index 6f0978a..79e212c 100644
--- a/gcc/tree-pretty-print.cc
+++ b/gcc/tree-pretty-print.cc
@@ -1884,7 +1884,9 @@ dump_block_node (pretty_printer *pp, tree block, int spc, dump_flags_t flags)
       newline_and_indent (pp, spc + 2);
     }
 
-  if (BLOCK_SUBBLOCKS (block))
+  if (BLOCK_SUBBLOCKS (block)
+      && (!lang_GNU_Fortran ()
+	  || TREE_CODE (BLOCK_SUBBLOCKS (block)) != STATEMENT_LIST))
     {
       pp_string (pp, "SUBBLOCKS: ");
       for (t = BLOCK_SUBBLOCKS (block); t; t = BLOCK_CHAIN (t))