Skip to content

Commit 7863350

Browse files
klauslerklausler
committed
break up runtime into multiple headers and source files
1 parent 0ab1704 commit 7863350

File tree

7 files changed

+534
-433
lines changed

7 files changed

+534
-433
lines changed

‎runtime/CMakeLists.txt

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,5 +14,7 @@
1414

1515
add_library(FortranRuntime
1616
ISO_Fortran_binding.cc
17+
derived-type.cc
1718
descriptor.cc
19+
type-code.cc
1820
)

‎runtime/derived-type.cc

Lines changed: 50 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,50 @@
1+
// Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
2+
//
3+
// Licensed under the Apache License, Version 2.0 (the "License");
4+
// you may not use this file except in compliance with the License.
5+
// You may obtain a copy of the License at
6+
//
7+
// http://www.apache.org/licenses/LICENSE-2.0
8+
//
9+
// Unless required by applicable law or agreed to in writing, software
10+
// distributed under the License is distributed on an "AS IS" BASIS,
11+
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12+
// See the License for the specific language governing permissions and
13+
// limitations under the License.
14+
15+
#include "derived-type.h"
16+
#include "descriptor.h"
17+
#include <cstring>
18+
19+
namespace Fortran::runtime {
20+
21+
TypeParameterValue TypeParameter::GetValue(const Descriptor &descriptor) const {
22+
if (which_ < 0) {
23+
return value_;
24+
} else {
25+
return descriptor.Addendum()->LenParameterValue(which_);
26+
}
27+
}
28+
29+
bool DerivedType::IsNontrivialAnalysis() const {
30+
if (kindParameters_ > 0 || lenParameters_ > 0 || typeBoundProcedures_ > 0 ||
31+
definedAssignments_ > 0) {
32+
return true;
33+
}
34+
for (int j{0}; j < components_; ++j) {
35+
if (component_[j].IsDescriptor()) {
36+
return true;
37+
}
38+
if (const Descriptor * staticDescriptor{component_[j].staticDescriptor()}) {
39+
if (const DescriptorAddendum * addendum{staticDescriptor->Addendum()}) {
40+
if (const DerivedType * dt{addendum->derivedType()}) {
41+
if (dt->IsNontrivial()) {
42+
return true;
43+
}
44+
}
45+
}
46+
}
47+
}
48+
return false;
49+
}
50+
} // namespace Fortran::runtime

‎runtime/derived-type.h

