1//===-- runtime/type-info.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_TYPE_INFO_H_
10#define FORTRAN_RUNTIME_TYPE_INFO_H_
11
12// A C++ perspective of the derived type description schemata in
13// flang/module/__fortran_type_info.f90.
14
15#include "terminator.h"
16#include "flang/Common/Fortran.h"
17#include "flang/Common/bit-population-count.h"
18#include "flang/Common/optional.h"
19#include "flang/Runtime/descriptor.h"
20#include <cinttypes>
21#include <memory>
22
23namespace Fortran::runtime::typeInfo {
24
25class DerivedType;
26
27using ProcedurePointer = void (*)(); // TYPE(C_FUNPTR)
28
29struct Binding {
30 ProcedurePointer proc;
31 StaticDescriptor<0> name; // CHARACTER(:), POINTER
32};
33
34class Value {
35public:
36 enum class Genre : std::uint8_t {
37 Deferred = 1,
38 Explicit = 2,
39 LenParameter = 3
40 };
41 RT_API_ATTRS Genre genre() const { return genre_; }
42 RT_API_ATTRS Fortran::common::optional<TypeParameterValue> GetValue(
43 const Descriptor *) const;
44
45private:
46 Genre genre_{Genre::Explicit};
47 // The value encodes an index into the table of LEN type parameters in
48 // a descriptor's addendum for genre == Genre::LenParameter.
49 TypeParameterValue value_{0};
50};
51
52class Component {
53public:
54 enum class Genre : std::uint8_t {
55 Data = 1,
56 Pointer = 2,
57 Allocatable = 3,
58 Automatic = 4
59 };
60
61 RT_API_ATTRS const Descriptor &name() const { return name_.descriptor(); }
62 RT_API_ATTRS Genre genre() const { return genre_; }
63 RT_API_ATTRS TypeCategory category() const {
64 return static_cast<TypeCategory>(category_);
65 }
66 RT_API_ATTRS int kind() const { return kind_; }
67 RT_API_ATTRS int rank() const { return rank_; }
68 RT_API_ATTRS std::uint64_t offset() const { return offset_; }
69 RT_API_ATTRS const Value &characterLen() const { return characterLen_; }
70 RT_API_ATTRS const DerivedType *derivedType() const {
71 return derivedType_.descriptor().OffsetElement<const DerivedType>();
72 }
73 RT_API_ATTRS const Value *lenValue() const {
74 return lenValue_.descriptor().OffsetElement<const Value>();
75 }
76 RT_API_ATTRS const Value *bounds() const {
77 return bounds_.descriptor().OffsetElement<const Value>();
78 }
79 RT_API_ATTRS const char *initialization() const { return initialization_; }
80
81 RT_API_ATTRS std::size_t GetElementByteSize(const Descriptor &) const;
82 RT_API_ATTRS std::size_t GetElements(const Descriptor &) const;
83
84 // For components that are descriptors, returns size of descriptor;
85 // for Genre::Data, returns elemental byte size times element count.
86 RT_API_ATTRS std::size_t SizeInBytes(const Descriptor &) const;
87
88 // Establishes a descriptor from this component description.
89 RT_API_ATTRS void EstablishDescriptor(
90 Descriptor &, const Descriptor &container, Terminator &) const;
91
92 // Creates a pointer descriptor from this component description, possibly
93 // with subscripts
94 RT_API_ATTRS void CreatePointerDescriptor(Descriptor &,
95 const Descriptor &container, Terminator &,
96 const SubscriptValue * = nullptr) const;
97
98 FILE *Dump(FILE * = stdout) const;
99
100private:
101 StaticDescriptor<0> name_; // CHARACTER(:), POINTER
102 Genre genre_{Genre::Data};
103 std::uint8_t category_; // common::TypeCategory
104 std::uint8_t kind_{0};
105 std::uint8_t rank_{0};
106 std::uint64_t offset_{0};
107 Value characterLen_; // for TypeCategory::Character
108 StaticDescriptor<0, true> derivedType_; // TYPE(DERIVEDTYPE), POINTER
109 StaticDescriptor<1, true>
110 lenValue_; // TYPE(VALUE), POINTER, DIMENSION(:), CONTIGUOUS
111 StaticDescriptor<2, true>
112 bounds_; // TYPE(VALUE), POINTER, DIMENSION(2,:), CONTIGUOUS
113 const char *initialization_{nullptr}; // for Genre::Data and Pointer
114 // TODO: cobounds
115 // TODO: `PRIVATE` attribute
116};
117
118struct ProcPtrComponent {
119 StaticDescriptor<0> name; // CHARACTER(:), POINTER
120 std::uint64_t offset{0};
121 ProcedurePointer procInitialization;
122};
123
124class SpecialBinding {
125public:
126 enum class Which : std::uint8_t {
127 None = 0,
128 ScalarAssignment = 1,
129 ElementalAssignment = 2,
130 ReadFormatted = 3,
131 ReadUnformatted = 4,
132 WriteFormatted = 5,
133 WriteUnformatted = 6,
134 ElementalFinal = 7,
135 AssumedRankFinal = 8,
136 ScalarFinal = 9,
137 // higher-ranked final procedures follow
138 };
139
140 // Special bindings can be created during execution to handle defined
141 // I/O procedures that are not type-bound.
142 RT_API_ATTRS SpecialBinding(Which which, ProcedurePointer proc,
143 std::uint8_t isArgDescSet, std::uint8_t isTypeBound,
144 std::uint8_t isArgContiguousSet)
145 : which_{which}, isArgDescriptorSet_{isArgDescSet},
146 isTypeBound_{isTypeBound}, isArgContiguousSet_{isArgContiguousSet},
147 proc_{proc} {}
148
149 static constexpr RT_API_ATTRS Which RankFinal(int rank) {
150 return static_cast<Which>(static_cast<int>(Which::ScalarFinal) + rank);
151 }
152
153 RT_API_ATTRS Which which() const { return which_; }
154 RT_API_ATTRS bool IsArgDescriptor(int zeroBasedArg) const {
155 return (isArgDescriptorSet_ >> zeroBasedArg) & 1;
156 }
157 RT_API_ATTRS bool isTypeBound() const { return isTypeBound_; }
158 RT_API_ATTRS bool IsArgContiguous(int zeroBasedArg) const {
159 return (isArgContiguousSet_ >> zeroBasedArg) & 1;
160 }
161 template <typename PROC> RT_API_ATTRS PROC GetProc() const {
162 return reinterpret_cast<PROC>(proc_);
163 }
164
165 FILE *Dump(FILE *) const;
166
167private:
168 Which which_{Which::None};
169
170 // The following little bit-set identifies which dummy arguments are
171 // passed via descriptors for their derived type arguments.
172 // Which::Assignment and Which::ElementalAssignment:
173 // Set to 1, 2, or (usually 3).
174 // The passed-object argument (usually the "to") is always passed via a
175 // a descriptor in the cases where the runtime will call a defined
176 // assignment because these calls are to type-bound generics,
177 // not generic interfaces, and type-bound generic defined assigment
178 // may appear only in an extensible type and requires a passed-object
179 // argument (see C774), and passed-object arguments to TBPs must be
180 // both polymorphic and scalar (C760). The non-passed-object argument
181 // (usually the "from") is usually, but not always, also a descriptor.
182 // Which::Final and Which::ElementalFinal:
183 // Set to 1 when dummy argument is assumed-shape; otherwise, the
184 // argument can be passed by address. (Fortran guarantees that
185 // any finalized object must be whole and contiguous by restricting
186 // the use of DEALLOCATE on pointers. The dummy argument of an
187 // elemental final subroutine must be scalar and monomorphic, but
188 // use a descriptors when the type has LEN parameters.)
189 // Which::AssumedRankFinal: flag must necessarily be set
190 // Defined I/O:
191 // Set to 1 when "dtv" initial dummy argument is polymorphic, which is
192 // the case when and only when the derived type is extensible.
193 // When false, the defined I/O subroutine must have been
194 // called via a generic interface, not a generic TBP.
195 std::uint8_t isArgDescriptorSet_{0};
196 std::uint8_t isTypeBound_{0};
197 // True when a FINAL subroutine has a dummy argument that is an array that
198 // is CONTIGUOUS or neither assumed-rank nor assumed-shape.
199 std::uint8_t isArgContiguousSet_{0};
200
201 ProcedurePointer proc_{nullptr};
202};
203
204class DerivedType {
205public:
206 ~DerivedType(); // never defined
207
208 RT_API_ATTRS const Descriptor &binding() const {
209 return binding_.descriptor();
210 }
211 RT_API_ATTRS const Descriptor &name() const { return name_.descriptor(); }
212 RT_API_ATTRS std::uint64_t sizeInBytes() const { return sizeInBytes_; }
213 RT_API_ATTRS const Descriptor &uninstatiated() const {
214 return uninstantiated_.descriptor();
215 }
216 RT_API_ATTRS const Descriptor &kindParameter() const {
217 return kindParameter_.descriptor();
218 }
219 RT_API_ATTRS const Descriptor &lenParameterKind() const {
220 return lenParameterKind_.descriptor();
221 }
222 RT_API_ATTRS const Descriptor &component() const {
223 return component_.descriptor();
224 }
225 RT_API_ATTRS const Descriptor &procPtr() const {
226 return procPtr_.descriptor();
227 }
228 RT_API_ATTRS const Descriptor &special() const {
229 return special_.descriptor();
230 }
231 RT_API_ATTRS bool hasParent() const { return hasParent_; }
232 RT_API_ATTRS bool noInitializationNeeded() const {
233 return noInitializationNeeded_;
234 }
235 RT_API_ATTRS bool noDestructionNeeded() const { return noDestructionNeeded_; }
236 RT_API_ATTRS bool noFinalizationNeeded() const {
237 return noFinalizationNeeded_;
238 }
239
240 RT_API_ATTRS std::size_t LenParameters() const {
241 return lenParameterKind().Elements();
242 }
243
244 RT_API_ATTRS const DerivedType *GetParentType() const;
245
246 // Finds a data component by name in this derived type or its ancestors.
247 RT_API_ATTRS const Component *FindDataComponent(
248 const char *name, std::size_t nameLen) const;
249
250 // O(1) look-up of special procedure bindings
251 RT_API_ATTRS const SpecialBinding *FindSpecialBinding(
252 SpecialBinding::Which which) const {
253 auto bitIndex{static_cast<std::uint32_t>(which)};
254 auto bit{std::uint32_t{1} << bitIndex};
255 if (specialBitSet_ & bit) {
256 // The index of this special procedure in the sorted array is the
257 // number of special bindings that are present with smaller "which"
258 // code values.
259 int offset{common::BitPopulationCount(specialBitSet_ & (bit - 1))};
260 const auto *binding{
261 special_.descriptor().ZeroBasedIndexedElement<SpecialBinding>(
262 offset)};
263 INTERNAL_CHECK(binding && binding->which() == which);
264 return binding;
265 } else {
266 return nullptr;
267 }
268 }
269
270 FILE *Dump(FILE * = stdout) const;
271
272private:
273 // This member comes first because it's used like a vtable by generated code.
274 // It includes all of the ancestor types' bindings, if any, first,
275 // with any overrides from descendants already applied to them. Local
276 // bindings then follow in alphabetic order of binding name.
277 StaticDescriptor<1, true>
278 binding_; // TYPE(BINDING), DIMENSION(:), POINTER, CONTIGUOUS
279
280 StaticDescriptor<0> name_; // CHARACTER(:), POINTER
281
282 std::uint64_t sizeInBytes_{0};
283
284 // Instantiations of a parameterized derived type with KIND type
285 // parameters will point this data member to the description of
286 // the original uninstantiated type, which may be shared from a
287 // module via use association. The original uninstantiated derived
288 // type description will point to itself. Derived types that have
289 // no KIND type parameters will have a null pointer here.
290 StaticDescriptor<0, true> uninstantiated_; // TYPE(DERIVEDTYPE), POINTER
291
292 // These pointer targets include all of the items from the parent, if any.
293 StaticDescriptor<1> kindParameter_; // pointer to rank-1 array of INTEGER(8)
294 StaticDescriptor<1>
295 lenParameterKind_; // pointer to rank-1 array of INTEGER(1)
296
297 // This array of local data components includes the parent component.
298 // Components are in component order, not collation order of their names.
299 // It does not include procedure pointer components.
300 StaticDescriptor<1, true>
301 component_; // TYPE(COMPONENT), POINTER, DIMENSION(:), CONTIGUOUS
302
303 // Procedure pointer components
304 StaticDescriptor<1, true>
305 procPtr_; // TYPE(PROCPTR), POINTER, DIMENSION(:), CONTIGUOUS
306
307 // Packed in ascending order of "which" code values.
308 // Does not include special bindings from ancestral types.
309 StaticDescriptor<1, true>
310 special_; // TYPE(SPECIALBINDING), POINTER, DIMENSION(:), CONTIGUOUS
311
312 // Little-endian bit-set of special procedure binding "which" code values
313 // for O(1) look-up in FindSpecialBinding() above.
314 std::uint32_t specialBitSet_{0};
315
316 // Flags
317 bool hasParent_{false};
318 bool noInitializationNeeded_{false};
319 bool noDestructionNeeded_{false};
320 bool noFinalizationNeeded_{false};
321};
322
323} // namespace Fortran::runtime::typeInfo
324#endif // FORTRAN_RUNTIME_TYPE_INFO_H_
325

source code of flang/runtime/type-info.h