[flang] Runtime API for data pointers

[klausler]

Summary

Define and implement an API for use by lowering to
implement operations on pointers.

[jeanPerier]

LGTM

[DavidSpickett]

This change has broken the flang build on our latest-gcc bot:
https://lab.llvm.org/buildbot/#/builders/160/builds/3224

../llvm-project/flang/runtime/descriptor.h:52:22: error: array subscript ‘Fortran::runtime::Dimension[1]’ is partly outside array bounds of ‘Fortran::runtime::StaticDescriptor<0, true> [1]’ [-Werror=array-bounds]
   52 |     raw_.lower_bound = lower;
      |     ~~~~~~~~~~~~~~~~~^~~~~~~
../llvm-project/flang/runtime/descriptor-io.cpp:35:31: note: while referencing ‘statDesc’
   35 |     StaticDescriptor<0, true> statDesc;
      |                               ^~~~~~~~

Though it has gone through latest-clang fine: https://lab.llvm.org/buildbot/#/builders/180/builds/440

So could be gcc being pessimistic or clang missing something.

Can you please investigate?

Edit: "latest" gcc is 11

-- The C compiler identification is GNU 11.1.0
-- The CXX compiler identification is GNU 11.1.0

[klausler]

Will do, thanks.

[klausler]

Fix has been pushed, and I'll keep an eye on the buildbots to make sure that they go/stay green. The warning was legitimate and I'm glad it was caught.

[DavidSpickett]

Bots are green.

I want to check if clang should have warned here and raise a bug if so, it does support array-bounds. Is it possible to make a small example that represents what was going on?

flang/runtime/CMakeLists.txt

   numeric.cpp
   random.cpp
   reduction.cpp
+  pointer.cpp
   product.cpp
   stat.cpp
   stop.cpp

flang/runtime/allocatable.h

 // to manipulate and query allocatable variables, dummy arguments, & components.
 #ifndef FORTRAN_RUNTIME_ALLOCATABLE_H_
 #define FORTRAN_RUNTIME_ALLOCATABLE_H_
+
 #include "descriptor.h"
 #include "entry-names.h"
 
-namespace Fortran::runtime::typeInfo {
-class DerivedType;
-}
-
 namespace Fortran::runtime {
+
 extern "C" {
 
 // Initializes the descriptor for an allocatable of intrinsic or derived type.

 void RTNAME(AllocatableSetBounds)(
     Descriptor &, int zeroBasedDim, SubscriptValue lower, SubscriptValue upper);
 
-// The upper bound is ignored for the last codimension.
+// The upper cobound is ignored for the last codimension.
 void RTNAME(AllocatableSetCoBounds)(Descriptor &, int zeroBasedCoDim,
     SubscriptValue lower, SubscriptValue upper = 0);
 

flang/runtime/allocatable.cpp

   // The byte strides are computed when the object is allocated.
 }
 
+void RTNAME(AllocatableSetDerivedLength)(
+    Descriptor &descriptor, int which, SubscriptValue x) {
+  DescriptorAddendum *addendum{descriptor.Addendum()};
+  INTERNAL_CHECK(addendum != nullptr);
+  addendum->SetLenParameterValue(which, x);
+}
+
+void RTNAME(AllocatableApplyMold)(
+    Descriptor &descriptor, const Descriptor &mold) {
+  descriptor = mold;
+  descriptor.set_base_addr(nullptr);
+  descriptor.raw().attribute = CFI_attribute_allocatable;
+}
+
 int RTNAME(AllocatableAllocate)(Descriptor &descriptor, bool hasStat,
     const Descriptor *errMsg, const char *sourceFile, int sourceLine) {
   Terminator terminator{sourceFile, sourceLine};

     return ReturnError(terminator, StatBaseNotNull, errMsg, hasStat);
   }
   return ReturnError(terminator, descriptor.Allocate(), errMsg, hasStat);
+  // TODO: default component initialization
 }
 
 int RTNAME(AllocatableDeallocate)(Descriptor &descriptor, bool hasStat,

   }
   return ReturnError(terminator, descriptor.Deallocate(), errMsg, hasStat);
 }
+
+// TODO: AllocatableCheckLengthParameter, AllocatableAllocateSource
 }
 } // namespace Fortran::runtime

