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 void Component::EstablishDescriptor(Descriptor &descriptor,
33     const Descriptor &container, const SubscriptValue subscripts[],
34     Terminator &terminator) const {
35   RUNTIME_CHECK(terminator, genre_ == Genre::Data);
36   TypeCategory cat{category()};
37   if (cat == TypeCategory::Character) {
38     auto length{characterLen_.GetValue(&container)};
39     RUNTIME_CHECK(terminator, length.has_value());
40     descriptor.Establish(kind_, *length / kind_, nullptr, rank_);
41   } else if (cat == TypeCategory::Derived) {
42     const DerivedType *type{derivedType()};
43     RUNTIME_CHECK(terminator, type != nullptr);
44     descriptor.Establish(*type, nullptr, rank_);
45   } else {
46     descriptor.Establish(cat, kind_, nullptr, rank_);
47   }
48   if (rank_) {
49     const typeInfo::Value *boundValues{bounds()};
50     RUNTIME_CHECK(terminator, boundValues != nullptr);
51     auto byteStride{static_cast<SubscriptValue>(descriptor.ElementBytes())};
52     for (int j{0}; j < rank_; ++j) {
53       auto lb{boundValues++->GetValue(&container)};
54       auto ub{boundValues++->GetValue(&container)};
55       RUNTIME_CHECK(terminator, lb.has_value() && ub.has_value());
56       Dimension &dim{descriptor.GetDimension(j)};
57       dim.SetBounds(*lb, *ub);
58       dim.SetByteStride(byteStride);
59       byteStride *= dim.Extent();
60     }
61   }
62   descriptor.set_base_addr(container.Element<char>(subscripts) + offset_);
63 }
64 
65 const Component *DerivedType::FindDataComponent(
66     const char *compName, std::size_t compNameLen) const {
67   const Descriptor &compDesc{component()};
68   std::size_t n{compDesc.Elements()};
69   SubscriptValue at[maxRank];
70   compDesc.GetLowerBounds(at);
71   for (std::size_t j{0}; j < n; ++j, compDesc.IncrementSubscripts(at)) {
72     const Component *component{compDesc.Element<Component>(at)};
73     INTERNAL_CHECK(component != nullptr);
74     const Descriptor &nameDesc{component->name()};
75     if (nameDesc.ElementBytes() == compNameLen &&
76         std::memcmp(compName, nameDesc.OffsetElement(), compNameLen) == 0) {
77       return component;
78     }
79   }
80   const DerivedType *ancestor{parent().OffsetElement<DerivedType>()};
81   return ancestor ? ancestor->FindDataComponent(compName, compNameLen)
82                   : nullptr;
83 }
84 
85 const SpecialBinding *DerivedType::FindSpecialBinding(
86     SpecialBinding::Which which) const {
87   const Descriptor &specialDesc{special()};
88   std::size_t n{specialDesc.Elements()};
89   SubscriptValue at[maxRank];
90   specialDesc.GetLowerBounds(at);
91   for (std::size_t j{0}; j < n; ++j, specialDesc.IncrementSubscripts(at)) {
92     const SpecialBinding &special{*specialDesc.Element<SpecialBinding>(at)};
93     if (special.which() == which) {
94       return &special;
95     }
96   }
97   return nullptr;
98 }
99 
100 static void DumpScalarCharacter(
101     FILE *f, const Descriptor &desc, const char *what) {
102   if (desc.raw().version == CFI_VERSION &&
103       desc.type() == TypeCode{TypeCategory::Character, 1} &&
104       desc.ElementBytes() > 0 && desc.rank() == 0 &&
105       desc.OffsetElement() != nullptr) {
106     std::fwrite(desc.OffsetElement(), desc.ElementBytes(), 1, f);
107   } else {
108     std::fprintf(f, "bad %s descriptor: ", what);
109     desc.Dump(f);
110   }
111 }
112 
113 FILE *DerivedType::Dump(FILE *f) const {
114   std::fprintf(
115       f, "DerivedType @ 0x%p:\n", reinterpret_cast<const void *>(this));
116   const std::uint64_t *uints{reinterpret_cast<const std::uint64_t *>(this)};
117   for (int j{0}; j < 64; ++j) {
118     int offset{j * static_cast<int>(sizeof *uints)};
119     std::fprintf(f, "    [+%3d](0x%p) %#016jx", offset,
120         reinterpret_cast<const void *>(&uints[j]),
121         static_cast<std::uintmax_t>(uints[j]));
122     if (offset == offsetof(DerivedType, binding_)) {
123       std::fputs(" <-- binding_\n", f);
124     } else if (offset == offsetof(DerivedType, name_)) {
125       std::fputs(" <-- name_\n", f);
126     } else if (offset == offsetof(DerivedType, sizeInBytes_)) {
127       std::fputs(" <-- sizeInBytes_\n", f);
128     } else if (offset == offsetof(DerivedType, parent_)) {
129       std::fputs(" <-- parent_\n", f);
130     } else if (offset == offsetof(DerivedType, uninstantiated_)) {
131       std::fputs(" <-- uninstantiated_\n", f);
132     } else if (offset == offsetof(DerivedType, typeHash_)) {
133       std::fputs(" <-- typeHash_\n", f);
134     } else if (offset == offsetof(DerivedType, kindParameter_)) {
135       std::fputs(" <-- kindParameter_\n", f);
136     } else if (offset == offsetof(DerivedType, lenParameterKind_)) {
137       std::fputs(" <-- lenParameterKind_\n", f);
138     } else if (offset == offsetof(DerivedType, component_)) {
139       std::fputs(" <-- component_\n", f);
140     } else if (offset == offsetof(DerivedType, procPtr_)) {
141       std::fputs(" <-- procPtr_\n", f);
142     } else if (offset == offsetof(DerivedType, special_)) {
143       std::fputs(" <-- special_\n", f);
144     } else {
145       std::fputc('\n', f);
146     }
147   }
148   std::fputs("  name: ", f);
149   DumpScalarCharacter(f, name(), "DerivedType::name");
150   const Descriptor &bindingDesc{binding()};
151   std::fprintf(
152       f, "\n  binding descriptor (byteSize 0x%zx): ", binding_.byteSize);
153   bindingDesc.Dump(f);
154   const Descriptor &compDesc{component()};
155   std::fputs("\n  components:\n", f);
156   if (compDesc.raw().version == CFI_VERSION &&
157       compDesc.type() == TypeCode{TypeCategory::Derived, 0} &&
158       compDesc.ElementBytes() == sizeof(Component) && compDesc.rank() == 1) {
159     std::size_t n{compDesc.Elements()};
160     for (std::size_t j{0}; j < n; ++j) {
161       const Component &comp{*compDesc.ZeroBasedIndexedElement<Component>(j)};
162       std::fprintf(f, "  [%3zd] ", j);
163       comp.Dump(f);
164     }
165   } else {
166     std::fputs("    bad descriptor: ", f);
167     compDesc.Dump(f);
168   }
169   const Descriptor &specialDesc{special()};
170   std::fprintf(
171       f, "\n  special descriptor (byteSize 0x%zx): ", special_.byteSize);
172   specialDesc.Dump(f);
173   std::size_t specials{specialDesc.Elements()};
174   for (std::size_t j{0}; j < specials; ++j) {
175     std::fprintf(f, "  [%3zd] ", j);
176     specialDesc.ZeroBasedIndexedElement<SpecialBinding>(j)->Dump(f);
177   }
178   return f;
179 }
180 
181 FILE *Component::Dump(FILE *f) const {
182   std::fprintf(f, "Component @ 0x%p:\n", reinterpret_cast<const void *>(this));
183   std::fputs("    name: ", f);
184   DumpScalarCharacter(f, name(), "Component::name");
185   if (genre_ == Genre::Data) {
186     std::fputs("    Data       ", f);
187   } else if (genre_ == Genre::Pointer) {
188     std::fputs("    Pointer    ", f);
189   } else if (genre_ == Genre::Allocatable) {
190     std::fputs("    Allocatable", f);
191   } else if (genre_ == Genre::Automatic) {
192     std::fputs("    Automatic  ", f);
193   } else {
194     std::fprintf(f, "    (bad genre 0x%x)", static_cast<int>(genre_));
195   }
196   std::fprintf(f, " category %d  kind %d  rank %d  offset 0x%zx\n", category_,
197       kind_, rank_, static_cast<std::size_t>(offset_));
198   return f;
199 }
200 
201 FILE *SpecialBinding::Dump(FILE *f) const {
202   std::fprintf(
203       f, "SpecialBinding @ 0x%p:\n", reinterpret_cast<const void *>(this));
204   switch (which_) {
205   case Which::Assignment:
206     std::fputs("    Assignment", f);
207     break;
208   case Which::ElementalAssignment:
209     std::fputs("    ElementalAssignment", f);
210     break;
211   case Which::Final:
212     std::fputs("    Final", f);
213     break;
214   case Which::ElementalFinal:
215     std::fputs("    ElementalFinal", f);
216     break;
217   case Which::AssumedRankFinal:
218     std::fputs("    AssumedRankFinal", f);
219     break;
220   case Which::ReadFormatted:
221     std::fputs("    ReadFormatted", f);
222     break;
223   case Which::ReadUnformatted:
224     std::fputs("    ReadUnformatted", f);
225     break;
226   case Which::WriteFormatted:
227     std::fputs("    WriteFormatted", f);
228     break;
229   case Which::WriteUnformatted:
230     std::fputs("    WriteUnformatted", f);
231     break;
232   default:
233     std::fprintf(
234         f, "    Unknown which: 0x%x", static_cast<std::uint8_t>(which_));
235     break;
236   }
237   std::fprintf(f, "\n    rank: %d\n", rank_);
238   std::fprintf(f, "    isArgDescriptoSetr: 0x%x\n", isArgDescriptorSet_);
239   std::fprintf(f, "    proc: 0x%p\n", reinterpret_cast<void *>(proc_));
240   return f;
241 }
242 
243 } // namespace Fortran::runtime::typeInfo
244