PR90030 "Fortran OpenACC subarray data alignment" (was: [PATCH] Fortran OpenMP 4.0 target support)

Thomas Schwinge thomas@codesourcery.com
Wed May 29 14:42:00 GMT 2019


Hi Jakub!

Any comments on this, please?

On Wed, 10 Apr 2019 15:00:06 +0200, I wrote:
> In context of PR90030 "Fortran OpenACC subarray data alignment" (which
> actually is reproducible for OpenMP with nvptx offloading in the very
> same way, see below), can you please explain the reason for the seven
> "[var] = fold_convert (build_pointer_type (char_type_node), [var])"
> instances that you've added as part of your 2014 trunk r211768 "Fortran
> OpenMP 4.0 target support" commit?
> 
> Replacing all these with "gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)))"
> (see the attached WIP patch, which also includes an OpenMP test case), I
> don't see any ill effects for 'check-gcc-fortran', and
> 'check-target-libgomp' with nvptx offloading, and the errors 'libgomp:
> cuStreamSynchronize error: misaligned address' are gone.  I added these
> 'gcc_assert's just for checking; Cesar in
> <https://gcc.gnu.org/ml/gcc-patches/2015-09/msg01664.html>, and Julian in
> <https://gcc.gnu.org/ml/gcc-patches/2018-08/msg01911.html> propose to
> simply drop (a subset of) these casts.  Do we need (a) all, (b) some, (c)
> none of these casts?  And do we want to replace them with 'gcc_assert's,
> or not do that?
> 
> If approving such a patch (for all release branches), please respond with
> "Reviewed-by: NAME <EMAIL>" so that your effort will be recorded in the
> commit log, see <https://gcc.gnu.org/wiki/Reviewed-by>.
> 
> For reference, see the seven 'char_type_node' instances:
> 
> On Tue, 17 Jun 2014 23:03:47 +0200, Jakub Jelinek <jakub@redhat.com> wrote:
> > --- gcc/fortran/trans-openmp.c.jj	2014-06-16 10:06:39.164099047 +0200
> > +++ gcc/fortran/trans-openmp.c	2014-06-17 19:32:58.939176877 +0200
> > @@ -873,6 +873,110 @@ gfc_omp_clause_dtor (tree clause, tree d
> >  }
> >  
> >  
> > +void
> > +gfc_omp_finish_clause (tree c, gimple_seq *pre_p)
> > +{
> > +  if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_MAP)
> > +    return;
> > +
> > +  tree decl = OMP_CLAUSE_DECL (c);
> > +  tree c2 = NULL_TREE, c3 = NULL_TREE, c4 = NULL_TREE;
> > +  if (POINTER_TYPE_P (TREE_TYPE (decl)))
> > +    {
> > +      if (!gfc_omp_privatize_by_reference (decl)
> > +	  && !GFC_DECL_GET_SCALAR_POINTER (decl)
> > +	  && !GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
> > +	  && !GFC_DECL_CRAY_POINTEE (decl)
> > +	  && !GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (decl))))
> > +	return;
> > +      c4 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP);
> > +      OMP_CLAUSE_MAP_KIND (c4) = OMP_CLAUSE_MAP_POINTER;
> > +      OMP_CLAUSE_DECL (c4) = decl;
> > +      OMP_CLAUSE_SIZE (c4) = size_int (0);
> > +      decl = build_fold_indirect_ref (decl);
> > +      OMP_CLAUSE_DECL (c) = decl;
> > +    }
> > +  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
> > +    {
> > +      stmtblock_t block;
> > +      gfc_start_block (&block);
> > +      tree type = TREE_TYPE (decl);
> > +      tree ptr = gfc_conv_descriptor_data_get (decl);
> > +      ptr = fold_convert (build_pointer_type (char_type_node), ptr);
> > +      ptr = build_fold_indirect_ref (ptr);
> > +      OMP_CLAUSE_DECL (c) = ptr;
> > +      c2 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
> > +      OMP_CLAUSE_MAP_KIND (c2) = OMP_CLAUSE_MAP_TO_PSET;
> > +      OMP_CLAUSE_DECL (c2) = decl;
> > +      OMP_CLAUSE_SIZE (c2) = TYPE_SIZE_UNIT (type);
> > +      c3 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP);
> > +      OMP_CLAUSE_MAP_KIND (c3) = OMP_CLAUSE_MAP_POINTER;
> > +      OMP_CLAUSE_DECL (c3) = gfc_conv_descriptor_data_get (decl);
> > +      OMP_CLAUSE_SIZE (c3) = size_int (0);
> > +      tree size = create_tmp_var (gfc_array_index_type, NULL);
> > +      tree elemsz = TYPE_SIZE_UNIT (gfc_get_element_type (type));
> > +      elemsz = fold_convert (gfc_array_index_type, elemsz);
> > +      if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER
> > +	  || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT)
> > +	{
> > +	  stmtblock_t cond_block;
> > +	  tree tem, then_b, else_b, zero, cond;
> > +
> > +	  gfc_init_block (&cond_block);
> > +	  tem = gfc_full_array_size (&cond_block, decl,
> > +				     GFC_TYPE_ARRAY_RANK (type));
> > +	  gfc_add_modify (&cond_block, size, tem);
> > +	  gfc_add_modify (&cond_block, size,
> > +			  fold_build2 (MULT_EXPR, gfc_array_index_type,
> > +				       size, elemsz));
> > +	  then_b = gfc_finish_block (&cond_block);
> > +	  gfc_init_block (&cond_block);
> > +	  zero = build_int_cst (gfc_array_index_type, 0);
> > +	  gfc_add_modify (&cond_block, size, zero);
> > +	  else_b = gfc_finish_block (&cond_block);
> > +	  tem = gfc_conv_descriptor_data_get (decl);
> > +	  tem = fold_convert (pvoid_type_node, tem);
> > +	  cond = fold_build2_loc (input_location, NE_EXPR,
> > +				  boolean_type_node, tem, null_pointer_node);
> > +	  gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR,
> > +						     void_type_node, cond,
> > +						     then_b, else_b));
> > +	}
> > +      else
> > +	{
> > +	  gfc_add_modify (&block, size,
> > +			  gfc_full_array_size (&block, decl,
> > +					       GFC_TYPE_ARRAY_RANK (type)));
> > +	  gfc_add_modify (&block, size,
> > +			  fold_build2 (MULT_EXPR, gfc_array_index_type,
> > +				       size, elemsz));
> > +	}
> > +      OMP_CLAUSE_SIZE (c) = size;
> > +      tree stmt = gfc_finish_block (&block);
> > +      gimplify_and_add (stmt, pre_p);
> > +    }
> > +  tree last = c;
> > +  if (c2)
> > +    {
> > +      OMP_CLAUSE_CHAIN (c2) = OMP_CLAUSE_CHAIN (last);
> > +      OMP_CLAUSE_CHAIN (last) = c2;
> > +      last = c2;
> > +    }
> > +  if (c3)
> > +    {
> > +      OMP_CLAUSE_CHAIN (c3) = OMP_CLAUSE_CHAIN (last);
> > +      OMP_CLAUSE_CHAIN (last) = c3;
> > +      last = c3;
> > +    }
> > +  if (c4)
> > +    {
> > +      OMP_CLAUSE_CHAIN (c4) = OMP_CLAUSE_CHAIN (last);
> > +      OMP_CLAUSE_CHAIN (last) = c4;
> > +      last = c4;
> > +    }
> > +}
> > +
> > +
> >  /* Return true if DECL's DECL_VALUE_EXPR (if any) should be
> >     disregarded in OpenMP construct, because it is going to be
> >     remapped during OpenMP lowering.  SHARED is true if DECL
> > @@ -1487,7 +1591,7 @@ gfc_trans_omp_reduction_list (gfc_omp_na
> >  	    tree node = build_omp_clause (where.lb->location,
> >  					  OMP_CLAUSE_REDUCTION);
> >  	    OMP_CLAUSE_DECL (node) = t;
> > -	    switch (namelist->rop)
> > +	    switch (namelist->u.reduction_op)
> >  	      {
> >  	      case OMP_REDUCTION_PLUS:
> >  		OMP_CLAUSE_REDUCTION_CODE (node) = PLUS_EXPR;
> > @@ -1532,7 +1636,7 @@ gfc_trans_omp_reduction_list (gfc_omp_na
> >  		gcc_unreachable ();
> >  	      }
> >  	    if (namelist->sym->attr.dimension
> > -		|| namelist->rop == OMP_REDUCTION_USER
> > +		|| namelist->u.reduction_op == OMP_REDUCTION_USER
> >  		|| namelist->sym->attr.allocatable)
> >  	      gfc_trans_omp_array_reduction_or_udr (node, namelist, where);
> >  	    list = gfc_trans_add_clause (node, list);
> > @@ -1661,8 +1765,7 @@ gfc_trans_omp_clauses (stmtblock_t *bloc
> >  	      }
> >  	  }
> >  	  break;
> > -	case OMP_LIST_DEPEND_IN:
> > -	case OMP_LIST_DEPEND_OUT:
> > +	case OMP_LIST_DEPEND:
> >  	  for (; n != NULL; n = n->next)
> >  	    {
> >  	      if (!n->sym->attr.referenced)
> > @@ -1671,9 +1774,19 @@ gfc_trans_omp_clauses (stmtblock_t *bloc
> >  	      tree node = build_omp_clause (input_location, OMP_CLAUSE_DEPEND);
> >  	      if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
> >  		{
> > -		  OMP_CLAUSE_DECL (node) = gfc_get_symbol_decl (n->sym);
> > -		  if (DECL_P (OMP_CLAUSE_DECL (node)))
> > -		    TREE_ADDRESSABLE (OMP_CLAUSE_DECL (node)) = 1;
> > +		  tree decl = gfc_get_symbol_decl (n->sym);
> > +		  if (gfc_omp_privatize_by_reference (decl))
> > +		    decl = build_fold_indirect_ref (decl);
> > +		  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
> > +		    {
> > +		      decl = gfc_conv_descriptor_data_get (decl);
> > +		      decl = fold_convert (build_pointer_type (char_type_node),
> > +					   decl);
> > +		      decl = build_fold_indirect_ref (decl);
> > +		    }
> > +		  else if (DECL_P (decl))
> > +		    TREE_ADDRESSABLE (decl) = 1;
> > +		  OMP_CLAUSE_DECL (node) = decl;
> >  		}
> >  	      else
> >  		{
> > @@ -1691,13 +1804,286 @@ gfc_trans_omp_clauses (stmtblock_t *bloc
> >  		    }
> >  		  gfc_add_block_to_block (block, &se.pre);
> >  		  gfc_add_block_to_block (block, &se.post);
> > -		  OMP_CLAUSE_DECL (node)
> > -		    = fold_build1_loc (input_location, INDIRECT_REF,
> > -				       TREE_TYPE (TREE_TYPE (ptr)), ptr);
> > +		  ptr = fold_convert (build_pointer_type (char_type_node),
> > +				      ptr);
> > +		  OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
> > +		}
> > +	      switch (n->u.depend_op)
> > +		{
> > +		case OMP_DEPEND_IN:
> > +		  OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_IN;
> > +		  break;
> > +		case OMP_DEPEND_OUT:
> > +		  OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_OUT;
> > +		  break;
> > +		case OMP_DEPEND_INOUT:
> > +		  OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_INOUT;
> > +		  break;
> > +		default:
> > +		  gcc_unreachable ();
> > +		}
> > +	      omp_clauses = gfc_trans_add_clause (node, omp_clauses);
> > +	    }
> > +	  break;
> > +	case OMP_LIST_MAP:
> > +	  for (; n != NULL; n = n->next)
> > +	    {
> > +	      if (!n->sym->attr.referenced)
> > +		continue;
> > +
> > +	      tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP);
> > +	      tree node2 = NULL_TREE;
> > +	      tree node3 = NULL_TREE;
> > +	      tree node4 = NULL_TREE;
> > +	      tree decl = gfc_get_symbol_decl (n->sym);
> > +	      if (DECL_P (decl))
> > +		TREE_ADDRESSABLE (decl) = 1;
> > +	      if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
> > +		{
> > +		  if (POINTER_TYPE_P (TREE_TYPE (decl)))
> > +		    {
> > +		      node4 = build_omp_clause (input_location,
> > +						OMP_CLAUSE_MAP);
> > +		      OMP_CLAUSE_MAP_KIND (node4) = OMP_CLAUSE_MAP_POINTER;
> > +		      OMP_CLAUSE_DECL (node4) = decl;
> > +		      OMP_CLAUSE_SIZE (node4) = size_int (0);
> > +		      decl = build_fold_indirect_ref (decl);
> > +		    }
> > +		  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
> > +		    {
> > +		      tree type = TREE_TYPE (decl);
> > +		      tree ptr = gfc_conv_descriptor_data_get (decl);
> > +		      ptr = fold_convert (build_pointer_type (char_type_node),
> > +					  ptr);
> > +		      ptr = build_fold_indirect_ref (ptr);
> > +		      OMP_CLAUSE_DECL (node) = ptr;
> > +		      node2 = build_omp_clause (input_location,
> > +						OMP_CLAUSE_MAP);
> > +		      OMP_CLAUSE_MAP_KIND (node2) = OMP_CLAUSE_MAP_TO_PSET;
> > +		      OMP_CLAUSE_DECL (node2) = decl;
> > +		      OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type);
> > +		      node3 = build_omp_clause (input_location,
> > +						OMP_CLAUSE_MAP);
> > +		      OMP_CLAUSE_MAP_KIND (node3) = OMP_CLAUSE_MAP_POINTER;
> > +		      OMP_CLAUSE_DECL (node3)
> > +			= gfc_conv_descriptor_data_get (decl);
> > +		      OMP_CLAUSE_SIZE (node3) = size_int (0);
> > +		      if (n->sym->attr.pointer)
> > +			{
> > +			  stmtblock_t cond_block;
> > +			  tree size
> > +			    = gfc_create_var (gfc_array_index_type, NULL);
> > +			  tree tem, then_b, else_b, zero, cond;
> > +
> > +			  gfc_init_block (&cond_block);
> > +			  tem
> > +			    = gfc_full_array_size (&cond_block, decl,
> > +						   GFC_TYPE_ARRAY_RANK (type));
> > +			  gfc_add_modify (&cond_block, size, tem);
> > +			  then_b = gfc_finish_block (&cond_block);
> > +			  gfc_init_block (&cond_block);
> > +			  zero = build_int_cst (gfc_array_index_type, 0);
> > +			  gfc_add_modify (&cond_block, size, zero);
> > +			  else_b = gfc_finish_block (&cond_block);
> > +			  tem = gfc_conv_descriptor_data_get (decl);
> > +			  tem = fold_convert (pvoid_type_node, tem);
> > +			  cond = fold_build2_loc (input_location, NE_EXPR,
> > +						  boolean_type_node,
> > +						  tem, null_pointer_node);
> > +			  gfc_add_expr_to_block (block,
> > +						 build3_loc (input_location,
> > +							     COND_EXPR,
> > +							     void_type_node,
> > +							     cond, then_b,
> > +							     else_b));
> > +			  OMP_CLAUSE_SIZE (node) = size;
> > +			}
> > +		      else
> > +			OMP_CLAUSE_SIZE (node)
> > +			  = gfc_full_array_size (block, decl,
> > +						 GFC_TYPE_ARRAY_RANK (type));
> > +		      tree elemsz
> > +			= TYPE_SIZE_UNIT (gfc_get_element_type (type));
> > +		      elemsz = fold_convert (gfc_array_index_type, elemsz);
> > +		      OMP_CLAUSE_SIZE (node)
> > +			= fold_build2 (MULT_EXPR, gfc_array_index_type,
> > +				       OMP_CLAUSE_SIZE (node), elemsz);
> > +		    }
> > +		  else
> > +		    OMP_CLAUSE_DECL (node) = decl;
> > +		}
> > +	      else
> > +		{
> > +		  tree ptr, ptr2;
> > +		  gfc_init_se (&se, NULL);
> > +		  if (n->expr->ref->u.ar.type == AR_ELEMENT)
> > +		    {
> > +		      gfc_conv_expr_reference (&se, n->expr);
> > +		      gfc_add_block_to_block (block, &se.pre);
> > +		      ptr = se.expr;
> > +		      OMP_CLAUSE_SIZE (node)
> > +			= TYPE_SIZE_UNIT (TREE_TYPE (ptr));
> > +		    }
> > +		  else
> > +		    {
> > +		      gfc_conv_expr_descriptor (&se, n->expr);
> > +		      ptr = gfc_conv_array_data (se.expr);
> > +		      tree type = TREE_TYPE (se.expr);
> > +		      gfc_add_block_to_block (block, &se.pre);
> > +		      OMP_CLAUSE_SIZE (node)
> > +			= gfc_full_array_size (block, se.expr,
> > +					       GFC_TYPE_ARRAY_RANK (type));
> > +		      tree elemsz
> > +			= TYPE_SIZE_UNIT (gfc_get_element_type (type));
> > +		      elemsz = fold_convert (gfc_array_index_type, elemsz);
> > +		      OMP_CLAUSE_SIZE (node)
> > +			= fold_build2 (MULT_EXPR, gfc_array_index_type,
> > +				       OMP_CLAUSE_SIZE (node), elemsz);
> > +		    }
> > +		  gfc_add_block_to_block (block, &se.post);
> > +		  ptr = fold_convert (build_pointer_type (char_type_node),
> > +				      ptr);
> > +		  OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
> > +
> > +		  if (POINTER_TYPE_P (TREE_TYPE (decl))
> > +		      && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (decl))))
> > +		    {
> > +		      node4 = build_omp_clause (input_location,
> > +						OMP_CLAUSE_MAP);
> > +		      OMP_CLAUSE_MAP_KIND (node4) = OMP_CLAUSE_MAP_POINTER;
> > +		      OMP_CLAUSE_DECL (node4) = decl;
> > +		      OMP_CLAUSE_SIZE (node4) = size_int (0);
> > +		      decl = build_fold_indirect_ref (decl);
> > +		    }
> > +		  ptr = fold_convert (sizetype, ptr);
> > +		  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
> > +		    {
> > +		      tree type = TREE_TYPE (decl);
> > +		      ptr2 = gfc_conv_descriptor_data_get (decl);
> > +		      node2 = build_omp_clause (input_location,
> > +						OMP_CLAUSE_MAP);
> > +		      OMP_CLAUSE_MAP_KIND (node2) = OMP_CLAUSE_MAP_TO_PSET;
> > +		      OMP_CLAUSE_DECL (node2) = decl;
> > +		      OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type);
> > +		      node3 = build_omp_clause (input_location,
> > +						OMP_CLAUSE_MAP);
> > +		      OMP_CLAUSE_MAP_KIND (node3) = OMP_CLAUSE_MAP_POINTER;
> > +		      OMP_CLAUSE_DECL (node3)
> > +			= gfc_conv_descriptor_data_get (decl);
> > +		    }
> > +		  else
> > +		    {
> > +		      if (TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE)
> > +			ptr2 = build_fold_addr_expr (decl);
> > +		      else
> > +			{
> > +			  gcc_assert (POINTER_TYPE_P (TREE_TYPE (decl)));
> > +			  ptr2 = decl;
> > +			}
> > +		      node3 = build_omp_clause (input_location,
> > +						OMP_CLAUSE_MAP);
> > +		      OMP_CLAUSE_MAP_KIND (node3) = OMP_CLAUSE_MAP_POINTER;
> > +		      OMP_CLAUSE_DECL (node3) = decl;
> > +		    }
> > +		  ptr2 = fold_convert (sizetype, ptr2);
> > +		  OMP_CLAUSE_SIZE (node3)
> > +		    = fold_build2 (MINUS_EXPR, sizetype, ptr, ptr2);
> > +		}
> > +	      switch (n->u.map_op)
> > +		{
> > +		case OMP_MAP_ALLOC:
> > +		  OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_ALLOC;
> > +		  break;
> > +		case OMP_MAP_TO:
> > +		  OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_TO;
> > +		  break;
> > +		case OMP_MAP_FROM:
> > +		  OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_FROM;
> > +		  break;
> > +		case OMP_MAP_TOFROM:
> > +		  OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_TOFROM;
> > +		  break;
> > +		default:
> > +		  gcc_unreachable ();
> > +		}
> > +	      omp_clauses = gfc_trans_add_clause (node, omp_clauses);
> > +	      if (node2)
> > +		omp_clauses = gfc_trans_add_clause (node2, omp_clauses);
> > +	      if (node3)
> > +		omp_clauses = gfc_trans_add_clause (node3, omp_clauses);
> > +	      if (node4)
> > +		omp_clauses = gfc_trans_add_clause (node4, omp_clauses);
> > +	    }
> > +	  break;
> > +	case OMP_LIST_TO:
> > +	case OMP_LIST_FROM:
> > +	  for (; n != NULL; n = n->next)
> > +	    {
> > +	      if (!n->sym->attr.referenced)
> > +		continue;
> > +
> > +	      tree node = build_omp_clause (input_location,
> > +					    list == OMP_LIST_TO
> > +					    ? OMP_CLAUSE_TO : OMP_CLAUSE_FROM);
> > +	      if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
> > +		{
> > +		  tree decl = gfc_get_symbol_decl (n->sym);
> > +		  if (gfc_omp_privatize_by_reference (decl))
> > +		    decl = build_fold_indirect_ref (decl);
> > +		  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
> > +		    {
> > +		      tree type = TREE_TYPE (decl);
> > +		      tree ptr = gfc_conv_descriptor_data_get (decl);
> > +		      ptr = fold_convert (build_pointer_type (char_type_node),
> > +					  ptr);
> > +		      ptr = build_fold_indirect_ref (ptr);
> > +		      OMP_CLAUSE_DECL (node) = ptr;
> > +		      OMP_CLAUSE_SIZE (node)
> > +			= gfc_full_array_size (block, decl,
> > +					       GFC_TYPE_ARRAY_RANK (type));
> > +		      tree elemsz
> > +			= TYPE_SIZE_UNIT (gfc_get_element_type (type));
> > +		      elemsz = fold_convert (gfc_array_index_type, elemsz);
> > +		      OMP_CLAUSE_SIZE (node)
> > +			= fold_build2 (MULT_EXPR, gfc_array_index_type,
> > +				       OMP_CLAUSE_SIZE (node), elemsz);
> > +		    }
> > +		  else
> > +		    OMP_CLAUSE_DECL (node) = decl;
> > +		}
> > +	      else
> > +		{
> > +		  tree ptr;
> > +		  gfc_init_se (&se, NULL);
> > +		  if (n->expr->ref->u.ar.type == AR_ELEMENT)
> > +		    {
> > +		      gfc_conv_expr_reference (&se, n->expr);
> > +		      ptr = se.expr;
> > +		      gfc_add_block_to_block (block, &se.pre);
> > +		      OMP_CLAUSE_SIZE (node)
> > +			= TYPE_SIZE_UNIT (TREE_TYPE (ptr));
> > +		    }
> > +		  else
> > +		    {
> > +		      gfc_conv_expr_descriptor (&se, n->expr);
> > +		      ptr = gfc_conv_array_data (se.expr);
> > +		      tree type = TREE_TYPE (se.expr);
> > +		      gfc_add_block_to_block (block, &se.pre);
> > +		      OMP_CLAUSE_SIZE (node)
> > +			= gfc_full_array_size (block, se.expr,
> > +					       GFC_TYPE_ARRAY_RANK (type));
> > +		      tree elemsz
> > +			= TYPE_SIZE_UNIT (gfc_get_element_type (type));
> > +		      elemsz = fold_convert (gfc_array_index_type, elemsz);
> > +		      OMP_CLAUSE_SIZE (node)
> > +			= fold_build2 (MULT_EXPR, gfc_array_index_type,
> > +				       OMP_CLAUSE_SIZE (node), elemsz);
> > +		    }
> > +		  gfc_add_block_to_block (block, &se.post);
> > +		  ptr = fold_convert (build_pointer_type (char_type_node),
> > +				      ptr);
> > +		  OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
> >  		}
> > -	      OMP_CLAUSE_DEPEND_KIND (node)
> > -		= ((list == OMP_LIST_DEPEND_IN)
> > -		   ? OMP_CLAUSE_DEPEND_IN : OMP_CLAUSE_DEPEND_OUT);
> >  	      omp_clauses = gfc_trans_add_clause (node, omp_clauses);
> >  	    }
> >  	  break;
> > @@ -1920,7 +2306,69 @@ gfc_trans_omp_clauses (stmtblock_t *bloc
> >        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
> >      }
> >  
> > -  return omp_clauses;
> > +  if (clauses->num_teams)
> > +    {
> > +      tree num_teams;
> > +
> > +      gfc_init_se (&se, NULL);
> > +      gfc_conv_expr (&se, clauses->num_teams);
> > +      gfc_add_block_to_block (block, &se.pre);
> > +      num_teams = gfc_evaluate_now (se.expr, block);
> > +      gfc_add_block_to_block (block, &se.post);
> > +
> > +      c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_TEAMS);
> > +      OMP_CLAUSE_NUM_TEAMS_EXPR (c) = num_teams;
> > +      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
> > +    }
> > +
> > +  if (clauses->device)
> > +    {
> > +      tree device;
> > +
> > +      gfc_init_se (&se, NULL);
> > +      gfc_conv_expr (&se, clauses->device);
> > +      gfc_add_block_to_block (block, &se.pre);
> > +      device = gfc_evaluate_now (se.expr, block);
> > +      gfc_add_block_to_block (block, &se.post);
> > +
> > +      c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEVICE);
> > +      OMP_CLAUSE_DEVICE_ID (c) = device;
> > +      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
> > +    }
> > +
> > +  if (clauses->thread_limit)
> > +    {
> > +      tree thread_limit;
> > +
> > +      gfc_init_se (&se, NULL);
> > +      gfc_conv_expr (&se, clauses->thread_limit);
> > +      gfc_add_block_to_block (block, &se.pre);
> > +      thread_limit = gfc_evaluate_now (se.expr, block);
> > +      gfc_add_block_to_block (block, &se.post);
> > +
> > +      c = build_omp_clause (where.lb->location, OMP_CLAUSE_THREAD_LIMIT);
> > +      OMP_CLAUSE_THREAD_LIMIT_EXPR (c) = thread_limit;
> > +      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
> > +    }
> > +
> > +  chunk_size = NULL_TREE;
> > +  if (clauses->dist_chunk_size)
> > +    {
> > +      gfc_init_se (&se, NULL);
> > +      gfc_conv_expr (&se, clauses->dist_chunk_size);
> > +      gfc_add_block_to_block (block, &se.pre);
> > +      chunk_size = gfc_evaluate_now (se.expr, block);
> > +      gfc_add_block_to_block (block, &se.post);
> > +    }
> > +
> > +  if (clauses->dist_sched_kind != OMP_SCHED_NONE)
> > +    {
> > +      c = build_omp_clause (where.lb->location, OMP_CLAUSE_DIST_SCHEDULE);
> > +      OMP_CLAUSE_DIST_SCHEDULE_CHUNK_EXPR (c) = chunk_size;
> > +      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
> > +    }
> > +
> > +  return nreverse (omp_clauses);
> >  }


Grüße
 Thomas


-------------- next part --------------
A non-text attachment was scrubbed...
Name: 0001-WIP-PR90030.patch
Type: text/x-diff
Size: 5069 bytes
Desc: not available
URL: <http://gcc.gnu.org/pipermail/gcc-patches/attachments/20190529/5ef085a1/attachment.bin>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: signature.asc
Type: application/pgp-signature
Size: 658 bytes
Desc: not available
URL: <http://gcc.gnu.org/pipermail/gcc-patches/attachments/20190529/5ef085a1/attachment.sig>


More information about the Gcc-patches mailing list