1 //===-- runtime/misc-intrinsic.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/misc-intrinsic.h" 10 #include "terminator.h" 11 #include "tools.h" 12 #include "flang/Common/optional.h" 13 #include "flang/Runtime/descriptor.h" 14 #include <algorithm> 15 #include <cstdio> 16 #include <cstring> 17 18 namespace Fortran::runtime { 19 20 static RT_API_ATTRS void TransferImpl(Descriptor &result, 21 const Descriptor &source, const Descriptor &mold, const char *sourceFile, 22 int line, Fortran::common::optional<std::int64_t> resultExtent) { 23 int rank{resultExtent.has_value() ? 1 : 0}; 24 std::size_t elementBytes{mold.ElementBytes()}; 25 result.Establish(mold.type(), elementBytes, nullptr, rank, nullptr, 26 CFI_attribute_allocatable, mold.Addendum() != nullptr); 27 if (resultExtent) { 28 result.GetDimension(0).SetBounds(1, *resultExtent); 29 } 30 if (const DescriptorAddendum * addendum{mold.Addendum()}) { 31 *result.Addendum() = *addendum; 32 } 33 if (int stat{result.Allocate()}) { 34 Terminator{sourceFile, line}.Crash( 35 "TRANSFER: could not allocate memory for result; STAT=%d", stat); 36 } 37 char *to{result.OffsetElement<char>()}; 38 std::size_t resultBytes{result.Elements() * result.ElementBytes()}; 39 const std::size_t sourceElementBytes{source.ElementBytes()}; 40 std::size_t sourceElements{source.Elements()}; 41 SubscriptValue sourceAt[maxRank]; 42 source.GetLowerBounds(sourceAt); 43 while (resultBytes > 0 && sourceElements > 0) { 44 std::size_t toMove{std::min(resultBytes, sourceElementBytes)}; 45 std::memcpy(to, source.Element<char>(sourceAt), toMove); 46 to += toMove; 47 resultBytes -= toMove; 48 --sourceElements; 49 source.IncrementSubscripts(sourceAt); 50 } 51 if (resultBytes > 0) { 52 std::memset(to, 0, resultBytes); 53 } 54 } 55 56 extern "C" { 57 RT_EXT_API_GROUP_BEGIN 58 59 void RTDEF(Rename)(const Descriptor &path1, const Descriptor &path2, 60 const Descriptor *status, const char *sourceFile, int line) { 61 Terminator terminator{sourceFile, line}; 62 #if !defined(RT_DEVICE_COMPILATION) 63 char *pathSrc{EnsureNullTerminated( 64 path1.OffsetElement(), path1.ElementBytes(), terminator)}; 65 char *pathDst{EnsureNullTerminated( 66 path2.OffsetElement(), path2.ElementBytes(), terminator)}; 67 68 // We simply call rename(2) from POSIX 69 int result{rename(pathSrc, pathDst)}; 70 if (status) { 71 // When an error has happened, 72 int errorCode{0}; // Assume success 73 if (result != 0) { 74 // The rename operation has failed, so return the error code as status. 75 errorCode = errno; 76 } 77 StoreIntToDescriptor(status, errorCode, terminator); 78 } 79 80 // Deallocate memory if EnsureNullTerminated dynamically allocated memory 81 if (pathSrc != path1.OffsetElement()) { 82 FreeMemory(pathSrc); 83 } 84 if (pathDst != path2.OffsetElement()) { 85 FreeMemory(pathDst); 86 } 87 #else // !defined(RT_DEVICE_COMPILATION) 88 terminator.Crash("RENAME intrinsic is only supported on host devices"); 89 #endif // !defined(RT_DEVICE_COMPILATION) 90 } 91 92 void RTDEF(Transfer)(Descriptor &result, const Descriptor &source, 93 const Descriptor &mold, const char *sourceFile, int line) { 94 Fortran::common::optional<std::int64_t> elements; 95 if (mold.rank() > 0) { 96 if (std::size_t sourceElementBytes{ 97 source.Elements() * source.ElementBytes()}) { 98 if (std::size_t moldElementBytes{mold.ElementBytes()}) { 99 elements = static_cast<std::int64_t>( 100 (sourceElementBytes + moldElementBytes - 1) / moldElementBytes); 101 } else { 102 Terminator{sourceFile, line}.Crash("TRANSFER: zero-sized type of MOLD= " 103 "when SOURCE= is not zero-sized"); 104 } 105 } else { 106 elements = std::int64_t{0}; 107 } 108 } 109 return TransferImpl( 110 result, source, mold, sourceFile, line, std::move(elements)); 111 } 112 113 void RTDEF(TransferSize)(Descriptor &result, const Descriptor &source, 114 const Descriptor &mold, const char *sourceFile, int line, 115 std::int64_t size) { 116 return TransferImpl(result, source, mold, sourceFile, line, size); 117 } 118 119 RT_EXT_API_GROUP_END 120 } // extern "C" 121 } // namespace Fortran::runtime 122