text: //===-- runtime/descriptor.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/descriptor.h"
  #include "derived.h"
  #include "memory.h"
  #include "stat.h"
  #include "terminator.h"
  #include "type-info.h"
  #include <cassert>
  #include <cstdlib>
  #include <cstring>
  
  namespace Fortran::runtime {
  
  Descriptor::Descriptor(const Descriptor &that) { *this = that; }
  
  Descriptor &Descriptor::operator=(const Descriptor &that) {
    std::memcpy(this, &that, that.SizeInBytes());
    return *this;
  }
  
  void Descriptor::Establish(TypeCode t, std::size_t elementBytes, void *p,
      int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute,
      bool addendum) {
    Terminator terminator{__FILE__, __LINE__};
    // Subtle: the standard CFI_establish() function doesn't allow a zero
    // elem_len argument in cases where elem_len is not ignored; and when it
    // returns an error code (CFI_INVALID_ELEM_LEN in this case), it must not
    // modify the descriptor.  That design makes sense, maybe, for actual
    // C interoperability, but we need to work around it here.  A zero
    // incoming element length is replaced by 4 so that it will be valid
    // for all CHARACTER kinds.
    std::size_t workaroundElemLen{elementBytes ? elementBytes : 4};
    int cfiStatus{ISO::CFI_establish(
        &raw_, p, attribute, t.raw(), workaroundElemLen, rank, extent)};
    if (cfiStatus != CFI_SUCCESS) {
      terminator.Crash(
          "Descriptor::Establish: CFI_establish returned %d", cfiStatus, t.raw());
    }
    if (elementBytes == 0) {
      raw_.elem_len = 0;
      for (int j{0}; j < rank; ++j) {
        GetDimension(j).SetByteStride(0);
      }
    }
    raw_.f18Addendum = addendum;
    DescriptorAddendum *a{Addendum()};
    RUNTIME_CHECK(terminator, addendum == (a != nullptr));
    if (a) {
      new (a) DescriptorAddendum{};
    }
  }
  
  void Descriptor::Establish(TypeCategory c, int kind, void *p, int rank,
      const SubscriptValue *extent, ISO::CFI_attribute_t attribute,
      bool addendum) {
    Establish(TypeCode(c, kind), BytesFor(c, kind), p, rank, extent, attribute,
        addendum);
  }
  
  void Descriptor::Establish(int characterKind, std::size_t characters, void *p,
      int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute,
      bool addendum) {
    Establish(TypeCode{TypeCategory::Character, characterKind},
        characterKind * characters, p, rank, extent, attribute, addendum);
  }
  
  void Descriptor::Establish(const typeInfo::DerivedType &dt, void *p, int rank,
      const SubscriptValue *extent, ISO::CFI_attribute_t attribute) {
    Establish(TypeCode{TypeCategory::Derived, 0}, dt.sizeInBytes(), p, rank,
        extent, attribute, true);
    DescriptorAddendum *a{Addendum()};
    Terminator terminator{__FILE__, __LINE__};
    RUNTIME_CHECK(terminator, a != nullptr);
    new (a) DescriptorAddendum{&dt};
  }
  
  OwningPtr<Descriptor> Descriptor::Create(TypeCode t, std::size_t elementBytes,
      void *p, int rank, const SubscriptValue *extent,
      ISO::CFI_attribute_t attribute, int derivedTypeLenParameters) {
    std::size_t bytes{SizeInBytes(rank, true, derivedTypeLenParameters)};
    Terminator terminator{__FILE__, __LINE__};
    Descriptor *result{
        reinterpret_cast<Descriptor *>(AllocateMemoryOrCrash(terminator, bytes))};
    result->Establish(t, elementBytes, p, rank, extent, attribute, true);
    return OwningPtr<Descriptor>{result};
  }
  
  OwningPtr<Descriptor> Descriptor::Create(TypeCategory c, int kind, void *p,
      int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute) {
    return Create(
        TypeCode(c, kind), BytesFor(c, kind), p, rank, extent, attribute);
  }
  
  OwningPtr<Descriptor> Descriptor::Create(int characterKind,
      SubscriptValue characters, void *p, int rank, const SubscriptValue *extent,
      ISO::CFI_attribute_t attribute) {
    return Create(TypeCode{TypeCategory::Character, characterKind},
        characterKind * characters, p, rank, extent, attribute);
  }
  
  OwningPtr<Descriptor> Descriptor::Create(const typeInfo::DerivedType &dt,
      void *p, int rank, const SubscriptValue *extent,
      ISO::CFI_attribute_t attribute) {
    return Create(TypeCode{TypeCategory::Derived, 0}, dt.sizeInBytes(), p, rank,
        extent, attribute, dt.LenParameters());
  }
  
  std::size_t Descriptor::SizeInBytes() const {
    const DescriptorAddendum *addendum{Addendum()};
    return sizeof *this - sizeof(Dimension) + raw_.rank * sizeof(Dimension) +
        (addendum ? addendum->SizeInBytes() : 0);
  }
  
  std::size_t Descriptor::Elements() const {
    int n{rank()};
    std::size_t elements{1};
    for (int j{0}; j < n; ++j) {
      elements *= GetDimension(j).Extent();
    }
    return elements;
  }
  
  int Descriptor::Allocate() {
    std::size_t byteSize{Elements() * ElementBytes()};
    void *p{std::malloc(byteSize)};
    if (!p && byteSize) {
      return CFI_ERROR_MEM_ALLOCATION;
    }
    // TODO: image synchronization
    raw_.base_addr = p;
    if (int dims{rank()}) {
      std::size_t stride{ElementBytes()};
      for (int j{0}; j < dims; ++j) {
        auto &dimension{GetDimension(j)};
        dimension.SetByteStride(stride);
        stride *= dimension.Extent();
      }
    }
    return 0;
  }
  
  int Descriptor::Destroy(bool finalize) {
    if (raw_.attribute == CFI_attribute_pointer) {
      return StatOk;
    } else {
      if (auto *addendum{Addendum()}) {
        if (const auto *derived{addendum->derivedType()}) {
          if (!derived->noDestructionNeeded()) {
            runtime::Destroy(*this, finalize, *derived);
          }
        }
      }
      return Deallocate();
    }
  }
  
  int Descriptor::Deallocate() { return ISO::CFI_deallocate(&raw_); }
  
  bool Descriptor::DecrementSubscripts(
      SubscriptValue *subscript, const int *permutation) const {
    for (int j{raw_.rank - 1}; j >= 0; --j) {
      int k{permutation ? permutation[j] : j};
      const Dimension &dim{GetDimension(k)};
      if (--subscript[k] >= dim.LowerBound()) {
        return true;
      }
      subscript[k] = dim.UpperBound();
    }
    return false;
  }
  
  std::size_t Descriptor::ZeroBasedElementNumber(
      const SubscriptValue *subscript, const int *permutation) const {
    std::size_t result{0};
    std::size_t coefficient{1};
    for (int j{0}; j < raw_.rank; ++j) {
      int k{permutation ? permutation[j] : j};
      const Dimension &dim{GetDimension(k)};
      result += coefficient * (subscript[k] - dim.LowerBound());
      coefficient *= dim.Extent();
    }
    return result;
  }
  
  bool Descriptor::EstablishPointerSection(const Descriptor &source,
      const SubscriptValue *lower, const SubscriptValue *upper,
      const SubscriptValue *stride) {
    *this = source;
    raw_.attribute = CFI_attribute_pointer;
    int newRank{raw_.rank};
    for (int j{0}; j < raw_.rank; ++j) {
      if (!stride || stride[j] == 0) {
        if (newRank > 0) {
          --newRank;
        } else {
          return false;
        }
      }
    }
    raw_.rank = newRank;
    if (const auto *sourceAddendum = source.Addendum()) {
      if (auto *addendum{Addendum()}) {
        *addendum = *sourceAddendum;
      } else {
        return false;
      }
    }
    return CFI_section(&raw_, &source.raw_, lower, upper, stride) == CFI_SUCCESS;
  }
  
  void Descriptor::Check() const {
    // TODO
  }
  
  void Descriptor::Dump(FILE *f) const {
    std::fprintf(f, "Descriptor @ %p:\n", reinterpret_cast<const void *>(this));
    std::fprintf(f, "  base_addr %p\n", raw_.base_addr);
    std::fprintf(f, "  elem_len  %zd\n", static_cast<std::size_t>(raw_.elem_len));
    std::fprintf(f, "  version   %d\n", static_cast<int>(raw_.version));
    std::fprintf(f, "  rank      %d\n", static_cast<int>(raw_.rank));
    std::fprintf(f, "  type      %d\n", static_cast<int>(raw_.type));
    std::fprintf(f, "  attribute %d\n", static_cast<int>(raw_.attribute));
    std::fprintf(f, "  addendum  %d\n", static_cast<int>(raw_.f18Addendum));
    for (int j{0}; j < raw_.rank; ++j) {
      std::fprintf(f, "  dim[%d] lower_bound %jd\n", j,
          static_cast<std::intmax_t>(raw_.dim[j].lower_bound));
      std::fprintf(f, "         extent      %jd\n",
          static_cast<std::intmax_t>(raw_.dim[j].extent));
      std::fprintf(f, "         sm          %jd\n",
          static_cast<std::intmax_t>(raw_.dim[j].sm));
    }
    if (const DescriptorAddendum * addendum{Addendum()}) {
      addendum->Dump(f);
    }
  }
  
  DescriptorAddendum &DescriptorAddendum::operator=(
      const DescriptorAddendum &that) {
    derivedType_ = that.derivedType_;
    auto lenParms{that.LenParameters()};
    for (std::size_t j{0}; j < lenParms; ++j) {
      len_[j] = that.len_[j];
    }
    return *this;
  }
  
  std::size_t DescriptorAddendum::SizeInBytes() const {
    return SizeInBytes(LenParameters());
  }
  
  std::size_t DescriptorAddendum::LenParameters() const {
    const auto *type{derivedType()};
    return type ? type->LenParameters() : 0;
  }
  
  void DescriptorAddendum::Dump(FILE *f) const {
    std::fprintf(
        f, "  derivedType @ %p\n", reinterpret_cast<const void *>(derivedType()));
    std::size_t lenParms{LenParameters()};
    for (std::size_t j{0}; j < lenParms; ++j) {
      std::fprintf(f, "  len[%zd] %jd\n", j, static_cast<std::intmax_t>(len_[j]));
    }
  }
  } // namespace Fortran::runtime
  