504 lines · cpp
1//===-- lib/runtime/descriptor.cpp ------------------------------*- C++ -*-===//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-exception6//7//===----------------------------------------------------------------------===//8 9#include "flang-rt/runtime/descriptor.h"10#include "ISO_Fortran_util.h"11#include "memory.h"12#include "flang-rt/runtime/allocator-registry.h"13#include "flang-rt/runtime/derived.h"14#include "flang-rt/runtime/stat.h"15#include "flang-rt/runtime/terminator.h"16#include "flang-rt/runtime/type-info.h"17#include "flang/Common/type-kinds.h"18#include "flang/Runtime/freestanding-tools.h"19#include <cassert>20#include <cstdlib>21#include <cstring>22 23namespace Fortran::runtime {24 25RT_OFFLOAD_API_GROUP_BEGIN26 27RT_API_ATTRS Descriptor::Descriptor(const Descriptor &that) { *this = that; }28 29RT_API_ATTRS Descriptor &Descriptor::operator=(const Descriptor &that) {30 runtime::memcpy(reinterpret_cast<void *>(this), &that, that.SizeInBytes());31 return *this;32}33 34RT_API_ATTRS void Descriptor::Establish(TypeCode t, std::size_t elementBytes,35 void *p, int rank, const SubscriptValue *extent,36 ISO::CFI_attribute_t attribute, bool addendum, int allocatorIdx) {37 Terminator terminator{__FILE__, __LINE__};38 int cfiStatus{ISO::VerifyEstablishParameters(&raw_, p, attribute, t.raw(),39 elementBytes, rank, extent, /*external=*/false)};40 if (cfiStatus != CFI_SUCCESS) {41 terminator.Crash(42 "Descriptor::Establish: CFI_establish returned %d for CFI_type_t(%d)",43 cfiStatus, t.raw());44 }45 ISO::EstablishDescriptor(46 &raw_, p, attribute, t.raw(), elementBytes, rank, extent);47 if (elementBytes == 0) {48 raw_.elem_len = 0;49 // Reset byte strides of the dimensions, since EstablishDescriptor()50 // only does that when the base address is not nullptr.51 for (int j{0}; j < rank; ++j) {52 GetDimension(j).SetByteStride(0);53 }54 }55 if (addendum) {56 SetHasAddendum();57 }58 DescriptorAddendum *a{Addendum()};59 RUNTIME_CHECK(terminator, addendum == (a != nullptr));60 if (a) {61 new (a) DescriptorAddendum{};62 }63 SetAllocIdx(allocatorIdx);64}65 66RT_API_ATTRS std::size_t Descriptor::BytesFor(TypeCategory category, int kind) {67 Terminator terminator{__FILE__, __LINE__};68 int bytes{common::TypeSizeInBytes(category, kind)};69 RUNTIME_CHECK(terminator, bytes > 0);70 return bytes;71}72 73RT_API_ATTRS void Descriptor::Establish(TypeCategory c, int kind, void *p,74 int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute,75 bool addendum, int allocatorIdx) {76 Establish(TypeCode(c, kind), BytesFor(c, kind), p, rank, extent, attribute,77 addendum, allocatorIdx);78}79 80RT_API_ATTRS void Descriptor::Establish(int characterKind,81 std::size_t characters, void *p, int rank, const SubscriptValue *extent,82 ISO::CFI_attribute_t attribute, bool addendum, int allocatorIdx) {83 Establish(TypeCode{TypeCategory::Character, characterKind},84 characterKind * characters, p, rank, extent, attribute, addendum,85 allocatorIdx);86}87 88RT_API_ATTRS void Descriptor::Establish(const typeInfo::DerivedType &dt,89 void *p, int rank, const SubscriptValue *extent,90 ISO::CFI_attribute_t attribute, int allocatorIdx) {91 auto elementBytes{static_cast<std::size_t>(dt.sizeInBytes())};92 ISO::EstablishDescriptor(93 &raw_, p, attribute, CFI_type_struct, elementBytes, rank, extent);94 if (elementBytes == 0) {95 raw_.elem_len = 0;96 // Reset byte strides of the dimensions, since EstablishDescriptor()97 // only does that when the base address is not nullptr.98 for (int j{0}; j < rank; ++j) {99 GetDimension(j).SetByteStride(0);100 }101 }102 SetHasAddendum();103 new (Addendum()) DescriptorAddendum{&dt};104 SetAllocIdx(allocatorIdx);105}106 107RT_API_ATTRS void Descriptor::UncheckedScalarEstablish(108 const typeInfo::DerivedType &dt, void *p) {109 auto elementBytes{static_cast<std::size_t>(dt.sizeInBytes())};110 ISO::EstablishDescriptor(111 &raw_, p, CFI_attribute_other, CFI_type_struct, elementBytes, 0, nullptr);112 SetHasAddendum();113 new (Addendum()) DescriptorAddendum{&dt};114}115 116RT_API_ATTRS OwningPtr<Descriptor> Descriptor::Create(TypeCode t,117 std::size_t elementBytes, void *p, int rank, const SubscriptValue *extent,118 ISO::CFI_attribute_t attribute, bool addendum,119 const typeInfo::DerivedType *dt) {120 Terminator terminator{__FILE__, __LINE__};121 RUNTIME_CHECK(terminator, t.IsDerived() == (dt != nullptr));122 int derivedTypeLenParameters = dt ? dt->LenParameters() : 0;123 std::size_t bytes{SizeInBytes(rank, addendum, derivedTypeLenParameters)};124 Descriptor *result{125 reinterpret_cast<Descriptor *>(AllocateMemoryOrCrash(terminator, bytes))};126 if (dt) {127 result->Establish(*dt, p, rank, extent, attribute);128 } else {129 result->Establish(t, elementBytes, p, rank, extent, attribute, addendum);130 }131 return OwningPtr<Descriptor>{result};132}133 134RT_API_ATTRS OwningPtr<Descriptor> Descriptor::Create(TypeCategory c, int kind,135 void *p, int rank, const SubscriptValue *extent,136 ISO::CFI_attribute_t attribute) {137 return Create(138 TypeCode(c, kind), BytesFor(c, kind), p, rank, extent, attribute);139}140 141RT_API_ATTRS OwningPtr<Descriptor> Descriptor::Create(int characterKind,142 SubscriptValue characters, void *p, int rank, const SubscriptValue *extent,143 ISO::CFI_attribute_t attribute) {144 return Create(TypeCode{TypeCategory::Character, characterKind},145 characterKind * characters, p, rank, extent, attribute);146}147 148RT_API_ATTRS OwningPtr<Descriptor> Descriptor::Create(149 const typeInfo::DerivedType &dt, void *p, int rank,150 const SubscriptValue *extent, ISO::CFI_attribute_t attribute) {151 return Create(TypeCode{TypeCategory::Derived, 0}, dt.sizeInBytes(), p, rank,152 extent, attribute, /*addendum=*/true, &dt);153}154 155RT_API_ATTRS std::size_t Descriptor::SizeInBytes() const {156 const DescriptorAddendum *addendum{Addendum()};157 std::size_t bytes{ sizeof *this - sizeof(Dimension) + raw_.rank * sizeof(Dimension) +158 (addendum ? addendum->SizeInBytes() : 0)};159 assert (bytes <= MaxDescriptorSizeInBytes(raw_.rank,addendum) && "Descriptor must fit compiler-allocated space");160 return bytes;161}162 163RT_API_ATTRS std::size_t Descriptor::Elements() const {164 return InlineElements();165}166 167RT_API_ATTRS int Descriptor::Allocate(std::int64_t *asyncObject) {168 std::size_t elementBytes{ElementBytes()};169 if (static_cast<std::int64_t>(elementBytes) < 0) {170 // F'2023 7.4.4.2 p5: "If the character length parameter value evaluates171 // to a negative value, the length of character entities declared is zero."172 elementBytes = raw_.elem_len = 0;173 }174 std::size_t byteSize{Elements() * elementBytes};175 AllocFct alloc{allocatorRegistry.GetAllocator(MapAllocIdx())};176 // Zero size allocation is possible in Fortran and the resulting177 // descriptor must be allocated/associated. Since std::malloc(0)178 // result is implementation defined, always allocate at least one byte.179 void *p{alloc(byteSize ? byteSize : 1, asyncObject)};180 if (!p) {181 return CFI_ERROR_MEM_ALLOCATION;182 }183 // TODO: image synchronization184 raw_.base_addr = p;185 SetByteStrides();186 return 0;187}188 189RT_API_ATTRS void Descriptor::SetByteStrides() {190 if (int dims{rank()}) {191 std::size_t stride{ElementBytes()};192 for (int j{0}; j < dims; ++j) {193 auto &dimension{GetDimension(j)};194 dimension.SetByteStride(stride);195 stride *= dimension.Extent();196 }197 }198}199 200RT_API_ATTRS int Descriptor::Destroy(201 bool finalize, bool destroyPointers, Terminator *terminator) {202 if (!destroyPointers && raw_.attribute == CFI_attribute_pointer) {203 return StatOk;204 } else {205 if (auto *addendum{Addendum()}) {206 if (const auto *derived{addendum->derivedType()}) {207 if (!derived->noDestructionNeeded()) {208 runtime::Destroy(*this, finalize, *derived, terminator);209 }210 }211 }212 return Deallocate();213 }214}215 216RT_API_ATTRS bool Descriptor::DecrementSubscripts(217 SubscriptValue *subscript, const int *permutation) const {218 for (int j{raw_.rank - 1}; j >= 0; --j) {219 int k{permutation ? permutation[j] : j};220 const Dimension &dim{GetDimension(k)};221 if (--subscript[k] >= dim.LowerBound()) {222 return true;223 }224 subscript[k] = dim.UpperBound();225 }226 return false;227}228 229RT_API_ATTRS std::size_t Descriptor::ZeroBasedElementNumber(230 const SubscriptValue *subscript, const int *permutation) const {231 std::size_t result{0};232 std::size_t coefficient{1};233 for (int j{0}; j < raw_.rank; ++j) {234 int k{permutation ? permutation[j] : j};235 const Dimension &dim{GetDimension(k)};236 result += coefficient * (subscript[k] - dim.LowerBound());237 coefficient *= dim.Extent();238 }239 return result;240}241 242RT_API_ATTRS bool Descriptor::EstablishPointerSection(const Descriptor &source,243 const SubscriptValue *lower, const SubscriptValue *upper,244 const SubscriptValue *stride) {245 *this = source;246 raw_.attribute = CFI_attribute_pointer;247 SetAllocIdx(source.GetAllocIdx());248 int newRank{raw_.rank};249 for (int j{0}; j < raw_.rank; ++j) {250 if (!stride || stride[j] == 0) {251 if (newRank > 0) {252 --newRank;253 } else {254 return false;255 }256 }257 }258 raw_.rank = newRank;259 if (CFI_section(&raw_, &source.raw_, lower, upper, stride) != CFI_SUCCESS) {260 return false;261 }262 if (const auto *sourceAddendum = source.Addendum()) {263 if (auto *addendum{Addendum()}) {264 *addendum = *sourceAddendum;265 } else {266 return false;267 }268 }269 return true;270}271 272RT_API_ATTRS void Descriptor::ApplyMold(273 const Descriptor &mold, int rank, bool isMonomorphic) {274 raw_.rank = rank;275 for (int j{0}; j < rank && j < mold.raw_.rank; ++j) {276 GetDimension(j) = mold.GetDimension(j);277 }278 if (!isMonomorphic) {279 raw_.elem_len = mold.raw_.elem_len;280 raw_.type = mold.raw_.type;281 if (auto *addendum{Addendum()}) {282 if (auto *moldAddendum{mold.Addendum()}) {283 *addendum = *moldAddendum;284 } else {285 INTERNAL_CHECK(!addendum->derivedType());286 }287 }288 }289}290 291RT_API_ATTRS void Descriptor::Check() const {292 // TODO293}294 295static const char *GetTypeStr(ISO::CFI_type_t type, bool dumpRawType) {296 if (dumpRawType) {297#define CASE(x) \298 case (x): \299 return #x;300 switch (type) {301 CASE(CFI_type_signed_char)302 CASE(CFI_type_short)303 CASE(CFI_type_int)304 CASE(CFI_type_long)305 CASE(CFI_type_long_long)306 CASE(CFI_type_size_t)307 CASE(CFI_type_int8_t)308 CASE(CFI_type_int16_t)309 CASE(CFI_type_int32_t)310 CASE(CFI_type_int64_t)311 CASE(CFI_type_int128_t)312 CASE(CFI_type_int_least8_t)313 CASE(CFI_type_int_least16_t)314 CASE(CFI_type_int_least32_t)315 CASE(CFI_type_int_least64_t)316 CASE(CFI_type_int_least128_t)317 CASE(CFI_type_int_fast8_t)318 CASE(CFI_type_int_fast16_t)319 CASE(CFI_type_int_fast32_t)320 CASE(CFI_type_int_fast64_t)321 CASE(CFI_type_int_fast128_t)322 CASE(CFI_type_intmax_t)323 CASE(CFI_type_intptr_t)324 CASE(CFI_type_ptrdiff_t)325 CASE(CFI_type_half_float)326 CASE(CFI_type_bfloat)327 CASE(CFI_type_float)328 CASE(CFI_type_double)329 CASE(CFI_type_extended_double)330 CASE(CFI_type_long_double)331 CASE(CFI_type_float128)332 CASE(CFI_type_half_float_Complex)333 CASE(CFI_type_bfloat_Complex)334 CASE(CFI_type_float_Complex)335 CASE(CFI_type_double_Complex)336 CASE(CFI_type_extended_double_Complex)337 CASE(CFI_type_long_double_Complex)338 CASE(CFI_type_float128_Complex)339 CASE(CFI_type_Bool)340 CASE(CFI_type_char)341 CASE(CFI_type_cptr)342 CASE(CFI_type_struct)343 CASE(CFI_type_char16_t)344 CASE(CFI_type_char32_t)345 CASE(CFI_type_uint8_t)346 CASE(CFI_type_uint16_t)347 CASE(CFI_type_uint32_t)348 CASE(CFI_type_uint64_t)349 CASE(CFI_type_uint128_t)350 }351#undef CASE352 return nullptr;353 }354 TypeCode code{type};355 356 if (!code.IsValid())357 return "invalid";358 359 common::optional<std::pair<TypeCategory, int>> categoryAndKind =360 code.GetCategoryAndKind();361 if (!categoryAndKind)362 return nullptr;363 364 TypeCategory tcat;365 int kind;366 std::tie(tcat, kind) = *categoryAndKind;367 368#define CASE(cat, k) \369 case (k): \370 return #cat "(kind=" #k ")";371 switch (tcat) {372 case TypeCategory::Integer:373 switch (kind) {374 CASE(INTEGER, 1)375 CASE(INTEGER, 2)376 CASE(INTEGER, 4)377 CASE(INTEGER, 8)378 CASE(INTEGER, 16)379 }380 break;381 case TypeCategory::Unsigned:382 switch (kind) {383 CASE(UNSIGNED, 1)384 CASE(UNSIGNED, 2)385 CASE(UNSIGNED, 4)386 CASE(UNSIGNED, 8)387 CASE(UNSIGNED, 16)388 }389 break;390 case TypeCategory::Real:391 switch (kind) {392 CASE(REAL, 2)393 CASE(REAL, 3)394 CASE(REAL, 4)395 CASE(REAL, 8)396 CASE(REAL, 10)397 CASE(REAL, 16)398 }399 break;400 case TypeCategory::Complex:401 switch (kind) {402 CASE(COMPLEX, 2)403 CASE(COMPLEX, 3)404 CASE(COMPLEX, 4)405 CASE(COMPLEX, 8)406 CASE(COMPLEX, 10)407 CASE(COMPLEX, 16)408 }409 break;410 case TypeCategory::Character:411 switch (kind) {412 CASE(CHARACTER, 1)413 CASE(CHARACTER, 2)414 CASE(CHARACTER, 4)415 }416 break;417 case TypeCategory::Logical:418 switch (kind) {419 CASE(LOGICAL, 1)420 CASE(LOGICAL, 2)421 CASE(LOGICAL, 4)422 CASE(LOGICAL, 8)423 }424 break;425 case TypeCategory::Derived:426 return "DERIVED";427 }428#undef CASE429 return nullptr;430}431 432void Descriptor::Dump(FILE *f, bool dumpRawType) const {433 std::fprintf(f, "Descriptor @ %p:\n", reinterpret_cast<const void *>(this));434 std::fprintf(f, " base_addr %p\n", raw_.base_addr);435 std::fprintf(f, " elem_len %zd\n", ElementBytes());436 std::fprintf(f, " version %d\n", static_cast<int>(raw_.version));437 if (rank() > 0) {438 std::fprintf(f, " rank %d\n", rank());439 } else {440 std::fprintf(f, " scalar\n");441 }442 int ty = static_cast<int>(raw_.type);443 if (const char *tyStr = GetTypeStr(raw_.type, dumpRawType)) {444 std::fprintf(f, " type %d \"%s\"\n", ty, tyStr);445 } else {446 std::fprintf(f, " type %d\n", ty);447 }448 int attr = static_cast<int>(raw_.attribute);449 if (IsPointer()) {450 std::fprintf(f, " attribute %d (pointer) \n", attr);451 } else if (IsAllocatable()) {452 std::fprintf(f, " attribute %d (allocatable)\n", attr);453 } else {454 std::fprintf(f, " attribute %d\n", attr);455 }456 457 std::fprintf(f, " extra %d\n", static_cast<int>(raw_.extra));458 std::fprintf(f, " addendum %d\n", static_cast<int>(HasAddendum()));459 std::fprintf(f, " alloc_idx %d\n", static_cast<int>(GetAllocIdx()));460 for (int j{0}; j < raw_.rank; ++j) {461 std::fprintf(f, " dim[%d] lower_bound %jd\n", j,462 static_cast<std::intmax_t>(raw_.dim[j].lower_bound));463 std::fprintf(f, " extent %jd\n",464 static_cast<std::intmax_t>(raw_.dim[j].extent));465 std::fprintf(f, " sm %jd\n",466 static_cast<std::intmax_t>(raw_.dim[j].sm));467 }468 if (const DescriptorAddendum * addendum{Addendum()}) {469 addendum->Dump(f);470 }471}472 473RT_API_ATTRS DescriptorAddendum &DescriptorAddendum::operator=(474 const DescriptorAddendum &that) {475 derivedType_ = that.derivedType_;476 auto lenParms{that.LenParameters()};477 for (std::size_t j{0}; j < lenParms; ++j) {478 len_[j] = that.len_[j];479 }480 return *this;481}482 483RT_API_ATTRS std::size_t DescriptorAddendum::SizeInBytes() const {484 return SizeInBytes(LenParameters());485}486 487RT_API_ATTRS std::size_t DescriptorAddendum::LenParameters() const {488 const auto *type{derivedType()};489 return type ? type->LenParameters() : 0;490}491 492void DescriptorAddendum::Dump(FILE *f) const {493 std::fprintf(494 f, " derivedType @ %p\n", reinterpret_cast<const void *>(derivedType()));495 std::size_t lenParms{LenParameters()};496 for (std::size_t j{0}; j < lenParms; ++j) {497 std::fprintf(f, " len[%zd] %jd\n", j, static_cast<std::intmax_t>(len_[j]));498 }499}500 501RT_OFFLOAD_API_GROUP_END502 503} // namespace Fortran::runtime504