1 //===-- runtime/pointer.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 "flang/Runtime/pointer.h"
10 #include "assign-impl.h"
11 #include "derived.h"
12 #include "environment.h"
13 #include "stat.h"
14 #include "terminator.h"
15 #include "tools.h"
16 #include "type-info.h"
17
18 namespace Fortran::runtime {
19 extern "C" {
20 RT_EXT_API_GROUP_BEGIN
21
RTDEF(PointerNullifyIntrinsic)22 void RTDEF(PointerNullifyIntrinsic)(Descriptor &pointer, TypeCategory category,
23 int kind, int rank, int corank) {
24 INTERNAL_CHECK(corank == 0);
25 pointer.Establish(TypeCode{category, kind},
26 Descriptor::BytesFor(category, kind), nullptr, rank, nullptr,
27 CFI_attribute_pointer);
28 }
29
RTDEF(PointerNullifyCharacter)30 void RTDEF(PointerNullifyCharacter)(Descriptor &pointer, SubscriptValue length,
31 int kind, int rank, int corank) {
32 INTERNAL_CHECK(corank == 0);
33 pointer.Establish(
34 kind, length, nullptr, rank, nullptr, CFI_attribute_pointer);
35 }
36
RTDEF(PointerNullifyDerived)37 void RTDEF(PointerNullifyDerived)(Descriptor &pointer,
38 const typeInfo::DerivedType &derivedType, int rank, int corank) {
39 INTERNAL_CHECK(corank == 0);
40 pointer.Establish(derivedType, nullptr, rank, nullptr, CFI_attribute_pointer);
41 }
42
RTDEF(PointerSetBounds)43 void RTDEF(PointerSetBounds)(Descriptor &pointer, int zeroBasedDim,
44 SubscriptValue lower, SubscriptValue upper) {
45 INTERNAL_CHECK(zeroBasedDim >= 0 && zeroBasedDim < pointer.rank());
46 pointer.GetDimension(zeroBasedDim).SetBounds(lower, upper);
47 // The byte strides are computed when the pointer is allocated.
48 }
49
50 // TODO: PointerSetCoBounds
51
RTDEF(PointerSetDerivedLength)52 void RTDEF(PointerSetDerivedLength)(
53 Descriptor &pointer, int which, SubscriptValue x) {
54 DescriptorAddendum *addendum{pointer.Addendum()};
55 INTERNAL_CHECK(addendum != nullptr);
56 addendum->SetLenParameterValue(which, x);
57 }
58
RTDEF(PointerApplyMold)59 void RTDEF(PointerApplyMold)(
60 Descriptor &pointer, const Descriptor &mold, int rank) {
61 pointer.ApplyMold(mold, rank);
62 }
63
RTDEF(PointerAssociateScalar)64 void RTDEF(PointerAssociateScalar)(Descriptor &pointer, void *target) {
65 pointer.set_base_addr(target);
66 }
67
RTDEF(PointerAssociate)68 void RTDEF(PointerAssociate)(Descriptor &pointer, const Descriptor &target) {
69 pointer = target;
70 pointer.raw().attribute = CFI_attribute_pointer;
71 }
72
RTDEF(PointerAssociateLowerBounds)73 void RTDEF(PointerAssociateLowerBounds)(Descriptor &pointer,
74 const Descriptor &target, const Descriptor &lowerBounds) {
75 pointer = target;
76 pointer.raw().attribute = CFI_attribute_pointer;
77 int rank{pointer.rank()};
78 Terminator terminator{__FILE__, __LINE__};
79 std::size_t boundElementBytes{lowerBounds.ElementBytes()};
80 for (int j{0}; j < rank; ++j) {
81 Dimension &dim{pointer.GetDimension(j)};
82 dim.SetLowerBound(dim.Extent() == 0
83 ? 1
84 : GetInt64(lowerBounds.ZeroBasedIndexedElement<const char>(j),
85 boundElementBytes, terminator));
86 }
87 }
88
RTDEF(PointerAssociateRemapping)89 void RTDEF(PointerAssociateRemapping)(Descriptor &pointer,
90 const Descriptor &target, const Descriptor &bounds, const char *sourceFile,
91 int sourceLine) {
92 pointer = target;
93 pointer.raw().attribute = CFI_attribute_pointer;
94 Terminator terminator{sourceFile, sourceLine};
95 SubscriptValue byteStride{/*captured from first dimension*/};
96 std::size_t boundElementBytes{bounds.ElementBytes()};
97 std::size_t boundsRank{
98 static_cast<std::size_t>(bounds.GetDimension(1).Extent())};
99 pointer.raw().rank = boundsRank;
100 for (unsigned j{0}; j < boundsRank; ++j) {
101 auto &dim{pointer.GetDimension(j)};
102 dim.SetBounds(GetInt64(bounds.ZeroBasedIndexedElement<const char>(2 * j),
103 boundElementBytes, terminator),
104 GetInt64(bounds.ZeroBasedIndexedElement<const char>(2 * j + 1),
105 boundElementBytes, terminator));
106 if (j == 0) {
107 byteStride = dim.ByteStride() * dim.Extent();
108 } else {
109 dim.SetByteStride(byteStride);
110 byteStride *= dim.Extent();
111 }
112 }
113 if (pointer.Elements() > target.Elements()) {
114 terminator.Crash("PointerAssociateRemapping: too many elements in remapped "
115 "pointer (%zd > %zd)",
116 pointer.Elements(), target.Elements());
117 }
118 if (auto *pointerAddendum{pointer.Addendum()}) {
119 if (const auto *targetAddendum{target.Addendum()}) {
120 if (const auto *derived{targetAddendum->derivedType()}) {
121 pointerAddendum->set_derivedType(derived);
122 }
123 }
124 }
125 }
126
AllocateValidatedPointerPayload(std::size_t byteSize)127 RT_API_ATTRS void *AllocateValidatedPointerPayload(std::size_t byteSize) {
128 // Add space for a footer to validate during deallocation.
129 constexpr std::size_t align{sizeof(std::uintptr_t)};
130 byteSize = ((byteSize + align - 1) / align) * align;
131 std::size_t total{byteSize + sizeof(std::uintptr_t)};
132 void *p{std::malloc(total)};
133 if (p) {
134 // Fill the footer word with the XOR of the ones' complement of
135 // the base address, which is a value that would be highly unlikely
136 // to appear accidentally at the right spot.
137 std::uintptr_t *footer{
138 reinterpret_cast<std::uintptr_t *>(static_cast<char *>(p) + byteSize)};
139 *footer = ~reinterpret_cast<std::uintptr_t>(p);
140 }
141 return p;
142 }
143
RTDEF(PointerAllocate)144 int RTDEF(PointerAllocate)(Descriptor &pointer, bool hasStat,
145 const Descriptor *errMsg, const char *sourceFile, int sourceLine) {
146 Terminator terminator{sourceFile, sourceLine};
147 if (!pointer.IsPointer()) {
148 return ReturnError(terminator, StatInvalidDescriptor, errMsg, hasStat);
149 }
150 std::size_t elementBytes{pointer.ElementBytes()};
151 if (static_cast<std::int64_t>(elementBytes) < 0) {
152 // F'2023 7.4.4.2 p5: "If the character length parameter value evaluates
153 // to a negative value, the length of character entities declared is zero."
154 elementBytes = pointer.raw().elem_len = 0;
155 }
156 std::size_t byteSize{pointer.Elements() * elementBytes};
157 void *p{AllocateValidatedPointerPayload(byteSize)};
158 if (!p) {
159 return ReturnError(terminator, CFI_ERROR_MEM_ALLOCATION, errMsg, hasStat);
160 }
161 pointer.set_base_addr(p);
162 pointer.SetByteStrides();
163 int stat{StatOk};
164 if (const DescriptorAddendum * addendum{pointer.Addendum()}) {
165 if (const auto *derived{addendum->derivedType()}) {
166 if (!derived->noInitializationNeeded()) {
167 stat = Initialize(pointer, *derived, terminator, hasStat, errMsg);
168 }
169 }
170 }
171 return ReturnError(terminator, stat, errMsg, hasStat);
172 }
173
RTDEF(PointerAllocateSource)174 int RTDEF(PointerAllocateSource)(Descriptor &pointer, const Descriptor &source,
175 bool hasStat, const Descriptor *errMsg, const char *sourceFile,
176 int sourceLine) {
177 int stat{RTNAME(PointerAllocate)(
178 pointer, hasStat, errMsg, sourceFile, sourceLine)};
179 if (stat == StatOk) {
180 Terminator terminator{sourceFile, sourceLine};
181 DoFromSourceAssign(pointer, source, terminator);
182 }
183 return stat;
184 }
185
GetByteSize(const ISO::CFI_cdesc_t & descriptor)186 static RT_API_ATTRS std::size_t GetByteSize(
187 const ISO::CFI_cdesc_t &descriptor) {
188 std::size_t rank{descriptor.rank};
189 const ISO::CFI_dim_t *dim{descriptor.dim};
190 std::size_t byteSize{descriptor.elem_len};
191 for (std::size_t j{0}; j < rank; ++j) {
192 byteSize *= dim[j].extent;
193 }
194 return byteSize;
195 }
196
ValidatePointerPayload(const ISO::CFI_cdesc_t & desc)197 bool RT_API_ATTRS ValidatePointerPayload(const ISO::CFI_cdesc_t &desc) {
198 std::size_t byteSize{GetByteSize(desc)};
199 constexpr std::size_t align{sizeof(std::uintptr_t)};
200 byteSize = ((byteSize + align - 1) / align) * align;
201 const void *p{desc.base_addr};
202 const std::uintptr_t *footer{reinterpret_cast<const std::uintptr_t *>(
203 static_cast<const char *>(p) + byteSize)};
204 return *footer == ~reinterpret_cast<std::uintptr_t>(p);
205 }
206
RTDEF(PointerDeallocate)207 int RTDEF(PointerDeallocate)(Descriptor &pointer, bool hasStat,
208 const Descriptor *errMsg, const char *sourceFile, int sourceLine) {
209 Terminator terminator{sourceFile, sourceLine};
210 if (!pointer.IsPointer()) {
211 return ReturnError(terminator, StatInvalidDescriptor, errMsg, hasStat);
212 }
213 if (!pointer.IsAllocated()) {
214 return ReturnError(terminator, StatBaseNull, errMsg, hasStat);
215 }
216 if (executionEnvironment.checkPointerDeallocation &&
217 !ValidatePointerPayload(pointer.raw())) {
218 return ReturnError(terminator, StatBadPointerDeallocation, errMsg, hasStat);
219 }
220 return ReturnError(terminator,
221 pointer.Destroy(/*finalize=*/true, /*destroyPointers=*/true, &terminator),
222 errMsg, hasStat);
223 }
224
RTDEF(PointerDeallocatePolymorphic)225 int RTDEF(PointerDeallocatePolymorphic)(Descriptor &pointer,
226 const typeInfo::DerivedType *derivedType, bool hasStat,
227 const Descriptor *errMsg, const char *sourceFile, int sourceLine) {
228 int stat{RTNAME(PointerDeallocate)(
229 pointer, hasStat, errMsg, sourceFile, sourceLine)};
230 if (stat == StatOk) {
231 if (DescriptorAddendum * addendum{pointer.Addendum()}) {
232 addendum->set_derivedType(derivedType);
233 pointer.raw().type = derivedType ? CFI_type_struct : CFI_type_other;
234 } else {
235 // Unlimited polymorphic descriptors initialized with
236 // PointerNullifyIntrinsic do not have an addendum. Make sure the
237 // derivedType is null in that case.
238 INTERNAL_CHECK(!derivedType);
239 pointer.raw().type = CFI_type_other;
240 }
241 }
242 return stat;
243 }
244
RTDEF(PointerIsAssociated)245 bool RTDEF(PointerIsAssociated)(const Descriptor &pointer) {
246 return pointer.raw().base_addr != nullptr;
247 }
248
RTDEF(PointerIsAssociatedWith)249 bool RTDEF(PointerIsAssociatedWith)(
250 const Descriptor &pointer, const Descriptor *target) {
251 if (!target) {
252 return pointer.raw().base_addr != nullptr;
253 }
254 if (!target->raw().base_addr ||
255 (target->raw().type != CFI_type_struct && target->ElementBytes() == 0)) {
256 return false;
257 }
258 int rank{pointer.rank()};
259 if (pointer.raw().base_addr != target->raw().base_addr ||
260 pointer.ElementBytes() != target->ElementBytes() ||
261 rank != target->rank()) {
262 return false;
263 }
264 for (int j{0}; j < rank; ++j) {
265 const Dimension &pDim{pointer.GetDimension(j)};
266 const Dimension &tDim{target->GetDimension(j)};
267 auto pExtent{pDim.Extent()};
268 if (pExtent == 0 || pExtent != tDim.Extent() ||
269 (pExtent != 1 && pDim.ByteStride() != tDim.ByteStride())) {
270 return false;
271 }
272 }
273 return true;
274 }
275
276 // TODO: PointerCheckLengthParameter
277
278 RT_EXT_API_GROUP_END
279 } // extern "C"
280 } // namespace Fortran::runtime
281