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