Merge branch 'main' into users/rampitec/08-05-_amdgpu_add_gfx1250_wmma_scale_16__f32_32x16x128_f4_instructions

Author: rampitec

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

@@ -101,6 +101,9 @@ class DescriptorAddendum {
   explicit RT_API_ATTRS DescriptorAddendum(
       const typeInfo::DerivedType *dt = nullptr)
       : derivedType_{dt}, len_{0} {}
+  RT_API_ATTRS DescriptorAddendum(const DescriptorAddendum &that) {
+    *this = that;
+  }
   RT_API_ATTRS DescriptorAddendum &operator=(const DescriptorAddendum &);
 
   RT_API_ATTRS const typeInfo::DerivedType *derivedType() const {
@@ -181,6 +184,9 @@ class Descriptor {
       const SubscriptValue *extent = nullptr,
       ISO::CFI_attribute_t attribute = CFI_attribute_other);
 
+  RT_API_ATTRS void UncheckedScalarEstablish(
+      const typeInfo::DerivedType &, void *);
+
   // To create a descriptor for a derived type the caller
   // must provide non-null dt argument.
   // The addendum argument is only used for testing purposes,
@@ -433,7 +439,9 @@ class Descriptor {
     bool stridesAreContiguous{true};
     for (int j{0}; j < leadingDimensions; ++j) {
       const Dimension &dim{GetDimension(j)};
-      stridesAreContiguous &= bytes == dim.ByteStride() || dim.Extent() == 1;
+      if (bytes != dim.ByteStride() && dim.Extent() != 1) {
+        stridesAreContiguous = false;
+      }
       bytes *= dim.Extent();
     }
     // One and zero element arrays are contiguous even if the descriptor
@@ -448,28 +456,44 @@ class Descriptor {
 
   // 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.
+  // the case of an array with extent 1 on all dimensions but one.
+  // Returns 0 for an empty array, a byte stride if one is well-defined
+  // for the array, or nullopt otherwise.
   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();
+    int rank{raw_.rank};
+    auto elementBytes{static_cast<SubscriptValue>(ElementBytes())};
+    if (rank == 0) {
+      return elementBytes;
+    } else if (rank == 1) {
+      const Dimension &dim{GetDimension(0)};
+      return dim.Extent() == 0 ? 0 : dim.ByteStride();
+    } else {
+      common::optional<SubscriptValue> stride;
+      auto bytes{elementBytes};
+      for (int j{0}; j < rank; ++j) {
+        const Dimension &dim{GetDimension(j)};
+        auto extent{dim.Extent()};
+        if (extent == 0) {
+          return 0; // empty array
+        } else if (extent == 1) { // ok
         } else {
-          return common::nullopt;
+          if (stride) { // Extent > 1 on multiple dimensions
+            if (bytes != dim.ByteStride()) { // discontiguity
+              while (++j < rank) {
+                if (GetDimension(j).Extent() == 0) {
+                  return 0; // empty array
+                }
+              }
+              return common::nullopt; // nonempty, discontiguous
+            }
+          } else {
+            stride = dim.ByteStride();
+          }
+          bytes *= extent;
         }
-      } else {
-        stride = dim.ByteStride();
       }
+      return stride.value_or(elementBytes /*for singleton*/);
     }
-    return stride.value_or(0); // 0 for scalars and empty arrays
   }
 
   // Establishes a pointer to a section or element.

flang-rt/include/flang-rt/runtime/io-stmt.h

@@ -461,14 +461,16 @@ class ListDirectedStatementState<Direction::Input>
     inNamelistSequence_ = inNamelistSequence;
   }
 
+protected:
+  bool inNamelistSequence_{false};
+
 private:
   int remaining_{0}; // for "r*" repetition
   Fortran::common::optional<SavedPosition> repeatPosition_;
   bool eatComma_{false}; // consume comma after previously read item
   bool hitSlash_{false}; // once '/' is seen, nullify further items
   bool realPart_{false};
   bool imaginaryPart_{false};
-  bool inNamelistSequence_{false};
 };
 
 template <Direction DIR>
@@ -688,7 +690,8 @@ template <Direction DIR>
 class ChildListIoStatementState : public ChildIoStatementState<DIR>,
                                   public ListDirectedStatementState<DIR> {
 public:
-  using ChildIoStatementState<DIR>::ChildIoStatementState;
+  RT_API_ATTRS ChildListIoStatementState(
+      ChildIo &, const char *sourceFile = nullptr, int sourceLine = 0);
   using ListDirectedStatementState<DIR>::GetNextDataEdit;
   RT_API_ATTRS int EndIoStatement();
 };

flang-rt/lib/runtime/derived.cpp

@@ -360,6 +360,8 @@ RT_API_ATTRS int FinalizeTicket::Continue(WorkQueue &workQueue) {
     } else if (component_->genre() == typeInfo::Component::Genre::Data &&
         component_->derivedType() &&
         !component_->derivedType()->noFinalizationNeeded()) {
+      // todo: calculate and use fixedStride_ here as in DestroyTicket to
+      // avoid subscripts and repeated descriptor establishment.
       SubscriptValue extents[maxRank];
       GetComponentExtents(extents, *component_, instance_);
       Descriptor &compDesc{componentDescriptor_.descriptor()};
@@ -452,6 +454,24 @@ RT_API_ATTRS int DestroyTicket::Continue(WorkQueue &workQueue) {
     } else if (component_->genre() == typeInfo::Component::Genre::Data) {
       if (!componentDerived || componentDerived->noDestructionNeeded()) {
         SkipToNextComponent();
+      } else if (fixedStride_) {
+        // faster path, no need for subscripts, can reuse descriptor
+        char *p{instance_.OffsetElement<char>(
+            elementAt_ * *fixedStride_ + component_->offset())};
+        Descriptor &compDesc{componentDescriptor_.descriptor()};
+        const typeInfo::DerivedType &compType{*componentDerived};
+        compDesc.UncheckedScalarEstablish(compType, p);
+        for (std::size_t j{elementAt_}; j < elements_;
+            ++j, p += *fixedStride_) {
+          compDesc.set_base_addr(p);
+          ++elementAt_;
+          if (int status{workQueue.BeginDestroy(
+                  compDesc, compType, /*finalize=*/false)};
+              status != StatOk) {
+            return status;
+          }
+        }
+        SkipToNextComponent();
       } else {
         SubscriptValue extents[maxRank];
         GetComponentExtents(extents, *component_, instance_);
@@ -461,8 +481,8 @@ RT_API_ATTRS int DestroyTicket::Continue(WorkQueue &workQueue) {
             instance_.ElementComponent<char>(subscripts_, component_->offset()),
             component_->rank(), extents);
         Advance();
-        if (int status{workQueue.BeginDestroy(
-                compDesc, *componentDerived, /*finalize=*/false)};
+        if (int status{
+                workQueue.BeginDestroy(compDesc, compType, /*finalize=*/false)};
             status != StatOk) {
           return status;
         }

flang-rt/lib/runtime/descriptor-io.cpp

@@ -110,7 +110,7 @@ static RT_API_ATTRS Fortran::common::optional<bool> DefinedFormattedIo(
     Fortran::common::optional<std::int64_t> startPos;
     if (edit.descriptor == DataEdit::DefinedDerivedType &&
         special.which() == typeInfo::SpecialBinding::Which::ReadFormatted) {
-      // DT is an edit descriptor so everything that the child
+      // DT is an edit descriptor, so everything that the child
       // I/O subroutine reads counts towards READ(SIZE=).
       startPos = io.InquirePos();
     }

flang-rt/lib/runtime/descriptor.cpp

@@ -100,6 +100,15 @@ RT_API_ATTRS void Descriptor::Establish(const typeInfo::DerivedType &dt,
   new (Addendum()) DescriptorAddendum{&dt};
 }
 
+RT_API_ATTRS void Descriptor::UncheckedScalarEstablish(
+    const typeInfo::DerivedType &dt, void *p) {
+  auto elementBytes{static_cast<std::size_t>(dt.sizeInBytes())};
+  ISO::EstablishDescriptor(
+      &raw_, p, CFI_attribute_other, CFI_type_struct, elementBytes, 0, nullptr);
+  SetHasAddendum();
+  new (Addendum()) DescriptorAddendum{&dt};
+}
+
 RT_API_ATTRS OwningPtr<Descriptor> Descriptor::Create(TypeCode t,
     std::size_t elementBytes, void *p, int rank, const SubscriptValue *extent,
     ISO::CFI_attribute_t attribute, bool addendum,
@@ -231,6 +240,7 @@ RT_API_ATTRS bool Descriptor::EstablishPointerSection(const Descriptor &source,
     const SubscriptValue *stride) {
   *this = source;
   raw_.attribute = CFI_attribute_pointer;
+  SetAllocIdx(source.GetAllocIdx());
   int newRank{raw_.rank};
   for (int j{0}; j < raw_.rank; ++j) {
     if (!stride || stride[j] == 0) {
@@ -242,14 +252,17 @@ RT_API_ATTRS bool Descriptor::EstablishPointerSection(const Descriptor &source,
     }
   }
   raw_.rank = newRank;
+  if (CFI_section(&raw_, &source.raw_, lower, upper, stride) != CFI_SUCCESS) {
+    return false;
+  }
   if (const auto *sourceAddendum = source.Addendum()) {
     if (auto *addendum{Addendum()}) {
       *addendum = *sourceAddendum;
     } else {
       return false;
     }
   }
-  return CFI_section(&raw_, &source.raw_, lower, upper, stride) == CFI_SUCCESS;
+  return true;
 }
 
 RT_API_ATTRS void Descriptor::ApplyMold(

flang-rt/lib/runtime/edit-input.cpp

@@ -396,8 +396,9 @@ static RT_API_ATTRS ScannedRealInput ScanRealInput(
       }
     }
   } else if (first == radixPointChar || (first >= '0' && first <= '9') ||
-      (bzMode && (first == ' ' || first == '\t')) || first == 'E' ||
-      first == 'D' || first == 'Q') {
+      (bzMode && (first == ' ' || first == '\t')) ||
+      (remaining.has_value() &&
+          (first == 'D' || first == 'E' || first == 'Q'))) {
     if (first == '0') {
       next = io.NextInField(remaining, edit);
       if (next && (*next == 'x' || *next == 'X')) { // 0X...
@@ -462,6 +463,14 @@ static RT_API_ATTRS ScannedRealInput ScanRealInput(
         // optional exponent letter and the exponent value.
         io.SkipSpaces(remaining);
         next = io.NextInField(remaining, edit);
+        if (!next) {
+          if (remaining.has_value()) {
+            // bare exponent letter accepted in fixed-width field
+            hasGoodExponent = true;
+          } else {
+            return {}; // error
+          }
+        }
       }
     }
     if (next &&

flang-rt/lib/runtime/io-stmt.cpp

@@ -1078,6 +1078,22 @@ bool ChildFormattedIoStatementState<DIR, CHAR>::AdvanceRecord(int n) {
 #endif
 }
 
+template <Direction DIR>
+ChildListIoStatementState<DIR>::ChildListIoStatementState(
+    ChildIo &child, const char *sourceFile, int sourceLine)
+    : ChildIoStatementState<DIR>{child, sourceFile, sourceLine} {
+#if !defined(RT_DEVICE_AVOID_RECURSION)
+  if constexpr (DIR == Direction::Input) {
+    if (auto *listInput{child.parent()
+                .get_if<ListDirectedStatementState<Direction::Input>>()}) {
+      this->inNamelistSequence_ = listInput->inNamelistSequence();
+    }
+  }
+#else
+  this->ReportUnsupportedChildIo();
+#endif
+}
+
 template <Direction DIR>
 bool ChildUnformattedIoStatementState<DIR>::Receive(
     char *data, std::size_t bytes, std::size_t elementBytes) {

flang-rt/lib/runtime/namelist.cpp

@@ -268,13 +268,21 @@ static RT_API_ATTRS void StorageSequenceExtension(
                 ? source.GetDimension(0).ByteStride()
                 : static_cast<SubscriptValue>(source.ElementBytes())};
         stride != 0) {
+      common::optional<DescriptorAddendum> savedAddendum;
+      if (const DescriptorAddendum *addendum{desc.Addendum()}) {
+        // Preserve a copy of the addendum, if any, before clobbering it
+        savedAddendum.emplace(*addendum);
+      }
       desc.raw().attribute = CFI_attribute_pointer;
       desc.raw().rank = 1;
       desc.GetDimension(0)
           .SetBounds(1,
               source.Elements() -
                   ((source.OffsetElement() - desc.OffsetElement()) / stride))
           .SetByteStride(stride);
+      if (savedAddendum) {
+        *desc.Addendum() = *savedAddendum;
+      }
     }
   }
 }
@@ -570,12 +578,14 @@ bool IODEF(InputNamelist)(Cookie cookie, const NamelistGroup &group) {
         addendum && addendum->derivedType()) {
       const NonTbpDefinedIoTable *table{group.nonTbpDefinedIo};
       listInput->ResetForNextNamelistItem(/*inNamelistSequence=*/true);
-      if (!IONAME(InputDerivedType)(cookie, *useDescriptor, table)) {
+      if (!IONAME(InputDerivedType)(cookie, *useDescriptor, table) &&
+          handler.InError()) {
         return false;
       }
     } else {
       listInput->ResetForNextNamelistItem(useDescriptor->rank() > 0);
-      if (!descr::DescriptorIO<Direction::Input>(io, *useDescriptor)) {
+      if (!descr::DescriptorIO<Direction::Input>(io, *useDescriptor) &&
+          handler.InError()) {
         return false;
       }
     }

flang-rt/unittests/Runtime/CMakeLists.txt

@@ -17,6 +17,7 @@ add_flangrt_unittest(RuntimeTests
   Complex.cpp
   CrashHandlerFixture.cpp
   Derived.cpp
+  Descriptor.cpp
   ExternalIOTest.cpp
   Format.cpp
   InputExtensions.cpp