[Patch, fortran] PR20938 and where_19 - equivalence dependencies

[Paul Thomas <paulthomas2 at wanadoo dot fr>]

:ADDPATCH fortran:

This is a revamp of the original patch: 
http://gcc.gnu.org/ml/fortran/2006-02/msg00420.html.

It stores some of the data in the segment_info lists, produced in 
trans-common.c(add_equivalences), in new structures and uses the 
information in dependency.c to check for dependencies through direct and 
indirect equivalences.  The segment offsets are used in this checking.  
The check is conservative, in that a small group of cases, where the 
offset and the  array references are such that, in reality, there is no 
dependency, will still produce temporaries; eg. an offset of -1 and an 
index difference of +1.  The clean up occurs in gfc_free_namespace, 
partly for consistency and partly because analysis showed that there was 
no great advantage in doing it earlier.

The testcases are all as originally submitted.

Regtested on FC3/Athlon.  OK for trunk and, eventually, 4.1?

Paul

2005-02-25  Paul Thomas  <pault@gcc.gnu.org>

   PR fortran/20938
   * trans-array.c (gfc_conv_resolve_dependencies): Add call to
   gfc_are_equivalenced_arrays.
   * symbol.c (gfc_free_equiv_infos, gfc_free_equiv_lists): New
   functions. (gfc_free_namespace): Call them.
   * trans-common.c (copy_equiv_list_to_ns): New function.
   (add_equivalences): Call it.
   * gfortran.h: Add equiv_lists to gfc_namespace and define
   gfc_equiv_list and gfc_equiv_info.
   * dependency.c (gfc_are_equivalenced_arrays): New function.
   (gfc_check_dependency): Call it.
   * dependency.h: Prototype for gfc_are_equivalenced_arrays.

2005-02-25  Paul Thomas  <pault@gcc.gnu.org>

   PR fortran/20938
   * gfortran.dg/dependency_2.f90: New test.
   * gfortran.fortran-torture/execute/where17.f90: New test.
   * gfortran.fortran-torture/execute/where18.f90: New test.
   * gfortran.fortran-torture/execute/where19.f90: New test.
   * gfortran.fortran-torture/execute/where_20.f90: New test.




Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c	(revision 111416)
--- gcc/fortran/trans-array.c	(working copy)
*************** gfc_conv_resolve_dependencies (gfc_loopi
*** 2581,2587 ****
        if (ss->type != GFC_SS_SECTION)
  	continue;
  
!       if (gfc_could_be_alias (dest, ss))
  	{
  	  nDepend = 1;
  	  break;
--- 2581,2588 ----
        if (ss->type != GFC_SS_SECTION)
  	continue;
  
!       if (gfc_could_be_alias (dest, ss)
! 	    || gfc_are_equivalenced_arrays (dest->expr, ss->expr))
  	{
  	  nDepend = 1;
  	  break;
Index: gcc/fortran/symbol.c
===================================================================
*** gcc/fortran/symbol.c	(revision 111416)
--- gcc/fortran/symbol.c	(working copy)
*************** gfc_free_dt_list (gfc_dt_list * dt)
*** 2424,2429 ****
--- 2424,2454 ----
  }
  
  
+ /* Free the gfc_equiv_info's.  */
+ 
+ static void
+ gfc_free_equiv_infos (gfc_equiv_info * s)
+ {
+   if (s == NULL)
+     return;
+   gfc_free_equiv_infos (s->next);
+   gfc_free (s);
+ }
+ 
+ 
+ /* Free the gfc_equiv_lists.  */
+ 
+ static void
+ gfc_free_equiv_lists (gfc_equiv_list * l)
+ {
+   if (l == NULL)
+     return;
+   gfc_free_equiv_lists (l->next);
+   gfc_free_equiv_infos (l->equiv);
+   gfc_free (l);
+ }
+ 
+ 
  /* Free a namespace structure and everything below it.  Interface
     lists associated with intrinsic operators are not freed.  These are
     taken care of when a specific name is freed.  */
*************** gfc_free_namespace (gfc_namespace * ns)
*** 2459,2464 ****
--- 2484,2490 ----
    free_st_labels (ns->st_labels);
  
    gfc_free_equiv (ns->equiv);
+   gfc_free_equiv_lists (ns->equiv_lists);
  
    gfc_free_dt_list (ns->derived_types);
  
Index: gcc/fortran/trans-common.c
===================================================================
*** gcc/fortran/trans-common.c	(revision 111416)
--- gcc/fortran/trans-common.c	(working copy)
*************** typedef struct segment_info
*** 122,127 ****
--- 122,128 ----
  static segment_info * current_segment;
  static gfc_namespace *gfc_common_ns = NULL;
  
+ 
  /* Make a segment_info based on a symbol.  */
  
  static segment_info *
*************** get_segment_info (gfc_symbol * sym, HOST
*** 144,149 ****
--- 145,178 ----
    return s;
  }
  
+ 
+ /* Add a copy of a segment list to the namespace.  This is specifically for
+    equivalence segments, so that dependency checking can be done on
+    equivalence group members.  */
+ 
+ static void
+ copy_equiv_list_to_ns (segment_info *c)
+ {
+   segment_info *f;
+   gfc_equiv_info *s;
+   gfc_equiv_list *l;
+ 
+   l = (gfc_equiv_list *) gfc_getmem (sizeof (gfc_equiv_list));
+ 
+   l->next = c->sym->ns->equiv_lists;
+   c->sym->ns->equiv_lists = l;
+ 
+   for (f = c; f; f = f->next)
+     {
+       s = (gfc_equiv_info *) gfc_getmem (sizeof (gfc_equiv_info));
+       s->next = l->equiv;
+       l->equiv = s;
+       s->sym = f->sym;
+       s->offset = f->offset;
+     }
+ }
+ 
+ 
  /* Add combine segment V and segment LIST.  */
  
  static segment_info *
*************** add_equivalences (bool *saw_equiv)
*** 787,792 ****
--- 816,824 ----
  	    }
  	}
      }
