[flang][runtime] Add ragged array runtime functions

This patch adds the runtime function to allocate and
deallocate ragged arrays.

This patch is part of the upstreaming effort from fir-dev branch.

Reviewed By: klausler

Differential Revision: https://reviews.llvm.org/D114534

Co-authored-by: Eric Schweitz <[email protected]>

Author: clementval

flang/include/flang/Runtime/ragged.h

@@ -0,0 +1,69 @@
+//===-- Runtime/ragged.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
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_RUNTIME_RAGGED_H_
+#define FORTRAN_RUNTIME_RAGGED_H_
+
+#include "flang/Runtime/entry-names.h"
+#include <cstdint>
+
+namespace Fortran::runtime {
+
+// A ragged array header block.
+// The header block is used to create the "array of arrays" ragged data
+// structure. It contains a pair in `flags` to indicate if the header points to
+// an array of headers (isIndirection) or data elements and the rank of the
+// pointed-to array. The rank is the length of the extents vector accessed
+// through `extentPointer`. The `bufferPointer` is overloaded and is null,
+// points to an array of headers (isIndirection), or data.
+// By default, a header is set to zero, which is its unused state.
+// The layout of a ragged buffer header is mirrored in the compiler.
+struct RaggedArrayHeader {
+  bool indirection{false};
+  std::uint8_t rank;
+  void *bufferPointer{nullptr};
+  std::int64_t *extentPointer{nullptr};
+
+  bool isIndirection() { return indirection; }
+  std::uint8_t getRank() { return rank; }
+};
+
+RaggedArrayHeader *RaggedArrayAllocate(
+    RaggedArrayHeader *, bool, std::int64_t, std::int64_t, std::int64_t *);
+
+void RaggedArrayDeallocate(RaggedArrayHeader *);
+
+extern "C" {
+
+// For more on ragged arrays see https://en.wikipedia.org/wiki/Jagged_array. The
+// Flang compiler allocates ragged arrays as a generalization for
+// non-rectangular array temporaries. Ragged arrays can be allocated recursively
+// and on demand. Structurally, each leaf is an optional rectangular array of
+// elements. The shape of each leaf is independent and may be computed on
+// demand. Each branch node is an optional, possibly sparse rectangular array of
+// headers. The shape of each branch is independent and may be computed on
+// demand. Ragged arrays preserve a correspondence between a multidimensional
+// iteration space and array access vectors, which is helpful for dependence
+// analysis.
+
+// Runtime helper for allocation of ragged array buffers.
+// A pointer to the header block to be allocated is given as header. The flag
+// isHeader indicates if a block of headers or data is to be allocated. A
+// non-negative rank indicates the length of the extentVector, which is a list
+// of non-negative extents. elementSize is the size of a data element in the
+// rectangular space defined by the extentVector.
+void *RTNAME(RaggedArrayAllocate)(void *header, bool isHeader,
+    std::int64_t rank, std::int64_t elementSize, std::int64_t *extentVector);
+
+// Runtime helper for deallocation of ragged array buffers. The root header of
+// the ragged array structure is passed to deallocate the entire ragged array.
+void RTNAME(RaggedArrayDeallocate)(void *raggedArrayHeader);
+
+} // extern "C"
+} // namespace Fortran::runtime
+#endif // FORTRAN_RUNTIME_RAGGED_H_

flang/runtime/CMakeLists.txt

