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

source code of flang-rt/lib/runtime/descriptor.cpp