1 //===-- runtime/derived-type.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 "derived-type.h" 10 #include "descriptor.h" 11 #include <cstring> 12 13 namespace Fortran::runtime { 14 GetValue(const Descriptor & descriptor) const15TypeParameterValue TypeParameter::GetValue(const Descriptor &descriptor) const { 16 if (which_ < 0) { 17 return value_; 18 } else { 19 return descriptor.Addendum()->LenParameterValue(which_); 20 } 21 } 22 IsNontrivialAnalysis() const23bool DerivedType::IsNontrivialAnalysis() const { 24 if (kindParameters_ > 0 || lenParameters_ > 0 || typeBoundProcedures_ > 0) { 25 return true; 26 } 27 for (std::size_t j{0}; j < components_; ++j) { 28 if (component_[j].IsDescriptor()) { 29 return true; 30 } 31 if (const Descriptor * staticDescriptor{component_[j].staticDescriptor()}) { 32 if (const DescriptorAddendum * addendum{staticDescriptor->Addendum()}) { 33 if (const DerivedType * dt{addendum->derivedType()}) { 34 if (dt->IsNontrivial()) { 35 return true; 36 } 37 } 38 } 39 } 40 } 41 return false; 42 } 43 Initialize(char * instance) const44void DerivedType::Initialize(char *instance) const { 45 if (typeBoundProcedures_ > InitializerTBP) { 46 if (auto f{reinterpret_cast<void (*)(char *)>( 47 typeBoundProcedure_[InitializerTBP].code.host)}) { 48 f(instance); 49 } 50 } 51 #if 0 // TODO 52 for (std::size_t j{0}; j < components_; ++j) { 53 if (const Descriptor * descriptor{component_[j].GetDescriptor(instance)}) { 54 // invoke initialization TBP 55 } 56 } 57 #endif 58 } 59 Destroy(char * instance,bool finalize) const60void DerivedType::Destroy(char *instance, bool finalize) const { 61 if (finalize && typeBoundProcedures_ > FinalTBP) { 62 if (auto f{reinterpret_cast<void (*)(char *)>( 63 typeBoundProcedure_[FinalTBP].code.host)}) { 64 f(instance); 65 } 66 } 67 const char *constInstance{instance}; 68 for (std::size_t j{0}; j < components_; ++j) { 69 if (Descriptor * descriptor{component_[j].GetDescriptor(instance)}) { 70 descriptor->Deallocate(finalize); 71 } else if (const Descriptor * 72 descriptor{component_[j].GetDescriptor(constInstance)}) { 73 descriptor->Destroy(component_[j].Locate<char>(instance), finalize); 74 } 75 } 76 } 77 } // namespace Fortran::runtime 78