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