Merge pull request #1029 from flang-compiler/jpr-update-equivalence-handling

Jpr update equivalence handling

Author: jeanPerier

flang/include/flang/Evaluate/initial-image.h

@@ -30,6 +30,7 @@ class InitialImage {
   };
 
   explicit InitialImage(std::size_t bytes) : data_(bytes) {}
+  InitialImage(InitialImage &&that) = default;
 
   std::size_t size() const { return data_.size(); }
 
@@ -93,19 +94,17 @@ class InitialImage {
 
   void AddPointer(ConstantSubscript, const Expr<SomeType> &);
 
-  void Incorporate(ConstantSubscript, const InitialImage &);
+  void Incorporate(ConstantSubscript toOffset, const InitialImage &from,
+      ConstantSubscript fromOffset, ConstantSubscript bytes);
 
   // Conversions to constant initializers
   std::optional<Expr<SomeType>> AsConstant(FoldingContext &,
       const DynamicType &, const ConstantSubscripts &,
       ConstantSubscript offset = 0) const;
-  std::optional<Expr<SomeType>> AsConstantDataPointer(
-      const DynamicType &, ConstantSubscript offset = 0) const;
-  const ProcedureDesignator &AsConstantProcPointer(
+  std::optional<Expr<SomeType>> AsConstantPointer(
       ConstantSubscript offset = 0) const;
 
   friend class AsConstantHelper;
-  friend class AsConstantDataPointerHelper;
 
 private:
   std::vector<char> data_;

flang/include/flang/Lower/PFTBuilder.h

@@ -392,31 +392,49 @@ struct Variable {
     std::size_t aliasOffset{};
   };
 
+  /// <offset, size> pair
   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::Scope &scope,
-                   bool isDeclaration = false)
-        : interval{std::move(interval)}, scope{&scope}, isDecl{isDeclaration} {}
-    AggregateStore(
-        Interval &&interval, const Fortran::semantics::Scope &scope,
-        const llvm::SmallVector<const semantics::Symbol *> &unorderedVars,
-        bool isDeclaration = false);
-
-    bool isGlobal() const { return vars.size() > 0; }
+    AggregateStore(Interval &&interval,
+                   const Fortran::semantics::Symbol &namingSym,
+                   bool isDeclaration = false, bool isGlobal = false)
+        : interval{std::move(interval)}, namingSymbol{&namingSym},
+          isDecl{isDeclaration}, isGlobalAggregate{isGlobal} {}
+    AggregateStore(const semantics::Symbol &initialValueSym,
+                   const semantics::Symbol &namingSym,
+                   bool isDeclaration = false, bool isGlobal = false)
+        : interval{initialValueSym.offset(), initialValueSym.size()},
+          namingSymbol{&namingSym}, initialValueSymbol{&initialValueSym},
+          isDecl{isDeclaration}, isGlobalAggregate{isGlobal} {};
+
+    bool isGlobal() const { return isGlobalAggregate; }
     bool isDeclaration() const { return isDecl; }
     /// 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 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{};
-    /// scope in which the interval is.
-    const Fortran::semantics::Scope *scope;
-    llvm::SmallVector<const semantics::Symbol *> vars{};
+    /// 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;
     /// Is this a declaration of a storage defined in another scope ?
     bool isDecl;
+    /// Is this a global aggregate ?
+    bool isGlobalAggregate;
   };
 
   explicit Variable(const Fortran::semantics::Symbol &sym, bool global = false,
@@ -464,7 +482,7 @@ struct Variable {
     return std::visit(
         common::visitors{
             [](const Nominal &x) { return &x.symbol->GetUltimate().owner(); },
-            [](const AggregateStore &agg) { return agg.scope; }},
+            [](const AggregateStore &agg) { return &agg.getOwningScope(); }},
         var);
   }
 

flang/include/flang/Semantics/scope.h

@@ -41,6 +41,8 @@ struct EquivalenceObject {
       std::optional<ConstantSubscript> substringStart, parser::CharBlock source)
       : symbol{symbol}, subscripts{subscripts},
         substringStart{substringStart}, source{source} {}
+  explicit EquivalenceObject(Symbol &symbol)
+      : symbol{symbol}, source{symbol.name()} {}
 
   bool operator==(const EquivalenceObject &) const;
   bool operator<(const EquivalenceObject &) const;

flang/include/flang/Semantics/symbol.h

@@ -497,6 +497,7 @@ class Symbol {
       LocalityShared, // named in SHARED locality-spec
       InDataStmt, // initialized in a DATA statement
       InNamelist, // flag is set if the symbol is in Namelist statement
+      CompilerCreated,
       // OpenACC data-sharing attribute
       AccPrivate, AccFirstPrivate, AccShared,
       // OpenACC data-mapping attribute
@@ -782,7 +783,7 @@ struct SymbolAddressCompare {
   }
 };
 
