flang/runtime/descriptor.cpp

   1 //===-- runtime/descriptor.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/descriptor.h"
  10 #include "ISO_Fortran_util.h"
  11 #include "derived.h"
  12 #include "memory.h"
  13 #include "stat.h"
  14 #include "terminator.h"
  15 #include "tools.h"
  16 #include "type-info.h"
  17 #include <cassert>
  18 #include <cstdlib>
  19 #include <cstring>
  20
  21 namespace Fortran::runtime {
  22
  23 Descriptor::Descriptor(const Descriptor &that) { *this = that; }
  24
  25 Descriptor &Descriptor::operator=(const Descriptor &that) {
  26   std::memcpy(this, &that, that.SizeInBytes());
  27   return *this;
  28 }
  29
  30 void Descriptor::Establish(TypeCode t, std::size_t elementBytes, void *p,
  31     int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute,
  32     bool addendum) {
  33   Terminator terminator{__FILE__, __LINE__};
  34   int cfiStatus{ISO::VerifyEstablishParameters(&raw_, p, attribute, t.raw(),
  35       elementBytes, rank, extent, /*external=*/false)};
  36   if (cfiStatus != CFI_SUCCESS) {
  37     terminator.Crash(
  38         "Descriptor::Establish: CFI_establish returned %d for CFI_type_t(%d)",
  39         cfiStatus, t.raw());
  40   }
  41   ISO::EstablishDescriptor(
  42       &raw_, p, attribute, t.raw(), elementBytes, rank, extent);
  43   if (elementBytes == 0) {
  44     raw_.elem_len = 0;
  45     // Reset byte strides of the dimensions, since EstablishDescriptor()
  46     // only does that when the base address is not nullptr.
  47     for (int j{0}; j < rank; ++j) {
  48       GetDimension(j).SetByteStride(0);
  49     }
  50   }
  51   raw_.f18Addendum = addendum;
  52   DescriptorAddendum *a{Addendum()};
  53   RUNTIME_CHECK(terminator, addendum == (a != nullptr));
  54   if (a) {
  55     new (a) DescriptorAddendum{};
  56   }
  57 }
  58
  59 namespace {
  60 template <TypeCategory CAT, int KIND> struct TypeSizeGetter {
  61   constexpr std::size_t operator()() const {
  62     CppTypeFor<CAT, KIND> arr[2];
  63     return sizeof arr / 2;
  64   }
  65 };
  66 } // namespace
  67
  68 std::size_t Descriptor::BytesFor(TypeCategory category, int kind) {
  69   Terminator terminator{__FILE__, __LINE__};
  70   return ApplyType<TypeSizeGetter, std::size_t>(category, kind, terminator);
  71 }
  72
  73 void Descriptor::Establish(TypeCategory c, int kind, void *p, int rank,
  74     const SubscriptValue *extent, ISO::CFI_attribute_t attribute,
  75     bool addendum) {
  76   Establish(TypeCode(c, kind), BytesFor(c, kind), p, rank, extent, attribute,
  77       addendum);
  78 }
  79
  80 void Descriptor::Establish(int characterKind, std::size_t characters, void *p,
  81     int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute,
  82     bool addendum) {
  83   Establish(TypeCode{TypeCategory::Character, characterKind},
  84       characterKind * characters, p, rank, extent, attribute, addendum);
  85 }
  86
  87 void Descriptor::Establish(const typeInfo::DerivedType &dt, void *p, int rank,
  88     const SubscriptValue *extent, ISO::CFI_attribute_t attribute) {
  89   Establish(TypeCode{TypeCategory::Derived, 0}, dt.sizeInBytes(), p, rank,
  90       extent, attribute, true);
  91   DescriptorAddendum *a{Addendum()};
  92   Terminator terminator{__FILE__, __LINE__};
  93   RUNTIME_CHECK(terminator, a != nullptr);
  94   new (a) DescriptorAddendum{&dt};
  95 }
  96
  97 OwningPtr<Descriptor> Descriptor::Create(TypeCode t, std::size_t elementBytes,
  98     void *p, int rank, const SubscriptValue *extent,
  99     ISO::CFI_attribute_t attribute, int derivedTypeLenParameters) {
 100   std::size_t bytes{SizeInBytes(rank, true, derivedTypeLenParameters)};
 101   Terminator terminator{__FILE__, __LINE__};
 102   Descriptor *result{
 103       reinterpret_cast<Descriptor *>(AllocateMemoryOrCrash(terminator, bytes))};
 104   result->Establish(t, elementBytes, p, rank, extent, attribute, true);
 105   return OwningPtr<Descriptor>{result};
 106 }
 107
 108 OwningPtr<Descriptor> Descriptor::Create(TypeCategory c, int kind, void *p,
 109     int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute) {
 110   return Create(
 111       TypeCode(c, kind), BytesFor(c, kind), p, rank, extent, attribute);
 112 }
 113
 114 OwningPtr<Descriptor> Descriptor::Create(int characterKind,
 115     SubscriptValue characters, void *p, int rank, const SubscriptValue *extent,
 116     ISO::CFI_attribute_t attribute) {
 117   return Create(TypeCode{TypeCategory::Character, characterKind},
 118       characterKind * characters, p, rank, extent, attribute);
 119 }
 120
 121 OwningPtr<Descriptor> Descriptor::Create(const typeInfo::DerivedType &dt,
 122     void *p, int rank, const SubscriptValue *extent,
 123     ISO::CFI_attribute_t attribute) {
 124   return Create(TypeCode{TypeCategory::Derived, 0}, dt.sizeInBytes(), p, rank,
 125       extent, attribute, dt.LenParameters());
 126 }
 127
 128 std::size_t Descriptor::SizeInBytes() const {
 129   const DescriptorAddendum *addendum{Addendum()};
 130   return sizeof *this - sizeof(Dimension) + raw_.rank * sizeof(Dimension) +
 131       (addendum ? addendum->SizeInBytes() : 0);
 132 }
 133
 134 std::size_t Descriptor::Elements() const {
 135   int n{rank()};
 136   std::size_t elements{1};
 137   for (int j{0}; j < n; ++j) {
 138     elements *= GetDimension(j).Extent();
 139   }
 140   return elements;
 141 }
 142
 143 int Descriptor::Allocate() {
 144   std::size_t byteSize{Elements() * ElementBytes()};
 145   void *p{std::malloc(byteSize)};
 146   if (!p && byteSize) {
 147     return CFI_ERROR_MEM_ALLOCATION;
 148   }
 149   // TODO: image synchronization
 150   raw_.base_addr = p;
 151   if (int dims{rank()}) {
 152     std::size_t stride{ElementBytes()};
 153     for (int j{0}; j < dims; ++j) {
 154       auto &dimension{GetDimension(j)};
 155       dimension.SetByteStride(stride);
 156       stride *= dimension.Extent();
 157     }
 158   }
 159   return 0;
 160 }
 161
 162 int Descriptor::Destroy(bool finalize, bool destroyPointers) {
 163   if (!destroyPointers && raw_.attribute == CFI_attribute_pointer) {
 164     return StatOk;
 165   } else {
 166     if (auto *addendum{Addendum()}) {
 167       if (const auto *derived{addendum->derivedType()}) {
 168         if (!derived->noDestructionNeeded()) {
 169           runtime::Destroy(*this, finalize, *derived);
 170         }
 171       }
 172     }
 173     return Deallocate();
 174   }
 175 }
 176
 177 int Descriptor::Deallocate() { return ISO::CFI_deallocate(&raw_); }
 178
 179 bool Descriptor::DecrementSubscripts(
 180     SubscriptValue *subscript, const int *permutation) const {
 181   for (int j{raw_.rank - 1}; j >= 0; --j) {
 182     int k{permutation ? permutation[j] : j};
 183     const Dimension &dim{GetDimension(k)};
 184     if (--subscript[k] >= dim.LowerBound()) {
 185       return true;
 186     }
 187     subscript[k] = dim.UpperBound();
 188   }
 189   return false;
 190 }
 191
 192 std::size_t Descriptor::ZeroBasedElementNumber(
 193     const SubscriptValue *subscript, const int *permutation) const {
 194   std::size_t result{0};
 195   std::size_t coefficient{1};
 196   for (int j{0}; j < raw_.rank; ++j) {
 197     int k{permutation ? permutation[j] : j};
 198     const Dimension &dim{GetDimension(k)};
 199     result += coefficient * (subscript[k] - dim.LowerBound());
 200     coefficient *= dim.Extent();
 201   }
 202   return result;
 203 }
 204
 205 bool Descriptor::EstablishPointerSection(const Descriptor &source,
 206     const SubscriptValue *lower, const SubscriptValue *upper,
 207     const SubscriptValue *stride) {
 208   *this = source;
 209   raw_.attribute = CFI_attribute_pointer;
 210   int newRank{raw_.rank};
 211   for (int j{0}; j < raw_.rank; ++j) {
 212     if (!stride || stride[j] == 0) {
 213       if (newRank > 0) {
 214         --newRank;
 215       } else {
 216         return false;
 217       }
 218     }
 219   }
 220   raw_.rank = newRank;
 221   if (const auto *sourceAddendum = source.Addendum()) {
 222     if (auto *addendum{Addendum()}) {
 223       *addendum = *sourceAddendum;
 224     } else {
 225       return false;
 226     }
 227   }
 228   return CFI_section(&raw_, &source.raw_, lower, upper, stride) == CFI_SUCCESS;
 229 }
 230
 231 void Descriptor::Check() const {
 232   // TODO
 233 }
 234
 235 void Descriptor::Dump(FILE *f) const {
 236   std::fprintf(f, "Descriptor @ %p:\n", reinterpret_cast<const void *>(this));
 237   std::fprintf(f, "  base_addr %p\n", raw_.base_addr);
 238   std::fprintf(f, "  elem_len  %zd\n", static_cast<std::size_t>(raw_.elem_len));
 239   std::fprintf(f, "  version   %d\n", static_cast<int>(raw_.version));
 240   std::fprintf(f, "  rank      %d\n", static_cast<int>(raw_.rank));
 241   std::fprintf(f, "  type      %d\n", static_cast<int>(raw_.type));
 242   std::fprintf(f, "  attribute %d\n", static_cast<int>(raw_.attribute));
 243   std::fprintf(f, "  addendum  %d\n", static_cast<int>(raw_.f18Addendum));
 244   for (int j{0}; j < raw_.rank; ++j) {
 245     std::fprintf(f, "  dim[%d] lower_bound %jd\n", j,
 246         static_cast<std::intmax_t>(raw_.dim[j].lower_bound));
 247     std::fprintf(f, "         extent      %jd\n",
 248         static_cast<std::intmax_t>(raw_.dim[j].extent));
 249     std::fprintf(f, "         sm          %jd\n",
 250         static_cast<std::intmax_t>(raw_.dim[j].sm));
 251   }
 252   if (const DescriptorAddendum * addendum{Addendum()}) {
 253     addendum->Dump(f);
 254   }
 255 }
 256
 257 DescriptorAddendum &DescriptorAddendum::operator=(
 258     const DescriptorAddendum &that) {
 259   derivedType_ = that.derivedType_;
 260   auto lenParms{that.LenParameters()};
 261   for (std::size_t j{0}; j < lenParms; ++j) {
 262     len_[j] = that.len_[j];
 263   }
 264   return *this;
 265 }
 266
 267 std::size_t DescriptorAddendum::SizeInBytes() const {
 268   return SizeInBytes(LenParameters());
 269 }
 270
 271 std::size_t DescriptorAddendum::LenParameters() const {
 272   const auto *type{derivedType()};
 273   return type ? type->LenParameters() : 0;
 274 }
 275
 276 void DescriptorAddendum::Dump(FILE *f) const {
 277   std::fprintf(
 278       f, "  derivedType @ %p\n", reinterpret_cast<const void *>(derivedType()));
 279   std::size_t lenParms{LenParameters()};
 280   for (std::size_t j{0}; j < lenParms; ++j) {
 281     std::fprintf(f, "  len[%zd] %jd\n", j, static_cast<std::intmax_t>(len_[j]));
 282   }
 283 }
 284 } // namespace Fortran::runtime