[flang] Skip creating AggregateStores for common block associated aggregates

[jpenix-quic]

Summary

Previously, AggregateStores were created for aggregates associated with common
blocks. As a) AggregateStoreMap uses scope and offset information to search for
aggregate stores and b) variables related to common blocks have their
offsets set relative to the common block itself, if there were multiple
equivalences and at least one involved variables defined in a common block there
was an opportunity for the scope/offset pairs to match between distinct
aggregate stores. As a result, entries in AggregateStoreMap could collide,
resulting in incorrect stores being returned for a particular variable.

To prevent these collisions, skip creating AggregateStores for aggregates which
are associated with common blocks. This information was already unused as
aggregates associated with common blocks are handled by instantiateCommon.

Fixes https://github.com/llvm/llvm-project/issues/57749

[jeanPerier]

Thanks for identifying the issue and submitting this patch!

As you mention, AggregateStore are actually not used for common blocks since "instantiateCommon" is used even if they are equivalenced variables in the common block. They are meant to deal with storages that are interlaced because of an equivalence, but if the variables are part of a common, all this information is already available.

So, I think that instead of modifying the AggregateStoreKeys so that "common block" AggregateStore stores can be added without overriding non common block AggregateStores, and later be unused, I think it might be simpler to simply not build the AggregateStore for common blocks (see inlined suggestion).

flang/lib/Lower/PFTBuilder.cpp

1326

I think you could maybe simply continue here if first belong to a common block in order to not build aggregate stores for common blocks.

[jpenix-quic]

Implement @jeanPerier's suggestion and update the title/summary accordingly. Also fixed "equivaleneced" -> "equivalenced" in the test comment.

[jpenix-quic]

flang/lib/Lower/PFTBuilder.cpp

1326

This is indeed much simpler and tested ok for me. Thanks!

[jeanPerier]

Thanks for fixing the issue !

flang/include/flang/Lower/ConvertVariable.h

 namespace pft {
 struct Variable;
 }
 
 /// AggregateStoreMap is used to keep track of instantiated aggregate stores
 /// when lowering a scope containing equivalences (aliases). It must only be
 /// owned by the code lowering a scope and provided to instantiateVariable.
 using AggregateStoreKey =
-    std::tuple<const Fortran::semantics::Scope *, std::size_t>;
+    std::tuple<const Fortran::semantics::Scope *,
+               const Fortran::semantics::Symbol *, std::size_t>;
 using AggregateStoreMap = llvm::DenseMap<AggregateStoreKey, mlir::Value>;
 
 /// Instantiate variable \p var and add it to \p symMap.
 /// The AbstractConverter builder must be set.
 /// The AbstractConverter own symbol mapping is not used during the
 /// instantiation and can be different form \p symMap.
 void instantiateVariable(AbstractConverter &, const pft::Variable &var,
                          SymMap &symMap, AggregateStoreMap &storeMap);

flang/include/flang/Lower/PFTBuilder.h

struct Variable {
   using Interval = std::tuple<std::size_t, std::size_t>;
 
   /// An interval of storage is a contiguous block of memory to be allocated or
   /// mapped onto another variable. Aliasing variables will be pointers into
   /// interval stores and may overlap each other.
   struct AggregateStore {
     AggregateStore(Interval &&interval,
                    const Fortran::semantics::Symbol &namingSym,
+                   const Fortran::semantics::Symbol *commonSymbol,
                    bool isGlobal = false)
         : interval{std::move(interval)}, namingSymbol{&namingSym},
-          isGlobalAggregate{isGlobal} {}
+          commonSymbol{commonSymbol}, isGlobalAggregate{isGlobal} {}
     AggregateStore(const semantics::Symbol &initialValueSym,
-                   const semantics::Symbol &namingSym, bool isGlobal = false)
+                   const semantics::Symbol &namingSym,
+                   const semantics::Symbol *commonSymbol, bool isGlobal = false)
         : interval{initialValueSym.offset(), initialValueSym.size()},
           namingSymbol{&namingSym}, initialValueSymbol{&initialValueSym},
-          isGlobalAggregate{isGlobal} {};
+          commonSymbol{commonSymbol}, isGlobalAggregate{isGlobal} {};
 
