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(const SubscriptValue lb[], const SubscriptValue ub[]) {
113   int result{ISO::CFI_allocate(&raw_, lb, ub, ElementBytes())};
114   if (result == CFI_SUCCESS) {
115     // TODO: derived type initialization
116   }
117   return result;
118 }
119 
120 int Descriptor::Deallocate(bool finalize) {
121   if (raw_.base_addr) {
122     Destroy(static_cast<char *>(raw_.base_addr), finalize);
123   }
124   return ISO::CFI_deallocate(&raw_);
125 }
126 
127 void Descriptor::Destroy(char *data, bool finalize) const {
128   if (data) {
129     if (const DescriptorAddendum * addendum{Addendum()}) {
130       if (addendum->flags() & DescriptorAddendum::DoNotFinalize) {
131         finalize = false;
132       }
133       if (const DerivedType * dt{addendum->derivedType()}) {
134         std::size_t elements{Elements()};
135         std::size_t elementBytes{ElementBytes()};
136         for (std::size_t j{0}; j < elements; ++j) {
137           dt->Destroy(data + j * elementBytes, finalize);
138         }
139       }
140     }
141   }
142 }
143 
144 bool Descriptor::IncrementSubscripts(
145     SubscriptValue *subscript, const int *permutation) const {
146   for (int j{0}; j < raw_.rank; ++j) {
147     int k{permutation ? permutation[j] : j};
148     const Dimension &dim{GetDimension(k)};
149     if (subscript[k]++ < dim.UpperBound()) {
150       return true;
151     }
152     subscript[k] = dim.LowerBound();
153   }
154   return false;
155 }
156 
157 bool Descriptor::DecrementSubscripts(
158     SubscriptValue *subscript, const int *permutation) const {
159   for (int j{raw_.rank - 1}; j >= 0; --j) {
160     int k{permutation ? permutation[j] : j};
161     const Dimension &dim{GetDimension(k)};
162     if (--subscript[k] >= dim.LowerBound()) {
163       return true;
164     }
165     subscript[k] = dim.UpperBound();
166   }
167   return false;
168 }
169 
170 std::size_t Descriptor::ZeroBasedElementNumber(
171     const SubscriptValue *subscript, const int *permutation) const {
172   std::size_t result{0};
173   std::size_t coefficient{1};
174   for (int j{0}; j < raw_.rank; ++j) {
175     int k{permutation ? permutation[j] : j};
176     const Dimension &dim{GetDimension(k)};
177     result += coefficient * (subscript[k] - dim.LowerBound());
178     coefficient *= dim.Extent();
179   }
180   return result;
181 }
182 
183 bool Descriptor::SubscriptsForZeroBasedElementNumber(SubscriptValue *subscript,
184     std::size_t elementNumber, const int *permutation) const {
185   std::size_t coefficient{1};
186   std::size_t dimCoefficient[maxRank];
187   for (int j{0}; j < raw_.rank; ++j) {
188     int k{permutation ? permutation[j] : j};
189     const Dimension &dim{GetDimension(k)};
190     dimCoefficient[j] = coefficient;
191     coefficient *= dim.Extent();
192   }
193   if (elementNumber >= coefficient) {
194     return false; // out of range
195   }
196   for (int j{raw_.rank - 1}; j >= 0; --j) {
197     int k{permutation ? permutation[j] : j};
198     const Dimension &dim{GetDimension(k)};
199     std::size_t quotient{j ? elementNumber / dimCoefficient[j] : 0};
200     subscript[k] =
201         dim.LowerBound() + elementNumber - dimCoefficient[j] * quotient;
202     elementNumber = quotient;
203   }
204   return true;
205 }
206 
207 void Descriptor::Check() const {
208   // TODO
209 }
210 
211 void Descriptor::Dump(FILE *f) const {
212   std::fprintf(f, "Descriptor @ %p:\n", reinterpret_cast<const void *>(this));
213   std::fprintf(f, "  base_addr %p\n", raw_.base_addr);
214   std::fprintf(f, "  elem_len  %zd\n", static_cast<std::size_t>(raw_.elem_len));
215   std::fprintf(f, "  version   %d\n", static_cast<int>(raw_.version));
216   std::fprintf(f, "  rank      %d\n", static_cast<int>(raw_.rank));
217   std::fprintf(f, "  type      %d\n", static_cast<int>(raw_.type));
218   std::fprintf(f, "  attribute %d\n", static_cast<int>(raw_.attribute));
219   std::fprintf(f, "  addendum  %d\n", static_cast<int>(raw_.f18Addendum));
220   for (int j{0}; j < raw_.rank; ++j) {
221     std::fprintf(f, "  dim[%d] lower_bound %jd\n", j,
222         static_cast<std::intmax_t>(raw_.dim[j].lower_bound));
223     std::fprintf(f, "         extent      %jd\n",
224         static_cast<std::intmax_t>(raw_.dim[j].extent));
225     std::fprintf(f, "         sm          %jd\n",
226         static_cast<std::intmax_t>(raw_.dim[j].sm));
227   }
228   if (const DescriptorAddendum * addendum{Addendum()}) {
229     addendum->Dump(f);
230   }
231 }
232 
233 std::size_t DescriptorAddendum::SizeInBytes() const {
234   return SizeInBytes(LenParameters());
235 }
236 
237 void DescriptorAddendum::Dump(FILE *f) const {
238   std::fprintf(
239       f, "  derivedType @ %p\n", reinterpret_cast<const void *>(derivedType_));
240   std::fprintf(f, "  flags 0x%jx\n", static_cast<std::intmax_t>(flags_));
241   // TODO: LEN parameter values
242 }
243 } // namespace Fortran::runtime
244