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, fortran] PR36932,3 - unnecessary temporaries


Dear All,

This patch has evolved sufficiently that I think it needs to be resubmitted:

(i) The symmetry between the arguments of check_data_pointer_types is
now assured by calling it twice with the arguments interchanged.
(ii) A possible component reference is checked first; if it is found,
checking of all the components is not done.
(iii) Joost is keeping us on our toes... The bit of the patch in
trans-array.c fixes the testcase in his comment #3 of PR36932.

Note comment #3 of PR36933 remains to be done.

Bootstraps and regtests on FC9/x86_64 - OK for trunk?

Cheers

Paul


2010-02-14  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/36932
	PR fortran/36933
	* dependency.c (gfc_check_argument_var_dependency): Use enum
	value instead of arithmetic vaue for 'elemental'.
	(check_data_pointer_types): New function.
	(gfc_check_dependency): Call check_data_pointer_types.
	* trans-array.c (gfc_conv_array_parameter): A contiguous array
	can be a dummy but it must not be assumed shape.

2010-02-14  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/36932
	PR fortran/36933
	* gfortran.dg/dependency_26.f90: New test.
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c	(revision 156749)
--- gcc/fortran/trans-array.c	(working copy)
*************** gfc_conv_array_parameter (gfc_se * se, g
*** 5548,5554 ****
      }
  
    if (contiguous && g77 && !this_array_result
! 	&& !expr->symtree->n.sym->attr.dummy)
      {
        gfc_conv_expr_descriptor (se, expr, ss);
        if (expr->ts.type == BT_CHARACTER)
--- 5548,5554 ----
      }
  
    if (contiguous && g77 && !this_array_result
! 	&& expr->symtree->n.sym->as->type != AS_ASSUMED_SHAPE)
      {
        gfc_conv_expr_descriptor (se, expr, ss);
        if (expr->ts.type == BT_CHARACTER)
Index: gcc/fortran/dependency.c
===================================================================
*** gcc/fortran/dependency.c	(revision 156748)
--- gcc/fortran/dependency.c	(working copy)
*************** gfc_check_argument_var_dependency (gfc_e
*** 467,473 ****
        /* In case of elemental subroutines, there is no dependency 
           between two same-range array references.  */
        if (gfc_ref_needs_temporary_p (expr->ref)
! 	  || gfc_check_dependency (var, expr, !elemental))
  	{
  	  if (elemental == ELEM_DONT_CHECK_VARIABLE)
  	    {
--- 467,473 ----
        /* In case of elemental subroutines, there is no dependency 
           between two same-range array references.  */
        if (gfc_ref_needs_temporary_p (expr->ref)
! 	  || gfc_check_dependency (var, expr, elemental == NOT_ELEMENTAL))
  	{
  	  if (elemental == ELEM_DONT_CHECK_VARIABLE)
  	    {
*************** gfc_are_equivalenced_arrays (gfc_expr *e
*** 677,682 ****
--- 677,754 ----
  }
  
  
+ /* Return true if there is no possibility of aliasing because of a type
+    mismatch between all the possible pointer references and the
+    potential target.  Note that this function is asymmetric in the
+    arguments and so must be called twice with the arguments exchanged.  */
+ 
+ static bool
+ check_data_pointer_types (gfc_expr *expr1, gfc_expr *expr2)
+ {
+   gfc_component *cm1;
+   gfc_symbol *sym1;
+   gfc_symbol *sym2;
+   gfc_ref *ref1;
+   bool seen_component_ref;
+ 
+   if (expr1->expr_type != EXPR_VARIABLE
+ 	|| expr1->expr_type != EXPR_VARIABLE)
+     return false;
+ 
+   sym1 = expr1->symtree->n.sym;
+   sym2 = expr2->symtree->n.sym;
+ 
+   /* Keep it simple for now.  */
+   if (sym1->ts.type == BT_DERIVED && sym2->ts.type == BT_DERIVED)
+     return false;
+ 
+   if (sym1->attr.pointer)
+     {
+       if (gfc_compare_types (&sym1->ts, &sym2->ts))
+ 	return false;
+     }
+ 
+   /* This is a conservative check on the components of the derived type
+      if no component references have been seen.  Since we will not dig
+      into the components of derived type components, we play it safe by
+      returning false.  First we check the reference chain and then, if
+      no component references have been seen, the components.  */
+   seen_component_ref = false;
+   if (sym1->ts.type == BT_DERIVED)
+     {
+       for (ref1 = expr1->ref; ref1; ref1 = ref1->next)
+ 	{
+ 	  if (ref1->type != REF_COMPONENT)
+ 	    continue;
+ 
+ 	  if (ref1->u.c.component->ts.type == BT_DERIVED)
+ 	    return false;
+ 
+ 	  if ((sym2->attr.pointer || ref1->u.c.component->attr.pointer)
+ 		&& gfc_compare_types (&ref1->u.c.component->ts, &sym2->ts))
+ 	    return false;
+ 
+ 	  seen_component_ref = true;
+ 	}
+     }
+ 
+   if (sym1->ts.type == BT_DERIVED && !seen_component_ref)
+     {
+       for (cm1 = sym1->ts.u.derived->components; cm1; cm1 = cm1->next)
+ 	{
+ 	  if (cm1->ts.type == BT_DERIVED)
+ 	    return false;
+ 
+ 	  if ((sym2->attr.pointer || cm1->attr.pointer)
+ 		&& gfc_compare_types (&cm1->ts, &sym2->ts))
+ 	    return false;
+ 	}
+     }
+ 
+   return true;
+ }
+ 
+ 
  /* Return true if the statement body redefines the condition.  Returns
     true if expr2 depends on expr1.  expr1 should be a single term
     suitable for the lhs of an assignment.  The IDENTICAL flag indicates
*************** gfc_check_dependency (gfc_expr *expr1, g
*** 726,732 ****
  	  /* If either variable is a pointer, assume the worst.  */
  	  /* TODO: -fassume-no-pointer-aliasing */
  	  if (gfc_is_data_pointer (expr1) || gfc_is_data_pointer (expr2))
! 	    return 1;
  
  	  /* Otherwise distinct symbols have no dependencies.  */
  	  return 0;
--- 798,810 ----
  	  /* If either variable is a pointer, assume the worst.  */
  	  /* TODO: -fassume-no-pointer-aliasing */
  	  if (gfc_is_data_pointer (expr1) || gfc_is_data_pointer (expr2))
! 	    {
! 	      if (check_data_pointer_types (expr1, expr2)
! 		    && check_data_pointer_types (expr2, expr1))
! 		return 0;
! 
! 	      return 1;
! 	    }
  
  	  /* Otherwise distinct symbols have no dependencies.  */
  	  return 0;
Index: gcc/testsuite/gfortran.dg/dependency_26.f90
===================================================================
*** gcc/testsuite/gfortran.dg/dependency_26.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/dependency_26.f90	(revision 0)
***************
*** 0 ****
--- 1,53 ----
+ ! { dg-do compile }
+ ! { dg-options "-fdump-tree-original" }
+ !
+ ! Test the fix for PR36932 and PR36933, in which unnecessary
+ ! temporaries were being generated.  The module m2 tests the
+ ! additional testcase in comment #3 of PR36932.
+ !
+ ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+ !
+ MODULE M2
+   IMPLICIT NONE
+   TYPE particle
+    REAL :: r(3)
+   END TYPE
+ CONTAINS
+   SUBROUTINE S1(p)
+      TYPE(particle), POINTER, DIMENSION(:) :: p
+      REAL :: b(3)
+      INTEGER :: i
+      b=pbc(p(i)%r)
+   END SUBROUTINE S1
+   FUNCTION pbc(b)
+      REAL :: b(3)
+      REAL :: pbc(3)
+      pbc=b
+   END FUNCTION
+ END MODULE M2
+ 
+ MODULE M1
+   IMPLICIT NONE
+   TYPE cell_type
+      REAL :: h(3,3)
+   END TYPE
+ CONTAINS
+   SUBROUTINE S1(cell)
+      TYPE(cell_type), POINTER :: cell
+      REAL :: a(3)
+      REAL :: b(3) = [1, 2, 3]
+      a=MATMUL(cell%h,b)
+      if (ANY (INT (a) .ne. [30, 36, 42])) call abort
+   END SUBROUTINE S1
+ END MODULE M1
+ 
+   use M1
+   TYPE(cell_type), POINTER :: cell
+   allocate (cell)
+   cell%h = reshape ([(real(i), i = 1, 9)], [3, 3])
+   call s1 (cell)
+ end
+ ! { dg-final { cleanup-modules "M1" } }
+ ! { dg-final { scan-tree-dump-times "&a" 1 "original" } }
+ ! { dg-final { scan-tree-dump-times "pack" 0 "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]