[PATCH] Fix Fortran aliasing problem with EQUIVALENCE

[Jakub Jelinek]

Hi!

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=18518#c1 testcase is miscompiled
with GCC 4.1 and trunk at least on i?86 and x86_64 with -O2.
The scheduler swaps write into DMACH(1) with read from SMALL(1):

(insn 616 22 617 3 (set (reg:DI 1 dx)
        (const_int 4801453603149578240 [0x42a2309ce5400000])) 81 {*movdi_1_rex64} (nil)
    (nil))

(insn 617 616 26 3 (set (mem/s:DI (symbol_ref:DI ("equiv.0.1269") [flags 0x2] <var_decl 0x2b68b516cb00 equiv.0>) [9 equiv.0.dmach+0 S8 A64])
        (reg:DI 1 dx)) 81 {*movdi_1_rex64} (nil)
    (expr_list:REG_DEAD (reg:DI 1 dx)
        (nil)))

(insn:HI 26 617 27 3 (set (reg:SI 0 ax [orig:76 D.1316 ] [76])
        (mem/s:SI (symbol_ref:DI ("equiv.0.1269") [flags 0x2] <var_decl 0x2b68b516cb00 equiv.0>) [2 equiv.0.small+0 S4 A64])) 40 {*movsi_1} (nil)
    (nil))

becomes after sched2 pass:

(insn:TI 26 22 616 3 (set (reg:SI 0 ax [orig:76 D.1316 ] [76])
        (mem/s:SI (symbol_ref:DI ("equiv.0.1269") [flags 0x2] <var_decl 0x2b68b516cb00 equiv.0>) [2 equiv.0.small+0 S4 A64])) 40 {*movsi_1} (nil)
    (nil))

(insn 616 26 617 3 (set (reg:DI 1 dx)
        (const_int 4801453603149578240 [0x42a2309ce5400000])) 81 {*movdi_1_rex64} (nil)
    (nil))

(insn:TI 617 616 27 3 (set (mem/s:DI (symbol_ref:DI ("equiv.0.1269") [flags 0x2] <var_decl 0x2b68b516cb00 equiv.0>) [9 equiv.0.dmach+0 S8 A64])
        (reg:DI 1 dx)) 81 {*movdi_1_rex64} (nil)
    (expr_list:REG_DEAD (reg:DI 1 dx)
        (nil)))

That's because equiv.0.dmach and equiv.0.small use different alias sets (2
vs. 9).  C/C++ in this case uses alias set 0 and I think Fortran should do
the same.  If it is a component access through UNION_TYPE in Fortran, we
know it is either access to EQUIVALENCEd variable (which can't have POINTER
attribute nor be a CRAY POINTEE fortunately), or mixed entry master return
value.  In both cases we want to allow type-punning.

Ok for trunk (and obviously modified patch for 4.1)?

I'm not including a testcase, because I don't know if we can put netlib
code in gcc testsuite and I haven't managed to distill a smaller testcase
from it (as it is scheduling related, so highly sensitive to the content of
the whole function).

	Jakub
-------------- next part --------------
2006-03-22  Jakub Jelinek  <jakub@redhat.com>

	* f95-lang.c (gfc_get_alias_set): New function.
	(LANG_HOOKS_GET_ALIAS_SET): Define.

--- gcc/fortran/f95-lang.c.jj	2006-02-16 08:22:59.000000000 +0100
+++ gcc/fortran/f95-lang.c	2006-03-22 22:38:28.000000000 +0100
@@ -99,6 +99,7 @@ void insert_block (tree);
 static void gfc_clear_binding_stack (void);
 static void gfc_be_parse_file (int);
 static void gfc_expand_function (tree);
+static HOST_WIDE_INT gfc_get_alias_set (tree);
 
 #undef LANG_HOOKS_NAME
 #undef LANG_HOOKS_INIT
@@ -116,6 +117,7 @@ static void gfc_expand_function (tree);
 #undef LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE
 #undef LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION
 #undef LANG_HOOKS_CLEAR_BINDING_STACK
+#undef LANG_HOOKS_GET_ALIAS_SET
 #undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
 #undef LANG_HOOKS_OMP_PREDETERMINED_SHARING
 #undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR
@@ -139,6 +141,7 @@ static void gfc_expand_function (tree);
 #define LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE gfc_signed_or_unsigned_type
 #define LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION gfc_expand_function
 #define LANG_HOOKS_CLEAR_BINDING_STACK     gfc_clear_binding_stack
+#define LANG_HOOKS_GET_ALIAS_SET	   gfc_get_alias_set
 #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE	gfc_omp_privatize_by_reference
 #define LANG_HOOKS_OMP_PREDETERMINED_SHARING	gfc_omp_predetermined_sharing
 #define LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR	gfc_omp_disregard_value_expr
@@ -694,6 +697,24 @@ gfc_mark_addressable (tree exp)
       }
 }
 
+/* Return the typed-based alias set for T, which may be an expression
+   or a type.  Return -1 if we don't do anything special.  */
+
+static HOST_WIDE_INT
+gfc_get_alias_set (tree t)
+{
+  tree u;
+
+  /* Permit type-punning when accessing an EQUIVALENCEd variable or
+     mixed type entry master's return value.  */
+  for (u = t; handled_component_p (u); u = TREE_OPERAND (u, 0))
+    if (TREE_CODE (u) == COMPONENT_REF
+	&& TREE_CODE (TREE_TYPE (TREE_OPERAND (u, 0))) == UNION_TYPE)
+      return 0;
+
+  return -1;
+}
+
 /* press the big red button - garbage (ggc) collection is on */
 
 int ggc_p = 1;