1//===-- lib/runtime/misc-intrinsic.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-exception
6//
7//===----------------------------------------------------------------------===//
8
9#include "flang/Runtime/misc-intrinsic.h"
10#include "flang-rt/runtime/descriptor.h"
11#include "flang-rt/runtime/terminator.h"
12#include "flang-rt/runtime/tools.h"
13#include "flang/Common/optional.h"
14#include <algorithm>
15#include <cstdio>
16#include <cstring>
17
18namespace Fortran::runtime {
19
20static 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(kNoAsyncObject)}) {
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(a: resultBytes, b: sourceElementBytes)};
45 std::memcpy(dest: to, src: source.Element<char>(sourceAt), n: toMove);
46 to += toMove;
47 resultBytes -= toMove;
48 --sourceElements;
49 source.IncrementSubscripts(sourceAt);
50 }
51 if (resultBytes > 0) {
52 std::memset(s: to, c: 0, n: resultBytes);
53 }
54}
55
56extern "C" {
57RT_EXT_API_GROUP_BEGIN
58
59void 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
92void 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
113void 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
119RT_EXT_API_GROUP_END
120} // extern "C"
121} // namespace Fortran::runtime
122

source code of flang-rt/lib/runtime/misc-intrinsic.cpp