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