     bool isGlobal() const { return isGlobalAggregate; }
     /// Get offset of the aggregate inside its scope.
     std::size_t getOffset() const { return std::get<0>(interval); }
     /// Returns symbols holding the aggregate initial value if any.
     const semantics::Symbol *getInitialValueSymbol() const {
       return initialValueSymbol;
     }
+    /// Returns common block symbol associated with the aggregate store if any.
+    const semantics::Symbol *getCommonSymbol() const { return commonSymbol; }
     /// Returns the symbol that gives its name to the aggregate.
     const semantics::Symbol &getNamingSymbol() const { return *namingSymbol; }
     /// Scope to which the aggregates belongs to.
     const semantics::Scope &getOwningScope() const {
       return getNamingSymbol().owner();
     }
     /// <offset, size> of the aggregate in its scope.
     Interval interval{};
     /// Symbol that gives its name to the aggregate. Always set by constructor.
     const semantics::Symbol *namingSymbol;
     /// Compiler generated symbol with the aggregate initial value if any.
     const semantics::Symbol *initialValueSymbol = nullptr;
+    /// Common block symbol associated with the aggregate store if any.
+    const semantics::Symbol *commonSymbol;
     /// Is this a global aggregate ?
     bool isGlobalAggregate;
   };
 
   explicit Variable(const Fortran::semantics::Symbol &sym, bool global = false,
                     int depth = 0)
       : var{Nominal(&sym, depth, global)} {}
   explicit Variable(AggregateStore &&istore) : var{std::move(istore)} {}
struct Variable {
   const Fortran::semantics::Scope *getOwningScope() const {
     return std::visit(
         common::visitors{
             [](const Nominal &x) { return &x.symbol->GetUltimate().owner(); },
             [](const AggregateStore &agg) { return &agg.getOwningScope(); }},
         var);
   }
 
+  const Fortran::semantics::Symbol *getCommonSymbol() const {
+    return std::visit(
+        common::visitors{
+            [](const Nominal &x) {
+              return Fortran::semantics::FindCommonBlockContaining(
+                  x.symbol->GetUltimate());
+            },
+            [](const AggregateStore &agg) { return agg.getCommonSymbol(); }},
+        var);
+  }
+
   bool isHeapAlloc() const {
     if (auto *s = std::get_if<Nominal>(&var))
       return s->heapAlloc;
     return false;
   }
   bool isPointer() const {
     if (auto *s = std::get_if<Nominal>(&var))
       return s->pointer;

flang/lib/Lower/ConvertVariable.cpp

 // Aliased (EQUIVALENCE) variables instantiation
 //===----------------------------------------------------------------===//
 
 /// Insert \p aggregateStore instance into an AggregateStoreMap.
 static void insertAggregateStore(Fortran::lower::AggregateStoreMap &storeMap,
                                  const Fortran::lower::pft::Variable &var,
                                  mlir::Value aggregateStore) {
   std::size_t off = var.getAggregateStore().getOffset();
-  Fortran::lower::AggregateStoreKey key = {var.getOwningScope(), off};
+  Fortran::lower::AggregateStoreKey key = {var.getOwningScope(),
+                                           var.getCommonSymbol(), off};
   storeMap[key] = aggregateStore;
 }
 
 /// Retrieve the aggregate store instance of \p alias from an
 /// AggregateStoreMap.
 static mlir::Value
 getAggregateStore(Fortran::lower::AggregateStoreMap &storeMap,
                   const Fortran::lower::pft::Variable &alias) {
-  Fortran::lower::AggregateStoreKey key = {alias.getOwningScope(),
-                                           alias.getAlias()};
+  Fortran::lower::AggregateStoreKey key = {
+      alias.getOwningScope(), alias.getCommonSymbol(), alias.getAlias()};
   auto iter = storeMap.find(key);
   assert(iter != storeMap.end());
   return iter->second;
 }
 
 /// Build the name for the storage of a global equivalence.
 static std::string mangleGlobalAggregateStore(
     const Fortran::lower::pft::Variable::AggregateStore &st) {

flang/lib/Lower/PFTBuilder.cpp

if (analyzedScopes.find(&scope) != analyzedScopes.end())
       return;
 
     analyzedScopes.insert(&scope);
     std::list<std::list<semantics::SymbolRef>> aggregates =
         Fortran::semantics::GetStorageAssociations(scope);
     for (std::list<semantics::SymbolRef> aggregate : aggregates) {
       const Fortran::semantics::Symbol *aggregateSym = nullptr;
       bool isGlobal = false;
       const semantics::Symbol &first = *aggregate.front();
       std::size_t start = first.offset();
       std::size_t end = first.offset() + first.size();
       const Fortran::semantics::Symbol *namingSym = nullptr;
+      const Fortran::semantics::Symbol *commonSym = nullptr;
       for (semantics::SymbolRef symRef : aggregate) {
         const semantics::Symbol &sym = *symRef;
         aliasSyms.insert(&sym);
         if (sym.test(Fortran::semantics::Symbol::Flag::CompilerCreated)) {
           aggregateSym = &sym;
         } else {
           isGlobal |= lower::symbolIsGlobal(sym);
           start = std::min(sym.offset(), start);
           end = std::max(sym.offset() + sym.size(), end);
           if (!namingSym || (sym.name() < namingSym->name()))
             namingSym = &sym;
+          if (!commonSym) {
+            if (const Fortran::semantics::Symbol *common =
+                    Fortran::semantics::FindCommonBlockContaining(
+                        sym.GetUltimate()))
+              commonSym = common;
+          }
         }
       }
       assert(namingSym && "must contain at least one user symbol");
       if (!aggregateSym) {
         stores.emplace_back(
             Fortran::lower::pft::Variable::Interval{start, end - start},
-            *namingSym, isGlobal);
+            *namingSym, commonSym, isGlobal);
       } else {
-        stores.emplace_back(*aggregateSym, *namingSym, isGlobal);
+        stores.emplace_back(*aggregateSym, *namingSym, commonSym, isGlobal);
       }
     }
   }
 
