This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Re: [PATCH] Fix parts of PR43829

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" } }
Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]