|
| 1 | +//===-- runtime/external-unit.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 | +// Implemenation of ExternalFileUnit for RT_USE_PSEUDO_FILE_UNIT=0. |
| 10 | +// |
| 11 | +//===----------------------------------------------------------------------===// |
| 12 | + |
| 13 | +#include "tools.h" |
| 14 | + |
| 15 | +#if !defined(RT_USE_PSEUDO_FILE_UNIT) |
| 16 | + |
| 17 | +#include "io-error.h" |
| 18 | +#include "lock.h" |
| 19 | +#include "unit-map.h" |
| 20 | +#include "unit.h" |
| 21 | +#include <cstdio> |
| 22 | +#include <limits> |
| 23 | + |
| 24 | +namespace Fortran::runtime::io { |
| 25 | + |
| 26 | +// The per-unit data structures are created on demand so that Fortran I/O |
| 27 | +// should work without a Fortran main program. |
| 28 | +static Lock unitMapLock; |
| 29 | +static Lock createOpenLock; |
| 30 | +static UnitMap *unitMap{nullptr}; |
| 31 | + |
| 32 | +void FlushOutputOnCrash(const Terminator &terminator) { |
| 33 | + if (!defaultOutput && !errorOutput) { |
| 34 | + return; |
| 35 | + } |
| 36 | + IoErrorHandler handler{terminator}; |
| 37 | + handler.HasIoStat(); // prevent nested crash if flush has error |
| 38 | + CriticalSection critical{unitMapLock}; |
| 39 | + if (defaultOutput) { |
| 40 | + defaultOutput->FlushOutput(handler); |
| 41 | + } |
| 42 | + if (errorOutput) { |
| 43 | + errorOutput->FlushOutput(handler); |
| 44 | + } |
| 45 | +} |
| 46 | + |
| 47 | +ExternalFileUnit *ExternalFileUnit::LookUp(int unit) { |
| 48 | + return GetUnitMap().LookUp(unit); |
| 49 | +} |
| 50 | + |
| 51 | +ExternalFileUnit *ExternalFileUnit::LookUpOrCreate( |
| 52 | + int unit, const Terminator &terminator, bool &wasExtant) { |
| 53 | + return GetUnitMap().LookUpOrCreate(unit, terminator, wasExtant); |
| 54 | +} |
| 55 | + |
| 56 | +ExternalFileUnit *ExternalFileUnit::LookUpOrCreateAnonymous(int unit, |
| 57 | + Direction dir, Fortran::common::optional<bool> isUnformatted, |
| 58 | + const Terminator &terminator) { |
| 59 | + // Make sure that the returned anonymous unit has been opened |
| 60 | + // not just created in the unitMap. |
| 61 | + CriticalSection critical{createOpenLock}; |
| 62 | + bool exists{false}; |
| 63 | + ExternalFileUnit *result{ |
| 64 | + GetUnitMap().LookUpOrCreate(unit, terminator, exists)}; |
| 65 | + if (result && !exists) { |
| 66 | + IoErrorHandler handler{terminator}; |
| 67 | + result->OpenAnonymousUnit( |
| 68 | + dir == Direction::Input ? OpenStatus::Unknown : OpenStatus::Replace, |
| 69 | + Action::ReadWrite, Position::Rewind, Convert::Unknown, handler); |
| 70 | + result->isUnformatted = isUnformatted; |
| 71 | + } |
| 72 | + return result; |
| 73 | +} |
| 74 | + |
| 75 | +ExternalFileUnit *ExternalFileUnit::LookUp( |
| 76 | + const char *path, std::size_t pathLen) { |
| 77 | + return GetUnitMap().LookUp(path, pathLen); |
| 78 | +} |
| 79 | + |
| 80 | +ExternalFileUnit &ExternalFileUnit::CreateNew( |
| 81 | + int unit, const Terminator &terminator) { |
| 82 | + bool wasExtant{false}; |
| 83 | + ExternalFileUnit *result{ |
| 84 | + GetUnitMap().LookUpOrCreate(unit, terminator, wasExtant)}; |
| 85 | + RUNTIME_CHECK(terminator, result && !wasExtant); |
| 86 | + return *result; |
| 87 | +} |
| 88 | + |
| 89 | +ExternalFileUnit *ExternalFileUnit::LookUpForClose(int unit) { |
| 90 | + return GetUnitMap().LookUpForClose(unit); |
| 91 | +} |
| 92 | + |
| 93 | +ExternalFileUnit &ExternalFileUnit::NewUnit( |
| 94 | + const Terminator &terminator, bool forChildIo) { |
| 95 | + ExternalFileUnit &unit{GetUnitMap().NewUnit(terminator)}; |
| 96 | + unit.createdForInternalChildIo_ = forChildIo; |
| 97 | + return unit; |
| 98 | +} |
| 99 | + |
| 100 | +bool ExternalFileUnit::OpenUnit(Fortran::common::optional<OpenStatus> status, |
| 101 | + Fortran::common::optional<Action> action, Position position, |
| 102 | + OwningPtr<char> &&newPath, std::size_t newPathLength, Convert convert, |
| 103 | + IoErrorHandler &handler) { |
| 104 | + if (convert == Convert::Unknown) { |
| 105 | + convert = executionEnvironment.conversion; |
| 106 | + } |
| 107 | + swapEndianness_ = convert == Convert::Swap || |
| 108 | + (convert == Convert::LittleEndian && !isHostLittleEndian) || |
| 109 | + (convert == Convert::BigEndian && isHostLittleEndian); |
| 110 | + bool impliedClose{false}; |
| 111 | + if (IsConnected()) { |
| 112 | + bool isSamePath{newPath.get() && path() && pathLength() == newPathLength && |
| 113 | + std::memcmp(path(), newPath.get(), newPathLength) == 0}; |
| 114 | + if (status && *status != OpenStatus::Old && isSamePath) { |
| 115 | + handler.SignalError("OPEN statement for connected unit may not have " |
| 116 | + "explicit STATUS= other than 'OLD'"); |
| 117 | + return impliedClose; |
| 118 | + } |
| 119 | + if (!newPath.get() || isSamePath) { |
| 120 | + // OPEN of existing unit, STATUS='OLD' or unspecified, not new FILE= |
| 121 | + newPath.reset(); |
| 122 | + return impliedClose; |
| 123 | + } |
| 124 | + // Otherwise, OPEN on open unit with new FILE= implies CLOSE |
| 125 | + DoImpliedEndfile(handler); |
| 126 | + FlushOutput(handler); |
| 127 | + TruncateFrame(0, handler); |
| 128 | + Close(CloseStatus::Keep, handler); |
| 129 | + impliedClose = true; |
| 130 | + } |
| 131 | + if (newPath.get() && newPathLength > 0) { |
| 132 | + if (const auto *already{ |
| 133 | + GetUnitMap().LookUp(newPath.get(), newPathLength)}) { |
| 134 | + handler.SignalError(IostatOpenAlreadyConnected, |
| 135 | + "OPEN(UNIT=%d,FILE='%.*s'): file is already connected to unit %d", |
| 136 | + unitNumber_, static_cast<int>(newPathLength), newPath.get(), |
| 137 | + already->unitNumber_); |
| 138 | + return impliedClose; |
| 139 | + } |
| 140 | + } |
| 141 | + set_path(std::move(newPath), newPathLength); |
| 142 | + Open(status.value_or(OpenStatus::Unknown), action, position, handler); |
| 143 | + auto totalBytes{knownSize()}; |
| 144 | + if (access == Access::Direct) { |
| 145 | + if (!openRecl) { |
| 146 | + handler.SignalError(IostatOpenBadRecl, |
| 147 | + "OPEN(UNIT=%d,ACCESS='DIRECT'): record length is not known", |
| 148 | + unitNumber()); |
| 149 | + } else if (*openRecl <= 0) { |
| 150 | + handler.SignalError(IostatOpenBadRecl, |
| 151 | + "OPEN(UNIT=%d,ACCESS='DIRECT',RECL=%jd): record length is invalid", |
| 152 | + unitNumber(), static_cast<std::intmax_t>(*openRecl)); |
| 153 | + } else if (totalBytes && (*totalBytes % *openRecl != 0)) { |
| 154 | + handler.SignalError(IostatOpenBadRecl, |
| 155 | + "OPEN(UNIT=%d,ACCESS='DIRECT',RECL=%jd): record length is not an " |
| 156 | + "even divisor of the file size %jd", |
| 157 | + unitNumber(), static_cast<std::intmax_t>(*openRecl), |
| 158 | + static_cast<std::intmax_t>(*totalBytes)); |
| 159 | + } |
| 160 | + recordLength = openRecl; |
| 161 | + } |
| 162 | + endfileRecordNumber.reset(); |
| 163 | + currentRecordNumber = 1; |
| 164 | + if (totalBytes && access == Access::Direct && openRecl.value_or(0) > 0) { |
| 165 | + endfileRecordNumber = 1 + (*totalBytes / *openRecl); |
| 166 | + } |
| 167 | + if (position == Position::Append) { |
| 168 | + if (totalBytes) { |
| 169 | + frameOffsetInFile_ = *totalBytes; |
| 170 | + } |
| 171 | + if (access != Access::Stream) { |
| 172 | + if (!endfileRecordNumber) { |
| 173 | + // Fake it so that we can backspace relative from the end |
| 174 | + endfileRecordNumber = std::numeric_limits<std::int64_t>::max() - 2; |
| 175 | + } |
| 176 | + currentRecordNumber = *endfileRecordNumber; |
| 177 | + } |
| 178 | + } |
| 179 | + return impliedClose; |
| 180 | +} |
| 181 | + |
| 182 | +void ExternalFileUnit::OpenAnonymousUnit( |
| 183 | + Fortran::common::optional<OpenStatus> status, |
| 184 | + Fortran::common::optional<Action> action, Position position, |
| 185 | + Convert convert, IoErrorHandler &handler) { |
| 186 | + // I/O to an unconnected unit reads/creates a local file, e.g. fort.7 |
| 187 | + std::size_t pathMaxLen{32}; |
| 188 | + auto path{SizedNew<char>{handler}(pathMaxLen)}; |
| 189 | + std::snprintf(path.get(), pathMaxLen, "fort.%d", unitNumber_); |
| 190 | + OpenUnit(status, action, position, std::move(path), std::strlen(path.get()), |
| 191 | + convert, handler); |
| 192 | +} |
| 193 | + |
| 194 | +void ExternalFileUnit::CloseUnit(CloseStatus status, IoErrorHandler &handler) { |
| 195 | + DoImpliedEndfile(handler); |
| 196 | + FlushOutput(handler); |
| 197 | + Close(status, handler); |
| 198 | +} |
| 199 | + |
| 200 | +void ExternalFileUnit::DestroyClosed() { |
| 201 | + GetUnitMap().DestroyClosed(*this); // destroys *this |
| 202 | +} |
| 203 | + |
| 204 | +Iostat ExternalFileUnit::SetDirection(Direction direction) { |
| 205 | + if (direction == Direction::Input) { |
| 206 | + if (mayRead()) { |
| 207 | + direction_ = Direction::Input; |
| 208 | + return IostatOk; |
| 209 | + } else { |
| 210 | + return IostatReadFromWriteOnly; |
| 211 | + } |
| 212 | + } else { |
| 213 | + if (mayWrite()) { |
| 214 | + direction_ = Direction::Output; |
| 215 | + return IostatOk; |
| 216 | + } else { |
| 217 | + return IostatWriteToReadOnly; |
| 218 | + } |
| 219 | + } |
| 220 | +} |
| 221 | + |
| 222 | +UnitMap &ExternalFileUnit::CreateUnitMap() { |
| 223 | + Terminator terminator{__FILE__, __LINE__}; |
| 224 | + IoErrorHandler handler{terminator}; |
| 225 | + UnitMap &newUnitMap{*New<UnitMap>{terminator}().release()}; |
| 226 | + |
| 227 | + bool wasExtant{false}; |
| 228 | + ExternalFileUnit &out{*newUnitMap.LookUpOrCreate( |
| 229 | + FORTRAN_DEFAULT_OUTPUT_UNIT, terminator, wasExtant)}; |
| 230 | + RUNTIME_CHECK(terminator, !wasExtant); |
| 231 | + out.Predefine(1); |
| 232 | + handler.SignalError(out.SetDirection(Direction::Output)); |
| 233 | + out.isUnformatted = false; |
| 234 | + defaultOutput = &out; |
| 235 | + |
| 236 | + ExternalFileUnit &in{*newUnitMap.LookUpOrCreate( |
| 237 | + FORTRAN_DEFAULT_INPUT_UNIT, terminator, wasExtant)}; |
| 238 | + RUNTIME_CHECK(terminator, !wasExtant); |
| 239 | + in.Predefine(0); |
| 240 | + handler.SignalError(in.SetDirection(Direction::Input)); |
| 241 | + in.isUnformatted = false; |
| 242 | + defaultInput = ∈ |
| 243 | + |
| 244 | + ExternalFileUnit &error{ |
| 245 | + *newUnitMap.LookUpOrCreate(FORTRAN_ERROR_UNIT, terminator, wasExtant)}; |
| 246 | + RUNTIME_CHECK(terminator, !wasExtant); |
| 247 | + error.Predefine(2); |
| 248 | + handler.SignalError(error.SetDirection(Direction::Output)); |
| 249 | + error.isUnformatted = false; |
| 250 | + errorOutput = &error; |
| 251 | + |
| 252 | + return newUnitMap; |
| 253 | +} |
| 254 | + |
| 255 | +// A back-up atexit() handler for programs that don't terminate with a main |
| 256 | +// program END or a STOP statement or other Fortran-initiated program shutdown, |
| 257 | +// such as programs with a C main() that terminate normally. It flushes all |
| 258 | +// external I/O units. It is registered once the first time that any external |
| 259 | +// I/O is attempted. |
| 260 | +static void CloseAllExternalUnits() { |
| 261 | + IoErrorHandler handler{"Fortran program termination"}; |
| 262 | + ExternalFileUnit::CloseAll(handler); |
| 263 | +} |
| 264 | + |
| 265 | +UnitMap &ExternalFileUnit::GetUnitMap() { |
| 266 | + if (unitMap) { |
| 267 | + return *unitMap; |
| 268 | + } |
| 269 | + { |
| 270 | + CriticalSection critical{unitMapLock}; |
| 271 | + if (unitMap) { |
| 272 | + return *unitMap; |
| 273 | + } |
| 274 | + unitMap = &CreateUnitMap(); |
| 275 | + } |
| 276 | + std::atexit(CloseAllExternalUnits); |
| 277 | + return *unitMap; |
| 278 | +} |
| 279 | + |
| 280 | +void ExternalFileUnit::CloseAll(IoErrorHandler &handler) { |
| 281 | + CriticalSection critical{unitMapLock}; |
| 282 | + if (unitMap) { |
| 283 | + unitMap->CloseAll(handler); |
| 284 | + FreeMemoryAndNullify(unitMap); |
| 285 | + } |
| 286 | + defaultOutput = nullptr; |
| 287 | + defaultInput = nullptr; |
| 288 | + errorOutput = nullptr; |
| 289 | +} |
| 290 | + |
| 291 | +void ExternalFileUnit::FlushAll(IoErrorHandler &handler) { |
| 292 | + CriticalSection critical{unitMapLock}; |
| 293 | + if (unitMap) { |
| 294 | + unitMap->FlushAll(handler); |
| 295 | + } |
| 296 | +} |
| 297 | + |
| 298 | +int ExternalFileUnit::GetAsynchronousId(IoErrorHandler &handler) { |
| 299 | + if (!mayAsynchronous()) { |
| 300 | + handler.SignalError(IostatBadAsynchronous); |
| 301 | + return -1; |
| 302 | + } else { |
| 303 | + for (int j{0}; 64 * j < maxAsyncIds; ++j) { |
| 304 | + if (auto least{asyncIdAvailable_[j].LeastElement()}) { |
| 305 | + asyncIdAvailable_[j].reset(*least); |
| 306 | + return 64 * j + static_cast<int>(*least); |
| 307 | + } |
| 308 | + } |
| 309 | + handler.SignalError(IostatTooManyAsyncOps); |
| 310 | + return -1; |
| 311 | + } |
| 312 | +} |
| 313 | + |
| 314 | +bool ExternalFileUnit::Wait(int id) { |
| 315 | + if (static_cast<std::size_t>(id) >= maxAsyncIds || |
| 316 | + asyncIdAvailable_[id / 64].test(id % 64)) { |
| 317 | + return false; |
| 318 | + } else { |
| 319 | + if (id == 0) { // means "all IDs" |
| 320 | + for (int j{0}; 64 * j < maxAsyncIds; ++j) { |
| 321 | + asyncIdAvailable_[j].set(); |
| 322 | + } |
| 323 | + asyncIdAvailable_[0].reset(0); |
| 324 | + } else { |
| 325 | + asyncIdAvailable_[id / 64].set(id % 64); |
| 326 | + } |
| 327 | + return true; |
| 328 | + } |
| 329 | +} |
| 330 | + |
| 331 | +} // namespace Fortran::runtime::io |
| 332 | + |
| 333 | +#endif // !defined(RT_USE_PSEUDO_FILE_UNIT) |
0 commit comments