Merge branch 'master' into devel/sphinx

1 files changed, 187 insertions, 3 deletions

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 1e22cdb..f466ab6 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -1639,6 +1639,9 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc)
     OMP_CLAUSE_SIZE (c)
       = DECL_P (decl) ? DECL_SIZE_UNIT (decl)
 		      : TYPE_SIZE_UNIT (TREE_TYPE (decl));
+  if (gimplify_expr (&OMP_CLAUSE_SIZE (c), pre_p,
+		     NULL, is_gimple_val, fb_rvalue) == GS_ERROR)
+    OMP_CLAUSE_SIZE (c) = size_int (0);
   if (c2)
     {
       OMP_CLAUSE_CHAIN (c2) = OMP_CLAUSE_CHAIN (last);
@@ -5358,6 +5361,147 @@ enum
   GFC_OMP_MASK_TASKLOOP = (1 << GFC_OMP_SPLIT_TASKLOOP)
 };
 
+/* If a var is in lastprivate/firstprivate/reduction but not in a
+   data mapping/sharing clause, add it to 'map(tofrom:' if is_target
+   and to 'shared' otherwise.  */
+static void
+gfc_add_clause_implicitly (gfc_omp_clauses *clauses_out,
+			   gfc_omp_clauses *clauses_in,
+			   bool is_target, bool is_parallel_do)
+{
+  int clauselist_to_add = is_target ? OMP_LIST_MAP : OMP_LIST_SHARED;
+  gfc_omp_namelist *tail = NULL;
+  for (int i = 0; i < 5; ++i)
+    {
+      gfc_omp_namelist *n;
+      switch (i)
+	{
+	case 0: n = clauses_in->lists[OMP_LIST_FIRSTPRIVATE]; break;
+	case 1: n = clauses_in->lists[OMP_LIST_LASTPRIVATE]; break;
+	case 2: n = clauses_in->lists[OMP_LIST_REDUCTION]; break;
+	case 3: n = clauses_in->lists[OMP_LIST_REDUCTION_INSCAN]; break;
+	case 4: n = clauses_in->lists[OMP_LIST_REDUCTION_TASK]; break;
+	default: gcc_unreachable ();
+	}
+      for (; n != NULL; n = n->next)
+	{
+	  gfc_omp_namelist *n2, **n_firstp = NULL, **n_lastp = NULL;
+	  for (int j = 0; j < 6; ++j)
+	    {
+	      gfc_omp_namelist **n2ref = NULL, *prev2 = NULL;
+	      switch (j)
+		{
+		case 0:
+		  n2ref = &clauses_out->lists[clauselist_to_add];
+		  break;
+		case 1:
+		  n2ref = &clauses_out->lists[OMP_LIST_FIRSTPRIVATE];
+		  break;
+		case 2:
+		  if (is_target)
+		    n2ref = &clauses_in->lists[OMP_LIST_LASTPRIVATE];
+		  else
+		    n2ref = &clauses_out->lists[OMP_LIST_LASTPRIVATE];
+		  break;
+		case 3: n2ref = &clauses_out->lists[OMP_LIST_REDUCTION]; break;
+		case 4:
+		  n2ref = &clauses_out->lists[OMP_LIST_REDUCTION_INSCAN];
+		  break;
+		case 5:
+		  n2ref = &clauses_out->lists[OMP_LIST_REDUCTION_TASK];
+		  break;
+		default: gcc_unreachable ();
+		}
+	      for (n2 = *n2ref; n2 != NULL; prev2 = n2, n2 = n2->next)
+		if (n2->sym == n->sym)
+		  break;
+	      if (n2)
+		{
+		  if (j == 0 /* clauselist_to_add */)
+		    break;  /* Already present.  */
+		  if (j == 1 /* OMP_LIST_FIRSTPRIVATE */)
+		    {
+		      n_firstp = prev2 ? &prev2->next : n2ref;
+		      continue;
+		    }
+		  if (j == 2 /* OMP_LIST_LASTPRIVATE */)
+		    {
+		      n_lastp = prev2 ? &prev2->next : n2ref;
+		      continue;
+		    }
+		  break;
+		}
+	    }
+	  if (n_firstp && n_lastp)
+	    {
+	      /* For parallel do, GCC puts firstprivatee/lastprivate
+		 on the parallel.  */
+	      if (is_parallel_do)
+		continue;
+	      *n_firstp = (*n_firstp)->next;
+	      if (!is_target)
+		*n_lastp = (*n_lastp)->next;
+	    }
+	  else if (is_target && n_lastp)
+	    ;
+	  else if (n2 || n_firstp || n_lastp)
+	    continue;
+	  if (clauses_out->lists[clauselist_to_add]
+	      && (clauses_out->lists[clauselist_to_add]
+		  == clauses_in->lists[clauselist_to_add]))
+	    {
+	      gfc_omp_namelist *p = NULL;
+	      for (n2 = clauses_in->lists[clauselist_to_add]; n2; n2 = n2->next)
+		{
+		  if (p)
+		    {
+		      p->next = gfc_get_omp_namelist ();
+		      p = p->next;
+		    }
+		  else
+		    {
+		      p = gfc_get_omp_namelist ();
+		      clauses_out->lists[clauselist_to_add] = p;
+		    }
+		  *p = *n2;
+		}
+	    }
+	  if (!tail)
+	    {
+	      tail = clauses_out->lists[clauselist_to_add];
+	      for (; tail && tail->next; tail = tail->next)
+		;
+	    }
+	  n2 = gfc_get_omp_namelist ();
+	  n2->where = n->where;
+	  n2->sym = n->sym;
+	  if (is_target)
+	    n2->u.map_op = OMP_MAP_TOFROM;
+	  if (tail)
+	    {
+	      tail->next = n2;
+	      tail = n2;
+	    }
+	  else
+	    clauses_out->lists[clauselist_to_add] = n2;
+	}
+    }
+}
+
+static void
+gfc_free_split_omp_clauses (gfc_code *code, gfc_omp_clauses *clausesa)
+{
+  for (int i = 0; i < GFC_OMP_SPLIT_NUM; ++i)
+    for (int j = 0; j < OMP_LIST_NUM; ++j)
+      if (clausesa[i].lists[j] && clausesa[i].lists[j] != code->ext.omp_clauses->lists[j])
+	for (gfc_omp_namelist *n = clausesa[i].lists[j]; n;)
+	  {
+	    gfc_omp_namelist *p = n;
+	    n = n->next;
+	    free (p);
+	  }
+}
+
 static void
 gfc_split_omp_clauses (gfc_code *code,
 		       gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM])
