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

Message ID yxfpef6aaucp.fsf@hertz.schwinge.homeip.net
State New
Headers show
Series
  • PR90030 "Fortran OpenACC subarray data alignment" (was: [PATCH] Fortran OpenMP 4.0 target support)
Related show

Commit Message

Thomas Schwinge April 10, 2019, 1 p.m.
Hi Jakub!

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

Comments

Thomas Schwinge May 29, 2019, 2:40 p.m. | #1
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
From b8b60e9c1b0bd100717bf52e312f9285b8ac8fbf Mon Sep 17 00:00:00 2001
From: Thomas Schwinge <thomas@codesourcery.com>

Date: Wed, 10 Apr 2019 13:13:28 +0200
Subject: [PATCH] [WIP] PR90030

---
 gcc/fortran/trans-openmp.c                    | 20 +++++--------
 libgomp/testsuite/libgomp.fortran/pr90030.f90 |  3 ++
 .../libgomp.oacc-fortran/pr90030.f90          | 29 +++++++++++++++++++
 3 files changed, 39 insertions(+), 13 deletions(-)
 create mode 100644 libgomp/testsuite/libgomp.fortran/pr90030.f90
 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/pr90030.f90

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 0eb5956cc531..07a63f4a45ce 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -1125,7 +1125,7 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p)
       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);
+      gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
       ptr = build_fold_indirect_ref (ptr);
       OMP_CLAUSE_DECL (c) = ptr;
       c2 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
@@ -2081,8 +2081,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		  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);
+		      gcc_assert (POINTER_TYPE_P (TREE_TYPE (decl)));
 		      decl = build_fold_indirect_ref (decl);
 		    }
 		  else if (DECL_P (decl))
@@ -2105,8 +2104,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		    }
 		  gfc_add_block_to_block (block, &se.pre);
 		  gfc_add_block_to_block (block, &se.post);
-		  ptr = fold_convert (build_pointer_type (char_type_node),
-				      ptr);
+		  gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
 		  OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
 		}
 	      switch (n->u.depend_op)
@@ -2172,8 +2170,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		    {
 		      tree type = TREE_TYPE (decl);
 		      tree ptr = gfc_conv_descriptor_data_get (decl);
-		      ptr = fold_convert (build_pointer_type (char_type_node),
-					  ptr);
+		      gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
 		      ptr = build_fold_indirect_ref (ptr);
 		      OMP_CLAUSE_DECL (node) = ptr;
 		      node2 = build_omp_clause (input_location,
@@ -2266,8 +2263,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 				       OMP_CLAUSE_SIZE (node), elemsz);
 		    }
 		  gfc_add_block_to_block (block, &se.post);
-		  ptr = fold_convert (build_pointer_type (char_type_node),
-				      ptr);
+		  gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
 		  OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
 
 		  if (POINTER_TYPE_P (TREE_TYPE (decl))
@@ -2407,8 +2403,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		    {
 		      tree type = TREE_TYPE (decl);
 		      tree ptr = gfc_conv_descriptor_data_get (decl);
-		      ptr = fold_convert (build_pointer_type (char_type_node),
-					  ptr);
+		      gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
 		      ptr = build_fold_indirect_ref (ptr);
 		      OMP_CLAUSE_DECL (node) = ptr;
 		      OMP_CLAUSE_SIZE (node)
@@ -2453,8 +2448,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 				       OMP_CLAUSE_SIZE (node), elemsz);
 		    }
 		  gfc_add_block_to_block (block, &se.post);
-		  ptr = fold_convert (build_pointer_type (char_type_node),
-				      ptr);
+		  gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
 		  OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
 		}
 	      omp_clauses = gfc_trans_add_clause (node, omp_clauses);
diff --git a/libgomp/testsuite/libgomp.fortran/pr90030.f90 b/libgomp/testsuite/libgomp.fortran/pr90030.f90
new file mode 100644
index 000000000000..8c2432cb1783
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/pr90030.f90
@@ -0,0 +1,3 @@
+! { dg-do run }
+
+include '../libgomp.oacc-fortran/pr90030.f90'
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/pr90030.f90 b/libgomp/testsuite/libgomp.oacc-fortran/pr90030.f90
new file mode 100644
index 000000000000..bbfcff3a869f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/pr90030.f90
@@ -0,0 +1,29 @@
+! PR90030.
+! Test if the array data associated with c is properly aligned
+! on the accelerator.  If it is not, this program will crash.
+
+! This is also included from '../libgomp.fortran/pr90030.f90'.
+
+! { dg-do run }
+
+program routine_align_main
+  implicit none
+  integer :: i, n
+  real*8, dimension(:), allocatable :: c
+
+  n = 10
+
+  allocate (c(n))
+
+  !$omp target map(to: n) map(from: c(1:n))
+  !$acc parallel copyin(n) copyout(c(1:n))
+  do i = 1, n
+     c(i) = i
+  enddo
+  !$acc end parallel
+  !$omp end target
+
+  do i = 1, n
+     if (c(i) .ne. i) stop i
+  enddo
+end program routine_align_main
-- 
2.17.1

