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