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::Deallocate(bool finalize) {
152   Destroy(finalize);
153   return ISO::CFI_deallocate(&raw_);
154 }
155 
156 void Descriptor::Destroy(bool finalize) const {
157   if (const DescriptorAddendum * addendum{Addendum()}) {
158     if (const typeInfo::DerivedType * dt{addendum->derivedType()}) {
159       if (addendum->flags() & DescriptorAddendum::DoNotFinalize) {
160         finalize = false;
161       }
162       runtime::Destroy(*this, finalize, *dt);
163     }
164   }
165 }
166 
167 bool Descriptor::IncrementSubscripts(
168     SubscriptValue *subscript, const int *permutation) const {
169   for (int j{0}; j < raw_.rank; ++j) {
170     int k{permutation ? permutation[j] : j};
171     const Dimension &dim{GetDimension(k)};
172     if (subscript[k]++ < dim.UpperBound()) {
173       return true;
174     }
175     subscript[k] = dim.LowerBound();
176   }
177   return false;
178 }
179 
180 bool Descriptor::DecrementSubscripts(
181     SubscriptValue *subscript, const int *permutation) const {
182   for (int j{raw_.rank - 1}; j >= 0; --j) {
183     int k{permutation ? permutation[j] : j};
184     const Dimension &dim{GetDimension(k)};
185     if (--subscript[k] >= dim.LowerBound()) {
186       return true;
187     }
188     subscript[k] = dim.UpperBound();
189   }
190   return false;
191 }
192 
193 std::size_t Descriptor::ZeroBasedElementNumber(
194     const SubscriptValue *subscript, const int *permutation) const {
195   std::size_t result{0};
196   std::size_t coefficient{1};
197   for (int j{0}; j < raw_.rank; ++j) {
198     int k{permutation ? permutation[j] : j};
199     const Dimension &dim{GetDimension(k)};
200     result += coefficient * (subscript[k] - dim.LowerBound());
201     coefficient *= dim.Extent();
202   }
203   return result;
204 }
205 
206 bool Descriptor::SubscriptsForZeroBasedElementNumber(SubscriptValue *subscript,
207     std::size_t elementNumber, const int *permutation) const {
208   std::size_t coefficient{1};
209   std::size_t dimCoefficient[maxRank];
210   for (int j{0}; j < raw_.rank; ++j) {
211     int k{permutation ? permutation[j] : j};
212     const Dimension &dim{GetDimension(k)};
213     dimCoefficient[j] = coefficient;
214     coefficient *= dim.Extent();
215   }
216   if (elementNumber >= coefficient) {
217     return false; // out of range
218   }
219   for (int j{raw_.rank - 1}; j >= 0; --j) {
220     int k{permutation ? permutation[j] : j};
221     const Dimension &dim{GetDimension(k)};
222     std::size_t quotient{elementNumber / dimCoefficient[j]};
223     subscript[k] = quotient + dim.LowerBound();
224     elementNumber -= quotient * dimCoefficient[j];
225   }
226   return true;
227 }
228 
229 bool Descriptor::EstablishPointerSection(const Descriptor &source,
230     const SubscriptValue *lower, const SubscriptValue *upper,
231     const SubscriptValue *stride) {
232   *this = source;
233   raw_.attribute = CFI_attribute_pointer;
234   int newRank{raw_.rank};
235   for (int j{0}; j < raw_.rank; ++j) {
236     if (!stride || stride[j] == 0) {
237       if (newRank > 0) {
238         --newRank;
239       } else {
240         return false;
241       }
242     }
243   }
244   raw_.rank = newRank;
245   return CFI_section(&raw_, &source.raw_, lower, upper, stride) == CFI_SUCCESS;
246 }
247 
248 void Descriptor::Check() const {
249   // TODO
250 }
251 
252 void Descriptor::Dump(FILE *f) const {
253   std::fprintf(f, "Descriptor @ %p:\n", reinterpret_cast<const void *>(this));
254   std::fprintf(f, "  base_addr %p\n", raw_.base_addr);
255   std::fprintf(f, "  elem_len  %zd\n", static_cast<std::size_t>(raw_.elem_len));
256   std::fprintf(f, "  version   %d\n", static_cast<int>(raw_.version));
257   std::fprintf(f, "  rank      %d\n", static_cast<int>(raw_.rank));
258   std::fprintf(f, "  type      %d\n", static_cast<int>(raw_.type));
259   std::fprintf(f, "  attribute %d\n", static_cast<int>(raw_.attribute));
260   std::fprintf(f, "  addendum  %d\n", static_cast<int>(raw_.f18Addendum));
261   for (int j{0}; j < raw_.rank; ++j) {
262     std::fprintf(f, "  dim[%d] lower_bound %jd\n", j,
263         static_cast<std::intmax_t>(raw_.dim[j].lower_bound));
264     std::fprintf(f, "         extent      %jd\n",
265         static_cast<std::intmax_t>(raw_.dim[j].extent));
266     std::fprintf(f, "         sm          %jd\n",
267         static_cast<std::intmax_t>(raw_.dim[j].sm));
268   }
269   if (const DescriptorAddendum * addendum{Addendum()}) {
270     addendum->Dump(f);
271   }
272 }
273 
274 DescriptorAddendum &DescriptorAddendum::operator=(
275     const DescriptorAddendum &that) {
276   derivedType_ = that.derivedType_;
277   flags_ = that.flags_;
278   auto lenParms{that.LenParameters()};
279   for (std::size_t j{0}; j < lenParms; ++j) {
280     len_[j] = that.len_[j];
281   }
282   return *this;
283 }
284 
285 std::size_t DescriptorAddendum::SizeInBytes() const {
286   return SizeInBytes(LenParameters());
287 }
288 
289 std::size_t DescriptorAddendum::LenParameters() const {
290   const auto *type{derivedType()};
291   return type ? type->LenParameters() : 0;
292 }
293 
294 void DescriptorAddendum::Dump(FILE *f) const {
295   std::fprintf(
296       f, "  derivedType @ %p\n", reinterpret_cast<const void *>(derivedType_));
297   std::fprintf(f, "  flags 0x%jx\n", static_cast<std::intmax_t>(flags_));
298   // TODO: LEN parameter values
299 }
300 } // namespace Fortran::runtime
301