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