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) { *this = that; }
21 
22 Descriptor::~Descriptor() {
23   if (raw_.attribute != CFI_attribute_pointer) {
24     Deallocate();
25   }
26 }
27 
28 Descriptor &Descriptor::operator=(const Descriptor &that) {
29   std::memcpy(this, &that, that.SizeInBytes());
30   return *this;
31 }
32 
33 void Descriptor::Establish(TypeCode t, std::size_t elementBytes, void *p,
34     int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute,
35     bool addendum) {
36   Terminator terminator{__FILE__, __LINE__};
37   // Subtle: the standard CFI_establish() function doesn't allow a zero
38   // elem_len argument in cases where elem_len is not ignored; and when it
39   // returns an error code (CFI_INVALID_ELEM_LEN in this case), it must not
40   // modify the descriptor.  That design makes sense, maybe, for actual
41   // C interoperability, but we need to work around it here.  A zero
42   // incoming element length is replaced by 4 so that it will be valid
43   // for all CHARACTER kinds.
44   std::size_t workaroundElemLen{elementBytes ? elementBytes : 4};
45   RUNTIME_CHECK(terminator,
46       ISO::CFI_establish(&raw_, p, attribute, t.raw(), workaroundElemLen, rank,
47           extent) == CFI_SUCCESS);
48   if (elementBytes == 0) {
49     raw_.elem_len = 0;
50     for (int j{0}; j < rank; ++j) {
51       GetDimension(j).SetByteStride(0);
52     }
53   }
54   raw_.f18Addendum = addendum;
55   DescriptorAddendum *a{Addendum()};
56   RUNTIME_CHECK(terminator, addendum == (a != nullptr));
57   if (a) {
58     new (a) DescriptorAddendum{};
59   }
60 }
61 
62 void Descriptor::Establish(TypeCategory c, int kind, void *p, int rank,
63     const SubscriptValue *extent, ISO::CFI_attribute_t attribute,
64     bool addendum) {
65   Establish(TypeCode(c, kind), BytesFor(c, kind), p, rank, extent, attribute,
66       addendum);
67 }
68 
69 void Descriptor::Establish(int characterKind, std::size_t characters, void *p,
70     int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute,
71     bool addendum) {
72   Establish(TypeCode{TypeCategory::Character, characterKind},
73       characterKind * characters, p, rank, extent, attribute, addendum);
74 }
75 
76 void Descriptor::Establish(const typeInfo::DerivedType &dt, void *p, int rank,
77     const SubscriptValue *extent, ISO::CFI_attribute_t attribute) {
78   Establish(CFI_type_struct, dt.sizeInBytes, p, rank, extent, attribute, true);
79   DescriptorAddendum *a{Addendum()};
80   Terminator terminator{__FILE__, __LINE__};
81   RUNTIME_CHECK(terminator, a != nullptr);
82   new (a) DescriptorAddendum{&dt};
83 }
84 
85 OwningPtr<Descriptor> Descriptor::Create(TypeCode t, std::size_t elementBytes,
86     void *p, int rank, const SubscriptValue *extent,
87     ISO::CFI_attribute_t attribute, int derivedTypeLenParameters) {
88   std::size_t bytes{SizeInBytes(rank, true, derivedTypeLenParameters)};
89   Terminator terminator{__FILE__, __LINE__};
90   Descriptor *result{
91       reinterpret_cast<Descriptor *>(AllocateMemoryOrCrash(terminator, bytes))};
92   result->Establish(t, elementBytes, p, rank, extent, attribute, true);
93   return OwningPtr<Descriptor>{result};
94 }
95 
96 OwningPtr<Descriptor> Descriptor::Create(TypeCategory c, int kind, void *p,
97     int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute) {
98   return Create(
99       TypeCode(c, kind), BytesFor(c, kind), p, rank, extent, attribute);
100 }
101 
102 OwningPtr<Descriptor> Descriptor::Create(int characterKind,
103     SubscriptValue characters, void *p, int rank, const SubscriptValue *extent,
104     ISO::CFI_attribute_t attribute) {
105   return Create(TypeCode{TypeCategory::Character, characterKind},
106       characterKind * characters, p, rank, extent, attribute);
107 }
108 
109 OwningPtr<Descriptor> Descriptor::Create(const typeInfo::DerivedType &dt,
110     void *p, int rank, const SubscriptValue *extent,
111     ISO::CFI_attribute_t attribute) {
112   return Create(TypeCode{CFI_type_struct}, dt.sizeInBytes, p, rank, extent,
113       attribute, dt.LenParameters());
114 }
115 
116 std::size_t Descriptor::SizeInBytes() const {
117   const DescriptorAddendum *addendum{Addendum()};
118   return sizeof *this - sizeof(Dimension) + raw_.rank * sizeof(Dimension) +
119       (addendum ? addendum->SizeInBytes() : 0);
120 }
121 
122 std::size_t Descriptor::Elements() const {
123   int n{rank()};
124   std::size_t elements{1};
125   for (int j{0}; j < n; ++j) {
126     elements *= GetDimension(j).Extent();
127   }
128   return elements;
129 }
130 
131 int Descriptor::Allocate() {
132   std::size_t byteSize{Elements() * ElementBytes()};
133   void *p{std::malloc(byteSize)};
134   if (!p && byteSize) {
135     return CFI_ERROR_MEM_ALLOCATION;
136   }
137   // TODO: image synchronization
138   // TODO: derived type initialization
139   raw_.base_addr = p;
140   if (int dims{rank()}) {
141     std::size_t stride{ElementBytes()};
142     for (int j{0}; j < dims; ++j) {
143       auto &dimension{GetDimension(j)};
144       dimension.SetByteStride(stride);
145       stride *= dimension.Extent();
146     }
147   }
148   return 0;
149 }
150 
151 int Descriptor::Allocate(const SubscriptValue lb[], const SubscriptValue ub[]) {
152   int result{ISO::CFI_allocate(&raw_, lb, ub, ElementBytes())};
153   if (result == CFI_SUCCESS) {
154     // TODO: derived type initialization
155   }
156   return result;
157 }
158 
159 int Descriptor::Deallocate(bool finalize) {
160   Destroy(finalize);
161   return ISO::CFI_deallocate(&raw_);
162 }
163 
164 void Descriptor::Destroy(bool finalize) const {
165   if (const DescriptorAddendum * addendum{Addendum()}) {
166     if (const typeInfo::DerivedType * dt{addendum->derivedType()}) {
167       if (addendum->flags() & DescriptorAddendum::DoNotFinalize) {
168         finalize = false;
169       }
170       runtime::Destroy(*this, finalize, *dt);
171     }
172   }
173 }
174 
175 bool Descriptor::IncrementSubscripts(
176     SubscriptValue *subscript, const int *permutation) const {
177   for (int j{0}; j < raw_.rank; ++j) {
178     int k{permutation ? permutation[j] : j};
179     const Dimension &dim{GetDimension(k)};
180     if (subscript[k]++ < dim.UpperBound()) {
181       return true;
182     }
183     subscript[k] = dim.LowerBound();
184   }
185   return false;
186 }
187 
188 bool Descriptor::DecrementSubscripts(
189     SubscriptValue *subscript, const int *permutation) const {
190   for (int j{raw_.rank - 1}; j >= 0; --j) {
191     int k{permutation ? permutation[j] : j};
192     const Dimension &dim{GetDimension(k)};
193     if (--subscript[k] >= dim.LowerBound()) {
194       return true;
195     }
196     subscript[k] = dim.UpperBound();
197   }
198   return false;
199 }
200 
201 std::size_t Descriptor::ZeroBasedElementNumber(
202     const SubscriptValue *subscript, const int *permutation) const {
203   std::size_t result{0};
204   std::size_t coefficient{1};
205   for (int j{0}; j < raw_.rank; ++j) {
206     int k{permutation ? permutation[j] : j};
207     const Dimension &dim{GetDimension(k)};
208     result += coefficient * (subscript[k] - dim.LowerBound());
209     coefficient *= dim.Extent();
210   }
211   return result;
212 }
213 
214 bool Descriptor::SubscriptsForZeroBasedElementNumber(SubscriptValue *subscript,
215     std::size_t elementNumber, const int *permutation) const {
216   std::size_t coefficient{1};
217   std::size_t dimCoefficient[maxRank];
218   for (int j{0}; j < raw_.rank; ++j) {
219     int k{permutation ? permutation[j] : j};
220     const Dimension &dim{GetDimension(k)};
221     dimCoefficient[j] = coefficient;
222     coefficient *= dim.Extent();
223   }
224   if (elementNumber >= coefficient) {
225     return false; // out of range
226   }
227   for (int j{raw_.rank - 1}; j >= 0; --j) {
228     int k{permutation ? permutation[j] : j};
229     const Dimension &dim{GetDimension(k)};
230     std::size_t quotient{elementNumber / dimCoefficient[j]};
231     subscript[k] = quotient + dim.LowerBound();
232     elementNumber -= quotient * dimCoefficient[j];
233   }
234   return true;
235 }
236 
237 void Descriptor::Check() const {
238   // TODO
239 }
240 
241 void Descriptor::Dump(FILE *f) const {
242   std::fprintf(f, "Descriptor @ %p:\n", reinterpret_cast<const void *>(this));
243   std::fprintf(f, "  base_addr %p\n", raw_.base_addr);
244   std::fprintf(f, "  elem_len  %zd\n", static_cast<std::size_t>(raw_.elem_len));
245   std::fprintf(f, "  version   %d\n", static_cast<int>(raw_.version));
246   std::fprintf(f, "  rank      %d\n", static_cast<int>(raw_.rank));
247   std::fprintf(f, "  type      %d\n", static_cast<int>(raw_.type));
248   std::fprintf(f, "  attribute %d\n", static_cast<int>(raw_.attribute));
249   std::fprintf(f, "  addendum  %d\n", static_cast<int>(raw_.f18Addendum));
250   for (int j{0}; j < raw_.rank; ++j) {
251     std::fprintf(f, "  dim[%d] lower_bound %jd\n", j,
252         static_cast<std::intmax_t>(raw_.dim[j].lower_bound));
253     std::fprintf(f, "         extent      %jd\n",
254         static_cast<std::intmax_t>(raw_.dim[j].extent));
255     std::fprintf(f, "         sm          %jd\n",
256         static_cast<std::intmax_t>(raw_.dim[j].sm));
257   }
258   if (const DescriptorAddendum * addendum{Addendum()}) {
259     addendum->Dump(f);
260   }
261 }
262 
263 DescriptorAddendum &DescriptorAddendum::operator=(
264     const DescriptorAddendum &that) {
265   derivedType_ = that.derivedType_;
266   flags_ = that.flags_;
267   auto lenParms{that.LenParameters()};
268   for (std::size_t j{0}; j < lenParms; ++j) {
269     len_[j] = that.len_[j];
270   }
271   return *this;
272 }
273 
274 std::size_t DescriptorAddendum::SizeInBytes() const {
275   return SizeInBytes(LenParameters());
276 }
277 
278 std::size_t DescriptorAddendum::LenParameters() const {
279   const auto *type{derivedType()};
280   return type ? type->LenParameters() : 0;
281 }
282 
283 void DescriptorAddendum::Dump(FILE *f) const {
284   std::fprintf(
285       f, "  derivedType @ %p\n", reinterpret_cast<const void *>(derivedType_));
286   std::fprintf(f, "  flags 0x%jx\n", static_cast<std::intmax_t>(flags_));
287   // TODO: LEN parameter values
288 }
289 } // namespace Fortran::runtime
290