Patch

From b8b60e9c1b0bd100717bf52e312f9285b8ac8fbf Mon Sep 17 00:00:00 2001
From: Thomas Schwinge <thomas@codesourcery.com>
Date: Wed, 10 Apr 2019 13:13:28 +0200
Subject: [PATCH] [WIP] PR90030

---
 gcc/fortran/trans-openmp.c                    | 20 +++++--------
 libgomp/testsuite/libgomp.fortran/pr90030.f90 |  3 ++
 .../libgomp.oacc-fortran/pr90030.f90          | 29 +++++++++++++++++++
 3 files changed, 39 insertions(+), 13 deletions(-)
 create mode 100644 libgomp/testsuite/libgomp.fortran/pr90030.f90
 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/pr90030.f90

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 0eb5956cc531..07a63f4a45ce 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -1125,7 +1125,7 @@  gfc_omp_finish_clause (tree c, gimple_seq *pre_p)
       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);
+      gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
       ptr = build_fold_indirect_ref (ptr);
       OMP_CLAUSE_DECL (c) = ptr;
       c2 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
@@ -2081,8 +2081,7 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		  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);
+		      gcc_assert (POINTER_TYPE_P (TREE_TYPE (decl)));
 		      decl = build_fold_indirect_ref (decl);
 		    }
 		  else if (DECL_P (decl))
@@ -2105,8 +2104,7 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		    }
 		  gfc_add_block_to_block (block, &se.pre);
 		  gfc_add_block_to_block (block, &se.post);
-		  ptr = fold_convert (build_pointer_type (char_type_node),
-				      ptr);
+		  gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
 		  OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
 		}
 	      switch (n->u.depend_op)
@@ -2172,8 +2170,7 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		    {
 		      tree type = TREE_TYPE (decl);
 		      tree ptr = gfc_conv_descriptor_data_get (decl);
-		      ptr = fold_convert (build_pointer_type (char_type_node),
-					  ptr);
+		      gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
 		      ptr = build_fold_indirect_ref (ptr);
 		      OMP_CLAUSE_DECL (node) = ptr;
 		      node2 = build_omp_clause (input_location,
@@ -2266,8 +2263,7 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 				       OMP_CLAUSE_SIZE (node), elemsz);
 		    }
 		  gfc_add_block_to_block (block, &se.post);
-		  ptr = fold_convert (build_pointer_type (char_type_node),
-				      ptr);
+		  gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
 		  OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
 
 		  if (POINTER_TYPE_P (TREE_TYPE (decl))
@@ -2407,8 +2403,7 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		    {
 		      tree type = TREE_TYPE (decl);
 		      tree ptr = gfc_conv_descriptor_data_get (decl);
-		      ptr = fold_convert (build_pointer_type (char_type_node),
-					  ptr);
+		      gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
 		      ptr = build_fold_indirect_ref (ptr);
 		      OMP_CLAUSE_DECL (node) = ptr;
 		      OMP_CLAUSE_SIZE (node)
@@ -2453,8 +2448,7 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 				       OMP_CLAUSE_SIZE (node), elemsz);
 		    }
 		  gfc_add_block_to_block (block, &se.post);
-		  ptr = fold_convert (build_pointer_type (char_type_node),
-				      ptr);
+		  gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
 		  OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
 		}
 	      omp_clauses = gfc_trans_add_clause (node, omp_clauses);
diff --git a/libgomp/testsuite/libgomp.fortran/pr90030.f90 b/libgomp/testsuite/libgomp.fortran/pr90030.f90
new file mode 100644
index 000000000000..8c2432cb1783
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/pr90030.f90
@@ -0,0 +1,3 @@ 
+! { dg-do run }
+
+include '../libgomp.oacc-fortran/pr90030.f90'
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/pr90030.f90 b/libgomp/testsuite/libgomp.oacc-fortran/pr90030.f90
new file mode 100644
index 000000000000..bbfcff3a869f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/pr90030.f90
@@ -0,0 +1,29 @@ 
+! PR90030.
+! Test if the array data associated with c is properly aligned
+! on the accelerator.  If it is not, this program will crash.
+
+! This is also included from '../libgomp.fortran/pr90030.f90'.
+
+! { dg-do run }
+
+program routine_align_main
+  implicit none
+  integer :: i, n
+  real*8, dimension(:), allocatable :: c
+
+  n = 10
+
+  allocate (c(n))
+
+  !$omp target map(to: n) map(from: c(1:n))
+  !$acc parallel copyin(n) copyout(c(1:n))
+  do i = 1, n
+     c(i) = i
+  enddo
+  !$acc end parallel
+  !$omp end target
+
+  do i = 1, n
+     if (c(i) .ne. i) stop i
+  enddo
+end program routine_align_main
-- 
2.17.1