1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
|
//===-- runtime/derived-type.h ----------------------------------*- C++ -*-===//
//
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
// See https://llvm.org/LICENSE.txt for license information.
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
//
//===----------------------------------------------------------------------===//
#ifndef FORTRAN_RUNTIME_DERIVED_TYPE_H_
#define FORTRAN_RUNTIME_DERIVED_TYPE_H_
#include "type-code.h"
#include "flang/ISO_Fortran_binding.h"
#include <cinttypes>
#include <cstddef>
namespace Fortran::runtime {
class Descriptor;
// Static type information about derived type specializations,
// suitable for residence in read-only storage.
using TypeParameterValue = ISO::CFI_index_t;
class TypeParameter {
public:
const char *name() const { return name_; }
const TypeCode typeCode() const { return typeCode_; }
bool IsLenTypeParameter() const { return which_ < 0; }
// Returns the static value of a KIND type parameter, or the default
// value of a LEN type parameter.
TypeParameterValue StaticValue() const { return value_; }
// Returns the static value of a KIND type parameter, or an
// instantiated value of LEN type parameter.
TypeParameterValue GetValue(const Descriptor &) const;
private:
const char *name_;
TypeCode typeCode_; // INTEGER, but not necessarily default kind
int which_{-1}; // index into DescriptorAddendum LEN type parameter values
TypeParameterValue value_; // default in the case of LEN type parameter
};
// Components that have any need for a descriptor will either reference
// a static descriptor that applies to all instances, or will *be* a
// descriptor. Be advised: the base addresses in static descriptors
// are null. Most runtime interfaces separate the data address from that
// of the descriptor, and ignore the encapsulated base address in the
// descriptor. Some interfaces, e.g. calls to interoperable procedures,
// cannot pass a separate data address, and any static descriptor being used
// in that kind of situation must be copied and customized.
// Static descriptors are flagged in their attributes.
class Component {
public:
const char *name() const { return name_; }
TypeCode typeCode() const { return typeCode_; }
const Descriptor *staticDescriptor() const { return staticDescriptor_; }
bool IsParent() const { return (flags_ & PARENT) != 0; }
bool IsPrivate() const { return (flags_ & PRIVATE) != 0; }
bool IsDescriptor() const { return (flags_ & IS_DESCRIPTOR) != 0; }
template <typename A> A *Locate(char *dtInstance) const {
return reinterpret_cast<A *>(dtInstance + offset_);
}
template <typename A> const A *Locate(const char *dtInstance) const {
return reinterpret_cast<const A *>(dtInstance + offset_);
}
Descriptor *GetDescriptor(char *dtInstance) const {
if (IsDescriptor()) {
return Locate<Descriptor>(dtInstance);
} else {
return nullptr;
}
}
const Descriptor *GetDescriptor(const char *dtInstance) const {
if (staticDescriptor_) {
return staticDescriptor_;
} else if (IsDescriptor()) {
return Locate<const Descriptor>(dtInstance);
} else {
return nullptr;
}
}
private:
enum Flag { PARENT = 1, PRIVATE = 2, IS_DESCRIPTOR = 4 };
const char *name_{nullptr};
std::uint32_t flags_{0};
TypeCode typeCode_{CFI_type_other};
const Descriptor *staticDescriptor_{nullptr};
std::size_t offset_{0}; // byte offset in derived type instance
};
struct ExecutableCode {
ExecutableCode() {}
ExecutableCode(const ExecutableCode &) = default;
ExecutableCode &operator=(const ExecutableCode &) = default;
std::intptr_t host{0};
std::intptr_t device{0};
};
struct TypeBoundProcedure {
const char *name;
ExecutableCode code;
};
// Represents a specialization of a derived type; i.e., any KIND type
// parameters have values set at compilation time.
// Extended derived types have the EXTENDS flag set and place their base
// component first in the component descriptions, which is significant for
// the execution of FINAL subroutines.
class DerivedType {
public:
DerivedType(const char *n, std::size_t kps, std::size_t lps,
const TypeParameter *tp, std::size_t cs, const Component *ca,
std::size_t tbps, const TypeBoundProcedure *tbp, std::size_t sz)
: name_{n}, kindParameters_{kps}, lenParameters_{lps}, typeParameter_{tp},
components_{cs}, component_{ca}, typeBoundProcedures_{tbps},
typeBoundProcedure_{tbp}, bytes_{sz} {
if (IsNontrivialAnalysis()) {
flags_ |= NONTRIVIAL;
}
}
const char *name() const { return name_; }
std::size_t kindParameters() const { return kindParameters_; }
std::size_t lenParameters() const { return lenParameters_; }
// KIND type parameters come first.
const TypeParameter &typeParameter(int n) const { return typeParameter_[n]; }
std::size_t components() const { return components_; }
// The first few type-bound procedure indices are special.
enum SpecialTBP { InitializerTBP, CopierTBP, FinalTBP };
std::size_t typeBoundProcedures() const { return typeBoundProcedures_; }
const TypeBoundProcedure &typeBoundProcedure(int n) const {
return typeBoundProcedure_[n];
}
DerivedType &set_sequence() {
flags_ |= SEQUENCE;
return *this;
}
DerivedType &set_bind_c() {
flags_ |= BIND_C;
return *this;
}
std::size_t SizeInBytes() const { return bytes_; }
bool Extends() const { return components_ > 0 && component_[0].IsParent(); }
bool AnyPrivate() const;
bool IsSequence() const { return (flags_ & SEQUENCE) != 0; }
bool IsBindC() const { return (flags_ & BIND_C) != 0; }
bool IsNontrivial() const { return (flags_ & NONTRIVIAL) != 0; }
bool IsSameType(const DerivedType &) const;
void Initialize(char *instance) const;
void Destroy(char *instance, bool finalize = true) const;
private:
enum Flag { SEQUENCE = 1, BIND_C = 2, NONTRIVIAL = 4 };
// True when any descriptor of data of this derived type will require
// an addendum pointing to a DerivedType, possibly with values of
// LEN type parameters. Conservative.
bool IsNontrivialAnalysis() const;
const char *name_{""}; // NUL-terminated constant text
std::size_t kindParameters_{0};
std::size_t lenParameters_{0};
const TypeParameter *typeParameter_{nullptr}; // array
std::size_t components_{0}; // *not* including type parameters
const Component *component_{nullptr}; // array
std::size_t typeBoundProcedures_{0};
const TypeBoundProcedure *typeBoundProcedure_{nullptr}; // array
std::uint64_t flags_{0};
std::size_t bytes_{0};
};
} // namespace Fortran::runtime
#endif // FORTRAN_RUNTIME_DERIVED_TYPE_H_
|
