flang/runtime/external-unit.cpp

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