Re: PATCH: fortran/27662: Transpose doesn't work on function return

[Janne Blomqvist <jblomqvi at cc dot hut dot fi>]

Oops, I forgot to send this to gcc-patches. Here it goes.

On Mon, May 22, 2006 at 12:49:08AM +0300, Janne Blomqvist wrote:
> On Sat, May 20, 2006 at 12:36:40AM +0200, Paul Thomas wrote:
> > PS Who volunteers to clean up all the tests for stride = 0 in the library?
> 
> :ADDPATCH fortran:
> 
> Here goes.
> 
> Regtested on i686-pc-linux-gnu. Ok for trunk?
> 
> PS. I didn't remove the test for dot_product, since this intrinsic
> isn't needed in the library anymore because it's inlined in 4.2; I'll
> make another patch to remove it.
> 
> -- 
> Janne Blomqvist

> 2006-05-22  Janne Blomqvist  <jb@gcc.gnu.org>
> 
> 	* m4/in_pack.m4: Add TODO comment about detecting temporaries.
> 	* m4/transpose.m4: Remove test for stride 0.
> 	* m4/iforeach.m4: Likewise.
> 	* m4/shape.m4: Likewise.
> 	* m4/in_unpack.m4: Likewise.
> 	* m4/reshape.m4: Likewise.
> 	* m4/ifunction.m4: Likewise.
> 	* m4/matmul.m4: Likewise.
> 	* intrinsics/etime.c: Likewise.
> 	* intrinsics/transpose_generic.c: Likewise.
> 	* intrinsics/spread_generic.c: Likewise.
> 	* intrinsics/stat.c: Likewise.
> 	* intrinsics/reshape_generic.c: Likewise.
> 	* intrinsics/random.c: Likewise.
> 	