@@ -5689,7 +5833,8 @@ gfc_split_omp_clauses (gfc_code *code,
       if (mask & GFC_OMP_MASK_TASKLOOP)
 	clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_FIRSTPRIVATE]
 	  = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
-      if (mask & GFC_OMP_MASK_PARALLEL)
+      if ((mask & GFC_OMP_MASK_PARALLEL)
+	  && !(mask & GFC_OMP_MASK_TASKLOOP))
 	clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_FIRSTPRIVATE]
 	  = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
       else if ((mask & GFC_OMP_MASK_DO) && !is_loop)
@@ -5704,7 +5849,8 @@ gfc_split_omp_clauses (gfc_code *code,
       if (mask & GFC_OMP_MASK_TASKLOOP)
 	clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_LASTPRIVATE]
 	  = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
-      if ((mask & GFC_OMP_MASK_PARALLEL) && !is_loop)
+      if ((mask & GFC_OMP_MASK_PARALLEL) && !is_loop
+	  && !(mask & GFC_OMP_MASK_TASKLOOP))
 	clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_LASTPRIVATE]
 	  = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
       else if (mask & GFC_OMP_MASK_DO)
@@ -5731,6 +5877,7 @@ gfc_split_omp_clauses (gfc_code *code,
 	      = code->ext.omp_clauses->lists[i];
 	  if (mask & GFC_OMP_MASK_PARALLEL
 	      && i != OMP_LIST_REDUCTION_INSCAN
+	      && !(mask & GFC_OMP_MASK_TASKLOOP)
 	      && !is_loop)
 	    clausesa[GFC_OMP_SPLIT_PARALLEL].lists[i]
 	      = code->ext.omp_clauses->lists[i];
@@ -5752,6 +5899,18 @@ gfc_split_omp_clauses (gfc_code *code,
       clausesa[innermost].lists[OMP_LIST_LINEAR]
 	= code->ext.omp_clauses->lists[OMP_LIST_LINEAR];
     }
+   /* Propagate firstprivate/lastprivate/reduction vars to
+      shared (parallel, teams) and map-tofrom (target).  */
+   if (mask & GFC_OMP_MASK_TARGET)
+     gfc_add_clause_implicitly (&clausesa[GFC_OMP_SPLIT_TARGET],
+				code->ext.omp_clauses, true, false);
+   if ((mask & GFC_OMP_MASK_PARALLEL) && innermost != GFC_OMP_MASK_PARALLEL)
+     gfc_add_clause_implicitly (&clausesa[GFC_OMP_SPLIT_PARALLEL],
+				code->ext.omp_clauses, false,
+				mask & GFC_OMP_MASK_DO);
+   if (mask & GFC_OMP_MASK_TEAMS && innermost != GFC_OMP_MASK_TEAMS)
+     gfc_add_clause_implicitly (&clausesa[GFC_OMP_SPLIT_TEAMS],
+				code->ext.omp_clauses, false, false);
    if (((mask & (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO))
 	== (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO))
        && !is_loop)
@@ -5765,6 +5924,7 @@ gfc_trans_omp_do_simd (gfc_code *code, stmtblock_t *pblock,
   stmtblock_t block;
   gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
   tree stmt, body, omp_do_clauses = NULL_TREE;
+  bool free_clausesa = false;
 
   if (pblock == NULL)
     gfc_start_block (&block);
@@ -5775,6 +5935,7 @@ gfc_trans_omp_do_simd (gfc_code *code, stmtblock_t *pblock,
     {
       clausesa = clausesa_buf;
       gfc_split_omp_clauses (code, clausesa);
+      free_clausesa = true;
     }
   if (flag_openmp)
     omp_do_clauses
@@ -5800,6 +5961,8 @@ gfc_trans_omp_do_simd (gfc_code *code, stmtblock_t *pblock,
   else
     stmt = body;
   gfc_add_expr_to_block (&block, stmt);
+  if (free_clausesa)
+    gfc_free_split_omp_clauses (code, clausesa);
   return gfc_finish_block (&block);
 }
 
@@ -5810,6 +5973,7 @@ gfc_trans_omp_parallel_do (gfc_code *code, bool is_loop, stmtblock_t *pblock,
   stmtblock_t block, *new_pblock = pblock;
   gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
   tree stmt, omp_clauses = NULL_TREE;
+  bool free_clausesa = false;
 
   if (pblock == NULL)
     gfc_start_block (&block);
@@ -5820,6 +5984,7 @@ gfc_trans_omp_parallel_do (gfc_code *code, bool is_loop, stmtblock_t *pblock,
     {
       clausesa = clausesa_buf;
       gfc_split_omp_clauses (code, clausesa);
+      free_clausesa = true;
     }
   omp_clauses
     = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_PARALLEL],
@@ -5848,6 +6013,8 @@ gfc_trans_omp_parallel_do (gfc_code *code, bool is_loop, stmtblock_t *pblock,
 		     void_type_node, stmt, omp_clauses);
   OMP_PARALLEL_COMBINED (stmt) = 1;
   gfc_add_expr_to_block (&block, stmt);
+  if (free_clausesa)
+    gfc_free_split_omp_clauses (code, clausesa);
   return gfc_finish_block (&block);
 }
 
@@ -5858,6 +6025,7 @@ gfc_trans_omp_parallel_do_simd (gfc_code *code, stmtblock_t *pblock,
   stmtblock_t block;
   gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
   tree stmt, omp_clauses = NULL_TREE;
+  bool free_clausesa = false;
 
   if (pblock == NULL)
     gfc_start_block (&block);
@@ -5868,6 +6036,7 @@ gfc_trans_omp_parallel_do_simd (gfc_code *code, stmtblock_t *pblock,
     {
       clausesa = clausesa_buf;
       gfc_split_omp_clauses (code, clausesa);
+      free_clausesa = true;
     }
   if (flag_openmp)
     omp_clauses
@@ -5892,6 +6061,8 @@ gfc_trans_omp_parallel_do_simd (gfc_code *code, stmtblock_t *pblock,
       OMP_PARALLEL_COMBINED (stmt) = 1;
     }
   gfc_add_expr_to_block (&block, stmt);
+  if (free_clausesa)
+    gfc_free_split_omp_clauses (code, clausesa);
   return gfc_finish_block (&block);
 }
 
@@ -6049,12 +6220,14 @@ gfc_trans_omp_distribute (gfc_code *code, gfc_omp_clauses *clausesa)
   stmtblock_t block;
   gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
   tree stmt, omp_clauses = NULL_TREE;
+  bool free_clausesa = false;
 
   gfc_start_block (&block);
   if (clausesa == NULL)
     {
       clausesa = clausesa_buf;
       gfc_split_omp_clauses (code, clausesa);
+      free_clausesa = true;
     }
   if (flag_openmp)
     omp_clauses
@@ -6108,6 +6281,8 @@ gfc_trans_omp_distribute (gfc_code *code, gfc_omp_clauses *clausesa)
       stmt = distribute;
     }
   gfc_add_expr_to_block (&block, stmt);
+  if (free_clausesa)
+    gfc_free_split_omp_clauses (code, clausesa);
   return gfc_finish_block (&block);
 }
 
@@ -6118,13 +6293,14 @@ gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa,
   stmtblock_t block;
   gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
   tree stmt;
-  bool combined = true;
+  bool combined = true, free_clausesa = false;
 
   gfc_start_block (&block);
   if (clausesa == NULL)
     {
       clausesa = clausesa_buf;
       gfc_split_omp_clauses (code, clausesa);
+      free_clausesa = true;
     }
   if (flag_openmp)
     {
@@ -6167,6 +6343,8 @@ gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa,
 	OMP_TEAMS_COMBINED (stmt) = 1;
     }
   gfc_add_expr_to_block (&block, stmt);
+  if (free_clausesa)
+    gfc_free_split_omp_clauses (code, clausesa);
   return gfc_finish_block (&block);
 }
 
@@ -6276,6 +6454,7 @@ gfc_trans_omp_target (gfc_code *code)
       cfun->has_omp_target = true;
     }
   gfc_add_expr_to_block (&block, stmt);