flang/runtime/descriptor.h

 // array is determined by derivedType_->LenParameters().
 class DescriptorAddendum {
 public:
-  enum Flags {
-    StaticDescriptor = 0x001,
-    ImplicitAllocatable = 0x002, // compiler-created allocatable
-    DoNotFinalize = 0x004, // compiler temporary
-    Target = 0x008, // TARGET attribute
-  };
-
-  explicit DescriptorAddendum(
-      const typeInfo::DerivedType *dt = nullptr, std::uint64_t flags = 0)
-      : derivedType_{dt}, flags_{flags} {}
+  explicit DescriptorAddendum(const typeInfo::DerivedType *dt = nullptr)
+      : derivedType_{dt} {}
   DescriptorAddendum &operator=(const DescriptorAddendum &);
 
   const typeInfo::DerivedType *derivedType() const { return derivedType_; }

     derivedType_ = dt;
     return *this;
   }
-  std::uint64_t &flags() { return flags_; }
-  const std::uint64_t &flags() const { return flags_; }
 
   std::size_t LenParameters() const;
 

 
 private:
   const typeInfo::DerivedType *derivedType_;
-  std::uint64_t flags_{0};
   typeInfo::TypeParameterValue len_[1]; // must be the last component
   // The LEN type parameter values can also include captured values of
   // specification expressions that were used for bounds and for LEN type

   // Create() static member functions otherwise to dynamically allocate a
   // descriptor.
 
-  Descriptor() {
-    // Minimal initialization to prevent the destructor from running amuck
-    // later if the descriptor is never established.
-    raw_.base_addr = nullptr;
-    raw_.f18Addendum = false;
-  }
   Descriptor(const Descriptor &);
   ~Descriptor();
   Descriptor &operator=(const Descriptor &);

   static constexpr std::size_t byteSize{
       Descriptor::SizeInBytes(maxRank, hasAddendum, maxLengthTypeParameters)};
 
-  StaticDescriptor() { new (storage_) Descriptor{}; }
-
   ~StaticDescriptor() { descriptor().~Descriptor(); }
 
   Descriptor &descriptor() { return *reinterpret_cast<Descriptor *>(storage_); }

   }
 
 private:
-  char storage_[byteSize];
+  char storage_[byteSize]{};
 };
 } // namespace Fortran::runtime
 #endif // FORTRAN_RUNTIME_DESCRIPTOR_H_

