[flang][runtime] Speed up initialization & destruction

Rework derived type initialization in the runtime to just
initialize the first element of any array, and then memcpy
it to the others, rather than exercising the per-component
paths for each element.

Reword derived type destruction in the runtime to detect and
exploit a fast path for allocatable components whose types
themselves don't need nested destruction.

Small tweaks were made in hot paths exposed by profiling in
descriptor operations and derived type assignment.

Author: klausler

flang-rt/include/flang-rt/runtime/descriptor.h

@@ -20,13 +20,16 @@
 
 #include "memory.h"
 #include "type-code.h"
+#include "flang-rt/runtime/allocator-registry.h"
 #include "flang/Common/ISO_Fortran_binding_wrapper.h"
+#include "flang/Common/optional.h"
 #include "flang/Runtime/descriptor-consts.h"
 #include <algorithm>
 #include <cassert>
 #include <cinttypes>
 #include <cstddef>
 #include <cstdio>
+#include <cstdlib>
 #include <cstring>
 
 /// Value used for asyncObject when no specific stream is specified.
@@ -262,9 +265,20 @@ class Descriptor {
 
   template <typename A>
   RT_API_ATTRS A *ZeroBasedIndexedElement(std::size_t n) const {
-    SubscriptValue at[maxRank];
-    if (SubscriptsForZeroBasedElementNumber(at, n)) {
-      return Element<A>(at);
+    if (raw_.rank == 0) {
+      if (n == 0) {
+        return OffsetElement<A>();
+      }
+    } else if (raw_.rank == 1) {
+      const auto &dim{GetDimension(0)};
+      if (n < static_cast<std::size_t>(dim.Extent())) {
+        return OffsetElement<A>(n * dim.ByteStride());
+      }
+    } else {
+      SubscriptValue at[maxRank];
+      if (SubscriptsForZeroBasedElementNumber(at, n)) {
+        return Element<A>(at);
+      }
     }
     return nullptr;
   }
@@ -366,6 +380,18 @@ class Descriptor {
   RT_API_ATTRS std::size_t SizeInBytes() const;
 
   RT_API_ATTRS std::size_t Elements() const;
+  RT_API_ATTRS std::size_t InlineElements() const {
+    int n{rank()};
+    if (n == 0) {
+      return 1;
+    } else {
+      auto elements{static_cast<std::size_t>(GetDimension(0).Extent())};
+      for (int j{1}; j < n; ++j) {
+        elements *= GetDimension(j).Extent();
+      }
+      return elements;
+    }
+  }
 
   // Allocate() assumes Elements() and ElementBytes() work;
   // define the extents of the dimensions and the element length
@@ -377,7 +403,22 @@ class Descriptor {
 
   // Deallocates storage; does not call FINAL subroutines or
   // deallocate allocatable/automatic components.
-  RT_API_ATTRS int Deallocate();
+  RT_API_ATTRS int Deallocate() {
+    ISO::CFI_cdesc_t &descriptor{raw()};
+    void *pointer{descriptor.base_addr};
+    if (!pointer) {
+      return CFI_ERROR_BASE_ADDR_NULL;
+    } else {
+      int allocIndex{MapAllocIdx()};
+      if (allocIndex == kDefaultAllocator) {
+        std::free(pointer);
+      } else {
+        allocatorRegistry.GetDeallocator(MapAllocIdx())(pointer);
+      }
+      descriptor.base_addr = nullptr;
+      return CFI_SUCCESS;
+    }
+  }
 
   // Deallocates storage, including allocatable and automatic
   // components.  Optionally invokes FINAL subroutines.
@@ -392,8 +433,7 @@ class Descriptor {
     bool stridesAreContiguous{true};
     for (int j{0}; j < leadingDimensions; ++j) {
       const Dimension &dim{GetDimension(j)};
-      stridesAreContiguous &=
-          (bytes == dim.ByteStride()) || (dim.Extent() == 1);
+      stridesAreContiguous &= bytes == dim.ByteStride() || dim.Extent() == 1;
       bytes *= dim.Extent();
     }
     // One and zero element arrays are contiguous even if the descriptor
@@ -406,6 +446,32 @@ class Descriptor {
     return stridesAreContiguous || bytes == 0;
   }
 
+  // The result, if any, is a fixed stride value that can be used to
+  // address all elements.  It generalizes contiguity by also allowing
+  // the case of an array with extent 1 on all but one dimension.
+  RT_API_ATTRS common::optional<SubscriptValue> FixedStride() const {
+    auto rank{static_cast<std::size_t>(raw_.rank)};
+    common::optional<SubscriptValue> stride;
+    for (std::size_t j{0}; j < rank; ++j) {
+      const Dimension &dim{GetDimension(j)};
+      auto extent{dim.Extent()};
+      if (extent == 0) {
+        break; // empty array
+      } else if (extent == 1) { // ok
+      } else if (stride) {
+        // Extent > 1 on multiple dimensions
+        if (IsContiguous()) {
+          return ElementBytes();
+        } else {
+          return common::nullopt;
+        }
+      } else {
+        stride = dim.ByteStride();
+      }
+    }
+    return stride.value_or(0); // 0 for scalars and empty arrays
+  }
+
   // Establishes a pointer to a section or element.
   RT_API_ATTRS bool EstablishPointerSection(const Descriptor &source,
       const SubscriptValue *lower = nullptr,
@@ -427,6 +493,14 @@ class Descriptor {
   RT_API_ATTRS inline int GetAllocIdx() const {
     return (raw_.extra & _CFI_ALLOCATOR_IDX_MASK) >> _CFI_ALLOCATOR_IDX_SHIFT;
   }
+  RT_API_ATTRS int MapAllocIdx() const {
+#ifdef RT_DEVICE_COMPILATION
+    // Force default allocator in device code.
+    return kDefaultAllocator;
+#else
+    return GetAllocIdx();
+#endif
+  }
   RT_API_ATTRS inline void SetAllocIdx(int pos) {
     raw_.extra &= ~_CFI_ALLOCATOR_IDX_MASK; // Clear the allocator index bits.
     raw_.extra |= pos << _CFI_ALLOCATOR_IDX_SHIFT;

flang-rt/include/flang-rt/runtime/type-info.h

@@ -68,7 +68,9 @@ class Component {
   RT_API_ATTRS std::uint64_t offset() const { return offset_; }
   RT_API_ATTRS const Value &characterLen() const { return characterLen_; }
   RT_API_ATTRS const DerivedType *derivedType() const {
-    return derivedType_.descriptor().OffsetElement<const DerivedType>();
+    return category() == TypeCategory::Derived
+        ? derivedType_.descriptor().OffsetElement<const DerivedType>()
+        : nullptr;
   }
   RT_API_ATTRS const Value *lenValue() const {
     return lenValue_.descriptor().OffsetElement<const Value>();

flang-rt/include/flang-rt/runtime/work-queue.h

@@ -62,6 +62,7 @@
 #include "flang-rt/runtime/stat.h"
 #include "flang-rt/runtime/type-info.h"
 #include "flang/Common/api-attrs.h"
+#include "flang/Common/optional.h"
 #include "flang/Runtime/freestanding-tools.h"
 #include <flang/Common/variant.h>
 
@@ -122,7 +123,7 @@ class Elementwise {
 
 protected:
   const Descriptor &instance_, *from_{nullptr};
-  std::size_t elements_{instance_.Elements()};
+  std::size_t elements_{instance_.InlineElements()};
   std::size_t elementAt_{0};
   SubscriptValue subscripts_[common::maxRank];
   SubscriptValue fromSubscripts_[common::maxRank];
@@ -131,11 +132,19 @@ class Elementwise {
 // Base class for ticket workers that operate over derived type components.
 class Componentwise {
 public:
-  RT_API_ATTRS Componentwise(const typeInfo::DerivedType &);
+  RT_API_ATTRS Componentwise(const typeInfo::DerivedType &derived)
+      : derived_{derived}, components_{derived_.component().InlineElements()} {
+    GetFirstComponent();
+  }
+
   RT_API_ATTRS bool IsComplete() const { return componentAt_ >= components_; }
   RT_API_ATTRS void Advance() {
     ++componentAt_;
-    GetComponent();
+    if (IsComplete()) {
+      component_ = nullptr;
+    } else {
+      ++component_;
+    }
   }
   RT_API_ATTRS void SkipToEnd() {
     component_ = nullptr;
@@ -144,15 +153,21 @@ class Componentwise {
   RT_API_ATTRS void Reset() {
     component_ = nullptr;
     componentAt_ = 0;
-    GetComponent();
+    GetFirstComponent();
   }
-  RT_API_ATTRS void GetComponent();
 
 protected:
   const typeInfo::DerivedType &derived_;
   std::size_t components_{0}, componentAt_{0};
   const typeInfo::Component *component_{nullptr};
   StaticDescriptor<common::maxRank, true, 0> componentDescriptor_;
+
+private:
+  RT_API_ATTRS void GetFirstComponent() {
+    if (components_ > 0) {
+      component_ = derived_.component().OffsetElement<typeInfo::Component>();
+    }
+  }
 };
 
 // Base class for ticket workers that operate over derived type components
@@ -228,14 +243,14 @@ class ElementsOverComponents : public Elementwise, public Componentwise {
 
 // Ticket worker classes
 
-// Implements derived type instance initialization
+// Implements derived type instance initialization.
 class InitializeTicket : public ImmediateTicketRunner<InitializeTicket>,
-                         private ComponentsOverElements {
+                         private ElementsOverComponents {
 public:
   RT_API_ATTRS InitializeTicket(
       const Descriptor &instance, const typeInfo::DerivedType &derived)
       : ImmediateTicketRunner<InitializeTicket>{*this},
-        ComponentsOverElements{instance, derived} {}
+        ElementsOverComponents{instance, derived} {}
   RT_API_ATTRS int Begin(WorkQueue &);
   RT_API_ATTRS int Continue(WorkQueue &);
 };
@@ -283,12 +298,14 @@ class DestroyTicket : public ImmediateTicketRunner<DestroyTicket>,
   RT_API_ATTRS DestroyTicket(const Descriptor &instance,
       const typeInfo::DerivedType &derived, bool finalize)
       : ImmediateTicketRunner<DestroyTicket>{*this},
-        ComponentsOverElements{instance, derived}, finalize_{finalize} {}
+        ComponentsOverElements{instance, derived}, finalize_{finalize},
+        fixedStride_{instance.FixedStride()} {}
   RT_API_ATTRS int Begin(WorkQueue &);
   RT_API_ATTRS int Continue(WorkQueue &);
 
 private:
   bool finalize_{false};
+  std::optional<SubscriptValue> fixedStride_;
 };
 
 // Implements general intrinsic assignment
@@ -302,11 +319,11 @@ class AssignTicket : public ImmediateTicketRunner<AssignTicket> {
   RT_API_ATTRS int Continue(WorkQueue &);
 
 private:
+  RT_API_ATTRS Descriptor &GetTempDescriptor();
   RT_API_ATTRS bool IsSimpleMemmove() const {
     return !toDerived_ && to_.rank() == from_->rank() && to_.IsContiguous() &&
         from_->IsContiguous() && to_.ElementBytes() == from_->ElementBytes();
   }
-  RT_API_ATTRS Descriptor &GetTempDescriptor();
 
   Descriptor &to_;
   const Descriptor *from_{nullptr};
@@ -549,6 +566,7 @@ class WorkQueue {
   TicketList *first_{nullptr}, *last_{nullptr}, *insertAfter_{nullptr};
   TicketList static_[numStatic_];
   TicketList *firstFree_{static_};
+  bool anyDynamicAllocation_{false};
 };
 
 } // namespace Fortran::runtime

flang-rt/lib/runtime/assign.cpp

@@ -217,8 +217,8 @@ static RT_API_ATTRS void DoElementalDefinedAssignment(const Descriptor &to,
   toElementDesc.Establish(derived, nullptr, 0, nullptr, CFI_attribute_pointer);
   fromElementDesc.Establish(
       derived, nullptr, 0, nullptr, CFI_attribute_pointer);
-  for (std::size_t toElements{to.Elements()}; toElements-- > 0;
-       to.IncrementSubscripts(toAt), from.IncrementSubscripts(fromAt)) {
+  for (std::size_t toElements{to.InlineElements()}; toElements-- > 0;
+      to.IncrementSubscripts(toAt), from.IncrementSubscripts(fromAt)) {
     toElementDesc.set_base_addr(to.Element<char>(toAt));
     fromElementDesc.set_base_addr(from.Element<char>(fromAt));
     DoScalarDefinedAssignment(toElementDesc, fromElementDesc, derived, special);
@@ -431,11 +431,14 @@ RT_API_ATTRS int AssignTicket::Continue(WorkQueue &workQueue) {
     }
   }
   // Intrinsic assignment
-  std::size_t toElements{to_.Elements()};
-  if (from_->rank() > 0 && toElements != from_->Elements()) {
-    workQueue.terminator().Crash("Assign: mismatching element counts in array "
-                                 "assignment (to %zd, from %zd)",
-        toElements, from_->Elements());
+  std::size_t toElements{to_.InlineElements()};
+  if (from_->rank() > 0) {
+    std::size_t fromElements{from_->InlineElements()};
+    if (toElements != fromElements) {
+      workQueue.terminator().Crash("Assign: mismatching element counts in "
+                                   "array assignment (to %zd, from %zd)",
+          toElements, fromElements);
+    }
   }
   if (to_.type() != from_->type()) {
     workQueue.terminator().Crash(
@@ -529,7 +532,7 @@ RT_API_ATTRS int DerivedAssignTicket<IS_COMPONENTWISE>::Begin(
       // allocatable components or defined ASSIGNMENT(=) at any level.
       memmoveFct_(this->instance_.template OffsetElement<char>(),
           this->from_->template OffsetElement<const char *>(),
-          this->instance_.Elements() * elementBytes);
+          this->instance_.InlineElements() * elementBytes);
       return StatOk;
     }
   }
@@ -544,7 +547,7 @@ RT_API_ATTRS int DerivedAssignTicket<IS_COMPONENTWISE>::Begin(
   // Copy procedure pointer components
   const Descriptor &procPtrDesc{this->derived_.procPtr()};
   bool noDataComponents{this->IsComplete()};
-  if (std::size_t numProcPtrs{procPtrDesc.Elements()}) {
+  if (std::size_t numProcPtrs{procPtrDesc.InlineElements()}) {
     for (std::size_t k{0}; k < numProcPtrs; ++k) {
       const auto &procPtr{
           *procPtrDesc.ZeroBasedIndexedElement<typeInfo::ProcPtrComponent>(k)};
@@ -614,7 +617,7 @@ RT_API_ATTRS int DerivedAssignTicket<IS_COMPONENTWISE>::Continue(
               memmoveFct_(to, from, componentByteSize);
             }
           }
-          this->Componentwise::Advance();
+          this->SkipToNextComponent();
         } else {
           memmoveFct_(
               this->instance_.template Element<char>(this->subscripts_) +
@@ -646,7 +649,7 @@ RT_API_ATTRS int DerivedAssignTicket<IS_COMPONENTWISE>::Continue(
             memmoveFct_(to, from, componentByteSize);
           }
         }
-        this->Componentwise::Advance();
+        this->SkipToNextComponent();
       } else {
         memmoveFct_(this->instance_.template Element<char>(this->subscripts_) +
                 this->component_->offset(),
@@ -668,11 +671,11 @@ RT_API_ATTRS int DerivedAssignTicket<IS_COMPONENTWISE>::Continue(
       if (toDesc->IsAllocatable() && !fromDesc->IsAllocated()) {
         if (toDesc->IsAllocated()) {
           if (this->phase_ == 0) {
-            this->phase_++;
             if (componentDerived && !componentDerived->noDestructionNeeded()) {
               if (int status{workQueue.BeginDestroy(
                       *toDesc, *componentDerived, /*finalize=*/false)};
                   status != StatOk) {
+                this->phase_++;
                 return status;
               }
             }
@@ -725,15 +728,15 @@ RT_API_ATTRS void DoFromSourceAssign(Descriptor &alloc,
     SubscriptValue allocAt[maxRank];
     alloc.GetLowerBounds(allocAt);
     if (allocDerived) {
-      for (std::size_t n{alloc.Elements()}; n-- > 0;
-           alloc.IncrementSubscripts(allocAt)) {
+      for (std::size_t n{alloc.InlineElements()}; n-- > 0;
+          alloc.IncrementSubscripts(allocAt)) {
         Descriptor allocElement{*Descriptor::Create(*allocDerived,
             reinterpret_cast<void *>(alloc.Element<char>(allocAt)), 0)};
         Assign(allocElement, source, terminator, NoAssignFlags, memmoveFct);
       }
     } else { // intrinsic type
-      for (std::size_t n{alloc.Elements()}; n-- > 0;
-           alloc.IncrementSubscripts(allocAt)) {
+      for (std::size_t n{alloc.InlineElements()}; n-- > 0;
+          alloc.IncrementSubscripts(allocAt)) {
         memmoveFct(alloc.Element<char>(allocAt), source.raw().base_addr,
             alloc.ElementBytes());
       }