+ 
+   /* Add a copy of this segment list to the namespace.  */
+   copy_equiv_list_to_ns (current_segment);
  }
  
  
Index: gcc/fortran/gfortran.h
===================================================================
*** gcc/fortran/gfortran.h	(revision 111416)
--- gcc/fortran/gfortran.h	(working copy)
*************** typedef struct gfc_namespace
*** 950,955 ****
--- 950,959 ----
  
    /* Points to the equivalences set up in this namespace.  */
    struct gfc_equiv *equiv;
+ 
+   /* Points to the equivalence groups produced by trans_common.  */
+   struct gfc_equiv_list *equiv_lists;
+ 
    gfc_interface *operator[GFC_INTRINSIC_OPS];
  
    /* Points to the parent namespace, i.e. the namespace of a module or
*************** gfc_equiv;
*** 1343,1348 ****
--- 1347,1366 ----
  
  #define gfc_get_equiv() gfc_getmem(sizeof(gfc_equiv))
  
+ /* Holds a single equivalence member after processing.  */
+ typedef struct gfc_equiv_info
+ {
+   gfc_symbol *sym;
+   HOST_WIDE_INT offset;
+   struct gfc_equiv_info *next;
+ } gfc_equiv_info;
+ 
+ /* Holds equivalence groups, after they have been processed.  */
+ typedef struct gfc_equiv_list
+ {
+   gfc_equiv_info *equiv;
+   struct gfc_equiv_list *next;
+ } gfc_equiv_list;
  
  /* gfc_case stores the selector list of a case statement.  The *low
     and *high pointers can point to the same expression in the case of
Index: gcc/fortran/dependency.c
===================================================================
*** gcc/fortran/dependency.c	(revision 111416)
--- gcc/fortran/dependency.c	(working copy)
*************** gfc_check_fncall_dependency (gfc_expr * 
*** 337,342 ****
--- 337,387 ----
  }
  
  
+ /* Return 1 if e1 and e2 are equivalenced arrays, either
+    directly or indirectly; ie. equivalence (a,b) for a and b
+    or equivalence (a,c),(b,c).  This function uses the equiv_
+    lists, generated in trans-common(add_equivalences), that are
+    guaranteed to pick up indirect equivalences.  A rudimentary
+    use is made of the offset to ensure that cases where the
+    source elements are moved down to the destination are not
+    identified as dependencies.  */
+ 
+ int
+ gfc_are_equivalenced_arrays (gfc_expr *e1, gfc_expr *e2)
+ {
+   gfc_equiv_list *l;
+   gfc_equiv_info *s, *fl1, *fl2;
+ 
+   gcc_assert (e1->expr_type == EXPR_VARIABLE
+ 		&& e2->expr_type == EXPR_VARIABLE);
+ 
+   if (!e1->symtree->n.sym->attr.in_equivalence
+ 	|| !e2->symtree->n.sym->attr.in_equivalence
+ 	|| !e1->rank
+ 	|| !e2->rank)
+     return 0;
+ 
+   /* Go through the equiv_lists and return 1 if the variables
+      e1 and e2 are members of the same group and satisfy the
+      requirement on their relative offsets.  */
+   for (l = gfc_current_ns->equiv_lists; l; l = l->next)
+     {
+       fl1 = NULL;
+       fl2 = NULL;
+       for (s = l->equiv; s; s = s->next)
+ 	{
+ 	  if (s->sym == e1->symtree->n.sym)
+ 	    fl1 = s;
+ 	  if (s->sym == e2->symtree->n.sym)
+ 	    fl2 = s;
+ 	  if (fl1 && fl2 && (fl1->offset > fl2->offset))
+ 	    return 1;
+ 	}
+     }
+ return 0;
+ }
+ 
+ 
  /* 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, 
*** 383,388 ****
--- 428,437 ----
  	    return 1;
  	}
  
+       /* Return 1 if expr1 and expr2 are equivalenced arrays.  */
+       if (gfc_are_equivalenced_arrays (expr1, expr2))
+ 	return 1;
+ 
        if (expr1->symtree->n.sym != expr2->symtree->n.sym)
  	return 0;
  
Index: gcc/fortran/dependency.h
===================================================================
*** gcc/fortran/dependency.h	(revision 111416)
--- gcc/fortran/dependency.h	(working copy)
*************** int gfc_is_same_range (gfc_array_ref *, 
*** 30,32 ****
--- 30,33 ----
  int gfc_expr_is_one (gfc_expr *, int);
  
  int gfc_dep_resolver(gfc_ref *, gfc_ref *);
+ int gfc_are_equivalenced_arrays (gfc_expr *, gfc_expr *);