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) const15 TypeParameterValue 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() const23 bool 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) const44 void 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) const60 void 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