1 //===-- runtime/type-info.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 "type-info.h"
10 #include "terminator.h"
11 #include <cstdio>
12
13 namespace Fortran::runtime::typeInfo {
14
GetValue(const Descriptor * descriptor) const15 std::optional<TypeParameterValue> Value::GetValue(
16 const Descriptor *descriptor) const {
17 switch (genre_) {
18 case Genre::Explicit:
19 return value_;
20 case Genre::LenParameter:
21 if (descriptor) {
22 if (const auto *addendum{descriptor->Addendum()}) {
23 return addendum->LenParameterValue(value_);
24 }
25 }
26 return std::nullopt;
27 default:
28 return std::nullopt;
29 }
30 }
31
GetElementByteSize(const Descriptor & instance) const32 std::size_t Component::GetElementByteSize(const Descriptor &instance) const {
33 switch (category()) {
34 case TypeCategory::Integer:
35 case TypeCategory::Real:
36 case TypeCategory::Logical:
37 return kind_;
38 case TypeCategory::Complex:
39 return 2 * kind_;
40 case TypeCategory::Character:
41 if (auto value{characterLen_.GetValue(&instance)}) {
42 return kind_ * *value;
43 }
44 break;
45 case TypeCategory::Derived:
46 if (const auto *type{derivedType()}) {
47 return type->sizeInBytes();
48 }
49 break;
50 }
51 return 0;
52 }
53
GetElements(const Descriptor & instance) const54 std::size_t Component::GetElements(const Descriptor &instance) const {
55 std::size_t elements{1};
56 if (int rank{rank_}) {
57 if (const Value * boundValues{bounds()}) {
58 for (int j{0}; j < rank; ++j) {
59 TypeParameterValue lb{
60 boundValues[2 * j].GetValue(&instance).value_or(0)};
61 TypeParameterValue ub{
62 boundValues[2 * j + 1].GetValue(&instance).value_or(0)};
63 if (ub >= lb) {
64 elements *= ub - lb + 1;
65 } else {
66 return 0;
67 }
68 }
69 } else {
70 return 0;
71 }
72 }
73 return elements;
74 }
75
SizeInBytes(const Descriptor & instance) const76 std::size_t Component::SizeInBytes(const Descriptor &instance) const {
77 if (genre() == Genre::Data) {
78 return GetElementByteSize(instance) * GetElements(instance);
79 } else if (category() == TypeCategory::Derived) {
80 const DerivedType *type{derivedType()};
81 return Descriptor::SizeInBytes(
82 rank_, true, type ? type->LenParameters() : 0);
83 } else {
84 return Descriptor::SizeInBytes(rank_);
85 }
86 }
87
EstablishDescriptor(Descriptor & descriptor,const Descriptor & container,Terminator & terminator) const88 void Component::EstablishDescriptor(Descriptor &descriptor,
89 const Descriptor &container, Terminator &terminator) const {
90 TypeCategory cat{category()};
91 if (cat == TypeCategory::Character) {
92 auto length{characterLen_.GetValue(&container)};
93 RUNTIME_CHECK(terminator, length.has_value());
94 descriptor.Establish(kind_, *length / kind_, nullptr, rank_);
95 } else if (cat == TypeCategory::Derived) {
96 const DerivedType *type{derivedType()};
97 RUNTIME_CHECK(terminator, type != nullptr);
98 descriptor.Establish(*type, nullptr, rank_);
99 } else {
100 descriptor.Establish(cat, kind_, nullptr, rank_);
101 }
102 if (rank_ && genre_ != Genre::Allocatable) {
103 const typeInfo::Value *boundValues{bounds()};
104 RUNTIME_CHECK(terminator, boundValues != nullptr);
105 auto byteStride{static_cast<SubscriptValue>(descriptor.ElementBytes())};
106 for (int j{0}; j < rank_; ++j) {
107 auto lb{boundValues++->GetValue(&container)};
108 auto ub{boundValues++->GetValue(&container)};
109 RUNTIME_CHECK(terminator, lb.has_value() && ub.has_value());
110 Dimension &dim{descriptor.GetDimension(j)};
111 dim.SetBounds(*lb, *ub);
112 dim.SetByteStride(byteStride);
113 byteStride *= dim.Extent();
114 }
115 }
116 }
117
CreatePointerDescriptor(Descriptor & descriptor,const Descriptor & container,const SubscriptValue subscripts[],Terminator & terminator) const118 void Component::CreatePointerDescriptor(Descriptor &descriptor,
119 const Descriptor &container, const SubscriptValue subscripts[],
120 Terminator &terminator) const {
121 RUNTIME_CHECK(terminator, genre_ == Genre::Data);
122 EstablishDescriptor(descriptor, container, terminator);
123 descriptor.set_base_addr(container.Element<char>(subscripts) + offset_);
124 descriptor.raw().attribute = CFI_attribute_pointer;
125 }
126
GetParentType() const127 const DerivedType *DerivedType::GetParentType() const {
128 if (hasParent_) {
129 const Descriptor &compDesc{component()};
130 const Component &component{*compDesc.OffsetElement<const Component>()};
131 return component.derivedType();
132 } else {
133 return nullptr;
134 }
135 }
136
FindDataComponent(const char * compName,std::size_t compNameLen) const137 const Component *DerivedType::FindDataComponent(
138 const char *compName, std::size_t compNameLen) const {
139 const Descriptor &compDesc{component()};
140 std::size_t n{compDesc.Elements()};
141 SubscriptValue at[maxRank];
142 compDesc.GetLowerBounds(at);
143 for (std::size_t j{0}; j < n; ++j, compDesc.IncrementSubscripts(at)) {
144 const Component *component{compDesc.Element<Component>(at)};
145 INTERNAL_CHECK(component != nullptr);
146 const Descriptor &nameDesc{component->name()};
147 if (nameDesc.ElementBytes() == compNameLen &&
148 std::memcmp(compName, nameDesc.OffsetElement(), compNameLen) == 0) {
149 return component;
150 }
151 }
152 const DerivedType *parent{GetParentType()};
153 return parent ? parent->FindDataComponent(compName, compNameLen) : nullptr;
154 }
155
FindSpecialBinding(SpecialBinding::Which which) const156 const SpecialBinding *DerivedType::FindSpecialBinding(
157 SpecialBinding::Which which) const {
158 const Descriptor &specialDesc{special()};
159 std::size_t n{specialDesc.Elements()};
160 SubscriptValue at[maxRank];
161 specialDesc.GetLowerBounds(at);
162 for (std::size_t j{0}; j < n; ++j, specialDesc.IncrementSubscripts(at)) {
163 const SpecialBinding &special{*specialDesc.Element<SpecialBinding>(at)};
164 if (special.which() == which) {
165 return &special;
166 }
167 }
168 return nullptr;
169 }
170
DumpScalarCharacter(FILE * f,const Descriptor & desc,const char * what)171 static void DumpScalarCharacter(
172 FILE *f, const Descriptor &desc, const char *what) {
173 if (desc.raw().version == CFI_VERSION &&
174 desc.type() == TypeCode{TypeCategory::Character, 1} &&
175 desc.ElementBytes() > 0 && desc.rank() == 0 &&
176 desc.OffsetElement() != nullptr) {
177 std::fwrite(desc.OffsetElement(), desc.ElementBytes(), 1, f);
178 } else {
179 std::fprintf(f, "bad %s descriptor: ", what);
180 desc.Dump(f);
181 }
182 }
183
Dump(FILE * f) const184 FILE *DerivedType::Dump(FILE *f) const {
185 std::fprintf(
186 f, "DerivedType @ 0x%p:\n", reinterpret_cast<const void *>(this));
187 const std::uint64_t *uints{reinterpret_cast<const std::uint64_t *>(this)};
188 for (int j{0}; j < 64; ++j) {
189 int offset{j * static_cast<int>(sizeof *uints)};
190 std::fprintf(f, " [+%3d](0x%p) 0x%016jx", offset,
191 reinterpret_cast<const void *>(&uints[j]),
192 static_cast<std::uintmax_t>(uints[j]));
193 if (offset == offsetof(DerivedType, binding_)) {
194 std::fputs(" <-- binding_\n", f);
195 } else if (offset == offsetof(DerivedType, name_)) {
196 std::fputs(" <-- name_\n", f);
197 } else if (offset == offsetof(DerivedType, sizeInBytes_)) {
198 std::fputs(" <-- sizeInBytes_\n", f);
199 } else if (offset == offsetof(DerivedType, uninstantiated_)) {
200 std::fputs(" <-- uninstantiated_\n", f);
201 } else if (offset == offsetof(DerivedType, typeHash_)) {
202 std::fputs(" <-- typeHash_\n", f);
203 } else if (offset == offsetof(DerivedType, kindParameter_)) {
204 std::fputs(" <-- kindParameter_\n", f);
205 } else if (offset == offsetof(DerivedType, lenParameterKind_)) {
206 std::fputs(" <-- lenParameterKind_\n", f);
207 } else if (offset == offsetof(DerivedType, component_)) {
208 std::fputs(" <-- component_\n", f);
209 } else if (offset == offsetof(DerivedType, procPtr_)) {
210 std::fputs(" <-- procPtr_\n", f);
211 } else if (offset == offsetof(DerivedType, special_)) {
212 std::fputs(" <-- special_\n", f);
213 } else if (offset == offsetof(DerivedType, special_)) {
214 std::fputs(" <-- special_\n", f);
215 } else if (offset == offsetof(DerivedType, hasParent_)) {
216 std::fputs(
217 " <-- hasParent_, noInitializationNeeded_, noDestructionNeeded_\n",
218 f);
219 } else {
220 std::fputc('\n', f);
221 }
222 }
223 std::fputs(" name: ", f);
224 DumpScalarCharacter(f, name(), "DerivedType::name");
225 const Descriptor &bindingDesc{binding()};
226 std::fprintf(
227 f, "\n binding descriptor (byteSize 0x%zx): ", binding_.byteSize);
228 bindingDesc.Dump(f);
229 const Descriptor &compDesc{component()};
230 std::fputs("\n components:\n", f);
231 if (compDesc.raw().version == CFI_VERSION &&
232 compDesc.type() == TypeCode{TypeCategory::Derived, 0} &&
233 compDesc.ElementBytes() == sizeof(Component) && compDesc.rank() == 1) {
234 std::size_t n{compDesc.Elements()};
235 for (std::size_t j{0}; j < n; ++j) {
236 const Component &comp{*compDesc.ZeroBasedIndexedElement<Component>(j)};
237 std::fprintf(f, " [%3zd] ", j);
238 comp.Dump(f);
239 }
240 } else {
241 std::fputs(" bad descriptor: ", f);
242 compDesc.Dump(f);
243 }
244 const Descriptor &specialDesc{special()};
245 std::fprintf(
246 f, "\n special descriptor (byteSize 0x%zx): ", special_.byteSize);
247 specialDesc.Dump(f);
248 std::size_t specials{specialDesc.Elements()};
249 for (std::size_t j{0}; j < specials; ++j) {
250 std::fprintf(f, " [%3zd] ", j);
251 specialDesc.ZeroBasedIndexedElement<SpecialBinding>(j)->Dump(f);
252 }
253 return f;
254 }
255
Dump(FILE * f) const256 FILE *Component::Dump(FILE *f) const {
257 std::fprintf(f, "Component @ 0x%p:\n", reinterpret_cast<const void *>(this));
258 std::fputs(" name: ", f);
259 DumpScalarCharacter(f, name(), "Component::name");
260 if (genre_ == Genre::Data) {
261 std::fputs(" Data ", f);
262 } else if (genre_ == Genre::Pointer) {
263 std::fputs(" Pointer ", f);
264 } else if (genre_ == Genre::Allocatable) {
265 std::fputs(" Allocatable", f);
266 } else if (genre_ == Genre::Automatic) {
267 std::fputs(" Automatic ", f);
268 } else {
269 std::fprintf(f, " (bad genre 0x%x)", static_cast<int>(genre_));
270 }
271 std::fprintf(f, " category %d kind %d rank %d offset 0x%zx\n", category_,
272 kind_, rank_, static_cast<std::size_t>(offset_));
273 if (initialization_) {
274 std::fprintf(f, " initialization @ 0x%p:\n",
275 reinterpret_cast<const void *>(initialization_));
276 for (int j{0}; j < 128; j += sizeof(std::uint64_t)) {
277 std::fprintf(f, " [%3d] 0x%016jx\n", j,
278 static_cast<std::uintmax_t>(
279 *reinterpret_cast<const std::uint64_t *>(initialization_ + j)));
280 }
281 }
282 return f;
283 }
284
Dump(FILE * f) const285 FILE *SpecialBinding::Dump(FILE *f) const {
286 std::fprintf(
287 f, "SpecialBinding @ 0x%p:\n", reinterpret_cast<const void *>(this));
288 switch (which_) {
289 case Which::Assignment:
290 std::fputs(" Assignment", f);
291 break;
292 case Which::ElementalAssignment:
293 std::fputs(" ElementalAssignment", f);
294 break;
295 case Which::Final:
296 std::fputs(" Final", f);
297 break;
298 case Which::ElementalFinal:
299 std::fputs(" ElementalFinal", f);
300 break;
301 case Which::AssumedRankFinal:
302 std::fputs(" AssumedRankFinal", f);
303 break;
304 case Which::ReadFormatted:
305 std::fputs(" ReadFormatted", f);
306 break;
307 case Which::ReadUnformatted:
308 std::fputs(" ReadUnformatted", f);
309 break;
310 case Which::WriteFormatted:
311 std::fputs(" WriteFormatted", f);
312 break;
313 case Which::WriteUnformatted:
314 std::fputs(" WriteUnformatted", f);
315 break;
316 default:
317 std::fprintf(
318 f, " Unknown which: 0x%x", static_cast<std::uint8_t>(which_));
319 break;
320 }
321 std::fprintf(f, "\n rank: %d\n", rank_);
322 std::fprintf(f, " isArgDescriptorSet: 0x%x\n", isArgDescriptorSet_);
323 std::fprintf(f, " proc: 0x%p\n", reinterpret_cast<void *>(proc_));
324 return f;
325 }
326
327 } // namespace Fortran::runtime::typeInfo
328