This relates to FORTRAN code where different modules give different sizes to the
same array in a COMMON block (contrary to the fortran language specification).
SPEC have refused to patch the source code
(https://www.spec.org/cpu2006/Docs/faq.html#Run.05).

Hence, this patch provides a Fortran-specific option -funknown-commons that
marks such arrays as having unknown size - that is, NULL_TREE for both
TYPE_SIZE and max value of TYPE_DOMAIN. DECL_SIZE is preserved for e.g. output
in varasm.c.

On AArch64, it fixes the 416.gamess issue, and allows compiling 416.gamess
without the -fno-aggressive-loop-optimizations previously required (numerous
other PRs relating to 416.gamess).

I had to fix up a couple of places to deal with null TYPE_SIZE but in most cases
a test for such was already present. (omp-low.c had too many so I gave up: in
practice I think it's OK to just not use the new flag at the same time as
-fopenmp).

Bootstrapped + check-gcc + check-g++ on AArch64 and x86.
Also check-fortran with a variant enabling the option in all cases (to allow
compilation of C): here, only gfortran.dg/gomp/appendix-a/a.24.1.f90 fails,
this uses -fopenmp mentioned above.

Testcase fails both the FIND and one of the assignments if -funknown-commons is 
removed.

OK for trunk? I'd be happy to move this under -std=legacy if the Fortran folks
prefer. (-funcommon-commons has also been humourously suggested!)

gcc/ChangeLog:

        * expr.c (store_field): Handle null TYPE_SIZE.
        * tree-vect-data-refs.c (vect_analyze_data_refs): Bail out if TYPE_SIZE
        is null.
        * tree-dfa.c (get_ref_base_and_extent): Keep maxsize==-1 when reading
        the whole of a DECL.

gcc/fortran/ChangeLog:

        * lang.opt: Add -funknown-commons.
        * trans-common.ci (build_field): If flag_unknown_commons is on, set
        upper bound and size of arrays in common block to NULL_TREE.
        (create_common): Explicitly set DECL_SIZE and DECL_SIZE_UNIT.

gcc/testsuite/ChangeLog:
        * gfortran.dg/unknown_commons.f: New.
---
 gcc/expr.c                                  |  1 +
 gcc/fortran/lang.opt                        |  4 ++++
 gcc/fortran/trans-common.c                  | 35 +++++++++++++++++++++++++++++
 gcc/testsuite/gfortran.dg/unknown_commons.f | 20 +++++++++++++++++
 gcc/tree-dfa.c                              |  6 ++++-
 gcc/tree-vect-data-refs.c                   |  8 +++++++
 6 files changed, 73 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/unknown_commons.f

diff --git a/gcc/expr.c b/gcc/expr.c
index f4bac36..609bf59 100644
--- a/gcc/expr.c
+++ b/gcc/expr.c
@@ -6638,6 +6638,7 @@ store_field (rtx target, HOST_WIDE_INT bitsize, 
HOST_WIDE_INT bitpos,
         RHS isn't the same size as the bitfield, we must use bitfield
         operations.  */
       || (bitsize >= 0
+         && TYPE_SIZE (TREE_TYPE (exp))
          && TREE_CODE (TYPE_SIZE (TREE_TYPE (exp))) == INTEGER_CST
          && compare_tree_int (TYPE_SIZE (TREE_TYPE (exp)), bitsize) != 0
          /* Except for initialization of full bytes from a CONSTRUCTOR, which
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 45428d8..b1b4641 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -686,6 +686,10 @@ funderscoring
 Fortran Var(flag_underscoring) Init(1)
 Append underscores to externally visible names.
 
+funknown-commons
+Fortran Var(flag_unknown_commons)
+Treat arrays in common blocks as having unknown size.
+
 fwhole-file
 Fortran Ignore
 Does nothing.  Preserved for backward compatibility.
diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index 21d1928..bf99c56 100644
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -284,8 +284,41 @@ build_field (segment_info *h, tree union_type, 
record_layout_info rli)
   unsigned HOST_WIDE_INT desired_align, known_align;
 
   name = get_identifier (h->sym->name);
+
+  gcc_assert (TYPE_P (h->field));
+  tree size = TYPE_SIZE (h->field);
+  tree size_unit = TYPE_SIZE_UNIT (h->field);
+  if (GFC_ARRAY_TYPE_P (h->field)
+      && !h->sym->value
+      && flag_unknown_commons)
+    {
+      gcc_assert (!GFC_DESCRIPTOR_TYPE_P (h->field));
+      gcc_assert (TREE_CODE (h->field) == ARRAY_TYPE);
+
+      /* Could be merged at link time with a larger array whose size we don't
+        know.  */
+      static tree range_type = NULL_TREE;
+      if (!range_type)
+       range_type = build_range_type (gfc_array_index_type,
+                                      gfc_index_zero_node, NULL_TREE);
+      tree type = copy_node (h->field);
+      TYPE_DOMAIN (type) = range_type;
+      TYPE_SIZE (type) = NULL_TREE;
+      TYPE_SIZE_UNIT (type) = NULL_TREE;
+      SET_TYPE_MODE (type, BLKmode);
+      gcc_assert (TYPE_CANONICAL (h->field) == h->field);
+      gcc_assert (TYPE_MAIN_VARIANT (h->field) == h->field);
+      TYPE_CANONICAL (type) = type;
+      TYPE_MAIN_VARIANT (type) = type;
+      layout_type (type);
+      h->field = type;
+    }
+
   field = build_decl (h->sym->declared_at.lb->location,
                      FIELD_DECL, name, h->field);
+  DECL_SIZE (field) = size;
+  DECL_SIZE_UNIT (field) = size_unit;
+
   known_align = (offset & -offset) * BITS_PER_UNIT;
   if (known_align == 0 || known_align > BIGGEST_ALIGNMENT)
     known_align = BIGGEST_ALIGNMENT;
@@ -703,6 +736,8 @@ create_common (gfc_common_head *com, segment_info *head, 
bool saw_equiv)
                             VAR_DECL, DECL_NAME (s->field),
                             TREE_TYPE (s->field));
       TREE_STATIC (var_decl) = TREE_STATIC (decl);
+      DECL_SIZE (var_decl) = DECL_SIZE (s->field);
+      DECL_SIZE_UNIT (var_decl) = DECL_SIZE_UNIT (s->field);
       /* Mark the variable as used in order to avoid warnings about
         unused variables.  */
       TREE_USED (var_decl) = 1;
diff --git a/gcc/testsuite/gfortran.dg/unknown_commons.f 
b/gcc/testsuite/gfortran.dg/unknown_commons.f
new file mode 100644
index 0000000..97e3ce3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unknown_commons.f
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-O3 -funknown-commons -fdump-tree-dom2-details" }
+
+! Test for PR69368: a single-element array in a common block, which will be
+! overridden with a larger size at link time (contrary to language spec).
+! Dominator opts considers accesses to differently-computed elements of X as
+! equivalent, unless -funknown-commons is passed in.
+      SUBROUTINE FOO
+      IMPLICIT DOUBLE PRECISION (X)
+      INTEGER J
+      COMMON /MYCOMMON / X(1)
+      DO 10 J=1,1024
+         X(J+1)=X(J+7)
+  10  CONTINUE
+      RETURN
+      END
+! { dg-final { scan-tree-dump-not "FIND" "dom2" } }
+! We should retain both a read and write of mycommon.x.
+! { dg-final { scan-tree-dump-times "  _\[0-9\]+ = 
mycommon\\.x\\\[_\[0-9\]+\\\];" 1 "dom2" } }
+! { dg-final { scan-tree-dump-times "  mycommon\\.x\\\[_\[0-9\]+\\\] = 
_\[0-9\]+;" 1 "dom2" } }
diff --git a/gcc/tree-dfa.c b/gcc/tree-dfa.c
index 0e98056..340c04c 100644
--- a/gcc/tree-dfa.c
+++ b/gcc/tree-dfa.c
@@ -617,7 +617,11 @@ get_ref_base_and_extent (tree exp, HOST_WIDE_INT *poffset,
       if (maxsize == -1
          && DECL_SIZE (exp)
          && TREE_CODE (DECL_SIZE (exp)) == INTEGER_CST)
-       maxsize = wi::to_offset (DECL_SIZE (exp)) - bit_offset;
+       {
+         maxsize = wi::to_offset (DECL_SIZE (exp)) - bit_offset;
+         if (maxsize == bitsize)
+           maxsize = -1;
+       }
     }
   else if (CONSTANT_CLASS_P (exp))
     {
diff --git a/gcc/tree-vect-data-refs.c b/gcc/tree-vect-data-refs.c
index 4c0e135..f8e8dce 100644
--- a/gcc/tree-vect-data-refs.c
+++ b/gcc/tree-vect-data-refs.c
@@ -3412,6 +3412,14 @@ again:
           return false;
         }
 
+      if (TYPE_SIZE (TREE_TYPE (DR_REF (dr))) == NULL_TREE)
+       {
+         if (dump_enabled_p ())
+           dump_printf_loc (MSG_MISSED_OPTIMIZATION, vect_location,
+                            "not vectorized: data-ref of unknown size\n");
+         return false;
+       }
+
       stmt = DR_STMT (dr);
       stmt_info = vinfo_for_stmt (stmt);
 
-- 
1.9.1

Reply via email to