flang/runtime/ragged.cpp

   1 //===-- runtime/ragged.cpp ------------------------------------------------===//
   2 //
   3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
   4 // See https://llvm.org/LICENSE.txt for license information.
   5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
   6 //
   7 //===----------------------------------------------------------------------===//
   8
   9 #include "flang/Runtime/ragged.h"
  10 #include <cstdlib>
  11
  12 namespace Fortran::runtime {
  13
  14 inline bool isIndirection(const RaggedArrayHeader *const header) {
  15   return header->flags & 1;
  16 }
  17
  18 inline std::size_t rank(const RaggedArrayHeader *const header) {
  19   return header->flags >> 1;
  20 }
  21
  22 RaggedArrayHeader *RaggedArrayAllocate(RaggedArrayHeader *header, bool isHeader,
  23     std::int64_t rank, std::int64_t elementSize, std::int64_t *extentVector) {
  24   if (header && rank) {
  25     std::int64_t size{1};
  26     for (std::int64_t counter{0}; counter < rank; ++counter) {
  27       size *= extentVector[counter];
  28       if (size <= 0) {
  29         return nullptr;
  30       }
  31     }
  32     header->flags = (rank << 1) | isHeader;
  33     header->extentPointer = extentVector;
  34     if (isHeader) {
  35       header->bufferPointer = std::calloc(sizeof(RaggedArrayHeader), size);
  36     } else {
  37       header->bufferPointer =
  38           static_cast<void *>(std::calloc(elementSize, size));
  39     }
  40     return header;
  41   } else {
  42     return nullptr;
  43   }
  44 }
  45
  46 // Deallocate a ragged array from the heap.
  47 void RaggedArrayDeallocate(RaggedArrayHeader *raggedArrayHeader) {
  48   if (raggedArrayHeader) {
  49     if (std::size_t end{rank(raggedArrayHeader)}) {
  50       if (isIndirection(raggedArrayHeader)) {
  51         std::size_t linearExtent{1u};
  52         for (std::size_t counter{0u}; counter < end && linearExtent > 0;
  53              ++counter) {
  54           linearExtent *= raggedArrayHeader->extentPointer[counter];
  55         }
  56         for (std::size_t counter{0u}; counter < linearExtent; ++counter) {
  57           RaggedArrayDeallocate(&static_cast<RaggedArrayHeader *>(
  58               raggedArrayHeader->bufferPointer)[counter]);
  59         }
  60       }
  61       std::free(raggedArrayHeader->bufferPointer);
  62       std::free(raggedArrayHeader->extentPointer);
  63       raggedArrayHeader->flags = 0u;
  64     }
  65   }
  66 }
  67
  68 extern "C" {
  69 void *RTNAME(RaggedArrayAllocate)(void *header, bool isHeader,
  70     std::int64_t rank, std::int64_t elementSize, std::int64_t *extentVector) {
  71   auto *result = RaggedArrayAllocate(static_cast<RaggedArrayHeader *>(header),
  72       isHeader, rank, elementSize, extentVector);
  73   return static_cast<void *>(result);
  74 }
  75
  76 void RTNAME(RaggedArrayDeallocate)(void *raggedArrayHeader) {
  77   RaggedArrayDeallocate(static_cast<RaggedArrayHeader *>(raggedArrayHeader));
  78 }
  79 } // extern "C"
  80 } // namespace Fortran::runtime