Re: [PATCH] Fix parts of PR43829

[Paul Richard Thomas <paul dot richard dot thomas at gmail dot com>]

Dear Richard,

OK for trunk - it would be good if you would backport to 4.5 as well.

I wonder sometimes if testcases are necessary for patches like this?
After all, the functionality is tested already and we would notice
changes in benchmark runs if anything were to provoke the production
of temporaries again.

Thanks for the patch

Paul

On Wed, Apr 21, 2010 at 6:03 PM, Richard Guenther <rguenther@suse.de> wrote:
> On Wed, 21 Apr 2010, Richard Guenther wrote:
>
>>
>> This removes the need for the array temporary we seem to unconditionally
>> create for vector indexing in
>>
>> subroutine test0(esss,Ix, e_x)
>> ? real(kind=kind(1.0d0)), dimension(:), intent(out) :: esss
>> ? real(kind=kind(1.0d0)), dimension(:) :: Ix
>> ? integer(kind=kind(1)), dimension(:) :: e_x
>> ? esss = Ix(e_x)
>> end subroutine
>>
>> where the issue is the convert intrinsic inserted by gfc_resolve_index.
>> That conversion is not necessary as we can easily do the conversion
>> on the scalar when indexing into the array.
>>
>> The following restricts this special-casing to the start index
>> of an array reference (the testsuite also passes when doing so
>> unconditionally if I exclude EXPR_CONSTANT).
>>
>> Bootstrap and regtest running on x86_64-unknown-linux-gnu, ok if
>> it succeeds? ?I know this kind of indexing happens in 465.tonto,
>> so I'll make sure that still works.
>
> Tobias noticed the testcase doesn't make too much sense and I
> verified that with integer(8) 4.5 already gets away w/o a
> temporary. ?gfortran.dg/assign_10.f90 also needs adjustment.
>
> Thus, ok for the following?
>
> Thanks,
> Richard.
>
> 2010-04-21 ?Richard Guenther ?<rguenther@suse.de>
>
> ? ? ? ?PR fortran/43829
> ? ? ? ?* resolve.c (gfc_resolve_index): Wrap around ...
> ? ? ? ?(gfc_resolve_index_1): ... this. ?Add parameter to allow
> ? ? ? ?any integer kind index type.
> ? ? ? ?(resolve_array_ref): Allow any integer kind for the start
> ? ? ? ?index of an array ref.
>
> ? ? ? ?* gfortran.dg/vector_subscript_6.f90: New testcase.
> ? ? ? ?* gfortran.dg/assign_10.f90: Adjust.
>
> Index: gcc/fortran/resolve.c
> ===================================================================
> *** gcc/fortran/resolve.c.orig ?2010-04-21 17:45:22.000000000 +0200
> --- gcc/fortran/resolve.c ? ? ? 2010-04-21 17:54:26.000000000 +0200
> *************** compare_spec_to_ref (gfc_array_ref *ar)
> *** 3978,3985 ****
>
> ?/* Resolve one part of an array index. ?*/
>
> ! gfc_try
> ! gfc_resolve_index (gfc_expr *index, int check_scalar)
> ?{
> ? ?gfc_typespec ts;
>
> --- 3978,3986 ----
>
> ?/* Resolve one part of an array index. ?*/
>
> ! static gfc_try
> ! gfc_resolve_index_1 (gfc_expr *index, int check_scalar,
> ! ? ? ? ? ? ? ? ? ? ?int force_index_integer_kind)
> ?{
> ? ?gfc_typespec ts;
>
> *************** gfc_resolve_index (gfc_expr *index, int
> *** 4007,4013 ****
> ? ? ? ? ? ? ? ? ? ? ? ?&index->where) == FAILURE)
> ? ? ? ?return FAILURE;
>
> ! ? if (index->ts.kind != gfc_index_integer_kind
> ? ? ? ?|| index->ts.type != BT_INTEGER)
> ? ? ?{
> ? ? ? ?gfc_clear_ts (&ts);
> --- 4008,4015 ----
> ? ? ? ? ? ? ? ? ? ? ? ?&index->where) == FAILURE)
> ? ? ? ?return FAILURE;
>
> ! ? if ((index->ts.kind != gfc_index_integer_kind
> ! ? ? ? ?&& force_index_integer_kind)
> ? ? ? ?|| index->ts.type != BT_INTEGER)
> ? ? ?{
> ? ? ? ?gfc_clear_ts (&ts);
> *************** gfc_resolve_index (gfc_expr *index, int
> *** 4020,4025 ****
> --- 4022,4035 ----
> ? ?return SUCCESS;
> ?}
>
> + /* Resolve one part of an array index. ?*/
> +
> + gfc_try
> + gfc_resolve_index (gfc_expr *index, int check_scalar)
> + {
> + ? return gfc_resolve_index_1 (index, check_scalar, 1);
> + }
> +
> ?/* Resolve a dim argument to an intrinsic function. ?*/
>
> ?gfc_try
> *************** resolve_array_ref (gfc_array_ref *ar)
> *** 4144,4150 ****
> ? ? ?{
> ? ? ? ?check_scalar = ar->dimen_type[i] == DIMEN_RANGE;
>
> ! ? ? ? if (gfc_resolve_index (ar->start[i], check_scalar) == FAILURE)
> ? ? ? ?return FAILURE;
> ? ? ? ?if (gfc_resolve_index (ar->end[i], check_scalar) == FAILURE)
> ? ? ? ?return FAILURE;
> --- 4154,4163 ----
> ? ? ?{
> ? ? ? ?check_scalar = ar->dimen_type[i] == DIMEN_RANGE;
>
> ! ? ? ? /* Do not force gfc_index_integer_kind for the start. ?We can
> ! ? ? ? ? ?do fine with any integer kind. ?This avoids temporary arrays
> ! ? ? ? ?created for indexing with a vector. ?*/
> ! ? ? ? if (gfc_resolve_index_1 (ar->start[i], check_scalar, 0) == FAILURE)
> ? ? ? ?return FAILURE;
> ? ? ? ?if (gfc_resolve_index (ar->end[i], check_scalar) == FAILURE)
> ? ? ? ?return FAILURE;
> Index: gcc/fortran/trans-array.c
> ===================================================================
> *** gcc/fortran/trans-array.c.orig ? ? ?2010-04-21 17:45:22.000000000 +0200
> --- gcc/fortran/trans-array.c ? 2010-04-21 17:54:26.000000000 +0200
> *************** gfc_conv_array_index_offset (gfc_se * se
> *** 2434,2439 ****
> --- 2434,2440 ----
> ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?gfc_conv_array_data (desc));
> ? ? ? ? ?index = gfc_build_array_ref (data, index, NULL);
> ? ? ? ? ?index = gfc_evaluate_now (index, &se->pre);
> + ? ? ? ? index = fold_convert (gfc_array_index_type, index);
>
> ? ? ? ? ?/* Do any bounds checking on the final info->descriptor index. ?*/
> ? ? ? ? ?index = gfc_trans_array_bound_check (se, info->descriptor,
> Index: gcc/testsuite/gfortran.dg/vector_subscript_6.f90
> ===================================================================
> *** /dev/null ? 1970-01-01 00:00:00.000000000 +0000
> --- gcc/testsuite/gfortran.dg/vector_subscript_6.f90 ? ?2010-04-21 17:58:11.000000000 +0200
> ***************
> *** 0 ****
> --- 1,33 ----
> + ! { dg-do compile }
> + ! { dg-options "-fdump-tree-original" }
> +
> + subroutine test0(esss,Ix, e_x)
> + ? real(kind=kind(1.0d0)), dimension(:), intent(out) :: esss
> + ? real(kind=kind(1.0d0)), dimension(:), intent(in) :: Ix
> + ? integer(kind=kind(1)), dimension(:), intent(in) :: e_x
> + ? esss = Ix(e_x)
> + end subroutine
> +
> + subroutine test1(esss,Ix, e_x)
> + ? real(kind=kind(1.0d0)), dimension(:), intent(out) :: esss
> + ? real(kind=kind(1.0d0)), dimension(:), intent(in) :: Ix
> + ? integer(kind=4), dimension(:), intent(in) :: e_x
> + ? esss = Ix(e_x)
> + end subroutine
> +
> + subroutine test2(esss,Ix, e_x)
> + ? real(kind=kind(1.0d0)), dimension(:), intent(out) :: esss
> + ? real(kind=kind(1.0d0)), dimension(:), intent(in) :: Ix
> + ? integer(kind=8), dimension(:), intent(in) :: e_x
> + ? esss = Ix(e_x)
> + end subroutine
> +
> + subroutine test3(esss,Ix,Iyz, e_x, ii_ivec)
> + ? real(kind=kind(1.0d0)), dimension(:), intent(out) :: esss
> + ? real(kind=kind(1.0d0)), dimension(:), intent(in) :: Ix,Iyz
> + ? integer(kind=kind(1)), dimension(:), intent(in) :: e_x,ii_ivec
> + ? esss = esss + Ix(e_x) * Iyz(ii_ivec)
> + end subroutine
> +
> + ! { dg-final { scan-tree-dump-not "malloc" "original" } }
> + ! { dg-final { cleanup-tree-dump "original" } }
> Index: gcc/testsuite/gfortran.dg/assign_10.f90
> ===================================================================
> *** gcc/testsuite/gfortran.dg/assign_10.f90.orig ? ? ? ?2007-11-30 13:59:42.000000000 +0100
> --- gcc/testsuite/gfortran.dg/assign_10.f90 ? ? 2010-04-21 17:56:03.000000000 +0200
> ***************
> *** 19,28 ****
> ? ?if (any(p8 .ne. q8)) call abort ()
> ?end
> ?! Whichever is the default length for array indices will yield
> ! ! parm 9 times, because a temporary is not necessary. ?The other
> ! ! cases will all yield a temporary, so that atmp appears 27 times.
> ?! Note that it is the kind conversion that generates the temp.
> ?!
> ! ! { dg-final { scan-tree-dump-times "parm" 9 "original" } }
> ! ! { dg-final { scan-tree-dump-times "atmp" 27 "original" } }
> ?! { dg-final { cleanup-tree-dump "original" } }
> --- 19,28 ----
> ? ?if (any(p8 .ne. q8)) call abort ()
> ?end
> ?! Whichever is the default length for array indices will yield
> ! ! parm 18 times, because a temporary is not necessary. ?The other
> ! ! cases will all yield a temporary, so that atmp appears 18 times.
> ?! Note that it is the kind conversion that generates the temp.
> ?!
> ! ! { dg-final { scan-tree-dump-times "parm" 18 "original" } }
> ! ! { dg-final { scan-tree-dump-times "atmp" 18 "original" } }
> ?! { dg-final { cleanup-tree-dump "original" } }
>



-- 
The knack of flying is learning how to throw yourself at the ground and miss.
       --Hitchhikers Guide to the Galaxy