runtime/ragged.cpp

//===-- 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 {

inline bool isIndirection(const RaggedArrayHeader *const header) {
  return header->flags & 1;
}

inline std::size_t rank(const RaggedArrayHeader *const header) {
  return header->flags >> 1;
}

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->flags = (rank << 1) | isHeader;
    header->extentPointer = extentVector;
    if (isHeader) {
      header->bufferPointer = std::calloc(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{rank(raggedArrayHeader)}) {
      if (isIndirection(raggedArrayHeader)) {
        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->flags = 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