--- /dev/null
+//===-- include/flang/Runtime/temporary-stack.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
+//
+//===----------------------------------------------------------------------===//
+// Runtime functions for storing a dynamically resizable number of temporaries.
+// For use in HLFIR lowering.
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_RUNTIME_TEMPORARY_STACK_H_
+#define FORTRAN_RUNTIME_TEMPORARY_STACK_H_
+
+#include "flang/Runtime/entry-names.h"
+#include <stdint.h>
+
+namespace Fortran::runtime {
+class Descriptor;
+extern "C" {
+
+// Stores both the descriptor and a copy of the value in a dynamically resizable
+// data structure identified by opaquePtr. All value stacks must be destroyed
+// at the end of their lifetime and not used afterwards.
+// Popped descriptors point to the copy of the value, not the original address
+// of the value. This copy is dynamically allocated, it is up to the caller to
+// free the value pointed to by the box. The copy operation is a simple memcpy.
+// The sourceFile and line number used when creating the stack are shared for
+// all operations.
+// Opaque pointers returned from these are incompatible with those returned by
+// the flavours for storing descriptors.
+[[nodiscard]] void *RTNAME(CreateValueStack)(
+ const char *sourceFile = nullptr, int line = 0);
+void RTNAME(PushValue)(void *opaquePtr, const Descriptor &value);
+// Note: retValue should be large enough to hold the right number of dimensions,
+// and the optional descriptor addendum
+void RTNAME(PopValue)(void *opaquePtr, Descriptor &retValue);
+// Return the i'th element into retValue (which must be the right size). An
+// exact copy of this descriptor remains in this storage so this one should not
+// be deallocated
+void RTNAME(ValueAt)(void *opaquePtr, uint64_t i, Descriptor &retValue);
+void RTNAME(DestroyValueStack)(void *opaquePtr);
+
+// Stores descriptors value in a dynamically resizable data structure identified
+// by opaquePtr. All descriptor stacks must be destroyed at the end of their
+// lifetime and not used afterwards.
+// Popped descriptors are identical to those which were pushed.
+// The sourceFile and line number used when creating the stack are shared for
+// all operations.
+// Opaque pointers returned from these are incompatible with those returned by
+// the flavours for storing both descriptors and values.
+[[nodiscard]] void *RTNAME(CreateDescriptorStack)(
+ const char *sourceFile = nullptr, int line = 0);
+void RTNAME(PushDescriptor)(void *opaquePtr, const Descriptor &value);
+// Note: retValue should be large enough to hold the right number of dimensions,
+// and the optional descriptor addendum
+void RTNAME(PopDescriptor)(void *opaquePtr, Descriptor &retValue);
+// Return the i'th element into retValue (which must be the right size). An
+// exact copy of this descriptor remains in this storage so this one should not
+// be deallocated
+void RTNAME(DescriptorAt)(void *opaquePtr, uint64_t i, Descriptor &retValue);
+void RTNAME(DestroyDescriptorStack)(void *opaquePtr);
+
+} // extern "C"
+} // namespace Fortran::runtime
+
+#endif // FORTRAN_RUNTIME_TEMPORARY_STACK_H_
--- /dev/null
+//===-- runtime/temporary-stack.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
+//
+//===----------------------------------------------------------------------===//
+
+// Implements std::vector like storage for a dynamically resizable number of
+// temporaries. For use in HLFIR lowering.
+
+#include "flang/Runtime/temporary-stack.h"
+#include "terminator.h"
+#include "flang/ISO_Fortran_binding.h"
+#include "flang/Runtime/assign.h"
+#include "flang/Runtime/descriptor.h"
+#include "flang/Runtime/memory.h"
+
+namespace {
+
+using namespace Fortran::runtime;
+
+// the number of elements to allocate when first creating the vector
+constexpr size_t INITIAL_ALLOC = 8;
+
+/// To store C style data. Does not run constructors/destructors.
+/// Not using std::vector to avoid linking the runtime library to stdc++
+template <bool COPY_VALUES> class DescriptorStorage final {
+ using size_type = uint64_t; // see checkedMultiply()
+
+ size_type capacity_{0};
+ size_type size_{0};
+ Descriptor **data_{nullptr};
+ Terminator terminator_;
+
+ // return true on overflow
+ static bool checkedMultiply(size_type x, size_type y, size_type &res);
+
+ void resize(size_type newCapacity);
+
+ Descriptor *cloneDescriptor(const Descriptor &source);
+
+public:
+ DescriptorStorage(const char *sourceFile, int line);
+ ~DescriptorStorage();
+
+ // `new` but using the runtime allocation API
+ static inline DescriptorStorage *allocate(const char *sourceFile, int line) {
+ Terminator term{sourceFile, line};
+ void *ptr = AllocateMemoryOrCrash(term, sizeof(DescriptorStorage));
+ return new (ptr) DescriptorStorage{sourceFile, line};
+ }
+
+ // `delete` but using the runtime allocation API
+ static inline void destroy(DescriptorStorage *instance) {
+ instance->~DescriptorStorage();
+ FreeMemory(instance);
+ }
+
+ // clones a descriptor into this storage
+ void push(const Descriptor &source);
+
+ // out must be big enough to hold a descriptor of the right rank and addendum
+ void pop(Descriptor &out);
+
+ // out must be big enough to hold a descriptor of the right rank and addendum
+ void at(size_type i, Descriptor &out);
+};
+
+using ValueStack = DescriptorStorage</*COPY_VALUES=*/true>;
+using DescriptorStack = DescriptorStorage</*COPY_VALUES=*/false>;
+} // namespace
+
+template <bool COPY_VALUES>
+bool DescriptorStorage<COPY_VALUES>::checkedMultiply(
+ size_type x, size_type y, size_type &res) {
+ // TODO: c++20 [[unlikely]]
+ if (x > UINT64_MAX / y) {
+ return true;
+ }
+ res = x * y;
+ return false;
+}
+
+template <bool COPY_VALUES>
+void DescriptorStorage<COPY_VALUES>::resize(size_type newCapacity) {
+ if (newCapacity <= capacity_) {
+ return;
+ }
+ size_type bytes;
+ if (checkedMultiply(newCapacity, sizeof(Descriptor *), bytes)) {
+ terminator_.Crash("temporary-stack: out of memory");
+ }
+ Descriptor **newData =
+ static_cast<Descriptor **>(AllocateMemoryOrCrash(terminator_, bytes));
+ memcpy(newData, data_, capacity_ * sizeof(Descriptor *));
+ FreeMemory(data_);
+ data_ = newData;
+ capacity_ = newCapacity;
+}
+
+template <bool COPY_VALUES>
+Descriptor *DescriptorStorage<COPY_VALUES>::cloneDescriptor(
+ const Descriptor &source) {
+ const std::size_t bytes = source.SizeInBytes();
+ void *memory = AllocateMemoryOrCrash(terminator_, bytes);
+ Descriptor *desc = new (memory) Descriptor{source};
+ return desc;
+}
+
+template <bool COPY_VALUES>
+DescriptorStorage<COPY_VALUES>::DescriptorStorage(
+ const char *sourceFile, int line)
+ : terminator_{sourceFile, line} {
+ resize(INITIAL_ALLOC);
+}
+
+template <bool COPY_VALUES>
+DescriptorStorage<COPY_VALUES>::~DescriptorStorage() {
+ for (size_type i = 0; i < size_; ++i) {
+ Descriptor *element = data_[i];
+ if constexpr (COPY_VALUES) {
+ element->Destroy(false, true);
+ }
+ FreeMemory(element);
+ }
+ FreeMemory(data_);
+}
+
+template <bool COPY_VALUES>
+void DescriptorStorage<COPY_VALUES>::push(const Descriptor &source) {
+ if (size_ == capacity_) {
+ size_type newSize;
+ if (checkedMultiply(capacity_, 2, newSize)) {
+ terminator_.Crash("temporary-stack: out of address space");
+ }
+ resize(newSize);
+ }
+ data_[size_] = cloneDescriptor(source);
+ Descriptor &box = *data_[size_];
+ size_ += 1;
+
+ if constexpr (COPY_VALUES) {
+ // copy the data pointed to by the box
+ box.set_base_addr(nullptr);
+ box.Allocate();
+ RTNAME(AssignTemporary)
+ (box, source, terminator_.sourceFileName(), terminator_.sourceLine());
+ }
+}
+
+template <bool COPY_VALUES>
+void DescriptorStorage<COPY_VALUES>::pop(Descriptor &out) {
+ if (size_ == 0) {
+ terminator_.Crash("temporary-stack: pop empty storage");
+ }
+ size_ -= 1;
+ Descriptor *ptr = data_[size_];
+ out = *ptr; // Descriptor::operator= handles the different sizes
+ FreeMemory(ptr);
+}
+
+template <bool COPY_VALUES>
+void DescriptorStorage<COPY_VALUES>::at(size_type i, Descriptor &out) {
+ if (i >= size_) {
+ terminator_.Crash("temporary-stack: out of bounds access");
+ }
+ Descriptor *ptr = data_[i];
+ out = *ptr; // Descriptor::operator= handles the different sizes
+}
+
+inline static ValueStack *getValueStorage(void *opaquePtr) {
+ return static_cast<ValueStack *>(opaquePtr);
+}
+inline static DescriptorStack *getDescriptorStorage(void *opaquePtr) {
+ return static_cast<DescriptorStack *>(opaquePtr);
+}
+
+namespace Fortran::runtime {
+extern "C" {
+void *RTNAME(CreateValueStack)(const char *sourceFile, int line) {
+ return ValueStack::allocate(sourceFile, line);
+}
+
+void RTNAME(PushValue)(void *opaquePtr, const Descriptor &value) {
+ getValueStorage(opaquePtr)->push(value);
+}
+
+void RTNAME(PopValue)(void *opaquePtr, Descriptor &value) {
+ getValueStorage(opaquePtr)->pop(value);
+}
+
+void RTNAME(ValueAt)(void *opaquePtr, uint64_t i, Descriptor &value) {
+ getValueStorage(opaquePtr)->at(i, value);
+}
+
+void RTNAME(DestroyValueStack)(void *opaquePtr) {
+ ValueStack::destroy(getValueStorage(opaquePtr));
+}
+
+void *RTNAME(CreateDescriptorStack)(const char *sourceFile, int line) {
+ return DescriptorStack::allocate(sourceFile, line);
+}
+
+void RTNAME(PushDescriptor)(void *opaquePtr, const Descriptor &value) {
+ getDescriptorStorage(opaquePtr)->push(value);
+}
+
+void RTNAME(PopDescriptor)(void *opaquePtr, Descriptor &value) {
+ getDescriptorStorage(opaquePtr)->pop(value);
+}
+
+void RTNAME(DescriptorAt)(void *opaquePtr, uint64_t i, Descriptor &value) {
+ getValueStorage(opaquePtr)->at(i, value);
+}
+
+void RTNAME(DestroyDescriptorStack)(void *opaquePtr) {
+ DescriptorStack::destroy(getDescriptorStorage(opaquePtr));
+}
+
+} // extern "C"
+} // namespace Fortran::runtime
--- /dev/null
+//===--- flang/unittests/Runtime/TemporaryStack.cpp -------------*- 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
+//
+//===----------------------------------------------------------------------===//
+
+#include "gtest/gtest.h"
+#include "tools.h"
+#include "flang/ISO_Fortran_binding.h"
+#include "flang/Runtime/allocatable.h"
+#include "flang/Runtime/cpp-type.h"
+#include "flang/Runtime/descriptor.h"
+#include "flang/Runtime/temporary-stack.h"
+#include "flang/Runtime/type-code.h"
+#include <vector>
+
+using namespace Fortran::runtime;
+
+// true if two descriptors are otherwise identical, except for different data
+// pointers. The pointed-to elements are bit for bit identical.
+static void descriptorAlmostEqual(
+ const Descriptor &lhs, const Descriptor &rhs) {
+ const Fortran::ISO::CFI_cdesc_t &lhsRaw = lhs.raw();
+ const Fortran::ISO::CFI_cdesc_t &rhsRaw = rhs.raw();
+
+ ASSERT_EQ(lhs.ElementBytes() == rhs.ElementBytes(), true);
+ ASSERT_EQ(lhsRaw.version == rhsRaw.version, true);
+ ASSERT_EQ(lhs.rank() == rhs.rank(), true);
+ ASSERT_EQ(lhs.type() == rhs.type(), true);
+ ASSERT_EQ(lhsRaw.attribute == rhsRaw.attribute, true);
+
+ ASSERT_EQ(memcmp(lhsRaw.dim, rhsRaw.dim, lhs.rank()) == 0, true);
+ const std::size_t bytes = lhs.Elements() * lhs.ElementBytes();
+ ASSERT_EQ(memcmp(lhsRaw.base_addr, rhsRaw.base_addr, bytes) == 0, true);
+
+ const DescriptorAddendum *lhsAdd = lhs.Addendum();
+ const DescriptorAddendum *rhsAdd = rhs.Addendum();
+ if (lhsAdd) {
+ ASSERT_NE(rhsAdd, nullptr);
+ ASSERT_EQ(lhsAdd->SizeInBytes() == rhsAdd->SizeInBytes(), true);
+ ASSERT_EQ(memcmp(lhsAdd, rhsAdd, lhsAdd->SizeInBytes()) == 0, true);
+ } else {
+ ASSERT_EQ(rhsAdd, nullptr);
+ }
+}
+
+TEST(TemporaryStack, ValueStackBasic) {
+ const TypeCode code{CFI_type_int32_t};
+ constexpr size_t elementBytes = 4;
+ constexpr size_t rank = 2;
+ void *const descriptorPtr = reinterpret_cast<void *>(0xdeadbeef);
+ const SubscriptValue extent[rank]{42, 24};
+
+ StaticDescriptor<rank> testDescriptorStorage[3];
+ Descriptor &inputDesc{testDescriptorStorage[0].descriptor()};
+ Descriptor &outputDesc{testDescriptorStorage[1].descriptor()};
+ Descriptor &outputDesc2{testDescriptorStorage[2].descriptor()};
+ inputDesc.Establish(code, elementBytes, descriptorPtr, rank, extent);
+
+ inputDesc.Allocate();
+ ASSERT_EQ(inputDesc.IsAllocated(), true);
+ uint32_t *inputData = static_cast<uint32_t *>(inputDesc.raw().base_addr);
+ for (std::size_t i = 0; i < inputDesc.Elements(); ++i) {
+ inputData[i] = i;
+ }
+
+ void *storage = RTNAME(CreateValueStack)(__FILE__, __LINE__);
+ ASSERT_NE(storage, nullptr);
+
+ RTNAME(PushValue)(storage, inputDesc);
+
+ RTNAME(ValueAt)(storage, 0, outputDesc);
+ descriptorAlmostEqual(inputDesc, outputDesc);
+
+ RTNAME(PopValue)(storage, outputDesc2);
+ descriptorAlmostEqual(inputDesc, outputDesc2);
+
+ RTNAME(DestroyValueStack)(storage);
+}
+
+static unsigned max(unsigned x, unsigned y) {
+ if (x > y) {
+ return x;
+ }
+ return y;
+}
+
+TEST(TemporaryStack, ValueStackMultiSize) {
+ constexpr unsigned numToTest = 42;
+ const TypeCode code{CFI_type_int32_t};
+ constexpr size_t elementBytes = 4;
+ SubscriptValue extent[CFI_MAX_RANK];
+
+ std::vector<OwningPtr<Descriptor>> inputDescriptors;
+ inputDescriptors.reserve(numToTest);
+
+ void *storage = RTNAME(CreateValueStack)(__FILE__, __LINE__);
+ ASSERT_NE(storage, nullptr);
+
+ // create descriptors with and without adendums
+ auto getAdendum = [](unsigned i) { return i % 2; };
+ // create descriptors with varying ranks
+ auto getRank = [](unsigned i) { return max(i % 8, 1); };
+
+ // push descriptors of varying sizes and contents
+ for (unsigned i = 0; i < numToTest; ++i) {
+ const bool adendum = getAdendum(i);
+ const size_t rank = getRank(i);
+ for (unsigned dim = 0; dim < rank; ++dim) {
+ extent[dim] = ((i + dim) % 8) + 1;
+ }
+
+ const OwningPtr<Descriptor> &desc =
+ inputDescriptors.emplace_back(Descriptor::Create(code, elementBytes,
+ nullptr, rank, extent, CFI_attribute_allocatable, adendum));
+
+ // Descriptor::Establish doesn't initialise the extents if baseaddr is null
+ for (unsigned dim = 0; dim < rank; ++dim) {
+ Fortran::ISO::CFI_dim_t &boxDims = desc->raw().dim[dim];
+ boxDims.lower_bound = 1;
+ boxDims.extent = extent[dim];
+ boxDims.sm = elementBytes;
+ }
+ desc->Allocate();
+
+ // fill the array with some data to test
+ for (uint32_t i = 0; i < desc->Elements(); ++i) {
+ uint32_t *data = static_cast<uint32_t *>(desc->raw().base_addr);
+ ASSERT_NE(data, nullptr);
+ data[i] = i;
+ }
+
+ RTNAME(PushValue)(storage, *desc.get());
+ }
+
+ const TypeCode boolCode{CFI_type_Bool};
+ // peek and test each descriptor
+ for (unsigned i = 0; i < numToTest; ++i) {
+ const OwningPtr<Descriptor> &input = inputDescriptors[i];
+ const bool adendum = getAdendum(i);
+ const size_t rank = getRank(i);
+
+ // buffer to return the descriptor into
+ OwningPtr<Descriptor> out = Descriptor::Create(
+ boolCode, 1, nullptr, rank, extent, CFI_attribute_other, adendum);
+
+ (void)input;
+ RTNAME(ValueAt)(storage, i, *out.get());
+ descriptorAlmostEqual(*input, *out);
+ }
+
+ // pop and test each descriptor
+ for (unsigned i = numToTest; i > 0; --i) {
+ const OwningPtr<Descriptor> &input = inputDescriptors[i - 1];
+ const bool adendum = getAdendum(i - 1);
+ const size_t rank = getRank(i - 1);
+
+ // buffer to return the descriptor into
+ OwningPtr<Descriptor> out = Descriptor::Create(
+ boolCode, 1, nullptr, rank, extent, CFI_attribute_other, adendum);
+
+ RTNAME(PopValue)(storage, *out.get());
+ descriptorAlmostEqual(*input, *out);
+ }
+
+ RTNAME(DestroyValueStack)(storage);
+}
+
+TEST(TemporaryStack, DescriptorStackBasic) {
+ const TypeCode code{CFI_type_Bool};
+ constexpr size_t elementBytes = 4;
+ constexpr size_t rank = 2;
+ void *const descriptorPtr = reinterpret_cast<void *>(0xdeadbeef);
+ const SubscriptValue extent[rank]{42, 24};
+
+ StaticDescriptor<rank> testDescriptorStorage[3];
+ Descriptor &inputDesc{testDescriptorStorage[0].descriptor()};
+ Descriptor &outputDesc{testDescriptorStorage[1].descriptor()};
+ Descriptor &outputDesc2{testDescriptorStorage[2].descriptor()};
+ inputDesc.Establish(code, elementBytes, descriptorPtr, rank, extent);
+
+ void *storage = RTNAME(CreateDescriptorStack)(__FILE__, __LINE__);
+ ASSERT_NE(storage, nullptr);
+
+ RTNAME(PushDescriptor)(storage, inputDesc);
+
+ RTNAME(DescriptorAt)(storage, 0, outputDesc);
+ ASSERT_EQ(
+ memcmp(&inputDesc, &outputDesc, testDescriptorStorage[0].byteSize), 0);
+
+ RTNAME(PopDescriptor)(storage, outputDesc2);
+ ASSERT_EQ(
+ memcmp(&inputDesc, &outputDesc2, testDescriptorStorage[0].byteSize), 0);
+
+ RTNAME(DestroyDescriptorStack)(storage);
+}
+
+TEST(TemporaryStack, DescriptorStackMultiSize) {
+ constexpr unsigned numToTest = 42;
+ const TypeCode code{CFI_type_Bool};
+ constexpr size_t elementBytes = 4;
+ const uintptr_t ptrBase = 0xdeadbeef;
+ SubscriptValue extent[CFI_MAX_RANK];
+
+ std::vector<OwningPtr<Descriptor>> inputDescriptors;
+ inputDescriptors.reserve(numToTest);
+
+ void *storage = RTNAME(CreateDescriptorStack)(__FILE__, __LINE__);
+ ASSERT_NE(storage, nullptr);
+
+ // create descriptors with and without adendums
+ auto getAdendum = [](unsigned i) { return i % 2; };
+ // create descriptors with varying ranks
+ auto getRank = [](unsigned i) { return max(i % CFI_MAX_RANK, 1); };
+
+ // push descriptors of varying sizes and contents
+ for (unsigned i = 0; i < numToTest; ++i) {
+ const bool adendum = getAdendum(i);
+ const size_t rank = getRank(i);
+ for (unsigned dim = 0; dim < rank; ++dim) {
+ extent[dim] = max(i - dim, 1);
+ }
+
+ // varying pointers
+ void *const ptr = reinterpret_cast<void *>(ptrBase + i * elementBytes);
+
+ const OwningPtr<Descriptor> &desc =
+ inputDescriptors.emplace_back(Descriptor::Create(code, elementBytes,
+ ptr, rank, extent, CFI_attribute_other, adendum));
+ RTNAME(PushDescriptor)(storage, *desc.get());
+ }
+
+ const TypeCode intCode{CFI_type_int8_t};
+ // peek and test each descriptor
+ for (unsigned i = 0; i < numToTest; ++i) {
+ const OwningPtr<Descriptor> &input = inputDescriptors[i];
+ const bool adendum = getAdendum(i);
+ const size_t rank = getRank(i);
+
+ // buffer to return the descriptor into
+ OwningPtr<Descriptor> out = Descriptor::Create(
+ intCode, 1, nullptr, rank, extent, CFI_attribute_other, adendum);
+
+ RTNAME(DescriptorAt)(storage, i, *out.get());
+ ASSERT_EQ(memcmp(input.get(), out.get(), input->SizeInBytes()), 0);
+ }
+
+ // pop and test each descriptor
+ for (unsigned i = numToTest; i > 0; --i) {
+ const OwningPtr<Descriptor> &input = inputDescriptors[i - 1];
+ const bool adendum = getAdendum(i - 1);
+ const size_t rank = getRank(i - 1);
+
+ // buffer to return the descriptor into
+ OwningPtr<Descriptor> out = Descriptor::Create(
+ intCode, 1, nullptr, rank, extent, CFI_attribute_other, adendum);
+
+ RTNAME(PopDescriptor)(storage, *out.get());
+ ASSERT_EQ(memcmp(input.get(), out.get(), input->SizeInBytes()), 0);
+ }
+
+ RTNAME(DestroyDescriptorStack)(storage);
+}