+  gfc_free_split_omp_clauses (code, clausesa);
   return gfc_finish_block (&block);
 }
 
@@ -6318,6 +6497,7 @@ gfc_trans_omp_taskloop (gfc_code *code, gfc_exec_op op)
       stmt = taskloop;
     }
   gfc_add_expr_to_block (&block, stmt);
+  gfc_free_split_omp_clauses (code, clausesa);
   return gfc_finish_block (&block);
 }
 
@@ -6341,6 +6521,8 @@ gfc_trans_omp_master_taskloop (gfc_code *code, gfc_exec_op op)
 			       op != code->op
 			       ? &clausesa[GFC_OMP_SPLIT_TASKLOOP]
 			       : code->ext.omp_clauses, NULL);
+      if (op != code->op)
+	gfc_free_split_omp_clauses (code, clausesa);
     }
   if (TREE_CODE (stmt) != BIND_EXPR)
     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
@@ -6367,6 +6549,8 @@ gfc_trans_omp_parallel_master (gfc_code *code)
 				       ? code->ext.omp_clauses
 				       : &clausesa[GFC_OMP_SPLIT_PARALLEL],
 				       code->loc);
+  if (code->op != EXEC_OMP_PARALLEL_MASTER)
+    gfc_free_split_omp_clauses (code, clausesa);
   pushlevel ();
   if (code->op == EXEC_OMP_PARALLEL_MASTER)
     stmt = gfc_trans_omp_master (code);