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 std::size_t lengthInChars{0};
93 if (auto length{characterLen_.GetValue(&container)}) {
94 lengthInChars = static_cast<std::size_t>(*length);
95 } else {
96 RUNTIME_CHECK(
97 terminator, characterLen_.genre() == Value::Genre::Deferred);
98 }
99 descriptor.Establish(kind_, lengthInChars, nullptr, rank_);
100 } else if (cat == TypeCategory::Derived) {
101 const DerivedType *type{derivedType()};
102 RUNTIME_CHECK(terminator, type != nullptr);
103 descriptor.Establish(*type, nullptr, rank_);
104 } else {
105 descriptor.Establish(cat, kind_, nullptr, rank_);
106 }
107 if (rank_ && genre_ != Genre::Allocatable) {
108 const typeInfo::Value *boundValues{bounds()};
109 RUNTIME_CHECK(terminator, boundValues != nullptr);
110 auto byteStride{static_cast<SubscriptValue>(descriptor.ElementBytes())};
111 for (int j{0}; j < rank_; ++j) {
112 auto lb{boundValues++->GetValue(&container)};
113 auto ub{boundValues++->GetValue(&container)};
114 RUNTIME_CHECK(terminator, lb.has_value() && ub.has_value());
115 Dimension &dim{descriptor.GetDimension(j)};
116 dim.SetBounds(*lb, *ub);
117 dim.SetByteStride(byteStride);
118 byteStride *= dim.Extent();
119 }
120 }
121 }
122
CreatePointerDescriptor(Descriptor & descriptor,const Descriptor & container,Terminator & terminator,const SubscriptValue * subscripts) const123 void Component::CreatePointerDescriptor(Descriptor &descriptor,
124 const Descriptor &container, Terminator &terminator,
125 const SubscriptValue *subscripts) const {
126 RUNTIME_CHECK(terminator, genre_ == Genre::Data);
127 EstablishDescriptor(descriptor, container, terminator);
128 if (subscripts) {
129 descriptor.set_base_addr(container.Element<char>(subscripts) + offset_);
130 } else {
131 descriptor.set_base_addr(container.OffsetElement<char>() + offset_);
132 }
133 descriptor.raw().attribute = CFI_attribute_pointer;
134 }
135
GetParentType() const136 const DerivedType *DerivedType::GetParentType() const {
137 if (hasParent_) {
138 const Descriptor &compDesc{component()};
139 const Component &component{*compDesc.OffsetElement<const Component>()};
140 return component.derivedType();
141 } else {
142 return nullptr;
143 }
144 }
145
FindDataComponent(const char * compName,std::size_t compNameLen) const146 const Component *DerivedType::FindDataComponent(
147 const char *compName, std::size_t compNameLen) const {
148 const Descriptor &compDesc{component()};
149 std::size_t n{compDesc.Elements()};
150 SubscriptValue at[maxRank];
151 compDesc.GetLowerBounds(at);
152 for (std::size_t j{0}; j < n; ++j, compDesc.IncrementSubscripts(at)) {
153 const Component *component{compDesc.Element<Component>(at)};
154 INTERNAL_CHECK(component != nullptr);
155 const Descriptor &nameDesc{component->name()};
156 if (nameDesc.ElementBytes() == compNameLen &&
157 std::memcmp(compName, nameDesc.OffsetElement(), compNameLen) == 0) {
158 return component;
159 }
160 }
161 const DerivedType *parent{GetParentType()};
162 return parent ? parent->FindDataComponent(compName, compNameLen) : nullptr;
163 }
164
DumpScalarCharacter(FILE * f,const Descriptor & desc,const char * what)165 static void DumpScalarCharacter(
166 FILE *f, const Descriptor &desc, const char *what) {
167 if (desc.raw().version == CFI_VERSION &&
168 desc.type() == TypeCode{TypeCategory::Character, 1} &&
169 desc.ElementBytes() > 0 && desc.rank() == 0 &&
170 desc.OffsetElement() != nullptr) {
171 std::fwrite(desc.OffsetElement(), desc.ElementBytes(), 1, f);
172 } else {
173 std::fprintf(f, "bad %s descriptor: ", what);
174 desc.Dump(f);
175 }
176 }
177
Dump(FILE * f) const178 FILE *DerivedType::Dump(FILE *f) const {
179 std::fprintf(f, "DerivedType @ %p:\n", reinterpret_cast<const void *>(this));
180 const std::uint64_t *uints{reinterpret_cast<const std::uint64_t *>(this)};
181 for (int j{0}; j < 64; ++j) {
182 int offset{j * static_cast<int>(sizeof *uints)};
183 std::fprintf(f, " [+%3d](%p) 0x%016jx", offset,
184 reinterpret_cast<const void *>(&uints[j]),
185 static_cast<std::uintmax_t>(uints[j]));
186 if (offset == offsetof(DerivedType, binding_)) {
187 std::fputs(" <-- binding_\n", f);
188 } else if (offset == offsetof(DerivedType, name_)) {
189 std::fputs(" <-- name_\n", f);
190 } else if (offset == offsetof(DerivedType, sizeInBytes_)) {
191 std::fputs(" <-- sizeInBytes_\n", f);
192 } else if (offset == offsetof(DerivedType, uninstantiated_)) {
193 std::fputs(" <-- uninstantiated_\n", f);
194 } else if (offset == offsetof(DerivedType, kindParameter_)) {
195 std::fputs(" <-- kindParameter_\n", f);
196 } else if (offset == offsetof(DerivedType, lenParameterKind_)) {
197 std::fputs(" <-- lenParameterKind_\n", f);
198 } else if (offset == offsetof(DerivedType, component_)) {
199 std::fputs(" <-- component_\n", f);
200 } else if (offset == offsetof(DerivedType, procPtr_)) {
201 std::fputs(" <-- procPtr_\n", f);
202 } else if (offset == offsetof(DerivedType, special_)) {
203 std::fputs(" <-- special_\n", f);
204 } else if (offset == offsetof(DerivedType, specialBitSet_)) {
205 std::fputs(" <-- specialBitSet_\n", f);
206 } else if (offset == offsetof(DerivedType, hasParent_)) {
207 std::fputs(" <-- (flags)\n", f);
208 } else {
209 std::fputc('\n', f);
210 }
211 }
212 std::fputs(" name: ", f);
213 DumpScalarCharacter(f, name(), "DerivedType::name");
214 const Descriptor &bindingDesc{binding()};
215 std::fprintf(
216 f, "\n binding descriptor (byteSize 0x%zx): ", binding_.byteSize);
217 bindingDesc.Dump(f);
218 const Descriptor &compDesc{component()};
219 std::fputs("\n components:\n", f);
220 if (compDesc.raw().version == CFI_VERSION &&
221 compDesc.type() == TypeCode{TypeCategory::Derived, 0} &&
222 compDesc.ElementBytes() == sizeof(Component) && compDesc.rank() == 1) {
223 std::size_t n{compDesc.Elements()};
224 for (std::size_t j{0}; j < n; ++j) {
225 const Component &comp{*compDesc.ZeroBasedIndexedElement<Component>(j)};
226 std::fprintf(f, " [%3zd] ", j);
227 comp.Dump(f);
228 }
229 } else {
230 std::fputs(" bad descriptor: ", f);
231 compDesc.Dump(f);
232 }
233 const Descriptor &specialDesc{special()};
234 std::fprintf(
235 f, "\n special descriptor (byteSize 0x%zx): ", special_.byteSize);
236 specialDesc.Dump(f);
237 std::size_t specials{specialDesc.Elements()};
238 for (std::size_t j{0}; j < specials; ++j) {
239 std::fprintf(f, " [%3zd] ", j);
240 specialDesc.ZeroBasedIndexedElement<SpecialBinding>(j)->Dump(f);
241 }
242 return f;
243 }
244
Dump(FILE * f) const245 FILE *Component::Dump(FILE *f) const {
246 std::fprintf(f, "Component @ %p:\n", reinterpret_cast<const void *>(this));
247 std::fputs(" name: ", f);
248 DumpScalarCharacter(f, name(), "Component::name");
249 if (genre_ == Genre::Data) {
250 std::fputs(" Data ", f);
251 } else if (genre_ == Genre::Pointer) {
252 std::fputs(" Pointer ", f);
253 } else if (genre_ == Genre::Allocatable) {
254 std::fputs(" Allocatable", f);
255 } else if (genre_ == Genre::Automatic) {
256 std::fputs(" Automatic ", f);
257 } else {
258 std::fprintf(f, " (bad genre 0x%x)", static_cast<int>(genre_));
259 }
260 std::fprintf(f, " category %d kind %d rank %d offset 0x%zx\n", category_,
261 kind_, rank_, static_cast<std::size_t>(offset_));
262 if (initialization_) {
263 std::fprintf(f, " initialization @ %p:\n",
264 reinterpret_cast<const void *>(initialization_));
265 for (int j{0}; j < 128; j += sizeof(std::uint64_t)) {
266 std::fprintf(f, " [%3d] 0x%016jx\n", j,
267 static_cast<std::uintmax_t>(
268 *reinterpret_cast<const std::uint64_t *>(initialization_ + j)));
269 }
270 }
271 return f;
272 }
273
Dump(FILE * f) const274 FILE *SpecialBinding::Dump(FILE *f) const {
275 std::fprintf(
276 f, "SpecialBinding @ %p:\n", reinterpret_cast<const void *>(this));
277 switch (which_) {
278 case Which::ScalarAssignment:
279 std::fputs(" ScalarAssignment", f);
280 break;
281 case Which::ElementalAssignment:
282 std::fputs(" ElementalAssignment", f);
283 break;
284 case Which::ReadFormatted:
285 std::fputs(" ReadFormatted", f);
286 break;
287 case Which::ReadUnformatted:
288 std::fputs(" ReadUnformatted", f);
289 break;
290 case Which::WriteFormatted:
291 std::fputs(" WriteFormatted", f);
292 break;
293 case Which::WriteUnformatted:
294 std::fputs(" WriteUnformatted", f);
295 break;
296 case Which::ElementalFinal:
297 std::fputs(" ElementalFinal", f);
298 break;
299 case Which::AssumedRankFinal:
300 std::fputs(" AssumedRankFinal", f);
301 break;
302 default:
303 std::fprintf(f, " rank-%d final:",
304 static_cast<int>(which_) - static_cast<int>(Which::ScalarFinal));
305 break;
306 }
307 std::fprintf(f, " isArgDescriptorSet: 0x%x\n", isArgDescriptorSet_);
308 std::fprintf(f, " proc: %p\n", reinterpret_cast<void *>(proc_));
309 return f;
310 }
311
312 } // namespace Fortran::runtime::typeInfo
313