[flang] Handle EQUIVALENCE and COMMON in size and offset computations

[klausler]

Summary

Objects in common blocks have offsets relative to the start of the
common block, independent of the enclosing scope, so they are processed
first. Add alignment to CommonBlockDetails to record the required
alignment of the common block.

For equivalence sets, each object depends on the one that is forced to
occur first in memory. The rest are recorded in the dependents_ map and
have offsets assigned after the other symbols are done.

[sscalpone]

flang/include/flang/Semantics/symbol.h

306

align is a verb, and someone might think this call is aligning something. how about g/align/s//alignment/?

flang/lib/Semantics/compute-offsets.cpp

74

InCommonBlock might be helpful for lowering, but i'm just guessing, because i'm not doing any lowering.

[tskeith]

flang/include/flang/Semantics/symbol.h

306

Scope and ComputeOffsetsHelper already have data members named align_. Do you want those changed too?

flang/lib/Semantics/compute-offsets.cpp

74

Me neither. I think it should be made public if and when it is needed.

[tskeith]

flang/include/flang/Semantics/symbol.h

306

I'll do the renaming in a separate change.

flang/include/flang/Semantics/symbol.h

 //===-- include/flang/Semantics/symbol.h ------------------------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 

 };
 
 class CommonBlockDetails {
 public:
   const SymbolVector &objects() const { return objects_; }
   void add_object(const Symbol &object) { objects_.emplace_back(object); }
   MaybeExpr bindName() const { return bindName_; }
   void set_bindName(MaybeExpr &&expr) { bindName_ = std::move(expr); }
+  std::size_t align() const { return align_; }
+  void set_align(std::size_t align) { align_ = align; }
 
 private:
   SymbolVector objects_;
   MaybeExpr bindName_;
+  std::size_t align_{0}; // required alignment in bytes
 };
 
 class FinalProcDetails {}; // TODO
 
 class MiscDetails {
 public:
   ENUM_CLASS(Kind, None, ConstructName, ScopeName, PassName, ComplexPartRe,
       ComplexPartIm, KindParamInquiry, LenParamInquiry, SelectTypeAssociateName,

 
 private:
   const Scope *owner_;
   SourceName name_;
   Attrs attrs_;
   Flags flags_;
   Scope *scope_{nullptr};
   std::size_t size_{0}; // size in bytes
-  std::size_t offset_{0}; // byte offset in enclosing scope
+  std::size_t offset_{0}; // byte offset in scope or common block
   Details details_;
 
   Symbol() {} // only created in class Symbols
   const std::string GetDetailsName() const;
   friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const Symbol &);
   friend llvm::raw_ostream &DumpForUnparse(
       llvm::raw_ostream &, const Symbol &, bool);
 

flang/lib/Semantics/compute-offsets.cpp

 //===----------------------------------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 

 #include <algorithm>
 #include <vector>
 
 namespace Fortran::semantics {
 
 class ComputeOffsetsHelper {
 public:
   // TODO: configure based on target
-  static constexpr int descriptorSize{3 * 8};
   static constexpr int maxAlignment{8};
 
   ComputeOffsetsHelper(SemanticsContext &context) : context_{context} {}
   void Compute() { Compute(context_.globalScope()); }
 
 private:
   struct SizeAndAlign {
     SizeAndAlign() {}
     SizeAndAlign(std::size_t size) : size{size}, align{size} {}
     SizeAndAlign(std::size_t size, std::size_t align)
         : size{size}, align{align} {}
     std::size_t size{0};
     std::size_t align{0};
   };
+  struct SymbolAndOffset {
+    Symbol *symbol{nullptr};
+    std::size_t offset{0};
+  };
 
   void Compute(Scope &);
   void DoScope(Scope &);
+  void DoCommonBlock(Symbol &);
+  void DoEquivalenceSet(EquivalenceSet &);
+  std::size_t GetOffset(SymbolAndOffset &);
+  std::size_t ComputeOffset(const EquivalenceObject &);
   void DoSymbol(Symbol &);
   SizeAndAlign GetSizeAndAlign(const Symbol &);
+  SizeAndAlign GetElementSize(const Symbol &, bool isSubstring = false);
   std::size_t CountElements(const Symbol &);
   static std::size_t Align(std::size_t, std::size_t);
   static SizeAndAlign GetIntrinsicSizeAndAlign(TypeCategory, int);
 
   SemanticsContext &context_;
   evaluate::FoldingContext &foldingContext_{context_.foldingContext()};
   std::size_t offset_{0};
   std::size_t align_{0};
+  // symbol -> symbol+offset that determines its location, from EQUIVALENCE
+  std::map<MutableSymbolRef, SymbolAndOffset> dependents_;
 };
 
 void ComputeOffsetsHelper::Compute(Scope &scope) {
   for (Scope &child : scope.children()) {
     Compute(child);
   }
   DoScope(scope);
 }
 
+static bool InCommonBlock(const Symbol &symbol) {
+  const auto *details{symbol.detailsIf<ObjectEntityDetails>()};
+  return details && details->commonBlock();
+}
+
 void ComputeOffsetsHelper::DoScope(Scope &scope) {
   if (scope.symbol() && scope.IsParameterizedDerivedType()) {
     return; // only process instantiations of parameterized derived types
   }
+  // Symbols in common block get offsets from the beginning of the block
+  for (auto &pair : scope.commonBlocks()) {
+    DoCommonBlock(*pair.second);
+  }
+  // Build dependents_ from equivalences: symbol -> symbol+offset
+  for (EquivalenceSet &set : scope.equivalenceSets()) {
+    DoEquivalenceSet(set);
+  }
   offset_ = 0;
   align_ = 0;
-  for (auto symbol : scope.GetSymbols()) {
-    if (!symbol->has<TypeParamDetails>() && !symbol->has<SubprogramDetails>()) {
+  for (auto &symbol : scope.GetSymbols()) {
+    if (!InCommonBlock(*symbol) &&
+        dependents_.find(symbol) == dependents_.end()) {
       DoSymbol(*symbol);
     }
   }
+  for (auto &[symbol, dep] : dependents_) {
+    if (symbol->size() == 0) {
+      SizeAndAlign s{GetSizeAndAlign(*symbol)};
+      symbol->set_size(s.size);
+      symbol->set_offset(GetOffset(dep));
+      offset_ = std::max(offset_, symbol->offset() + symbol->size());
+    }
+  }
   scope.set_size(offset_);
   scope.set_align(align_);
 }
 
+std::size_t ComputeOffsetsHelper::GetOffset(SymbolAndOffset &dep) {
+  auto it{dependents_.find(*dep.symbol)};
+  if (it == dependents_.end()) {
+    return dep.symbol->offset() + dep.offset;
+  } else {
+    return GetOffset(it->second) + dep.offset;
+  }
+}
+
+void ComputeOffsetsHelper::DoCommonBlock(Symbol &commonBlock) {
+  auto &details{commonBlock.get<CommonBlockDetails>()};
+  offset_ = 0;
+  align_ = 0;
+  for (auto &object : details.objects()) {
+    DoSymbol(*object);
+  }
+  commonBlock.set_size(offset_);
+  details.set_align(align_);
+}
+
+void ComputeOffsetsHelper::DoEquivalenceSet(EquivalenceSet &set) {
+  std::vector<SymbolAndOffset> symbolOffsets;
+  SymbolAndOffset max;
+  for (EquivalenceObject &object : set) {
+    std::size_t offset{ComputeOffset(object)};
+    symbolOffsets.push_back({&object.symbol, offset});
+    if (offset >= max.offset) {
+      max.offset = offset;
+      max.symbol = &object.symbol;
+    }
+  }
+  CHECK(max.symbol);
+  for (auto &[symbol, offset] : symbolOffsets) {
+    if (symbol != max.symbol) {
+      dependents_.emplace(
+          *symbol, SymbolAndOffset{max.symbol, max.offset - offset});
+    }
+  }
+}
+
+// Offset of this equivalence object from the start of its variable.
+std::size_t ComputeOffsetsHelper::ComputeOffset(
+    const EquivalenceObject &object) {
+  std::size_t offset{0};
+  if (object.substringStart) {
+    offset = *object.substringStart - 1;
+  }
+  if (!object.subscripts.empty()) {
+    const ArraySpec &shape{object.symbol.get<ObjectEntityDetails>().shape()};
+    auto lbound{[&](std::size_t i) {
+      return *ToInt64(shape[i].lbound().GetExplicit());
+    }};
+    auto ubound{[&](std::size_t i) {
+      return *ToInt64(shape[i].ubound().GetExplicit());
+    }};
+    for (std::size_t i{object.subscripts.size() - 1};;) {
+      offset += object.subscripts[i] - lbound(i);
+      if (i == 0) {
+        break;
+      }
+      --i;
+      offset *= ubound(i) - lbound(i) + 1;
+    }
+  }
+  return offset *
+      GetElementSize(object.symbol, object.substringStart.has_value()).size;
+}
+
 void ComputeOffsetsHelper::DoSymbol(Symbol &symbol) {
+  if (symbol.has<TypeParamDetails>() || symbol.has<SubprogramDetails>() ||
+      symbol.has<UseDetails>() || symbol.has<ProcBindingDetails>()) {
+    return; // these have type but no size
+  }
   SizeAndAlign s{GetSizeAndAlign(symbol)};
   if (s.size == 0) {
     return;
   }
   offset_ = Align(offset_, s.align);
   symbol.set_size(s.size);
   symbol.set_offset(offset_);
   offset_ += s.size;
-  if (s.align > align_) {
-    align_ = s.align;
-  }
+  align_ = std::max(align_, s.align);
 }
 
 auto ComputeOffsetsHelper::GetSizeAndAlign(const Symbol &symbol)
     -> SizeAndAlign {
+  SizeAndAlign result{GetElementSize(symbol)};
+  std::size_t elements{CountElements(symbol)};
+  if (elements > 1) {
+    result.size = Align(result.size, result.align);
+  }
+  result.size *= elements;
+  return result;
+}
+
+auto ComputeOffsetsHelper::GetElementSize(
+    const Symbol &symbol, bool isSubstring) -> SizeAndAlign {
   const DeclTypeSpec *type{symbol.GetType()};
   if (!type) {
     return {};
   }
   if (IsDescriptor(symbol) || IsProcedure(symbol)) {
     int lenParams{0};
     if (const DerivedTypeSpec * derived{type->AsDerived()}) {
       lenParams = derived->NumLengthParameters();
     }
     std::size_t size{
         runtime::Descriptor::SizeInBytes(symbol.Rank(), false, lenParams)};
     return {size, maxAlignment};
   }
   SizeAndAlign result;
   if (const IntrinsicTypeSpec * intrinsic{type->AsIntrinsic()}) {
     if (auto kind{ToInt64(intrinsic->kind())}) {
       result = GetIntrinsicSizeAndAlign(intrinsic->category(), *kind);
     }
-    if (type->category() == DeclTypeSpec::Character) {
+    if (!isSubstring && type->category() == DeclTypeSpec::Character) {
       ParamValue length{type->characterTypeSpec().length()};
       CHECK(length.isExplicit()); // else should be descriptor
       if (MaybeIntExpr lengthExpr{length.GetExplicit()}) {
         if (auto lengthInt{ToInt64(*lengthExpr)}) {
           result.size *= *lengthInt;
         }
       }
     }
   } else if (const DerivedTypeSpec * derived{type->AsDerived()}) {
     if (derived->scope()) {
       result.size = derived->scope()->size();
       result.align = derived->scope()->align();
     }
   } else {
     DIE("not intrinsic or derived");
   }
-  std::size_t elements{CountElements(symbol)};
-  if (elements > 1) {
-    result.size = Align(result.size, result.align);
-  }
-  result.size *= elements;
   return result;
 }
 
 std::size_t ComputeOffsetsHelper::CountElements(const Symbol &symbol) {
   if (auto shape{GetShape(foldingContext_, symbol)}) {
     if (auto sizeExpr{evaluate::GetSize(std::move(*shape))}) {
       if (auto size{ToInt64(Fold(foldingContext_, std::move(*sizeExpr)))}) {
         return *size;

flang/lib/Semantics/symbol.cpp

 //===-- lib/Semantics/symbol.cpp ------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
std::visit(
             os << " => " << x.symbol().name();
             DumpOptional(os, "passName", x.passName());
           },
           [&](const NamelistDetails &x) {
             os << ':';
             DumpSymbolVector(os, x.objects());
           },
           [&](const CommonBlockDetails &x) {
+            if (x.align()) {
+              os << " align=" << x.align();
+            }
             os << ':';
             for (const Symbol &object : x.objects()) {
               os << ' ' << object.name();
             }
           },
           [&](const FinalProcDetails &) {},
           [&](const TypeParamDetails &x) {
             DumpOptional(os, "type", x.type());

flang/test/Semantics/offsets03.f90

+!RUN: %f18 -fdebug-dump-symbols -fparse-only %s | FileCheck %s
+
+! Size and alignment with EQUIVALENCE and COMMON
+
+! a1 depends on a2 depends on a3
+module ma
+  real :: a1(10), a2(10), a3(10)
+  equivalence(a1, a2(3)) !CHECK: a1, PUBLIC size=40 offset=20:
+  equivalence(a2, a3(4)) !CHECK: a2, PUBLIC size=40 offset=12:
+  !CHECK: a3, PUBLIC size=40 offset=0:
+end
+
+! equivalence and 2-dimensional array
+module mb
+  real :: b1(4), b2, b3, b4
+  real :: b(-1:1,2:6)     !CHECK: b, PUBLIC size=60 offset=0:
+  equivalence(b(1,6), b1) !CHECK: b1, PUBLIC size=16 offset=56:
+  equivalence(b(1,5), b2) !CHECK: b2, PUBLIC size=4 offset=44:
+  equivalence(b(0,6), b3) !CHECK: b3, PUBLIC size=4 offset=52:
+  equivalence(b(0,4), b4) !CHECK: b4, PUBLIC size=4 offset=28:
+end
+
+! equivalence and substring
+subroutine mc         !CHECK: Subprogram scope: mc size=12 align=1
+  character(10) :: c1 !CHECK: c1 size=10 offset=0:
+  character(5)  :: c2 !CHECK: c2 size=5 offset=7:
+  equivalence(c1(9:), c2(2:4))
+end
+
+! Common block: objects are in order from COMMON statement and not part of module
+module md                   !CHECK: Module scope: md size=1 align=1
+  integer(1) :: i 
+  integer(2) :: d1          !CHECK: d1, PUBLIC size=2 offset=8:
+  integer(4) :: d2          !CHECK: d2, PUBLIC size=4 offset=4:
+  integer(1) :: d3          !CHECK: d3, PUBLIC size=1 offset=0:
+  real(2) :: d4             !CHECK: d4, PUBLIC size=2 offset=0:
+  common /common1/ d3,d2,d1 !CHECK: common1 size=10 offset=0: CommonBlockDetails align=4:
+  common /common2/ d4       !CHECK: common2 size=2 offset=0: CommonBlockDetails align=2:
+end