-// Symbol comparison is based on the order of cooked source
+// Symbol comparison is usually based on the order of cooked source
 // stream creation and, when both are from the same cooked source,
 // their positions in that cooked source stream.
 // Don't use this comparator or OrderedSymbolSet to hold
@@ -794,12 +795,17 @@ struct SymbolSourcePositionCompare {
   bool operator()(const MutableSymbolRef &, const MutableSymbolRef &) const;
 };
 
+struct SymbolOffsetCompare {
+  bool operator()(const SymbolRef &, const SymbolRef &) const;
+  bool operator()(const MutableSymbolRef &, const MutableSymbolRef &) const;
+};
+
 using UnorderedSymbolSet = std::set<SymbolRef, SymbolAddressCompare>;
-using OrderedSymbolSet = std::set<SymbolRef, SymbolSourcePositionCompare>;
+using SourceOrderedSymbolSet = std::set<SymbolRef, SymbolSourcePositionCompare>;
 
 template <typename A>
-OrderedSymbolSet OrderBySourcePosition(const A &container) {
-  OrderedSymbolSet result;
+SourceOrderedSymbolSet OrderBySourcePosition(const A &container) {
+  SourceOrderedSymbolSet result;
   for (SymbolRef x : container) {
     result.emplace(x);
   }

flang/include/flang/Semantics/tools.h

@@ -56,6 +56,8 @@ const DeclTypeSpec *FindParentTypeSpec(const DeclTypeSpec &);
 const DeclTypeSpec *FindParentTypeSpec(const Scope &);
 const DeclTypeSpec *FindParentTypeSpec(const Symbol &);
 
+const EquivalenceSet *FindEquivalenceSet(const Symbol &);
+
 enum class Tristate { No, Yes, Maybe };
 inline Tristate ToTristate(bool x) { return x ? Tristate::Yes : Tristate::No; }
 
@@ -105,14 +107,13 @@ bool IsEventTypeOrLockType(const DerivedTypeSpec *);
 bool IsOrContainsEventOrLockComponent(const Symbol &);
 bool CanBeTypeBoundProc(const Symbol *);
 // Does a non-PARAMETER symbol have explicit initialization with =value or
-// =>target in its declaration, or optionally in a DATA statement? (Being
+// =>target in its declaration (but not in a DATA statement)? (Being
 // ALLOCATABLE or having a derived type with default component initialization
 // doesn't count; it must be a variable initialization that implies the SAVE
 // attribute, or a derived type component default value.)
-bool IsStaticallyInitialized(const Symbol &, bool ignoreDATAstatements = false);
+bool HasDeclarationInitializer(const Symbol &);
 // Is the symbol explicitly or implicitly initialized in any way?
-bool IsInitialized(const Symbol &, bool ignoreDATAstatements = false,
-    const Symbol *derivedType = nullptr);
+bool IsInitialized(const Symbol &, bool ignoreDATAstatements = false);
 // Is the symbol a component subject to deallocation or finalization?
 bool IsDestructible(const Symbol &, const Symbol *derivedType = nullptr);
 bool HasIntrinsicTypeName(const Symbol &);
@@ -330,6 +331,13 @@ enum class ProcedureDefinitionClass {
 
 ProcedureDefinitionClass ClassifyProcedure(const Symbol &);
 
+// Returns a list of storage associations due to EQUIVALENCE in a
+// scope; each storage association is a list of symbol references
+// in ascending order of scope offset.  Note that the scope may have
+// more EquivalenceSets than this function's result has storage
+// associations; these are closures over equivalences.
+std::list<std::list<SymbolRef>> GetStorageAssociations(const Scope &);
+
 // Derived type component iterator that provides a C++ LegacyForwardIterator
 // iterator over the Ordered, Direct, Ultimate or Potential components of a
 // DerivedTypeSpec. These iterators can be used with STL algorithms

flang/lib/Evaluate/initial-image.cpp

@@ -54,11 +54,14 @@ void InitialImage::AddPointer(
   pointers_.emplace(offset, pointer);
 }
 
-void InitialImage::Incorporate(
-    ConstantSubscript offset, const InitialImage &that) {
-  CHECK(that.pointers_.empty()); // pointers are not allowed in EQUIVALENCE
-  CHECK(offset + that.size() <= size());
-  std::memcpy(&data_[offset], &that.data_[0], that.size());
+void InitialImage::Incorporate(ConstantSubscript toOffset,
+    const InitialImage &from, ConstantSubscript fromOffset,
+    ConstantSubscript bytes) {
+  CHECK(from.pointers_.empty()); // pointers are not allowed in EQUIVALENCE
+  CHECK(fromOffset >= 0 && bytes >= 0 &&
+      static_cast<std::size_t>(fromOffset + bytes) <= from.size());
+  CHECK(static_cast<std::size_t>(toOffset + bytes) <= size());
+  std::memcpy(&data_[toOffset], &from.data_[fromOffset], bytes);
 }
 
 // Classes used with common::SearchTypes() to (re)construct Constant<> values
@@ -97,26 +100,31 @@ class AsConstantHelper {
       const semantics::DerivedTypeSpec &derived{type_.GetDerivedTypeSpec()};
       for (auto iter : DEREF(derived.scope())) {
         const Symbol &component{*iter.second};
-        bool isPointer{IsPointer(component)};
-        if (component.has<semantics::ObjectEntityDetails>() ||
-            component.has<semantics::ProcEntityDetails>()) {
-          auto componentType{DynamicType::From(component)};
-          CHECK(componentType);
+        bool isProcPtr{IsProcedurePointer(component)};
+        if (isProcPtr || component.has<semantics::ObjectEntityDetails>()) {
           auto at{offset_ + component.offset()};
-          if (isPointer) {
+          if (isProcPtr) {
             for (std::size_t j{0}; j < elements; ++j, at += stride) {
-              Result value{image_.AsConstantDataPointer(*componentType, at)};
-              CHECK(value);
-              typedValue[j].emplace(component, std::move(*value));
+              if (Result value{image_.AsConstantPointer(at)}) {
+                typedValue[j].emplace(component, std::move(*value));
+              }
+            }
+          } else if (IsPointer(component)) {
+            for (std::size_t j{0}; j < elements; ++j, at += stride) {
+              if (Result value{image_.AsConstantPointer(at)}) {
+                typedValue[j].emplace(component, std::move(*value));
+              }
             }
           } else {
+            auto componentType{DynamicType::From(component)};
+            CHECK(componentType.has_value());
             auto componentExtents{GetConstantExtents(context_, component)};
-            CHECK(componentExtents);
+            CHECK(componentExtents.has_value());
             for (std::size_t j{0}; j < elements; ++j, at += stride) {
-              Result value{image_.AsConstant(
-                  context_, *componentType, *componentExtents, at)};
-              CHECK(value);
-              typedValue[j].emplace(component, std::move(*value));
+              if (Result value{image_.AsConstant(
+                      context_, *componentType, *componentExtents, at)}) {
+                typedValue[j].emplace(component, std::move(*value));
+              }
             }
           }
         }
@@ -159,45 +167,11 @@ std::optional<Expr<SomeType>> InitialImage::AsConstant(FoldingContext &context,
       AsConstantHelper{context, type, extents, *this, offset});
 }
 
-class AsConstantDataPointerHelper {
-public:
-  using Result = std::optional<Expr<SomeType>>;
-  using Types = AllTypes;
-  AsConstantDataPointerHelper(const DynamicType &type,
-      const InitialImage &image, ConstantSubscript offset = 0)
-      : type_{type}, image_{image}, offset_{offset} {}
-  template <typename T> Result Test() {
-    if (T::category != type_.category()) {
-      return std::nullopt;
-    }
-    if constexpr (T::category != TypeCategory::Derived) {
-      if (T::kind != type_.kind()) {
-        return std::nullopt;
-      }
-    }
-    auto iter{image_.pointers_.find(offset_)};
-    if (iter == image_.pointers_.end()) {
-      return AsGenericExpr(NullPointer{});
-    }
-    return iter->second;
-  }
-
-private:
-  const DynamicType &type_;
-  const InitialImage &image_;
-  ConstantSubscript offset_;
-};
-
-std::optional<Expr<SomeType>> InitialImage::AsConstantDataPointer(
-    const DynamicType &type, ConstantSubscript offset) const {
-  return common::SearchTypes(AsConstantDataPointerHelper{type, *this, offset});
-}
-
-const ProcedureDesignator &InitialImage::AsConstantProcPointer(
+std::optional<Expr<SomeType>> InitialImage::AsConstantPointer(
     ConstantSubscript offset) const {
-  auto iter{pointers_.find(0)};
-  CHECK(iter != pointers_.end());
-  return DEREF(std::get_if<ProcedureDesignator>(&iter->second.u));
+  auto iter{pointers_.find(offset)};
+  return iter == pointers_.end() ? std::optional<Expr<SomeType>>{}
+                                 : iter->second;
 }
 
 } // namespace Fortran::evaluate