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 
15 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 
32 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 
54 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 
76 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 
88 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 
118 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 
127 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 
137 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 
156 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 
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 
184 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 
256 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 
285 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