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 "tools.h"
  11 #include <cstdlib>
  12
  13 namespace Fortran::runtime {
  14
  15 inline RT_API_ATTRS bool isIndirection(const RaggedArrayHeader *const header) {
  16   return header->flags & 1;
  17 }
  18
  19 inline RT_API_ATTRS std::size_t rank(const RaggedArrayHeader *const header) {
  20   return header->flags >> 1;
  21 }
  22
  23 RT_API_ATTRS RaggedArrayHeader *RaggedArrayAllocate(RaggedArrayHeader *header,
  24     bool isHeader, std::int64_t rank, std::int64_t elementSize,
  25     std::int64_t *extentVector) {
  26   if (header && rank) {
  27     std::int64_t size{1};
  28     for (std::int64_t counter{0}; counter < rank; ++counter) {
  29       size *= extentVector[counter];
  30       if (size <= 0) {
  31         return nullptr;
  32       }
  33     }
  34     header->flags = (rank << 1) | isHeader;
  35     header->extentPointer = extentVector;
  36     if (isHeader) {
  37       elementSize = sizeof(RaggedArrayHeader);
  38     }
  39     Terminator terminator{__FILE__, __LINE__};
  40     std::size_t bytes{static_cast<std::size_t>(elementSize * size)};
  41     header->bufferPointer = AllocateMemoryOrCrash(terminator, bytes);
  42     if (header->bufferPointer) {
  43       std::memset(header->bufferPointer, 0, bytes);
  44     }
  45     return header;
  46   } else {
  47     return nullptr;
  48   }
  49 }
  50
  51 // Deallocate a ragged array from the heap.
  52 RT_API_ATTRS void RaggedArrayDeallocate(RaggedArrayHeader *raggedArrayHeader) {
  53   if (raggedArrayHeader) {
  54     if (std::size_t end{rank(raggedArrayHeader)}) {
  55       if (isIndirection(raggedArrayHeader)) {
  56         std::size_t linearExtent{1u};
  57         for (std::size_t counter{0u}; counter < end && linearExtent > 0;
  58              ++counter) {
  59           linearExtent *= raggedArrayHeader->extentPointer[counter];
  60         }
  61         for (std::size_t counter{0u}; counter < linearExtent; ++counter) {
  62           RaggedArrayDeallocate(&static_cast<RaggedArrayHeader *>(
  63               raggedArrayHeader->bufferPointer)[counter]);
  64         }
  65       }
  66       std::free(raggedArrayHeader->bufferPointer);
  67       std::free(raggedArrayHeader->extentPointer);
  68       raggedArrayHeader->flags = 0u;
  69     }
  70   }
  71 }
  72
  73 extern "C" {
  74 void *RTDEF(RaggedArrayAllocate)(void *header, bool isHeader, std::int64_t rank,
  75     std::int64_t elementSize, std::int64_t *extentVector) {
  76   auto *result = RaggedArrayAllocate(static_cast<RaggedArrayHeader *>(header),
  77       isHeader, rank, elementSize, extentVector);
  78   return static_cast<void *>(result);
  79 }
  80
  81 void RTDEF(RaggedArrayDeallocate)(void *raggedArrayHeader) {
  82   RaggedArrayDeallocate(static_cast<RaggedArrayHeader *>(raggedArrayHeader));
  83 }
  84 } // extern "C"
  85 } // namespace Fortran::runtime