//===-- 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 "tools.h" #include namespace Fortran::runtime { inline RT_API_ATTRS bool isIndirection(const RaggedArrayHeader *const header) { return header->flags & 1; } inline RT_API_ATTRS std::size_t rank(const RaggedArrayHeader *const header) { return header->flags >> 1; } RT_API_ATTRS 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) { elementSize = sizeof(RaggedArrayHeader); } Terminator terminator{__FILE__, __LINE__}; std::size_t bytes{static_cast(elementSize * size)}; header->bufferPointer = AllocateMemoryOrCrash(terminator, bytes); if (header->bufferPointer) { std::memset(header->bufferPointer, 0, bytes); } return header; } else { return nullptr; } } // Deallocate a ragged array from the heap. RT_API_ATTRS 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->bufferPointer)[counter]); } } std::free(raggedArrayHeader->bufferPointer); std::free(raggedArrayHeader->extentPointer); raggedArrayHeader->flags = 0u; } } } extern "C" { void *RTDEF(RaggedArrayAllocate)(void *header, bool isHeader, std::int64_t rank, std::int64_t elementSize, std::int64_t *extentVector) { auto *result = RaggedArrayAllocate(static_cast(header), isHeader, rank, elementSize, extentVector); return static_cast(result); } void RTDEF(RaggedArrayDeallocate)(void *raggedArrayHeader) { RaggedArrayDeallocate(static_cast(raggedArrayHeader)); } } // extern "C" } // namespace Fortran::runtime