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   int cfiStatus{ISO::CFI_establish(
46       &raw_, p, attribute, t.raw(), workaroundElemLen, rank, extent)};
47   if (cfiStatus != CFI_SUCCESS) {
48     terminator.Crash(
49         "Descriptor::Establish: CFI_establish returned %d", cfiStatus, t.raw());
50   }
51   if (elementBytes == 0) {
52     raw_.elem_len = 0;
53     for (int j{0}; j < rank; ++j) {
54       GetDimension(j).SetByteStride(0);
55     }
56   }
57   raw_.f18Addendum = addendum;
58   DescriptorAddendum *a{Addendum()};
59   RUNTIME_CHECK(terminator, addendum == (a != nullptr));
60   if (a) {
61     new (a) DescriptorAddendum{};
62   }
63 }
64 
65 void Descriptor::Establish(TypeCategory c, int kind, void *p, int rank,
66     const SubscriptValue *extent, ISO::CFI_attribute_t attribute,
67     bool addendum) {
68   Establish(TypeCode(c, kind), BytesFor(c, kind), p, rank, extent, attribute,
69       addendum);
70 }
71 
72 void Descriptor::Establish(int characterKind, std::size_t characters, void *p,
73     int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute,
74     bool addendum) {
75   Establish(TypeCode{TypeCategory::Character, characterKind},
76       characterKind * characters, p, rank, extent, attribute, addendum);
77 }
78 
79 void Descriptor::Establish(const typeInfo::DerivedType &dt, void *p, int rank,
80     const SubscriptValue *extent, ISO::CFI_attribute_t attribute) {
81   Establish(TypeCode{TypeCategory::Derived, 0}, dt.sizeInBytes(), p, rank,
82       extent, attribute, true);
83   DescriptorAddendum *a{Addendum()};
84   Terminator terminator{__FILE__, __LINE__};
85   RUNTIME_CHECK(terminator, a != nullptr);
86   new (a) DescriptorAddendum{&dt};
87 }
88 
89 OwningPtr<Descriptor> Descriptor::Create(TypeCode t, std::size_t elementBytes,
90     void *p, int rank, const SubscriptValue *extent,
91     ISO::CFI_attribute_t attribute, int derivedTypeLenParameters) {
92   std::size_t bytes{SizeInBytes(rank, true, derivedTypeLenParameters)};
93   Terminator terminator{__FILE__, __LINE__};
94   Descriptor *result{
95       reinterpret_cast<Descriptor *>(AllocateMemoryOrCrash(terminator, bytes))};
96   result->Establish(t, elementBytes, p, rank, extent, attribute, true);
97   return OwningPtr<Descriptor>{result};
98 }
99 
100 OwningPtr<Descriptor> Descriptor::Create(TypeCategory c, int kind, void *p,
101     int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute) {
102   return Create(
103       TypeCode(c, kind), BytesFor(c, kind), p, rank, extent, attribute);
104 }
105 
106 OwningPtr<Descriptor> Descriptor::Create(int characterKind,
107     SubscriptValue characters, void *p, int rank, const SubscriptValue *extent,
108     ISO::CFI_attribute_t attribute) {
109   return Create(TypeCode{TypeCategory::Character, characterKind},
110       characterKind * characters, p, rank, extent, attribute);
111 }
112 
113 OwningPtr<Descriptor> Descriptor::Create(const typeInfo::DerivedType &dt,
114     void *p, int rank, const SubscriptValue *extent,
115     ISO::CFI_attribute_t attribute) {
116   return Create(TypeCode{TypeCategory::Derived, 0}, dt.sizeInBytes(), p, rank,
117       extent, attribute, dt.LenParameters());
118 }
119 
120 std::size_t Descriptor::SizeInBytes() const {
121   const DescriptorAddendum *addendum{Addendum()};
122   return sizeof *this - sizeof(Dimension) + raw_.rank * sizeof(Dimension) +
123       (addendum ? addendum->SizeInBytes() : 0);
124 }
125 
126 std::size_t Descriptor::Elements() const {
127   int n{rank()};
128   std::size_t elements{1};
129   for (int j{0}; j < n; ++j) {
130     elements *= GetDimension(j).Extent();
131   }
132   return elements;
133 }
134 
135 int Descriptor::Allocate() {
136   std::size_t byteSize{Elements() * ElementBytes()};
137   void *p{std::malloc(byteSize)};
138   if (!p && byteSize) {
139     return CFI_ERROR_MEM_ALLOCATION;
140   }
141   // TODO: image synchronization
142   // TODO: derived type initialization
143   raw_.base_addr = p;
144   if (int dims{rank()}) {
145     std::size_t stride{ElementBytes()};
146     for (int j{0}; j < dims; ++j) {
147       auto &dimension{GetDimension(j)};
148       dimension.SetByteStride(stride);
149       stride *= dimension.Extent();
150     }
151   }
152   return 0;
153 }
154 
155 int Descriptor::Deallocate(bool finalize) {
156   Destroy(finalize);
157   return ISO::CFI_deallocate(&raw_);
158 }
159 
160 void Descriptor::Destroy(bool finalize) const {
161   if (const DescriptorAddendum * addendum{Addendum()}) {
162     if (const typeInfo::DerivedType * dt{addendum->derivedType()}) {
163       if (addendum->flags() & DescriptorAddendum::DoNotFinalize) {
164         finalize = false;
165       }
166       runtime::Destroy(*this, finalize, *dt);
167     }
168   }
169 }
170 
171 bool Descriptor::IncrementSubscripts(
172     SubscriptValue *subscript, const int *permutation) const {
173   for (int j{0}; j < raw_.rank; ++j) {
174     int k{permutation ? permutation[j] : j};
175     const Dimension &dim{GetDimension(k)};
176     if (subscript[k]++ < dim.UpperBound()) {
177       return true;
178     }
179     subscript[k] = dim.LowerBound();
180   }
181   return false;
182 }
183 
184 bool Descriptor::DecrementSubscripts(
185     SubscriptValue *subscript, const int *permutation) const {
186   for (int j{raw_.rank - 1}; j >= 0; --j) {
187     int k{permutation ? permutation[j] : j};
188     const Dimension &dim{GetDimension(k)};
189     if (--subscript[k] >= dim.LowerBound()) {
190       return true;
191     }
192     subscript[k] = dim.UpperBound();
193   }
194   return false;
195 }
196 
197 std::size_t Descriptor::ZeroBasedElementNumber(
198     const SubscriptValue *subscript, const int *permutation) const {
199   std::size_t result{0};
200   std::size_t coefficient{1};
201   for (int j{0}; j < raw_.rank; ++j) {
202     int k{permutation ? permutation[j] : j};
203     const Dimension &dim{GetDimension(k)};
204     result += coefficient * (subscript[k] - dim.LowerBound());
205     coefficient *= dim.Extent();
206   }
207   return result;
208 }
209 
210 bool Descriptor::SubscriptsForZeroBasedElementNumber(SubscriptValue *subscript,
211     std::size_t elementNumber, const int *permutation) const {
212   std::size_t coefficient{1};
213   std::size_t dimCoefficient[maxRank];
214   for (int j{0}; j < raw_.rank; ++j) {
215     int k{permutation ? permutation[j] : j};
216     const Dimension &dim{GetDimension(k)};
217     dimCoefficient[j] = coefficient;
218     coefficient *= dim.Extent();
219   }
220   if (elementNumber >= coefficient) {
221     return false; // out of range
222   }
223   for (int j{raw_.rank - 1}; j >= 0; --j) {
224     int k{permutation ? permutation[j] : j};
225     const Dimension &dim{GetDimension(k)};
226     std::size_t quotient{elementNumber / dimCoefficient[j]};
227     subscript[k] = quotient + dim.LowerBound();
228     elementNumber -= quotient * dimCoefficient[j];
229   }
230   return true;
231 }
232 
233 bool Descriptor::EstablishPointerSection(const Descriptor &source,
234     const SubscriptValue *lower, const SubscriptValue *upper,
235     const SubscriptValue *stride) {
236   *this = source;
237   raw_.attribute = CFI_attribute_pointer;
238   int newRank{raw_.rank};
239   for (int j{0}; j < raw_.rank; ++j) {
240     if (!stride || stride[j] == 0) {
241       if (newRank > 0) {
242         --newRank;
243       } else {
244         return false;
245       }
246     }
247   }
248   raw_.rank = newRank;
249   return CFI_section(&raw_, &source.raw_, lower, upper, stride) == CFI_SUCCESS;
250 }
251 
252 void Descriptor::Check() const {
253   // TODO
254 }
255 
256 void Descriptor::Dump(FILE *f) const {
257   std::fprintf(f, "Descriptor @ %p:\n", reinterpret_cast<const void *>(this));
258   std::fprintf(f, "  base_addr %p\n", raw_.base_addr);
259   std::fprintf(f, "  elem_len  %zd\n", static_cast<std::size_t>(raw_.elem_len));
260   std::fprintf(f, "  version   %d\n", static_cast<int>(raw_.version));
261   std::fprintf(f, "  rank      %d\n", static_cast<int>(raw_.rank));
262   std::fprintf(f, "  type      %d\n", static_cast<int>(raw_.type));
263   std::fprintf(f, "  attribute %d\n", static_cast<int>(raw_.attribute));
264   std::fprintf(f, "  addendum  %d\n", static_cast<int>(raw_.f18Addendum));
265   for (int j{0}; j < raw_.rank; ++j) {
266     std::fprintf(f, "  dim[%d] lower_bound %jd\n", j,
267         static_cast<std::intmax_t>(raw_.dim[j].lower_bound));
268     std::fprintf(f, "         extent      %jd\n",
269         static_cast<std::intmax_t>(raw_.dim[j].extent));
270     std::fprintf(f, "         sm          %jd\n",
271         static_cast<std::intmax_t>(raw_.dim[j].sm));
272   }
273   if (const DescriptorAddendum * addendum{Addendum()}) {
274     addendum->Dump(f);
275   }
276 }
277 
278 DescriptorAddendum &DescriptorAddendum::operator=(
279     const DescriptorAddendum &that) {
280   derivedType_ = that.derivedType_;
281   flags_ = that.flags_;
282   auto lenParms{that.LenParameters()};
283   for (std::size_t j{0}; j < lenParms; ++j) {
284     len_[j] = that.len_[j];
285   }
286   return *this;
287 }
288 
289 std::size_t DescriptorAddendum::SizeInBytes() const {
290   return SizeInBytes(LenParameters());
291 }
292 
293 std::size_t DescriptorAddendum::LenParameters() const {
294   const auto *type{derivedType()};
295   return type ? type->LenParameters() : 0;
296 }
297 
298 void DescriptorAddendum::Dump(FILE *f) const {
299   std::fprintf(
300       f, "  derivedType @ %p\n", reinterpret_cast<const void *>(derivedType_));
301   std::fprintf(f, "  flags 0x%jx\n", static_cast<std::intmax_t>(flags_));
302   // TODO: LEN parameter values
303 }
304 } // namespace Fortran::runtime
305