1 //===-- runtime/descriptor.h ------------------------------------*- C++ -*-===//
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 #ifndef FORTRAN_RUNTIME_DESCRIPTOR_H_
10 #define FORTRAN_RUNTIME_DESCRIPTOR_H_
11 
12 // Defines data structures used during execution of a Fortran program
13 // to implement nontrivial dummy arguments, pointers, allocatables,
14 // function results, and the special behaviors of instances of derived types.
15 // This header file includes and extends the published language
16 // interoperability header that is required by the Fortran 2018 standard
17 // as a subset of definitions suitable for exposure to user C/C++ code.
18 // User C code is welcome to depend on that ISO_Fortran_binding.h file,
19 // but should never reference this internal header.
20 
21 #include "memory.h"
22 #include "type-code.h"
23 #include "flang/ISO_Fortran_binding.h"
24 #include <cassert>
25 #include <cinttypes>
26 #include <cstddef>
27 #include <cstdio>
28 #include <cstring>
29 
30 namespace Fortran::runtime::typeInfo {
31 using TypeParameterValue = std::int64_t;
32 class DerivedType;
33 } // namespace Fortran::runtime::typeInfo
34 
35 namespace Fortran::runtime {
36 
37 using SubscriptValue = ISO::CFI_index_t;
38 
39 static constexpr int maxRank{CFI_MAX_RANK};
40 
41 // A C++ view of the sole interoperable standard descriptor (ISO::CFI_cdesc_t)
42 // and its type and per-dimension information.
43 
44 class Dimension {
45 public:
LowerBound()46   SubscriptValue LowerBound() const { return raw_.lower_bound; }
Extent()47   SubscriptValue Extent() const { return raw_.extent; }
UpperBound()48   SubscriptValue UpperBound() const { return LowerBound() + Extent() - 1; }
ByteStride()49   SubscriptValue ByteStride() const { return raw_.sm; }
50 
SetBounds(SubscriptValue lower,SubscriptValue upper)51   Dimension &SetBounds(SubscriptValue lower, SubscriptValue upper) {
52     raw_.lower_bound = lower;
53     raw_.extent = upper >= lower ? upper - lower + 1 : 0;
54     return *this;
55   }
SetByteStride(SubscriptValue bytes)56   Dimension &SetByteStride(SubscriptValue bytes) {
57     raw_.sm = bytes;
58     return *this;
59   }
60 
61 private:
62   ISO::CFI_dim_t raw_;
63 };
64 
65 // The storage for this object follows the last used dim[] entry in a
66 // Descriptor (CFI_cdesc_t) generic descriptor.  Space matters here, since
67 // descriptors serve as POINTER and ALLOCATABLE components of derived type
68 // instances.  The presence of this structure is implied by the flag
69 // CFI_cdesc_t.f18Addendum, and the number of elements in the len_[]
70 // array is determined by derivedType_->LenParameters().
71 class DescriptorAddendum {
72 public:
73   enum Flags {
74     StaticDescriptor = 0x001,
75     ImplicitAllocatable = 0x002, // compiler-created allocatable
76     DoNotFinalize = 0x004, // compiler temporary
77     Target = 0x008, // TARGET attribute
78   };
79 
80   explicit DescriptorAddendum(
81       const typeInfo::DerivedType *dt = nullptr, std::uint64_t flags = 0)
82       : derivedType_{dt}, flags_{flags} {}
83 
derivedType()84   const typeInfo::DerivedType *derivedType() const { return derivedType_; }
set_derivedType(const typeInfo::DerivedType * dt)85   DescriptorAddendum &set_derivedType(const typeInfo::DerivedType *dt) {
86     derivedType_ = dt;
87     return *this;
88   }
flags()89   std::uint64_t &flags() { return flags_; }
flags()90   const std::uint64_t &flags() const { return flags_; }
91 
92   std::size_t LenParameters() const;
93 
LenParameterValue(int which)94   typeInfo::TypeParameterValue LenParameterValue(int which) const {
95     return len_[which];
96   }
SizeInBytes(int lenParameters)97   static constexpr std::size_t SizeInBytes(int lenParameters) {
98     return sizeof(DescriptorAddendum) - sizeof(typeInfo::TypeParameterValue) +
99         lenParameters * sizeof(typeInfo::TypeParameterValue);
100   }
101   std::size_t SizeInBytes() const;
102 
SetLenParameterValue(int which,typeInfo::TypeParameterValue x)103   void SetLenParameterValue(int which, typeInfo::TypeParameterValue x) {
104     len_[which] = x;
105   }
106 
107   void Dump(FILE * = stdout) const;
108 
109 private:
110   const typeInfo::DerivedType *derivedType_;
111   std::uint64_t flags_{0};
112   typeInfo::TypeParameterValue len_[1]; // must be the last component
113   // The LEN type parameter values can also include captured values of
114   // specification expressions that were used for bounds and for LEN type
115   // parameters of components.  The values have been truncated to the LEN
116   // type parameter's type, if shorter than 64 bits, then sign-extended.
117 };
118 
119 // A C++ view of a standard descriptor object.
120 class Descriptor {
121 public:
122   // Be advised: this class type is not suitable for use when allocating
123   // a descriptor -- it is a dynamic view of the common descriptor format.
124   // If used in a simple declaration of a local variable or dynamic allocation,
125   // the size is going to be correct only by accident, since the true size of
126   // a descriptor depends on the number of its dimensions and the presence and
127   // size of an addendum, which depends on the type of the data.
128   // Use the class template StaticDescriptor (below) to declare a descriptor
129   // whose type and rank are fixed and known at compilation time.  Use the
130   // Create() static member functions otherwise to dynamically allocate a
131   // descriptor.
132 
Descriptor()133   Descriptor() {
134     // Minimal initialization to prevent the destructor from running amuck
135     // later if the descriptor is never established.
136     raw_.base_addr = nullptr;
137     raw_.f18Addendum = false;
138   }
139   Descriptor(const Descriptor &);
140 
141   ~Descriptor();
142 
BytesFor(TypeCategory category,int kind)143   static constexpr std::size_t BytesFor(TypeCategory category, int kind) {
144     return category == TypeCategory::Complex ? kind * 2 : kind;
145   }
146 
147   void Establish(TypeCode t, std::size_t elementBytes, void *p = nullptr,
148       int rank = maxRank, const SubscriptValue *extent = nullptr,
149       ISO::CFI_attribute_t attribute = CFI_attribute_other,
150       bool addendum = false);
151   void Establish(TypeCategory, int kind, void *p = nullptr, int rank = maxRank,
152       const SubscriptValue *extent = nullptr,
153       ISO::CFI_attribute_t attribute = CFI_attribute_other,
154       bool addendum = false);
155   void Establish(int characterKind, std::size_t characters, void *p = nullptr,
156       int rank = maxRank, const SubscriptValue *extent = nullptr,
157       ISO::CFI_attribute_t attribute = CFI_attribute_other,
158       bool addendum = false);
159   void Establish(const typeInfo::DerivedType &dt, void *p = nullptr,
160       int rank = maxRank, const SubscriptValue *extent = nullptr,
161       ISO::CFI_attribute_t attribute = CFI_attribute_other);
162 
163   static OwningPtr<Descriptor> Create(TypeCode t, std::size_t elementBytes,
164       void *p = nullptr, int rank = maxRank,
165       const SubscriptValue *extent = nullptr,
166       ISO::CFI_attribute_t attribute = CFI_attribute_other,
167       int derivedTypeLenParameters = 0);
168   static OwningPtr<Descriptor> Create(TypeCategory, int kind, void *p = nullptr,
169       int rank = maxRank, const SubscriptValue *extent = nullptr,
170       ISO::CFI_attribute_t attribute = CFI_attribute_other);
171   static OwningPtr<Descriptor> Create(int characterKind,
172       SubscriptValue characters, void *p = nullptr, int rank = maxRank,
173       const SubscriptValue *extent = nullptr,
174       ISO::CFI_attribute_t attribute = CFI_attribute_other);
175   static OwningPtr<Descriptor> Create(const typeInfo::DerivedType &dt,
176       void *p = nullptr, int rank = maxRank,
177       const SubscriptValue *extent = nullptr,
178       ISO::CFI_attribute_t attribute = CFI_attribute_other);
179 
raw()180   ISO::CFI_cdesc_t &raw() { return raw_; }
raw()181   const ISO::CFI_cdesc_t &raw() const { return raw_; }
ElementBytes()182   std::size_t ElementBytes() const { return raw_.elem_len; }
rank()183   int rank() const { return raw_.rank; }
type()184   TypeCode type() const { return TypeCode{raw_.type}; }
185 
set_base_addr(void * p)186   Descriptor &set_base_addr(void *p) {
187     raw_.base_addr = p;
188     return *this;
189   }
190 
IsPointer()191   bool IsPointer() const { return raw_.attribute == CFI_attribute_pointer; }
IsAllocatable()192   bool IsAllocatable() const {
193     return raw_.attribute == CFI_attribute_allocatable;
194   }
IsAllocated()195   bool IsAllocated() const { return raw_.base_addr != nullptr; }
196 
GetDimension(int dim)197   Dimension &GetDimension(int dim) {
198     return *reinterpret_cast<Dimension *>(&raw_.dim[dim]);
199   }
GetDimension(int dim)200   const Dimension &GetDimension(int dim) const {
201     return *reinterpret_cast<const Dimension *>(&raw_.dim[dim]);
202   }
203 
SubscriptByteOffset(int dim,SubscriptValue subscriptValue)204   std::size_t SubscriptByteOffset(
205       int dim, SubscriptValue subscriptValue) const {
206     const Dimension &dimension{GetDimension(dim)};
207     return (subscriptValue - dimension.LowerBound()) * dimension.ByteStride();
208   }
209 
SubscriptsToByteOffset(const SubscriptValue subscript[])210   std::size_t SubscriptsToByteOffset(const SubscriptValue subscript[]) const {
211     std::size_t offset{0};
212     for (int j{0}; j < raw_.rank; ++j) {
213       offset += SubscriptByteOffset(j, subscript[j]);
214     }
215     return offset;
216   }
217 
218   template <typename A = char> A *OffsetElement(std::size_t offset = 0) const {
219     return reinterpret_cast<A *>(
220         reinterpret_cast<char *>(raw_.base_addr) + offset);
221   }
222 
Element(const SubscriptValue subscript[])223   template <typename A> A *Element(const SubscriptValue subscript[]) const {
224     return OffsetElement<A>(SubscriptsToByteOffset(subscript));
225   }
226 
ZeroBasedIndexedElement(std::size_t n)227   template <typename A> A *ZeroBasedIndexedElement(std::size_t n) const {
228     SubscriptValue at[maxRank];
229     if (SubscriptsForZeroBasedElementNumber(at, n)) {
230       return Element<A>(at);
231     }
232     return nullptr;
233   }
234 
GetLowerBounds(SubscriptValue subscript[])235   void GetLowerBounds(SubscriptValue subscript[]) const {
236     for (int j{0}; j < raw_.rank; ++j) {
237       subscript[j] = GetDimension(j).LowerBound();
238     }
239   }
240 
241   // When the passed subscript vector contains the last (or first)
242   // subscripts of the array, these wrap the subscripts around to
243   // their first (or last) values and return false.
244   bool IncrementSubscripts(
245       SubscriptValue[], const int *permutation = nullptr) const;
246   bool DecrementSubscripts(
247       SubscriptValue[], const int *permutation = nullptr) const;
248   // False when out of range.
249   bool SubscriptsForZeroBasedElementNumber(SubscriptValue *,
250       std::size_t elementNumber, const int *permutation = nullptr) const;
251   std::size_t ZeroBasedElementNumber(
252       const SubscriptValue *, const int *permutation = nullptr) const;
253 
Addendum()254   DescriptorAddendum *Addendum() {
255     if (raw_.f18Addendum != 0) {
256       return reinterpret_cast<DescriptorAddendum *>(&GetDimension(rank()));
257     } else {
258       return nullptr;
259     }
260   }
Addendum()261   const DescriptorAddendum *Addendum() const {
262     if (raw_.f18Addendum != 0) {
263       return reinterpret_cast<const DescriptorAddendum *>(
264           &GetDimension(rank()));
265     } else {
266       return nullptr;
267     }
268   }
269 
270   // Returns size in bytes of the descriptor (not the data)
271   static constexpr std::size_t SizeInBytes(
272       int rank, bool addendum = false, int lengthTypeParameters = 0) {
273     std::size_t bytes{sizeof(Descriptor) - sizeof(Dimension)};
274     bytes += rank * sizeof(Dimension);
275     if (addendum || lengthTypeParameters > 0) {
276       bytes += DescriptorAddendum::SizeInBytes(lengthTypeParameters);
277     }
278     return bytes;
279   }
280 
281   std::size_t SizeInBytes() const;
282 
283   std::size_t Elements() const;
284 
285   // TODO: SOURCE= and MOLD=
286   int Allocate();
287   int Allocate(const SubscriptValue lb[], const SubscriptValue ub[]);
288   int Deallocate(bool finalize = true);
289   void Destroy(bool finalize = true) const;
290 
291   bool IsContiguous(int leadingDimensions = maxRank) const {
292     auto bytes{static_cast<SubscriptValue>(ElementBytes())};
293     for (int j{0}; j < leadingDimensions && j < raw_.rank; ++j) {
294       const Dimension &dim{GetDimension(j)};
295       if (bytes != dim.ByteStride()) {
296         return false;
297       }
298       bytes *= dim.Extent();
299     }
300     return true;
301   }
302 
303   void Check() const;
304 
305   // TODO: creation of array sections
306 
307   void Dump(FILE * = stdout) const;
308 
309 private:
310   ISO::CFI_cdesc_t raw_;
311 };
312 static_assert(sizeof(Descriptor) == sizeof(ISO::CFI_cdesc_t));
313 
314 // Properly configured instances of StaticDescriptor will occupy the
315 // exact amount of storage required for the descriptor, its dimensional
316 // information, and possible addendum.  To build such a static descriptor,
317 // declare an instance of StaticDescriptor<>, extract a reference to its
318 // descriptor via the descriptor() accessor, and then built a Descriptor
319 // therein via descriptor.Establish(), e.g.:
320 //   StaticDescriptor<R,A,LP> statDesc;
321 //   Descriptor &descriptor{statDesc.descriptor()};
322 //   descriptor.Establish( ... );
323 template <int MAX_RANK = maxRank, bool ADDENDUM = false, int MAX_LEN_PARMS = 0>
324 class alignas(Descriptor) StaticDescriptor {
325 public:
326   static constexpr int maxRank{MAX_RANK};
327   static constexpr int maxLengthTypeParameters{MAX_LEN_PARMS};
328   static constexpr bool hasAddendum{ADDENDUM || MAX_LEN_PARMS > 0};
329   static constexpr std::size_t byteSize{
330       Descriptor::SizeInBytes(maxRank, hasAddendum, maxLengthTypeParameters)};
331 
StaticDescriptor()332   StaticDescriptor() { new (storage_) Descriptor{}; }
333 
~StaticDescriptor()334   ~StaticDescriptor() { descriptor().~Descriptor(); }
335 
descriptor()336   Descriptor &descriptor() { return *reinterpret_cast<Descriptor *>(storage_); }
descriptor()337   const Descriptor &descriptor() const {
338     return *reinterpret_cast<const Descriptor *>(storage_);
339   }
340 
Check()341   void Check() {
342     assert(descriptor().rank() <= maxRank);
343     assert(descriptor().SizeInBytes() <= byteSize);
344     if (DescriptorAddendum * addendum{descriptor().Addendum()}) {
345       assert(hasAddendum);
346       assert(addendum->LenParameters() <= maxLengthTypeParameters);
347     } else {
348       assert(!hasAddendum);
349       assert(maxLengthTypeParameters == 0);
350     }
351     descriptor().Check();
352   }
353 
354 private:
355   char storage_[byteSize];
356 };
357 } // namespace Fortran::runtime
358 #endif // FORTRAN_RUNTIME_DESCRIPTOR_H_
359