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