@@ -63,6 +63,7 @@ add_flang_library(FortranRuntime
   misc-intrinsic.cpp
   namelist.cpp
   numeric.cpp
+  ragged.cpp
   random.cpp
   reduction.cpp
   pointer.cpp

flang/runtime/ragged.cpp

@@ -0,0 +1,74 @@
+//===-- runtime/ragged.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 "flang/Runtime/ragged.h"
+#include <cstdlib>
+
+namespace Fortran::runtime {
+
+RaggedArrayHeader *RaggedArrayAllocate(RaggedArrayHeader *header, bool isHeader,
+    std::int64_t rank, std::int64_t elementSize, std::int64_t *extentVector) {
+  if (header && rank) {
+    std::int64_t size{1};
+    for (std::int64_t counter{0}; counter < rank; ++counter) {
+      size *= extentVector[counter];
+      if (size <= 0) {
+        return nullptr;
+      }
+    }
+    header->indirection = isHeader;
+    header->rank = rank;
+    header->extentPointer = extentVector;
+    if (isHeader) {
+      header->bufferPointer = std::malloc(sizeof(RaggedArrayHeader) * size);
+    } else {
+      header->bufferPointer =
+          static_cast<void *>(std::calloc(elementSize, size));
+    }
+    return header;
+  } else {
+    return nullptr;
+  }
+}
+
+// Deallocate a ragged array from the heap.
+void RaggedArrayDeallocate(RaggedArrayHeader *raggedArrayHeader) {
+  if (raggedArrayHeader) {
+    if (std::size_t end{raggedArrayHeader->getRank()}) {
+      if (raggedArrayHeader->isIndirection()) {
+        std::size_t linearExtent{1u};
+        for (std::size_t counter{0u}; counter < end && linearExtent > 0;
+             ++counter) {
+          linearExtent *= raggedArrayHeader->extentPointer[counter];
+        }
+        for (std::size_t counter{0u}; counter < linearExtent; ++counter) {
+          RaggedArrayDeallocate(&static_cast<RaggedArrayHeader *>(
+              raggedArrayHeader->bufferPointer)[counter]);
+        }
+      }
+      std::free(raggedArrayHeader->bufferPointer);
+      std::free(raggedArrayHeader->extentPointer);
+      raggedArrayHeader->indirection = false;
+      raggedArrayHeader->rank = 0u;
+    }
+  }
+}
+
+extern "C" {
+void *RTNAME(RaggedArrayAllocate)(void *header, bool isHeader,
+    std::int64_t rank, std::int64_t elementSize, std::int64_t *extentVector) {
+  auto *result = RaggedArrayAllocate(static_cast<RaggedArrayHeader *>(header),
+      isHeader, rank, elementSize, extentVector);
+  return static_cast<void *>(result);
+}
+
+void RTNAME(RaggedArrayDeallocate)(void *raggedArrayHeader) {
+  RaggedArrayDeallocate(static_cast<RaggedArrayHeader *>(raggedArrayHeader));
+}
+} // extern "C"
+} // namespace Fortran::runtime

flang/unittests/Runtime/CMakeLists.txt

@@ -11,6 +11,7 @@ add_flang_unittest(FlangRuntimeTests
   Namelist.cpp
   Numeric.cpp
   NumericalFormatTest.cpp
+  Ragged.cpp
   Random.cpp
   Reduction.cpp
   RuntimeCrashTest.cpp

flang/unittests/Runtime/Ragged.cpp

@@ -0,0 +1,33 @@
+//===-- flang/unittests/Runtime/Ragged.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 "flang/Runtime/ragged.h"
+#include "gtest/gtest.h"
+
+using namespace Fortran::runtime;
+
+TEST(Ragged, RaggedArrayAllocateDeallocateTest) {
+  struct RaggedArrayHeader header;
+  unsigned rank = 2;
+  int64_t *extents = new int64_t[2];
+  extents[0] = 10;
+  extents[1] = 100;
+  RaggedArrayHeader *ret = (RaggedArrayHeader *)_FortranARaggedArrayAllocate(
+      &header, false, rank, 32, extents);
+  EXPECT_TRUE(ret != nullptr);
+  EXPECT_TRUE(ret->bufferPointer != nullptr);
+  EXPECT_EQ(extents, ret->extentPointer);
+  EXPECT_EQ(10, ret->extentPointer[0]);
+  EXPECT_EQ(100, ret->extentPointer[1]);
+  EXPECT_EQ(rank, ret->getRank());
+  EXPECT_FALSE(ret->isIndirection());
+
+  _FortranARaggedArrayDeallocate(ret);
+  EXPECT_EQ(0u, ret->getRank());
+  EXPECT_FALSE(ret->isIndirection());
+}