1//===-- lib/runtime/internal-unit.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-rt/runtime/internal-unit.h"
10#include "flang-rt/runtime/descriptor.h"
11#include "flang-rt/runtime/io-error.h"
12#include "flang/Runtime/freestanding-tools.h"
13#include <algorithm>
14#include <type_traits>
15
16namespace Fortran::runtime::io {
17RT_OFFLOAD_API_GROUP_BEGIN
18
19template <Direction DIR>
20RT_API_ATTRS InternalDescriptorUnit<DIR>::InternalDescriptorUnit(
21 Scalar scalar, std::size_t length, int kind) {
22 internalIoCharKind = kind;
23 recordLength = length;
24 endfileRecordNumber = 2;
25 void *pointer{reinterpret_cast<void *>(const_cast<char *>(scalar))};
26 descriptor().Establish(TypeCode{TypeCategory::Character, kind}, length * kind,
27 pointer, 0, nullptr, CFI_attribute_pointer);
28}
29
30template <Direction DIR>
31RT_API_ATTRS InternalDescriptorUnit<DIR>::InternalDescriptorUnit(
32 const Descriptor &that, const Terminator &terminator) {
33 auto thatType{that.type().GetCategoryAndKind()};
34 RUNTIME_CHECK(terminator, thatType.has_value());
35 RUNTIME_CHECK(terminator, thatType->first == TypeCategory::Character);
36 Descriptor &d{descriptor()};
37 RUNTIME_CHECK(
38 terminator, that.SizeInBytes() <= d.SizeInBytes(maxRank, true, 0));
39 RUNTIME_CHECK(terminator,
40 that.SizeInBytes() <= MaxDescriptorSizeInBytes(maxRank, true, 0));
41 new (&d) Descriptor{that};
42 d.Check();
43 internalIoCharKind = thatType->second;
44 recordLength = d.ElementBytes();
45 endfileRecordNumber = d.Elements() + 1;
46}
47
48template <Direction DIR>
49RT_API_ATTRS bool InternalDescriptorUnit<DIR>::Emit(
50 const char *data, std::size_t bytes, IoErrorHandler &handler) {
51 if constexpr (DIR == Direction::Input) {
52 handler.Crash("InternalDescriptorUnit<Direction::Input>::Emit() called");
53 return false && data[bytes] != 0; // bogus compare silences GCC warning
54 } else {
55 if (bytes <= 0) {
56 return true;
57 }
58 char *record{CurrentRecord()};
59 if (!record) {
60 handler.SignalError(IostatInternalWriteOverrun);
61 return false;
62 }
63 auto furthestAfter{std::max(furthestPositionInRecord,
64 positionInRecord + static_cast<std::int64_t>(bytes))};
65 bool ok{true};
66 if (furthestAfter > static_cast<std::int64_t>(recordLength.value_or(0))) {
67 handler.SignalError(IostatRecordWriteOverrun);
68 furthestAfter = recordLength.value_or(0);
69 bytes = std::max(std::int64_t{0}, furthestAfter - positionInRecord);
70 ok = false;
71 } else if (positionInRecord > furthestPositionInRecord) {
72 BlankFill(record + furthestPositionInRecord,
73 positionInRecord - furthestPositionInRecord);
74 }
75 std::memcpy(record + positionInRecord, data, bytes);
76 positionInRecord += bytes;
77 furthestPositionInRecord = furthestAfter;
78 return ok;
79 }
80}
81
82template <Direction DIR>
83RT_API_ATTRS std::size_t InternalDescriptorUnit<DIR>::GetNextInputBytes(
84 const char *&p, IoErrorHandler &handler) {
85 p = nullptr;
86 if constexpr (DIR == Direction::Output) {
87 handler.Crash("InternalDescriptorUnit<Direction::Output>::"
88 "GetNextInputBytes() called");
89 return 0;
90 } else {
91 const char *record{CurrentRecord()};
92 if (!record) {
93 handler.SignalEnd();
94 return 0;
95 } else if (positionInRecord >= recordLength.value_or(positionInRecord)) {
96 return 0;
97 } else {
98 p = &record[positionInRecord];
99 return *recordLength - positionInRecord;
100 }
101 }
102}
103
104template <Direction DIR>
105RT_API_ATTRS std::size_t InternalDescriptorUnit<DIR>::ViewBytesInRecord(
106 const char *&p, bool forward) const {
107 p = nullptr;
108 auto recl{recordLength.value_or(positionInRecord)};
109 const char *record{CurrentRecord()};
110 if (forward) {
111 if (positionInRecord < recl) {
112 if (record) {
113 p = &record[positionInRecord];
114 }
115 return recl - positionInRecord;
116 }
117 } else {
118 if (record && positionInRecord <= recl) {
119 p = &record[positionInRecord];
120 }
121 return positionInRecord - leftTabLimit.value_or(0);
122 }
123 return 0;
124}
125
126template <Direction DIR>
127RT_API_ATTRS bool InternalDescriptorUnit<DIR>::AdvanceRecord(
128 IoErrorHandler &handler) {
129 if (currentRecordNumber >= endfileRecordNumber.value_or(0)) {
130 if constexpr (DIR == Direction::Input) {
131 handler.SignalEnd();
132 } else {
133 handler.SignalError(IostatInternalWriteOverrun);
134 }
135 return false;
136 }
137 if constexpr (DIR == Direction::Output) {
138 BlankFillOutputRecord();
139 }
140 ++currentRecordNumber;
141 BeginRecord();
142 return true;
143}
144
145template <Direction DIR>
146RT_API_ATTRS void InternalDescriptorUnit<DIR>::BlankFill(
147 char *at, std::size_t bytes) {
148 switch (internalIoCharKind) {
149 case 2:
150 Fortran::runtime::fill_n(reinterpret_cast<char16_t *>(at), bytes / 2,
151 static_cast<char16_t>(' '));
152 break;
153 case 4:
154 Fortran::runtime::fill_n(reinterpret_cast<char32_t *>(at), bytes / 4,
155 static_cast<char32_t>(' '));
156 break;
157 default:
158 Fortran::runtime::fill_n(at, bytes, ' ');
159 break;
160 }
161}
162
163template <Direction DIR>
164RT_API_ATTRS void InternalDescriptorUnit<DIR>::BlankFillOutputRecord() {
165 if constexpr (DIR == Direction::Output) {
166 if (furthestPositionInRecord <
167 recordLength.value_or(furthestPositionInRecord)) {
168 BlankFill(CurrentRecord() + furthestPositionInRecord,
169 *recordLength - furthestPositionInRecord);
170 }
171 }
172}
173
174template <Direction DIR>
175RT_API_ATTRS void InternalDescriptorUnit<DIR>::BackspaceRecord(
176 IoErrorHandler &handler) {
177 RUNTIME_CHECK(handler, currentRecordNumber > 1);
178 --currentRecordNumber;
179 BeginRecord();
180}
181
182template <Direction DIR>
183RT_API_ATTRS std::int64_t InternalDescriptorUnit<DIR>::InquirePos() {
184 return (currentRecordNumber - 1) * recordLength.value_or(0) +
185 positionInRecord + 1;
186}
187
188template class InternalDescriptorUnit<Direction::Output>;
189template class InternalDescriptorUnit<Direction::Input>;
190
191RT_OFFLOAD_API_GROUP_END
192} // namespace Fortran::runtime::io
193

source code of flang-rt/lib/runtime/internal-unit.cpp