Lines changed: 200 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,200 @@
1+
// Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
2+
//
3+
// Licensed under the Apache License, Version 2.0 (the "License");
4+
// you may not use this file except in compliance with the License.
5+
// You may obtain a copy of the License at
6+
//
7+
// http://www.apache.org/licenses/LICENSE-2.0
8+
//
9+
// Unless required by applicable law or agreed to in writing, software
10+
// distributed under the License is distributed on an "AS IS" BASIS,
11+
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12+
// See the License for the specific language governing permissions and
13+
// limitations under the License.
14+
15+
#ifndef FORTRAN_RUNTIME_DERIVED_TYPE_H_
16+
#define FORTRAN_RUNTIME_DERIVED_TYPE_H_
17+
18+
#include "type-code.h"
19+
#include "../include/flang/ISO_Fortran_binding.h"
20+
#include <cinttypes>
21+
#include <cstddef>
22+
23+
namespace Fortran::runtime {
24+
25+
class Descriptor;
26+
27+
// Static type information about derived type specializations,
28+
// suitable for residence in read-only storage.
29+
30+
using TypeParameterValue = ISO::CFI_index_t;
31+
32+
class TypeParameter {
33+
public:
34+
const char *name() const { return name_; }
35+
const TypeCode typeCode() const { return typeCode_; }
36+
37+
bool IsLenTypeParameter() const { return which_ < 0; }
38+
39+
// Returns the static value of a KIND type parameter, or the default
40+
// value of a LEN type parameter.
41+
TypeParameterValue StaticValue() const { return value_; }
42+
43+
// Returns the static value of a KIND type parameter, or an
44+
// instantiated value of LEN type parameter.
45+
TypeParameterValue GetValue(const Descriptor &) const;
46+
47+
private:
48+
const char *name_;
49+
TypeCode typeCode_; // INTEGER, but not necessarily default kind
50+
int which_{-1}; // index into DescriptorAddendum LEN type parameter values
51+
TypeParameterValue value_; // default in the case of LEN type parameter
52+
};
53+
54+
// Components that have any need for a descriptor will either reference
55+
// a static descriptor that applies to all instances, or will *be* a
56+
// descriptor. Be advised: the base addresses in static descriptors
57+
// are null. Most runtime interfaces separate the data address from that
58+
// of the descriptor, and ignore the encapsulated base address in the
59+
// descriptor. Some interfaces, e.g. calls to interoperable procedures,
60+
// cannot pass a separate data address, and any static descriptor being used
61+
// in that kind of situation must be copied and customized.
62+
// Static descriptors are flagged in their attributes.
63+
class Component {
64+
public:
65+
const char *name() const { return name_; }
66+
TypeCode typeCode() const { return typeCode_; }
67+
const Descriptor *staticDescriptor() const { return staticDescriptor_; }
68+
69+
bool IsParent() const { return (flags_ & PARENT) != 0; }
70+
bool IsPrivate() const { return (flags_ & PRIVATE) != 0; }
71+
bool IsDescriptor() const { return (flags_ & IS_DESCRIPTOR) != 0; }
72+
73+
template<typename A> A *Locate(char *dtInstance) const {
74+
return reinterpret_cast<A *>(dtInstance + offset_);
75+
}
76+
template<typename A> const A *Locate(const char *dtInstance) const {
77+
return reinterpret_cast<const A *>(dtInstance + offset_);
78+
}
79+
80+
const Descriptor *GetDescriptor(const char *dtInstance) const {
81+
if (staticDescriptor_ != nullptr) {
82+
return staticDescriptor_;
83+
} else if (IsDescriptor()) {
84+
return Locate<const Descriptor>(dtInstance);
85+
} else {
86+
return nullptr;
87+
}
88+
}
89+
90+
private:
91+
enum Flag { PARENT = 1, PRIVATE = 2, IS_DESCRIPTOR = 4 };
92+
const char *name_{nullptr};
93+
std::uint32_t flags_{0};
94+
TypeCode typeCode_{CFI_type_other};
95+
const Descriptor *staticDescriptor_{nullptr};
96+
std::size_t offset_{0}; // byte offset in derived type instance
97+
};
98+
99+
struct ExecutableCode {
100+
ExecutableCode() {}
101+
ExecutableCode(const ExecutableCode &) = default;
102+
ExecutableCode &operator=(const ExecutableCode &) = default;
103+
std::intptr_t host{0};
104+
std::intptr_t device{0};
105+
};
106+
107+
struct TypeBoundProcedure {
108+
const char *name;
109+
ExecutableCode code;
110+
};
111+
112+
struct DefinedAssignment {
113+
int destinationRank, sourceRank;
114+
bool isElemental;
115+
ExecutableCode code;
116+
};
117+
118+
// Represents a specialization of a derived type; i.e., any KIND type
119+
// parameters have values set at compilation time.
120+
// Extended derived types have the EXTENDS flag set and place their base
121+
// component first in the component descriptions, which is significant for
122+
// the execution of FINAL subroutines.
123+
class DerivedType {
124+
public:
125+
DerivedType(const char *n, int kps, int lps, const TypeParameter *tp, int cs,
126+
const Component *ca, int tbps, const TypeBoundProcedure *tbp, int das,
127+
const DefinedAssignment *da, std::size_t sz)
128+
: name_{n}, kindParameters_{kps}, lenParameters_{lps}, typeParameter_{tp},
129+
components_{cs}, component_{ca}, typeBoundProcedures_{tbps},
130+
typeBoundProcedure_{tbp}, definedAssignments_{das},
131+
definedAssignment_{da}, bytes_{sz} {
132+
if (IsNontrivialAnalysis()) {
133+
flags_ |= NONTRIVIAL;
134+
}
135+
}
136+
137+
const char *name() const { return name_; }
138+
int kindParameters() const { return kindParameters_; }
139+
int lenParameters() const { return lenParameters_; }
140+
141+
// KIND type parameters come first.
142+
const TypeParameter &typeParameter(int n) const { return typeParameter_[n]; }
143+
144+
int components() const { return components_; }
145+
146+
// TBP 0 is the initializer: SUBROUTINE INIT(INSTANCE)
147+
static constexpr int initializerTBP{0};
148+
149+
// TBP 1 is the sourced allocation copier: SUBROUTINE COPYINIT(TO, FROM)
150+
static constexpr int copierTBP{1};
151+
152+
// TBP 2 is the FINAL subroutine.
153+
static constexpr int finalTBP{2};
154+
155+
int typeBoundProcedures() const { return typeBoundProcedures_; }
156+
const TypeBoundProcedure &typeBoundProcedure(int n) const {
157+
return typeBoundProcedure_[n];
158+
}
159+
160+
DerivedType &set_sequence() {
161+
flags_ |= SEQUENCE;
162+
return *this;
163+
}
164+
DerivedType &set_bind_c() {
165+
flags_ |= BIND_C;
166+
return *this;
167+
}
168+
169+
std::size_t SizeInBytes() const { return bytes_; }
170+
bool Extends() const { return components_ > 0 && component_[0].IsParent(); }
171+
bool AnyPrivate() const;
172+
bool IsSequence() const { return (flags_ & SEQUENCE) != 0; }
173+
bool IsBindC() const { return (flags_ & BIND_C) != 0; }
174+
bool IsNontrivial() const { return (flags_ & NONTRIVIAL) != 0; }
175+
176+
bool IsSameType(const DerivedType &) const;
177+
178+
private:
179+
enum Flag { SEQUENCE = 1, BIND_C = 2, NONTRIVIAL = 4 };
180+
181+
// True when any descriptor of data of this derived type will require
182+
// an addendum pointing to a DerivedType, possibly with values of
183+
// LEN type parameters. Conservative.
184+
bool IsNontrivialAnalysis() const;
185+
186+
const char *name_{""}; // NUL-terminated constant text
187+
int kindParameters_{0};
188+
int lenParameters_{0};
189+
const TypeParameter *typeParameter_{nullptr}; // array
190+
int components_{0}; // *not* including type parameters
191+
const Component *component_{nullptr}; // array
192+
int typeBoundProcedures_{0};
193+
const TypeBoundProcedure *typeBoundProcedure_{nullptr}; // array
194+
int definedAssignments_{0};
195+
const DefinedAssignment *definedAssignment_{nullptr}; // array
196+
std::uint64_t flags_{0};
197+
std::size_t bytes_{0};
198+
};
199+
} // namespace Fortran::runtime
200+
#endif // FORTRAN_RUNTIME_DERIVED_TYPE_H_

0 commit comments

Comments
 (0)