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