flang/runtime/descriptor.cpp

 void Descriptor::Destroy(bool finalize) const {
   if (const DescriptorAddendum * addendum{Addendum()}) {
     if (const typeInfo::DerivedType * dt{addendum->derivedType()}) {
-      if (addendum->flags() & DescriptorAddendum::DoNotFinalize) {
-        finalize = false;
-      }
       runtime::Destroy(*this, finalize, *dt);
     }
   }

 DescriptorAddendum &DescriptorAddendum::operator=(
     const DescriptorAddendum &that) {
   derivedType_ = that.derivedType_;
-  flags_ = that.flags_;
   auto lenParms{that.LenParameters()};
   for (std::size_t j{0}; j < lenParms; ++j) {
     len_[j] = that.len_[j];

 
 void DescriptorAddendum::Dump(FILE *f) const {
   std::fprintf(
-      f, "  derivedType @ %p\n", reinterpret_cast<const void *>(derivedType_));
-  std::fprintf(f, "  flags 0x%jx\n", static_cast<std::intmax_t>(flags_));
-  // TODO: LEN parameter values
+      f, "  derivedType @ %p\n", reinterpret_cast<const void *>(derivedType()));
+  std::size_t lenParms{LenParameters()};
+  for (std::size_t j{0}; j < lenParms; ++j) {
+    std::fprintf(f, "  len[%zd] %jd\n", j, static_cast<std::intmax_t>(len_[j]));
+  }
 }
 } // namespace Fortran::runtime

flang/runtime/misc-intrinsic.cpp

   }
   if (const DescriptorAddendum * addendum{mold.Addendum()}) {
     *result.Addendum() = *addendum;
-    auto &flags{result.Addendum()->flags()};
-    flags &= ~DescriptorAddendum::StaticDescriptor;
-    flags |= DescriptorAddendum::DoNotFinalize;
   }
   if (int stat{result.Allocate()}) {
     Terminator{sourceFile, line}.Crash(

flang/runtime/pointer.h

+//===-- runtime/pointer.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
+//
+//===----------------------------------------------------------------------===//
+
+// Defines APIs for Fortran runtime library support of code generated
+// to manipulate and query data pointers.
+
+#ifndef FORTRAN_RUNTIME_POINTER_H_
+#define FORTRAN_RUNTIME_POINTER_H_
+
+#include "descriptor.h"
+#include "entry-names.h"
+
+namespace Fortran::runtime {
+extern "C" {
+
+// Data pointer initialization for NULLIFY(), "p=>NULL()`, & for ALLOCATE().
+
+// Initializes a pointer to a disassociated state for NULLIFY() or "p=>NULL()".
+void RTNAME(PointerNullifyIntrinsic)(
+    Descriptor &, TypeCategory, int kind, int rank = 0, int corank = 0);
+void RTNAME(PointerNullifyCharacter)(Descriptor &, SubscriptValue length = 0,
+    int kind = 1, int rank = 0, int corank = 0);
+void RTNAME(PointerNullifyDerived)(
+    Descriptor &, const typeInfo::DerivedType &, int rank = 0, int corank = 0);
+
+// Explicitly sets the bounds of an initialized disassociated pointer.
+// The upper cobound is ignored for the last codimension.
+void RTNAME(PointerSetBounds)(
+    Descriptor &, int zeroBasedDim, SubscriptValue lower, SubscriptValue upper);
+void RTNAME(PointerSetCoBounds)(Descriptor &, int zeroBasedCoDim,
+    SubscriptValue lower, SubscriptValue upper = 0);
+
+// Length type parameters are indexed in declaration order; i.e., 0 is the
+// first length type parameter in the deepest base type.  (Not for use
+// with CHARACTER; see above.)
+void RTNAME(PointerSetDerivedLength)(Descriptor &, int which, SubscriptValue);
+
+// For MOLD= allocation: acquires information from another descriptor
+// to initialize a null data pointer.
+void RTNAME(PointerApplyMold)(Descriptor &, const Descriptor &mold);
+
+// Data pointer association for "p=>TARGET"
+
+// Associates a scalar pointer with a simple scalar target.
+void RTNAME(PointerAssociateScalar)(Descriptor &, void *);
+
+// Associates a pointer with a target of the same rank, possibly with new lower
+// bounds, which are passed in a vector whose length must equal the rank.
+void RTNAME(PointerAssociate)(Descriptor &, const Descriptor &target);
+void RTNAME(PointerAssociateLowerBounds)(
+    Descriptor &, const Descriptor &target, const Descriptor &lowerBounds);
+
+// Associates a pointer with a target with bounds remapping.  The target must be
+// simply contiguous &/or of rank 1.  The bounds constitute a [2,newRank]
+// integer array whose columns are [lower bound, upper bound] on each dimension.
+void RTNAME(PointerAssociateRemapping)(Descriptor &, const Descriptor &target,
+    const Descriptor &bounds, const char *sourceFile = nullptr,
+    int sourceLine = 0);
+
+// Data pointer allocation and deallocation
+
+// When an explicit type-spec appears in an ALLOCATE statement for an
+// pointer with an explicit (non-deferred) length type paramater for
+// a derived type or CHARACTER value, the explicit value has to match
+// the length type parameter's value.  This API checks that requirement.
+// Returns 0 for success, or the STAT= value on failure with hasStat==true.
+int RTNAME(PointerCheckLengthParameter)(Descriptor &,
+    int which /* 0 for CHARACTER length */, SubscriptValue other,
+    bool hasStat = false, const Descriptor *errMsg = nullptr,
+    const char *sourceFile = nullptr, int sourceLine = 0);
+
+// Allocates a data pointer.  Its descriptor must have been initialized
+// and its bounds and length type parameters set.  It need not be disassociated.
+// On failure, if hasStat is true, returns a nonzero error code for
+// STAT= and (if present) fills in errMsg; if hasStat is false, the
+// image is terminated.  On success, leaves errMsg alone and returns zero.
+// Successfully allocated memory is initialized if the pointer has a
+// derived type, and is always initialized by PointerAllocateSource().
+// Performs all necessary coarray synchronization and validation actions.
+int RTNAME(PointerAllocate)(Descriptor &, bool hasStat = false,
+    const Descriptor *errMsg = nullptr, const char *sourceFile = nullptr,
+    int sourceLine = 0);
+int RTNAME(PointerAllocateSource)(Descriptor &, const Descriptor &source,
+    bool hasStat = false, const Descriptor *errMsg = nullptr,
+    const char *sourceFile = nullptr, int sourceLine = 0);
+
+// Deallocates a data pointer, which must have been allocated by
+// PointerAllocate(), possibly copied with PointerAssociate().
+// Finalizes elements &/or components as needed.  The pointer is left
+// in an initialized disassociated state suitable for reallocation
+// with the same bounds, cobounds, and length type parameters.
+int RTNAME(PointerDeallocate)(Descriptor &, bool hasStat = false,
+    const Descriptor *errMsg = nullptr, const char *sourceFile = nullptr,
+    int sourceLine = 0);
+
+// Association inquiries for ASSOCIATED()
+
+// True when the pointer is not disassociated.
+bool RTNAME(PointerIsAssociated)(const Descriptor &);
+
+// True when the pointer is associated with a specific target.
+bool RTNAME(PointerIsAssociatedWith)(
+    const Descriptor &, const Descriptor &target);
+
+} // extern "C"
+} // namespace Fortran::runtime
+#endif // FORTRAN_RUNTIME_POINTER_H_

flang/runtime/pointer.cpp

+//===-- runtime/pointer.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 "pointer.h"
+#include "stat.h"
+#include "terminator.h"
+#include "tools.h"
+
+namespace Fortran::runtime {
+extern "C" {
+
+void RTNAME(PointerNullifyIntrinsic)(Descriptor &pointer, TypeCategory category,
+    int kind, int rank, int corank) {
+  INTERNAL_CHECK(corank == 0);
+  pointer.Establish(TypeCode{category, kind},
+      Descriptor::BytesFor(category, kind), nullptr, rank, nullptr,
+      CFI_attribute_pointer);
+}
+
+void RTNAME(PointerNullifyCharacter)(Descriptor &pointer, SubscriptValue length,
+    int kind, int rank, int corank) {
+  INTERNAL_CHECK(corank == 0);
+  pointer.Establish(
+      kind, length, nullptr, rank, nullptr, CFI_attribute_pointer);
+}
+
+void RTNAME(PointerNullifyDerived)(Descriptor &pointer,
+    const typeInfo::DerivedType &derivedType, int rank, int corank) {
+  INTERNAL_CHECK(corank == 0);
+  pointer.Establish(derivedType, nullptr, rank, nullptr, CFI_attribute_pointer);
+}
+
+void RTNAME(PointerSetBounds)(Descriptor &pointer, int zeroBasedDim,
+    SubscriptValue lower, SubscriptValue upper) {
+  INTERNAL_CHECK(zeroBasedDim >= 0 && zeroBasedDim < pointer.rank());
+  pointer.GetDimension(zeroBasedDim).SetBounds(lower, upper);
+  // The byte strides are computed when the pointer is allocated.
+}
+
+// TODO: PointerSetCoBounds
+
+void RTNAME(PointerSetDerivedLength)(
+    Descriptor &pointer, int which, SubscriptValue x) {
+  DescriptorAddendum *addendum{pointer.Addendum()};
+  INTERNAL_CHECK(addendum != nullptr);
+  addendum->SetLenParameterValue(which, x);
+}
+
+void RTNAME(PointerApplyMold)(Descriptor &pointer, const Descriptor &mold) {
+  pointer = mold;
+  pointer.set_base_addr(nullptr);
+  pointer.raw().attribute = CFI_attribute_pointer;
+}
+
+void RTNAME(PointerAssociateScalar)(Descriptor &pointer, void *target) {
+  pointer.set_base_addr(target);
+}
+
+void RTNAME(PointerAssociate)(Descriptor &pointer, const Descriptor &target) {
+  pointer = target;
+  pointer.raw().attribute = CFI_attribute_pointer;
+}
+
+void RTNAME(PointerAssociateLowerBounds)(Descriptor &pointer,
+    const Descriptor &target, const Descriptor &lowerBounds) {
+  pointer = target;
+  pointer.raw().attribute = CFI_attribute_pointer;
+  int rank{pointer.rank()};
+  Terminator terminator{__FILE__, __LINE__};
+  std::size_t boundElementBytes{lowerBounds.ElementBytes()};
+  for (int j{0}; j < rank; ++j) {
+    pointer.GetDimension(j).SetLowerBound(
+        GetInt64(lowerBounds.ZeroBasedIndexedElement<const char>(j),
+            boundElementBytes, terminator));
+  }
+}
+
+void RTNAME(PointerAssociateRemapping)(Descriptor &pointer,
+    const Descriptor &target, const Descriptor &bounds, const char *sourceFile,
+    int sourceLine) {
+  pointer = target;
+  pointer.raw().attribute = CFI_attribute_pointer;
+  int rank{pointer.rank()};
+  Terminator terminator{sourceFile, sourceLine};
+  SubscriptValue byteStride{/*captured from first dimension*/};
+  std::size_t boundElementBytes{bounds.ElementBytes()};
+  for (int j{0}; j < rank; ++j) {
+    auto &dim{pointer.GetDimension(j)};
+    dim.SetBounds(GetInt64(bounds.ZeroBasedIndexedElement<const char>(2 * j),
+                      boundElementBytes, terminator),
+        GetInt64(bounds.ZeroBasedIndexedElement<const char>(2 * j + 1),
+            boundElementBytes, terminator));
+    if (j == 0) {
+      byteStride = dim.ByteStride();
+    } else {
+      dim.SetByteStride(byteStride);
+      byteStride *= dim.Extent();
+    }
+  }
+  if (pointer.Elements() > target.Elements()) {
+    terminator.Crash("PointerAssociateRemapping: too many elements in remapped "
+                     "pointer (%zd > %zd)",
+        pointer.Elements(), target.Elements());
+  }
+}
+
+int RTNAME(PointerAllocate)(Descriptor &pointer, bool hasStat,
+    const Descriptor *errMsg, const char *sourceFile, int sourceLine) {
+  Terminator terminator{sourceFile, sourceLine};
+  if (!pointer.IsPointer()) {
+    return ReturnError(terminator, StatInvalidDescriptor, errMsg, hasStat);
+  }
+  return ReturnError(terminator, pointer.Allocate(), errMsg, hasStat);
+  // TODO: default component initialization
+}
+
+int RTNAME(PointerDeallocate)(Descriptor &pointer, bool hasStat,
+    const Descriptor *errMsg, const char *sourceFile, int sourceLine) {
+  Terminator terminator{sourceFile, sourceLine};
+  if (!pointer.IsPointer()) {
+    return ReturnError(terminator, StatInvalidDescriptor, errMsg, hasStat);
+  }
+  if (!pointer.IsAllocated()) {
+    return ReturnError(terminator, StatBaseNull, errMsg, hasStat);
+  }
+  return ReturnError(terminator, pointer.Deallocate(), errMsg, hasStat);
+}
+
+bool RTNAME(PointerIsAssociated)(const Descriptor &pointer) {
+  return pointer.raw().base_addr != nullptr;
+}
+
+bool RTNAME(PointerIsAssociatedWith)(
+    const Descriptor &pointer, const Descriptor &target) {
+  int rank{pointer.rank()};
+  if (pointer.raw().base_addr != target.raw().base_addr ||
+      pointer.ElementBytes() != target.ElementBytes() ||
+      rank != target.rank()) {
+    return false;
+  }
+  for (int j{0}; j < rank; ++j) {
+    const Dimension &pDim{pointer.GetDimension(j)};
+    const Dimension &tDim{target.GetDimension(j)};
+    if (pDim.Extent() != tDim.Extent() ||
+        pDim.ByteStride() != tDim.ByteStride()) {
+      return false;
+    }
+  }
+  return true;
+}
+
+// TODO: PointerCheckLengthParameter, PointerAllocateSource
+
+} // extern "C"
+} // namespace Fortran::runtime

flang/test/Semantics/offsets01.f90

     integer, len :: l2
     real :: b(l1, l2)
   end type
-  type(t1(n))   :: x1 !CHECK: x1 size=48 offset=
-  type(t2(n,n)) :: x2 !CHECK: x2 size=56 offset=
+  type(t1(n))   :: x1 !CHECK: x1 size=40 offset=
+  type(t2(n,n)) :: x2 !CHECK: x2 size=48 offset=
   !CHECK: a size=48 offset=0:
   !CHECK: b size=72 offset=0:
 end