   // Recursively visit each symbol to determine the height of its dependence on
   // other symbols.
   int analyze(const semantics::Symbol &sym) {
     auto done = seen.insert(&sym);

flang/test/Lower/equivalence-2.f90

! CHECK-LABEL: @_QPeq_and_entry_bar()
 
   ! CHECK-DAG: %[[xOffset:.*]] = arith.constant 0 : index
   ! CHECK-DAG: %[[xAddr:.*]] = fir.coordinate_of %[[xi]], %[[xOffset]] : (!fir.ref<!fir.array<8xi8>>, index) -> !fir.ref<i8>
   ! CHECK-DAG: %[[x:.*]] = fir.convert %[[xAddr]] : (!fir.ref<i8>) -> !fir.ptr<!fir.array<2xf32>>
   ! CHECK-NOT: fir.call @_QPfoo1
   ! CHECK: %[[xCast:.*]] = fir.convert %[[x]] : (!fir.ptr<!fir.array<2xf32>>) -> !fir.ref<!fir.array<2xf32>>
   ! CHECK: %[[iCast:.*]] = fir.convert %[[i]] : (!fir.ptr<i32>) -> !fir.ref<i32>
   ! CHECK: fir.call @_QPfoo2(%[[xCast]], %[[iCast]]) : (!fir.ref<!fir.array<2xf32>>, !fir.ref<i32>) -> ()
+
+
+! Check that cases where equivaleneced local variables and common blocks will
+! share the same offset use the correct stores
+! CHECK-LABEL: @_QPeq_and_comm_same_offset()
+subroutine eq_and_comm_same_offset
+  real common_arr1(133),common_arr2(133)
+  common /my_common_block/ common_arr1,common_arr2
+  real arr1(133),arr2(133)
+  real arr3(133,133),arr4(133,133)
+  equivalence(arr1,common_arr1),(arr2,common_arr2)
+  equivalence(arr3,arr4)
+
+  ! CHECK: %[[arr4Store:.*]] = fir.alloca !fir.array<70756xi8> {uniq_name = "_QFeq_and_comm_same_offsetEarr3"}
+  ! CHECK: %[[mcbAddr:.*]] = fir.address_of(@_QBmy_common_block) : !fir.ref<!fir.array<1064xi8>>
+  ! CHECK: %[[mcbCast:.*]] = fir.convert %[[mcbAddr]] : (!fir.ref<!fir.array<1064xi8>>) -> !fir.ref<!fir.array<?xi8>>
+  ! CHECK: %[[c0:.*]] = arith.constant 0 : index
+  ! CHECK: %[[mcbCoor:.*]] = fir.coordinate_of %[[mcbCast]], %[[c0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+  ! CHECK: %[[mcbCoorCast:.*]] = fir.convert %[[mcbCoor]] : (!fir.ref<i8>) -> !fir.ptr<!fir.array<133xf32>>
+  ! CHECK: %[[c1:.*]] = arith.constant 0 : index
+  ! CHECK: %[[arr4Addr:.*]] = fir.coordinate_of %[[arr4Store]], %[[c1]] : (!fir.ref<!fir.array<70756xi8>>, index) -> !fir.ref<i8>
+  ! CHECK: %[[arr4Cast:.*]] = fir.convert %[[arr4Addr]] : (!fir.ref<i8>) -> !fir.ptr<!fir.array<133x133xf32>>
+
+  arr1(1) = 1
+  ! CHECK:%[[mcbFinalAddr:.*]] = fir.coordinate_of %[[mcbCoorCast]], %{{.*}} : (!fir.ptr<!fir.array<133xf32>>, i64) -> !fir.ref<f32>
+  ! CHECK:fir.store %{{.*}} to %[[mcbFinalAddr]] : !fir.ref<f32>
+
+  arr4(1,1) = 2
+  ! CHECK: %[[arr4FinalAddr:.*]] = fir.coordinate_of %[[arr4Cast]], %{{.*}}, %{{.*}} : (!fir.ptr<!fir.array<133x133xf32>>, i64, i64) -> !fir.ref<f32>
+  ! CHECK: fir.store %{{.*}} to %[[arr4FinalAddr]] : !fir.ref<f32>
+end subroutine