> Index: m4/in_pack.m4
> ===================================================================
> --- m4/in_pack.m4	(revision 113949)
> +++ m4/in_pack.m4	(working copy)
> @@ -56,6 +56,8 @@ rtype_name *
>    int n;
>    int packed;
>  
> +  /* TODO: Investigate how we can figure out if this is a temporary
> +     since the stride=0 thing has been removed from the frontend.  */
>    if (source->dim[0].stride == 0)
>      {
>        source->dim[0].stride = 1;
> Index: m4/transpose.m4
> ===================================================================
> --- m4/transpose.m4	(revision 113949)
> +++ m4/transpose.m4	(working copy)
> @@ -72,11 +72,6 @@ transpose_`'rtype_code (rtype * const re
>        ret->offset = 0;
>      }
>  
> -  if (ret->dim[0].stride == 0)
> -    ret->dim[0].stride = 1;
> -  if (source->dim[0].stride == 0)
> -    source->dim[0].stride = 1;
> -
>    sxstride = source->dim[0].stride;
>    systride = source->dim[1].stride;
>    xcount = source->dim[0].ubound + 1 - source->dim[0].lbound;
> Index: m4/iforeach.m4
> ===================================================================
> --- m4/iforeach.m4	(revision 113949)
> +++ m4/iforeach.m4	(working copy)
> @@ -41,16 +41,8 @@ name`'rtype_qual`_'atype_code (rtype * c
>  
>        if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
>          runtime_error ("dimension of return array incorrect");
> -
> -      if (retarray->dim[0].stride == 0)
> -	retarray->dim[0].stride = 1;
>      }
>  
> -  /* TODO:  It should be a front end job to correctly set the strides.  */
> -
> -  if (array->dim[0].stride == 0)
> -    array->dim[0].stride = 1;
> -
>    dstride = retarray->dim[0].stride;
>    dest = retarray->data;
>    for (n = 0; n < rank; n++)
> @@ -153,19 +145,8 @@ void
>  
>        if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
>          runtime_error ("dimension of return array incorrect");
> -
> -      if (retarray->dim[0].stride == 0)
> -	retarray->dim[0].stride = 1;
>      }
>  
> -  /* TODO:  It should be a front end job to correctly set the strides.  */
> -
> -  if (array->dim[0].stride == 0)
> -    array->dim[0].stride = 1;
> -
> -  if (mask->dim[0].stride == 0)
> -    mask->dim[0].stride = 1;
> -
>    dstride = retarray->dim[0].stride;
>    dest = retarray->data;
>    for (n = 0; n < rank; n++)
> @@ -291,9 +272,6 @@ void
>  
>        if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
>          runtime_error ("dimension of return array incorrect");
> -
> -      if (retarray->dim[0].stride == 0)
> -	retarray->dim[0].stride = 1;
>      }
>  
>    dstride = retarray->dim[0].stride;
> Index: m4/shape.m4
> ===================================================================
> --- m4/shape.m4	(revision 113949)
> +++ m4/shape.m4	(working copy)
> @@ -48,8 +48,6 @@ shape_`'rtype_kind (rtype * const restri
>    index_type stride;
>  
>    stride = ret->dim[0].stride;
> -  if (stride == 0)
> -    stride = 1;
>  
>    for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++)
>      {
> Index: m4/in_unpack.m4
> ===================================================================
> --- m4/in_unpack.m4	(revision 113949)
> +++ m4/in_unpack.m4	(working copy)
> @@ -55,9 +55,6 @@ void
>    if (src == dest || !src)
>      return;
>  
> -  if (d->dim[0].stride == 0)
> -    d->dim[0].stride = 1;
> -
>    dim = GFC_DESCRIPTOR_RANK (d);
>    dsize = 1;
>    for (n = 0; n < dim; n++)
> Index: m4/matmull.m4
> ===================================================================
> --- m4/matmull.m4	(revision 113949)
> +++ m4/matmull.m4	(working copy)
> @@ -113,13 +113,6 @@ matmul_`'rtype_code (rtype * const restr
>      }
>    dest = retarray->data;
>  
> -  if (retarray->dim[0].stride == 0)
> -    retarray->dim[0].stride = 1;
> -  if (a->dim[0].stride == 0)
> -    a->dim[0].stride = 1;
> -  if (b->dim[0].stride == 0)
> -    b->dim[0].stride = 1;
> -
>  sinclude(`matmul_asm_'rtype_code`.m4')dnl
>  
>    if (GFC_DESCRIPTOR_RANK (retarray) == 1)
> Index: m4/reshape.m4
> ===================================================================
> --- m4/reshape.m4	(revision 113949)
> +++ m4/reshape.m4	(working copy)
> @@ -86,15 +86,6 @@ reshape_`'rtype_ccode (rtype * const res
>    int n;
>    int dim;
>  
> -  if (source->dim[0].stride == 0)
> -    source->dim[0].stride = 1;
> -  if (shape->dim[0].stride == 0)
> -    shape->dim[0].stride = 1;
> -  if (pad && pad->dim[0].stride == 0)
> -    pad->dim[0].stride = 1;
> -  if (order && order->dim[0].stride == 0)
> -    order->dim[0].stride = 1;
> -
>    if (ret->data == NULL)
>      {
>        rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
> @@ -114,8 +105,6 @@ reshape_`'rtype_ccode (rtype * const res
>    else
>      {
>        rdim = GFC_DESCRIPTOR_RANK (ret);
> -      if (ret->dim[0].stride == 0)
> -	ret->dim[0].stride = 1;
>      }
>  
>    rsize = 1;
> Index: m4/ifunction.m4
> ===================================================================
> --- m4/ifunction.m4	(revision 113949)
> +++ m4/ifunction.m4	(working copy)
> @@ -44,11 +44,6 @@ name`'rtype_qual`_'atype_code (rtype * c
>    dim = (*pdim) - 1;
>    rank = GFC_DESCRIPTOR_RANK (array) - 1;
>  
> -  /* TODO:  It should be a front end job to correctly set the strides.  */
> -
> -  if (array->dim[0].stride == 0)
> -    array->dim[0].stride = 1;
> -
>    len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
>    delta = array->dim[dim].stride;
>  
> @@ -85,9 +80,6 @@ name`'rtype_qual`_'atype_code (rtype * c
>      }
>    else
>      {
> -      if (retarray->dim[0].stride == 0)
> -	retarray->dim[0].stride = 1;
> -
>        if (rank != GFC_DESCRIPTOR_RANK (retarray))
>  	runtime_error ("rank of return array incorrect");
>      }
> @@ -184,14 +176,6 @@ void
>    dim = (*pdim) - 1;
>    rank = GFC_DESCRIPTOR_RANK (array) - 1;
>  
> -  /* TODO:  It should be a front end job to correctly set the strides.  */
> -
> -  if (array->dim[0].stride == 0)
> -    array->dim[0].stride = 1;
> -
> -  if (mask->dim[0].stride == 0)
> -    mask->dim[0].stride = 1;
> -
>    len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
>    if (len <= 0)
>      return;
> @@ -233,9 +217,6 @@ void
>      }
>    else
>      {
> -      if (retarray->dim[0].stride == 0)
> -	retarray->dim[0].stride = 1;
> -
>        if (rank != GFC_DESCRIPTOR_RANK (retarray))
>  	runtime_error ("rank of return array incorrect");
>      }
> @@ -360,9 +341,6 @@ void
>  
>        if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
>          runtime_error ("dimension of return array incorrect");
> -
> -      if (retarray->dim[0].stride == 0)
> -	retarray->dim[0].stride = 1;
>      }
>  
>      dstride = retarray->dim[0].stride;
> Index: m4/matmul.m4
> ===================================================================
> --- m4/matmul.m4	(revision 113949)
> +++ m4/matmul.m4	(working copy)
> @@ -121,15 +121,6 @@ matmul_`'rtype_code (rtype * const restr
>        retarray->offset = 0;
>      }
>  
> -  if (retarray->dim[0].stride == 0)
> -    retarray->dim[0].stride = 1;
> -
> -  /* This prevents constifying the input arguments.  */
> -  if (a->dim[0].stride == 0)
> -    a->dim[0].stride = 1;
> -  if (b->dim[0].stride == 0)
> -    b->dim[0].stride = 1;
> -
>  sinclude(`matmul_asm_'rtype_code`.m4')dnl
>  
>    if (GFC_DESCRIPTOR_RANK (retarray) == 1)
> Index: intrinsics/etime.c
> ===================================================================
> --- intrinsics/etime.c	(revision 113949)
> +++ intrinsics/etime.c	(working copy)
> @@ -71,9 +71,6 @@ etime_sub (gfc_array_r4 *t, GFC_REAL_4 *
>    if (((t->dim[0].ubound + 1 - t->dim[0].lbound)) < 2)
>      runtime_error ("Insufficient number of elements in TARRAY.");
>  
> -  if (t->dim[0].stride == 0)
> -    t->dim[0].stride = 1;
> -
>    tp = t->data;
>  
>    *tp = tu;
> Index: intrinsics/transpose_generic.c
> ===================================================================
> --- intrinsics/transpose_generic.c	(revision 113949)
> +++ intrinsics/transpose_generic.c	(working copy)
> @@ -71,15 +71,11 @@ transpose_internal (gfc_array_char *ret,
>      }
>  
>    sxstride = source->dim[0].stride * size;
> -  if (sxstride == 0)
> -    sxstride = size;
>    systride = source->dim[1].stride * size;
>    xcount = source->dim[0].ubound + 1 - source->dim[0].lbound;
>    ycount = source->dim[1].ubound + 1 - source->dim[1].lbound;
>  
>    rxstride = ret->dim[0].stride * size;
> -  if (rxstride == 0)
> -    rxstride = size;
>    rystride = ret->dim[1].stride * size;
>  
>    rptr = ret->data;
> Index: intrinsics/spread_generic.c
> ===================================================================
> --- intrinsics/spread_generic.c	(revision 113949)
> +++ intrinsics/spread_generic.c	(working copy)
> @@ -109,9 +109,6 @@ spread_internal (gfc_array_char *ret, co
>        if (GFC_DESCRIPTOR_RANK(ret) != rrank)
>  	runtime_error ("rank mismatch in spread()");
>  
> -      if (ret->dim[0].stride == 0)
> -	ret->dim[0].stride = 1;
> -
>        for (n = 0; n < rrank; n++)
>  	{
>  	  if (n == *along - 1)
> @@ -204,9 +201,6 @@ spread_internal_scalar (gfc_array_char *
>      }
>    else
>      {
> -      if (ret->dim[0].stride == 0)
> -	ret->dim[0].stride = 1;
> -
>        if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound)
>  			   / ret->dim[0].stride)
>  	runtime_error ("dim too large in spread()");
> Index: intrinsics/stat.c
> ===================================================================
> --- intrinsics/stat.c	(revision 113949)
> +++ intrinsics/stat.c	(working copy)
> @@ -81,9 +81,6 @@ stat_i4_sub (char *name, gfc_array_i4 *s
>    if (sarray->dim[0].ubound + 1 - sarray->dim[0].lbound < 13)
>      runtime_error ("Array size of SARRAY is too small.");
>  
> -  if (sarray->dim[0].stride == 0)
> -    sarray->dim[0].stride = 1;
> -
>    /* Trim trailing spaces from name.  */
>    while (name_len > 0 && name[name_len - 1] == ' ')
>      name_len--;
> @@ -174,9 +171,6 @@ stat_i8_sub (char *name, gfc_array_i8 *s
>    if (sarray->dim[0].ubound + 1 - sarray->dim[0].lbound < 13)
>      runtime_error ("Array size of SARRAY is too small.");
>  
> -  if (sarray->dim[0].stride == 0)
> -    sarray->dim[0].stride = 1;
> -
>    /* Trim trailing spaces from name.  */
>    while (name_len > 0 && name[name_len - 1] == ' ')
>      name_len--;
> @@ -297,9 +291,6 @@ fstat_i4_sub (GFC_INTEGER_4 *unit, gfc_a
>    if (sarray->dim[0].ubound + 1 - sarray->dim[0].lbound < 13)
>      runtime_error ("Array size of SARRAY is too small.");
>  
> -  if (sarray->dim[0].stride == 0)
> -    sarray->dim[0].stride = 1;
> -
>    /* Convert Fortran unit number to C file descriptor.  */
>    val = unit_to_fd (*unit);
>    if (val >= 0)
> @@ -381,9 +372,6 @@ fstat_i8_sub (GFC_INTEGER_8 *unit, gfc_a
>    if (sarray->dim[0].ubound + 1 - sarray->dim[0].lbound < 13)
>      runtime_error ("Array size of SARRAY is too small.");
>  
> -  if (sarray->dim[0].stride == 0)
> -    sarray->dim[0].stride = 1;
> -
>    /* Convert Fortran unit number to C file descriptor.  */
>    val = unit_to_fd ((int) *unit);
>    if (val >= 0)
> Index: intrinsics/reshape_generic.c
> ===================================================================
> --- intrinsics/reshape_generic.c	(revision 113949)
> +++ intrinsics/reshape_generic.c	(working copy)
> @@ -74,15 +74,6 @@ reshape_internal (parray *ret, parray *s
>    int n;
>    int dim;
>  
> -  if (source->dim[0].stride == 0)
> -    source->dim[0].stride = 1;
> -  if (shape->dim[0].stride == 0)
> -    shape->dim[0].stride = 1;
> -  if (pad && pad->dim[0].stride == 0)
> -    pad->dim[0].stride = 1;
> -  if (order && order->dim[0].stride == 0)
> -    order->dim[0].stride = 1;
> -
>    if (ret->data == NULL)
>      {
>        rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
> @@ -102,8 +93,6 @@ reshape_internal (parray *ret, parray *s
>    else
>      {
>        rdim = GFC_DESCRIPTOR_RANK (ret);
> -      if (ret->dim[0].stride == 0)
> -	ret->dim[0].stride = 1;
>      }
>  
>    rsize = 1;
> Index: intrinsics/random.c
> ===================================================================
> --- intrinsics/random.c	(revision 113949)
> +++ intrinsics/random.c	(working copy)
> @@ -188,9 +188,6 @@ arandom_r4 (gfc_array_r4 *x)
>  
>    dest = x->data;
>  
> -  if (x->dim[0].stride == 0)
> -    x->dim[0].stride = 1;
> -
>    dim = GFC_DESCRIPTOR_RANK (x);
>  
>    for (n = 0; n < dim; n++)
> @@ -261,9 +258,6 @@ arandom_r8 (gfc_array_r8 *x)
>  
>    dest = x->data;
>  
> -  if (x->dim[0].stride == 0)
> -    x->dim[0].stride = 1;
> -
>    dim = GFC_DESCRIPTOR_RANK (x);
>  
>    for (n = 0; n < dim; n++)
> @@ -349,9 +343,6 @@ random_seed (GFC_INTEGER_4 *size, gfc_ar
>        if (((put->dim[0].ubound + 1 - put->dim[0].lbound)) < kiss_size)
>          runtime_error ("Array size of PUT is too small.");
>  
> -      if (put->dim[0].stride == 0)
> -	put->dim[0].stride = 1;
> -
>        /*  This code now should do correct strides.  */
>        for (i = 0; i < kiss_size; i++)
>          kiss_seed[i] =(GFC_UINTEGER_4) put->data[i * put->dim[0].stride];
> @@ -368,9 +359,6 @@ random_seed (GFC_INTEGER_4 *size, gfc_ar
>        if (((get->dim[0].ubound + 1 - get->dim[0].lbound)) < kiss_size)
>  	runtime_error ("Array size of GET is too small.");
>  
> -      if (get->dim[0].stride == 0)
> -	get->dim[0].stride = 1;
> -
>        /*  This code now should do correct strides.  */
>        for (i = 0; i < kiss_size; i++)
>          get->data[i * get->dim[0].stride] = (GFC_INTEGER_4) kiss_seed[i];




-- 
Janne Blomqvist

Attachment: pgp00000.pgp
Description: PGP signature