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