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