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 "flang/Runtime/descriptor.h"
10 #include "derived.h"
11 #include "memory.h"
12 #include "stat.h"
13 #include "terminator.h"
14 #include "type-info.h"
15 #include <cassert>
16 #include <cstdlib>
17 #include <cstring>
18 
19 namespace Fortran::runtime {
20 
21 Descriptor::Descriptor(const Descriptor &that) { *this = that; }
22 
23 Descriptor &Descriptor::operator=(const Descriptor &that) {
24   std::memcpy(this, &that, that.SizeInBytes());
25   return *this;
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   // Subtle: the standard CFI_establish() function doesn't allow a zero
33   // elem_len argument in cases where elem_len is not ignored; and when it
34   // returns an error code (CFI_INVALID_ELEM_LEN in this case), it must not
35   // modify the descriptor.  That design makes sense, maybe, for actual
36   // C interoperability, but we need to work around it here.  A zero
37   // incoming element length is replaced by 4 so that it will be valid
38   // for all CHARACTER kinds.
39   std::size_t workaroundElemLen{elementBytes ? elementBytes : 4};
40   int cfiStatus{ISO::CFI_establish(
41       &raw_, p, attribute, t.raw(), workaroundElemLen, rank, extent)};
42   if (cfiStatus != CFI_SUCCESS) {
43     terminator.Crash(
44         "Descriptor::Establish: CFI_establish returned %d", cfiStatus, t.raw());
45   }
46   if (elementBytes == 0) {
47     raw_.elem_len = 0;
48     for (int j{0}; j < rank; ++j) {
49       GetDimension(j).SetByteStride(0);
50     }
51   }
52   raw_.f18Addendum = addendum;
53   DescriptorAddendum *a{Addendum()};
54   RUNTIME_CHECK(terminator, addendum == (a != nullptr));
55   if (a) {
56     new (a) DescriptorAddendum{};
57   }
58 }
59 
60 void Descriptor::Establish(TypeCategory c, int kind, void *p, int rank,
61     const SubscriptValue *extent, ISO::CFI_attribute_t attribute,
62     bool addendum) {
63   Establish(TypeCode(c, kind), BytesFor(c, kind), p, rank, extent, attribute,
64       addendum);
65 }
66 
67 void Descriptor::Establish(int characterKind, std::size_t characters, void *p,
68     int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute,
69     bool addendum) {
70   Establish(TypeCode{TypeCategory::Character, characterKind},
71       characterKind * characters, p, rank, extent, attribute, addendum);
72 }
73 
74 void Descriptor::Establish(const typeInfo::DerivedType &dt, void *p, int rank,
75     const SubscriptValue *extent, ISO::CFI_attribute_t attribute) {
76   Establish(TypeCode{TypeCategory::Derived, 0}, dt.sizeInBytes(), p, rank,
77       extent, attribute, true);
78   DescriptorAddendum *a{Addendum()};
79   Terminator terminator{__FILE__, __LINE__};
80   RUNTIME_CHECK(terminator, a != nullptr);
81   new (a) DescriptorAddendum{&dt};
82 }
83 
84 OwningPtr<Descriptor> Descriptor::Create(TypeCode t, std::size_t elementBytes,
85     void *p, int rank, const SubscriptValue *extent,
86     ISO::CFI_attribute_t attribute, int derivedTypeLenParameters) {
87   std::size_t bytes{SizeInBytes(rank, true, derivedTypeLenParameters)};
88   Terminator terminator{__FILE__, __LINE__};
89   Descriptor *result{
90       reinterpret_cast<Descriptor *>(AllocateMemoryOrCrash(terminator, bytes))};
91   result->Establish(t, elementBytes, p, rank, extent, attribute, true);
92   return OwningPtr<Descriptor>{result};
93 }
94 
95 OwningPtr<Descriptor> Descriptor::Create(TypeCategory c, int kind, void *p,
96     int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute) {
97   return Create(
98       TypeCode(c, kind), BytesFor(c, kind), p, rank, extent, attribute);
99 }
100 
101 OwningPtr<Descriptor> Descriptor::Create(int characterKind,
102     SubscriptValue characters, void *p, int rank, const SubscriptValue *extent,
103     ISO::CFI_attribute_t attribute) {
104   return Create(TypeCode{TypeCategory::Character, characterKind},
105       characterKind * characters, p, rank, extent, attribute);
106 }
107 
108 OwningPtr<Descriptor> Descriptor::Create(const typeInfo::DerivedType &dt,
109     void *p, int rank, const SubscriptValue *extent,
110     ISO::CFI_attribute_t attribute) {
111   return Create(TypeCode{TypeCategory::Derived, 0}, dt.sizeInBytes(), p, rank,
112       extent, attribute, dt.LenParameters());
113 }
114 
115 std::size_t Descriptor::SizeInBytes() const {
116   const DescriptorAddendum *addendum{Addendum()};
117   return sizeof *this - sizeof(Dimension) + raw_.rank * sizeof(Dimension) +
118       (addendum ? addendum->SizeInBytes() : 0);
119 }
120 
121 std::size_t Descriptor::Elements() const {
122   int n{rank()};
123   std::size_t elements{1};
124   for (int j{0}; j < n; ++j) {
125     elements *= GetDimension(j).Extent();
126   }
127   return elements;
128 }
129 
130 int Descriptor::Allocate() {
131   std::size_t byteSize{Elements() * ElementBytes()};
132   void *p{std::malloc(byteSize)};
133   if (!p && byteSize) {
134     return CFI_ERROR_MEM_ALLOCATION;
135   }
136   // TODO: image synchronization
137   raw_.base_addr = p;
138   if (int dims{rank()}) {
139     std::size_t stride{ElementBytes()};
140     for (int j{0}; j < dims; ++j) {
141       auto &dimension{GetDimension(j)};
142       dimension.SetByteStride(stride);
143       stride *= dimension.Extent();
144     }
145   }
146   return 0;
147 }
148 
149 int Descriptor::Destroy(bool finalize, bool destroyPointers) {
150   if (!destroyPointers && raw_.attribute == CFI_attribute_pointer) {
151     return StatOk;
152   } else {
153     if (auto *addendum{Addendum()}) {
154       if (const auto *derived{addendum->derivedType()}) {
155         if (!derived->noDestructionNeeded()) {
156           runtime::Destroy(*this, finalize, *derived);
157         }
158       }
159     }
160     return Deallocate();
161   }
162 }
163 
164 int Descriptor::Deallocate() { return ISO::CFI_deallocate(&raw_); }
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::EstablishPointerSection(const Descriptor &source,
193     const SubscriptValue *lower, const SubscriptValue *upper,
194     const SubscriptValue *stride) {
195   *this = source;
196   raw_.attribute = CFI_attribute_pointer;
197   int newRank{raw_.rank};
198   for (int j{0}; j < raw_.rank; ++j) {
199     if (!stride || stride[j] == 0) {
200       if (newRank > 0) {
201         --newRank;
202       } else {
203         return false;
204       }
205     }
206   }
207   raw_.rank = newRank;
208   if (const auto *sourceAddendum = source.Addendum()) {
209     if (auto *addendum{Addendum()}) {
210       *addendum = *sourceAddendum;
211     } else {
212       return false;
213     }
214   }
215   return CFI_section(&raw_, &source.raw_, lower, upper, stride) == CFI_SUCCESS;
216 }
217 
218 void Descriptor::Check() const {
219   // TODO
220 }
221 
222 void Descriptor::Dump(FILE *f) const {
223   std::fprintf(f, "Descriptor @ %p:\n", reinterpret_cast<const void *>(this));
224   std::fprintf(f, "  base_addr %p\n", raw_.base_addr);
225   std::fprintf(f, "  elem_len  %zd\n", static_cast<std::size_t>(raw_.elem_len));
226   std::fprintf(f, "  version   %d\n", static_cast<int>(raw_.version));
227   std::fprintf(f, "  rank      %d\n", static_cast<int>(raw_.rank));
228   std::fprintf(f, "  type      %d\n", static_cast<int>(raw_.type));
229   std::fprintf(f, "  attribute %d\n", static_cast<int>(raw_.attribute));
230   std::fprintf(f, "  addendum  %d\n", static_cast<int>(raw_.f18Addendum));
231   for (int j{0}; j < raw_.rank; ++j) {
232     std::fprintf(f, "  dim[%d] lower_bound %jd\n", j,
233         static_cast<std::intmax_t>(raw_.dim[j].lower_bound));
234     std::fprintf(f, "         extent      %jd\n",
235         static_cast<std::intmax_t>(raw_.dim[j].extent));
236     std::fprintf(f, "         sm          %jd\n",
237         static_cast<std::intmax_t>(raw_.dim[j].sm));
238   }
239   if (const DescriptorAddendum * addendum{Addendum()}) {
240     addendum->Dump(f);
241   }
242 }
243 
244 DescriptorAddendum &DescriptorAddendum::operator=(
245     const DescriptorAddendum &that) {
246   derivedType_ = that.derivedType_;
247   auto lenParms{that.LenParameters()};
248   for (std::size_t j{0}; j < lenParms; ++j) {
249     len_[j] = that.len_[j];
250   }
251   return *this;
252 }
253 
254 std::size_t DescriptorAddendum::SizeInBytes() const {
255   return SizeInBytes(LenParameters());
256 }
257 
258 std::size_t DescriptorAddendum::LenParameters() const {
259   const auto *type{derivedType()};
260   return type ? type->LenParameters() : 0;
261 }
262 
263 void DescriptorAddendum::Dump(FILE *f) const {
264   std::fprintf(
265       f, "  derivedType @ %p\n", reinterpret_cast<const void *>(derivedType()));
266   std::size_t lenParms{LenParameters()};
267   for (std::size_t j{0}; j < lenParms; ++j) {
268     std::fprintf(f, "  len[%zd] %jd\n", j, static_cast<std::intmax_t>(len_[j]));
269   }
270 }
271 } // namespace Fortran::runtime
272