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 "flang/Runtime/allocator-registry.h"
  18 #include <cassert>
  19 #include <cstdlib>
  20 #include <cstring>
  21
  22 namespace Fortran::runtime {
  23
  24 RT_OFFLOAD_API_GROUP_BEGIN
  25
  26 RT_API_ATTRS Descriptor::Descriptor(const Descriptor &that) { *this = that; }
  27
  28 RT_API_ATTRS Descriptor &Descriptor::operator=(const Descriptor &that) {
  29   std::memcpy(this, &that, that.SizeInBytes());
  30   return *this;
  31 }
  32
  33 RT_API_ATTRS void Descriptor::Establish(TypeCode t, std::size_t elementBytes,
  34     void *p, int rank, const SubscriptValue *extent,
  35     ISO::CFI_attribute_t attribute, bool addendum) {
  36   Terminator terminator{__FILE__, __LINE__};
  37   int cfiStatus{ISO::VerifyEstablishParameters(&raw_, p, attribute, t.raw(),
  38       elementBytes, rank, extent, /*external=*/false)};
  39   if (cfiStatus != CFI_SUCCESS) {
  40     terminator.Crash(
  41         "Descriptor::Establish: CFI_establish returned %d for CFI_type_t(%d)",
  42         cfiStatus, t.raw());
  43   }
  44   ISO::EstablishDescriptor(
  45       &raw_, p, attribute, t.raw(), elementBytes, rank, extent);
  46   if (elementBytes == 0) {
  47     raw_.elem_len = 0;
  48     // Reset byte strides of the dimensions, since EstablishDescriptor()
  49     // only does that when the base address is not nullptr.
  50     for (int j{0}; j < rank; ++j) {
  51       GetDimension(j).SetByteStride(0);
  52     }
  53   }
  54   if (addendum) {
  55     SetHasAddendum();
  56   }
  57   DescriptorAddendum *a{Addendum()};
  58   RUNTIME_CHECK(terminator, addendum == (a != nullptr));
  59   if (a) {
  60     new (a) DescriptorAddendum{};
  61   }
  62 }
  63
  64 namespace {
  65 template <TypeCategory CAT, int KIND> struct TypeSizeGetter {
  66   constexpr RT_API_ATTRS std::size_t operator()() const {
  67     CppTypeFor<CAT, KIND> arr[2];
  68     return sizeof arr / 2;
  69   }
  70 };
  71 } // namespace
  72
  73 RT_API_ATTRS std::size_t Descriptor::BytesFor(TypeCategory category, int kind) {
  74   Terminator terminator{__FILE__, __LINE__};
  75   return ApplyType<TypeSizeGetter, std::size_t>(category, kind, terminator);
  76 }
  77
  78 RT_API_ATTRS void Descriptor::Establish(TypeCategory c, int kind, void *p,
  79     int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute,
  80     bool addendum) {
  81   Establish(TypeCode(c, kind), BytesFor(c, kind), p, rank, extent, attribute,
  82       addendum);
  83 }
  84
  85 RT_API_ATTRS void Descriptor::Establish(int characterKind,
  86     std::size_t characters, void *p, int rank, const SubscriptValue *extent,
  87     ISO::CFI_attribute_t attribute, bool addendum) {
  88   Establish(TypeCode{TypeCategory::Character, characterKind},
  89       characterKind * characters, p, rank, extent, attribute, addendum);
  90 }
  91
  92 RT_API_ATTRS void Descriptor::Establish(const typeInfo::DerivedType &dt,
  93     void *p, int rank, const SubscriptValue *extent,
  94     ISO::CFI_attribute_t attribute) {
  95   Establish(TypeCode{TypeCategory::Derived, 0}, dt.sizeInBytes(), p, rank,
  96       extent, attribute, true);
  97   DescriptorAddendum *a{Addendum()};
  98   Terminator terminator{__FILE__, __LINE__};
  99   RUNTIME_CHECK(terminator, a != nullptr);
 100   new (a) DescriptorAddendum{&dt};
 101 }
 102
 103 RT_API_ATTRS OwningPtr<Descriptor> Descriptor::Create(TypeCode t,
 104     std::size_t elementBytes, void *p, int rank, const SubscriptValue *extent,
 105     ISO::CFI_attribute_t attribute, bool addendum,
 106     const typeInfo::DerivedType *dt) {
 107   Terminator terminator{__FILE__, __LINE__};
 108   RUNTIME_CHECK(terminator, t.IsDerived() == (dt != nullptr));
 109   int derivedTypeLenParameters = dt ? dt->LenParameters() : 0;
 110   std::size_t bytes{SizeInBytes(rank, addendum, derivedTypeLenParameters)};
 111   Descriptor *result{
 112       reinterpret_cast<Descriptor *>(AllocateMemoryOrCrash(terminator, bytes))};
 113   if (dt) {
 114     result->Establish(*dt, p, rank, extent, attribute);
 115   } else {
 116     result->Establish(t, elementBytes, p, rank, extent, attribute, addendum);
 117   }
 118   return OwningPtr<Descriptor>{result};
 119 }
 120
 121 RT_API_ATTRS OwningPtr<Descriptor> Descriptor::Create(TypeCategory c, int kind,
 122     void *p, int rank, const SubscriptValue *extent,
 123     ISO::CFI_attribute_t attribute) {
 124   return Create(
 125       TypeCode(c, kind), BytesFor(c, kind), p, rank, extent, attribute);
 126 }
 127
 128 RT_API_ATTRS OwningPtr<Descriptor> Descriptor::Create(int characterKind,
 129     SubscriptValue characters, void *p, int rank, const SubscriptValue *extent,
 130     ISO::CFI_attribute_t attribute) {
 131   return Create(TypeCode{TypeCategory::Character, characterKind},
 132       characterKind * characters, p, rank, extent, attribute);
 133 }
 134
 135 RT_API_ATTRS OwningPtr<Descriptor> Descriptor::Create(
 136     const typeInfo::DerivedType &dt, void *p, int rank,
 137     const SubscriptValue *extent, ISO::CFI_attribute_t attribute) {
 138   return Create(TypeCode{TypeCategory::Derived, 0}, dt.sizeInBytes(), p, rank,
 139       extent, attribute, /*addendum=*/true, &dt);
 140 }
 141
 142 RT_API_ATTRS std::size_t Descriptor::SizeInBytes() const {
 143   const DescriptorAddendum *addendum{Addendum()};
 144   return sizeof *this - sizeof(Dimension) + raw_.rank * sizeof(Dimension) +
 145       (addendum ? addendum->SizeInBytes() : 0);
 146 }
 147
 148 RT_API_ATTRS std::size_t Descriptor::Elements() const {
 149   int n{rank()};
 150   std::size_t elements{1};
 151   for (int j{0}; j < n; ++j) {
 152     elements *= GetDimension(j).Extent();
 153   }
 154   return elements;
 155 }
 156
 157 RT_API_ATTRS static inline int MapAllocIdx(const Descriptor &desc) {
 158 #ifdef RT_DEVICE_COMPILATION
 159   // Force default allocator in device code.
 160   return kDefaultAllocator;
 161 #else
 162   return desc.GetAllocIdx();
 163 #endif
 164 }
 165
 166 RT_API_ATTRS int Descriptor::Allocate() {
 167   std::size_t elementBytes{ElementBytes()};
 168   if (static_cast<std::int64_t>(elementBytes) < 0) {
 169     // F'2023 7.4.4.2 p5: "If the character length parameter value evaluates
 170     // to a negative value, the length of character entities declared is zero."
 171     elementBytes = raw_.elem_len = 0;
 172   }
 173   std::size_t byteSize{Elements() * elementBytes};
 174   AllocFct alloc{allocatorRegistry.GetAllocator(MapAllocIdx(*this))};
 175   // Zero size allocation is possible in Fortran and the resulting
 176   // descriptor must be allocated/associated. Since std::malloc(0)
 177   // result is implementation defined, always allocate at least one byte.
 178   void *p{alloc(byteSize ? byteSize : 1)};
 179   if (!p) {
 180     return CFI_ERROR_MEM_ALLOCATION;
 181   }
 182   // TODO: image synchronization
 183   raw_.base_addr = p;
 184   SetByteStrides();
 185   return 0;
 186 }
 187
 188 RT_API_ATTRS void Descriptor::SetByteStrides() {
 189   if (int dims{rank()}) {
 190     std::size_t stride{ElementBytes()};
 191     for (int j{0}; j < dims; ++j) {
 192       auto &dimension{GetDimension(j)};
 193       dimension.SetByteStride(stride);
 194       stride *= dimension.Extent();
 195     }
 196   }
 197 }
 198
 199 RT_API_ATTRS int Descriptor::Destroy(
 200     bool finalize, bool destroyPointers, Terminator *terminator) {
 201   if (!destroyPointers && raw_.attribute == CFI_attribute_pointer) {
 202     return StatOk;
 203   } else {
 204     if (auto *addendum{Addendum()}) {
 205       if (const auto *derived{addendum->derivedType()}) {
 206         if (!derived->noDestructionNeeded()) {
 207           runtime::Destroy(*this, finalize, *derived, terminator);
 208         }
 209       }
 210     }
 211     return Deallocate();
 212   }
 213 }
 214
 215 RT_API_ATTRS int Descriptor::Deallocate() {
 216   ISO::CFI_cdesc_t &descriptor{raw()};
 217   if (!descriptor.base_addr) {
 218     return CFI_ERROR_BASE_ADDR_NULL;
 219   } else {
 220     FreeFct free{allocatorRegistry.GetDeallocator(MapAllocIdx(*this))};
 221     free(descriptor.base_addr);
 222     descriptor.base_addr = nullptr;
 223     return CFI_SUCCESS;
 224   }
 225 }
 226
 227 RT_API_ATTRS bool Descriptor::DecrementSubscripts(
 228     SubscriptValue *subscript, const int *permutation) const {
 229   for (int j{raw_.rank - 1}; j >= 0; --j) {
 230     int k{permutation ? permutation[j] : j};
 231     const Dimension &dim{GetDimension(k)};
 232     if (--subscript[k] >= dim.LowerBound()) {
 233       return true;
 234     }
 235     subscript[k] = dim.UpperBound();
 236   }
 237   return false;
 238 }
 239
 240 RT_API_ATTRS std::size_t Descriptor::ZeroBasedElementNumber(
 241     const SubscriptValue *subscript, const int *permutation) const {
 242   std::size_t result{0};
 243   std::size_t coefficient{1};
 244   for (int j{0}; j < raw_.rank; ++j) {
 245     int k{permutation ? permutation[j] : j};
 246     const Dimension &dim{GetDimension(k)};
 247     result += coefficient * (subscript[k] - dim.LowerBound());
 248     coefficient *= dim.Extent();
 249   }
 250   return result;
 251 }
 252
 253 RT_API_ATTRS bool Descriptor::EstablishPointerSection(const Descriptor &source,
 254     const SubscriptValue *lower, const SubscriptValue *upper,
 255     const SubscriptValue *stride) {
 256   *this = source;
 257   raw_.attribute = CFI_attribute_pointer;
 258   int newRank{raw_.rank};
 259   for (int j{0}; j < raw_.rank; ++j) {
 260     if (!stride || stride[j] == 0) {
 261       if (newRank > 0) {
 262         --newRank;
 263       } else {
 264         return false;
 265       }
 266     }
 267   }
 268   raw_.rank = newRank;
 269   if (const auto *sourceAddendum = source.Addendum()) {
 270     if (auto *addendum{Addendum()}) {
 271       *addendum = *sourceAddendum;
 272     } else {
 273       return false;
 274     }
 275   }
 276   return CFI_section(&raw_, &source.raw_, lower, upper, stride) == CFI_SUCCESS;
 277 }
 278
 279 RT_API_ATTRS void Descriptor::ApplyMold(const Descriptor &mold, int rank) {
 280   raw_.elem_len = mold.raw_.elem_len;
 281   raw_.rank = rank;
 282   raw_.type = mold.raw_.type;
 283   for (int j{0}; j < rank && j < mold.raw_.rank; ++j) {
 284     GetDimension(j) = mold.GetDimension(j);
 285   }
 286   if (auto *addendum{Addendum()}) {
 287     if (auto *moldAddendum{mold.Addendum()}) {
 288       *addendum = *moldAddendum;
 289     } else {
 290       INTERNAL_CHECK(!addendum->derivedType());
 291     }
 292   }
 293 }
 294
 295 RT_API_ATTRS void Descriptor::Check() const {
 296   // TODO
 297 }
 298
 299 void Descriptor::Dump(FILE *f) const {
 300   std::fprintf(f, "Descriptor @ %p:\n", reinterpret_cast<const void *>(this));
 301   std::fprintf(f, "  base_addr %p\n", raw_.base_addr);
 302   std::fprintf(f, "  elem_len  %zd\n", static_cast<std::size_t>(raw_.elem_len));
 303   std::fprintf(f, "  version   %d\n", static_cast<int>(raw_.version));
 304   std::fprintf(f, "  rank      %d\n", static_cast<int>(raw_.rank));
 305   std::fprintf(f, "  type      %d\n", static_cast<int>(raw_.type));
 306   std::fprintf(f, "  attribute %d\n", static_cast<int>(raw_.attribute));
 307   std::fprintf(f, "  extra     %d\n", static_cast<int>(raw_.extra));
 308   std::fprintf(f, "    addendum  %d\n", static_cast<int>(HasAddendum()));
 309   std::fprintf(f, "    alloc_idx %d\n", static_cast<int>(GetAllocIdx()));
 310   for (int j{0}; j < raw_.rank; ++j) {
 311     std::fprintf(f, "  dim[%d] lower_bound %jd\n", j,
 312         static_cast<std::intmax_t>(raw_.dim[j].lower_bound));
 313     std::fprintf(f, "         extent      %jd\n",
 314         static_cast<std::intmax_t>(raw_.dim[j].extent));
 315     std::fprintf(f, "         sm          %jd\n",
 316         static_cast<std::intmax_t>(raw_.dim[j].sm));
 317   }
 318   if (const DescriptorAddendum * addendum{Addendum()}) {
 319     addendum->Dump(f);
 320   }
 321 }
 322
 323 RT_API_ATTRS DescriptorAddendum &DescriptorAddendum::operator=(
 324     const DescriptorAddendum &that) {
 325   derivedType_ = that.derivedType_;
 326   auto lenParms{that.LenParameters()};
 327   for (std::size_t j{0}; j < lenParms; ++j) {
 328     len_[j] = that.len_[j];
 329   }
 330   return *this;
 331 }
 332
 333 RT_API_ATTRS std::size_t DescriptorAddendum::SizeInBytes() const {
 334   return SizeInBytes(LenParameters());
 335 }
 336
 337 RT_API_ATTRS std::size_t DescriptorAddendum::LenParameters() const {
 338   const auto *type{derivedType()};
 339   return type ? type->LenParameters() : 0;
 340 }
 341
 342 void DescriptorAddendum::Dump(FILE *f) const {
 343   std::fprintf(
 344       f, "  derivedType @ %p\n", reinterpret_cast<const void *>(derivedType()));
 345   std::size_t lenParms{LenParameters()};
 346   for (std::size_t j{0}; j < lenParms; ++j) {
 347     std::fprintf(f, "  len[%zd] %jd\n", j, static_cast<std::intmax_t>(len_[j]));
 348   }
 349 }
 350
 351 RT_OFFLOAD_API_GROUP_END
 352
 353 } // namespace Fortran::runtime