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