[flang-commits] [flang] 00f3454 - [flang][runtime] Added pseudo file unit for simplified PRINT. (#86134)

via flang-commits flang-commits at lists.llvm.org
Thu Mar 21 15:12:34 PDT 2024


Author: Slava Zakharin
Date: 2024-03-21T15:12:31-07:00
New Revision: 00f3454bbe04ae8cf0eeda981c439e7f97390bd4

URL: https://github.com/llvm/llvm-project/commit/00f3454bbe04ae8cf0eeda981c439e7f97390bd4
DIFF: https://github.com/llvm/llvm-project/commit/00f3454bbe04ae8cf0eeda981c439e7f97390bd4.diff

LOG: [flang][runtime] Added pseudo file unit for simplified PRINT. (#86134)

A file unit is emulated via a temporary buffer that accumulates
the output, which is printed out via std::printf at the end
of the IO statement. This implementation will be used for the offload
devices.

Added: 
    flang/runtime/external-unit.cpp
    flang/runtime/pseudo-unit.cpp

Modified: 
    flang/runtime/CMakeLists.txt
    flang/runtime/io-stmt.cpp
    flang/runtime/lock.h
    flang/runtime/tools.h
    flang/runtime/unit.cpp
    flang/runtime/unit.h

Removed: 
    


################################################################################
diff  --git a/flang/runtime/CMakeLists.txt b/flang/runtime/CMakeLists.txt
index 7dd60b5edcd5fb..02147487115497 100644
--- a/flang/runtime/CMakeLists.txt
+++ b/flang/runtime/CMakeLists.txt
@@ -129,6 +129,7 @@ set(sources
   exceptions.cpp
   execute.cpp
   extensions.cpp
+  external-unit.cpp
   extrema.cpp
   file.cpp
   findloc.cpp
@@ -149,6 +150,7 @@ set(sources
   numeric.cpp
   pointer.cpp
   product.cpp
+  pseudo-unit.cpp
   ragged.cpp
   random.cpp
   reduction.cpp

diff  --git a/flang/runtime/external-unit.cpp b/flang/runtime/external-unit.cpp
new file mode 100644
index 00000000000000..9d650ceca4a8cc
--- /dev/null
+++ b/flang/runtime/external-unit.cpp
@@ -0,0 +1,333 @@
+//===-- runtime/external-unit.cpp -----------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+//
+// Implemenation of ExternalFileUnit for RT_USE_PSEUDO_FILE_UNIT=0.
+//
+//===----------------------------------------------------------------------===//
+
+#include "tools.h"
+
+#if !defined(RT_USE_PSEUDO_FILE_UNIT)
+
+#include "io-error.h"
+#include "lock.h"
+#include "unit-map.h"
+#include "unit.h"
+#include <cstdio>
+#include <limits>
+
+namespace Fortran::runtime::io {
+
+// The per-unit data structures are created on demand so that Fortran I/O
+// should work without a Fortran main program.
+static Lock unitMapLock;
+static Lock createOpenLock;
+static UnitMap *unitMap{nullptr};
+
+void FlushOutputOnCrash(const Terminator &terminator) {
+  if (!defaultOutput && !errorOutput) {
+    return;
+  }
+  IoErrorHandler handler{terminator};
+  handler.HasIoStat(); // prevent nested crash if flush has error
+  CriticalSection critical{unitMapLock};
+  if (defaultOutput) {
+    defaultOutput->FlushOutput(handler);
+  }
+  if (errorOutput) {
+    errorOutput->FlushOutput(handler);
+  }
+}
+
+ExternalFileUnit *ExternalFileUnit::LookUp(int unit) {
+  return GetUnitMap().LookUp(unit);
+}
+
+ExternalFileUnit *ExternalFileUnit::LookUpOrCreate(
+    int unit, const Terminator &terminator, bool &wasExtant) {
+  return GetUnitMap().LookUpOrCreate(unit, terminator, wasExtant);
+}
+
+ExternalFileUnit *ExternalFileUnit::LookUpOrCreateAnonymous(int unit,
+    Direction dir, Fortran::common::optional<bool> isUnformatted,
+    const Terminator &terminator) {
+  // Make sure that the returned anonymous unit has been opened
+  // not just created in the unitMap.
+  CriticalSection critical{createOpenLock};
+  bool exists{false};
+  ExternalFileUnit *result{
+      GetUnitMap().LookUpOrCreate(unit, terminator, exists)};
+  if (result && !exists) {
+    IoErrorHandler handler{terminator};
+    result->OpenAnonymousUnit(
+        dir == Direction::Input ? OpenStatus::Unknown : OpenStatus::Replace,
+        Action::ReadWrite, Position::Rewind, Convert::Unknown, handler);
+    result->isUnformatted = isUnformatted;
+  }
+  return result;
+}
+
+ExternalFileUnit *ExternalFileUnit::LookUp(
+    const char *path, std::size_t pathLen) {
+  return GetUnitMap().LookUp(path, pathLen);
+}
+
+ExternalFileUnit &ExternalFileUnit::CreateNew(
+    int unit, const Terminator &terminator) {
+  bool wasExtant{false};
+  ExternalFileUnit *result{
+      GetUnitMap().LookUpOrCreate(unit, terminator, wasExtant)};
+  RUNTIME_CHECK(terminator, result && !wasExtant);
+  return *result;
+}
+
+ExternalFileUnit *ExternalFileUnit::LookUpForClose(int unit) {
+  return GetUnitMap().LookUpForClose(unit);
+}
+
+ExternalFileUnit &ExternalFileUnit::NewUnit(
+    const Terminator &terminator, bool forChildIo) {
+  ExternalFileUnit &unit{GetUnitMap().NewUnit(terminator)};
+  unit.createdForInternalChildIo_ = forChildIo;
+  return unit;
+}
+
+bool ExternalFileUnit::OpenUnit(Fortran::common::optional<OpenStatus> status,
+    Fortran::common::optional<Action> action, Position position,
+    OwningPtr<char> &&newPath, std::size_t newPathLength, Convert convert,
+    IoErrorHandler &handler) {
+  if (convert == Convert::Unknown) {
+    convert = executionEnvironment.conversion;
+  }
+  swapEndianness_ = convert == Convert::Swap ||
+      (convert == Convert::LittleEndian && !isHostLittleEndian) ||
+      (convert == Convert::BigEndian && isHostLittleEndian);
+  bool impliedClose{false};
+  if (IsConnected()) {
+    bool isSamePath{newPath.get() && path() && pathLength() == newPathLength &&
+        std::memcmp(path(), newPath.get(), newPathLength) == 0};
+    if (status && *status != OpenStatus::Old && isSamePath) {
+      handler.SignalError("OPEN statement for connected unit may not have "
+                          "explicit STATUS= other than 'OLD'");
+      return impliedClose;
+    }
+    if (!newPath.get() || isSamePath) {
+      // OPEN of existing unit, STATUS='OLD' or unspecified, not new FILE=
+      newPath.reset();
+      return impliedClose;
+    }
+    // Otherwise, OPEN on open unit with new FILE= implies CLOSE
+    DoImpliedEndfile(handler);
+    FlushOutput(handler);
+    TruncateFrame(0, handler);
+    Close(CloseStatus::Keep, handler);
+    impliedClose = true;
+  }
+  if (newPath.get() && newPathLength > 0) {
+    if (const auto *already{
+            GetUnitMap().LookUp(newPath.get(), newPathLength)}) {
+      handler.SignalError(IostatOpenAlreadyConnected,
+          "OPEN(UNIT=%d,FILE='%.*s'): file is already connected to unit %d",
+          unitNumber_, static_cast<int>(newPathLength), newPath.get(),
+          already->unitNumber_);
+      return impliedClose;
+    }
+  }
+  set_path(std::move(newPath), newPathLength);
+  Open(status.value_or(OpenStatus::Unknown), action, position, handler);
+  auto totalBytes{knownSize()};
+  if (access == Access::Direct) {
+    if (!openRecl) {
+      handler.SignalError(IostatOpenBadRecl,
+          "OPEN(UNIT=%d,ACCESS='DIRECT'): record length is not known",
+          unitNumber());
+    } else if (*openRecl <= 0) {
+      handler.SignalError(IostatOpenBadRecl,
+          "OPEN(UNIT=%d,ACCESS='DIRECT',RECL=%jd): record length is invalid",
+          unitNumber(), static_cast<std::intmax_t>(*openRecl));
+    } else if (totalBytes && (*totalBytes % *openRecl != 0)) {
+      handler.SignalError(IostatOpenBadRecl,
+          "OPEN(UNIT=%d,ACCESS='DIRECT',RECL=%jd): record length is not an "
+          "even divisor of the file size %jd",
+          unitNumber(), static_cast<std::intmax_t>(*openRecl),
+          static_cast<std::intmax_t>(*totalBytes));
+    }
+    recordLength = openRecl;
+  }
+  endfileRecordNumber.reset();
+  currentRecordNumber = 1;
+  if (totalBytes && access == Access::Direct && openRecl.value_or(0) > 0) {
+    endfileRecordNumber = 1 + (*totalBytes / *openRecl);
+  }
+  if (position == Position::Append) {
+    if (totalBytes) {
+      frameOffsetInFile_ = *totalBytes;
+    }
+    if (access != Access::Stream) {
+      if (!endfileRecordNumber) {
+        // Fake it so that we can backspace relative from the end
+        endfileRecordNumber = std::numeric_limits<std::int64_t>::max() - 2;
+      }
+      currentRecordNumber = *endfileRecordNumber;
+    }
+  }
+  return impliedClose;
+}
+
+void ExternalFileUnit::OpenAnonymousUnit(
+    Fortran::common::optional<OpenStatus> status,
+    Fortran::common::optional<Action> action, Position position,
+    Convert convert, IoErrorHandler &handler) {
+  // I/O to an unconnected unit reads/creates a local file, e.g. fort.7
+  std::size_t pathMaxLen{32};
+  auto path{SizedNew<char>{handler}(pathMaxLen)};
+  std::snprintf(path.get(), pathMaxLen, "fort.%d", unitNumber_);
+  OpenUnit(status, action, position, std::move(path), std::strlen(path.get()),
+      convert, handler);
+}
+
+void ExternalFileUnit::CloseUnit(CloseStatus status, IoErrorHandler &handler) {
+  DoImpliedEndfile(handler);
+  FlushOutput(handler);
+  Close(status, handler);
+}
+
+void ExternalFileUnit::DestroyClosed() {
+  GetUnitMap().DestroyClosed(*this); // destroys *this
+}
+
+Iostat ExternalFileUnit::SetDirection(Direction direction) {
+  if (direction == Direction::Input) {
+    if (mayRead()) {
+      direction_ = Direction::Input;
+      return IostatOk;
+    } else {
+      return IostatReadFromWriteOnly;
+    }
+  } else {
+    if (mayWrite()) {
+      direction_ = Direction::Output;
+      return IostatOk;
+    } else {
+      return IostatWriteToReadOnly;
+    }
+  }
+}
+
+UnitMap &ExternalFileUnit::CreateUnitMap() {
+  Terminator terminator{__FILE__, __LINE__};
+  IoErrorHandler handler{terminator};
+  UnitMap &newUnitMap{*New<UnitMap>{terminator}().release()};
+
+  bool wasExtant{false};
+  ExternalFileUnit &out{*newUnitMap.LookUpOrCreate(
+      FORTRAN_DEFAULT_OUTPUT_UNIT, terminator, wasExtant)};
+  RUNTIME_CHECK(terminator, !wasExtant);
+  out.Predefine(1);
+  handler.SignalError(out.SetDirection(Direction::Output));
+  out.isUnformatted = false;
+  defaultOutput = &out;
+
+  ExternalFileUnit &in{*newUnitMap.LookUpOrCreate(
+      FORTRAN_DEFAULT_INPUT_UNIT, terminator, wasExtant)};
+  RUNTIME_CHECK(terminator, !wasExtant);
+  in.Predefine(0);
+  handler.SignalError(in.SetDirection(Direction::Input));
+  in.isUnformatted = false;
+  defaultInput = ∈
+
+  ExternalFileUnit &error{
+      *newUnitMap.LookUpOrCreate(FORTRAN_ERROR_UNIT, terminator, wasExtant)};
+  RUNTIME_CHECK(terminator, !wasExtant);
+  error.Predefine(2);
+  handler.SignalError(error.SetDirection(Direction::Output));
+  error.isUnformatted = false;
+  errorOutput = &error;
+
+  return newUnitMap;
+}
+
+// A back-up atexit() handler for programs that don't terminate with a main
+// program END or a STOP statement or other Fortran-initiated program shutdown,
+// such as programs with a C main() that terminate normally.  It flushes all
+// external I/O units.  It is registered once the first time that any external
+// I/O is attempted.
+static void CloseAllExternalUnits() {
+  IoErrorHandler handler{"Fortran program termination"};
+  ExternalFileUnit::CloseAll(handler);
+}
+
+UnitMap &ExternalFileUnit::GetUnitMap() {
+  if (unitMap) {
+    return *unitMap;
+  }
+  {
+    CriticalSection critical{unitMapLock};
+    if (unitMap) {
+      return *unitMap;
+    }
+    unitMap = &CreateUnitMap();
+  }
+  std::atexit(CloseAllExternalUnits);
+  return *unitMap;
+}
+
+void ExternalFileUnit::CloseAll(IoErrorHandler &handler) {
+  CriticalSection critical{unitMapLock};
+  if (unitMap) {
+    unitMap->CloseAll(handler);
+    FreeMemoryAndNullify(unitMap);
+  }
+  defaultOutput = nullptr;
+  defaultInput = nullptr;
+  errorOutput = nullptr;
+}
+
+void ExternalFileUnit::FlushAll(IoErrorHandler &handler) {
+  CriticalSection critical{unitMapLock};
+  if (unitMap) {
+    unitMap->FlushAll(handler);
+  }
+}
+
+int ExternalFileUnit::GetAsynchronousId(IoErrorHandler &handler) {
+  if (!mayAsynchronous()) {
+    handler.SignalError(IostatBadAsynchronous);
+    return -1;
+  } else {
+    for (int j{0}; 64 * j < maxAsyncIds; ++j) {
+      if (auto least{asyncIdAvailable_[j].LeastElement()}) {
+        asyncIdAvailable_[j].reset(*least);
+        return 64 * j + static_cast<int>(*least);
+      }
+    }
+    handler.SignalError(IostatTooManyAsyncOps);
+    return -1;
+  }
+}
+
+bool ExternalFileUnit::Wait(int id) {
+  if (static_cast<std::size_t>(id) >= maxAsyncIds ||
+      asyncIdAvailable_[id / 64].test(id % 64)) {
+    return false;
+  } else {
+    if (id == 0) { // means "all IDs"
+      for (int j{0}; 64 * j < maxAsyncIds; ++j) {
+        asyncIdAvailable_[j].set();
+      }
+      asyncIdAvailable_[0].reset(0);
+    } else {
+      asyncIdAvailable_[id / 64].set(id % 64);
+    }
+    return true;
+  }
+}
+
+} // namespace Fortran::runtime::io
+
+#endif // !defined(RT_USE_PSEUDO_FILE_UNIT)

diff  --git a/flang/runtime/io-stmt.cpp b/flang/runtime/io-stmt.cpp
index 075d7b5ae518a4..e3f1214324d887 100644
--- a/flang/runtime/io-stmt.cpp
+++ b/flang/runtime/io-stmt.cpp
@@ -227,7 +227,17 @@ ConnectionState &ExternalIoStatementBase::GetConnectionState() { return unit_; }
 int ExternalIoStatementBase::EndIoStatement() {
   CompleteOperation();
   auto result{IoStatementBase::EndIoStatement()};
+#if !defined(RT_USE_PSEUDO_FILE_UNIT)
   unit_.EndIoStatement(); // annihilates *this in unit_.u_
+#else
+  // Fetch the unit pointer before *this disappears.
+  ExternalFileUnit *unitPtr{&unit_};
+  // The pseudo file units are dynamically allocated
+  // and are not tracked in the unit map.
+  // They have to be destructed and deallocated here.
+  unitPtr->~ExternalFileUnit();
+  FreeMemory(unitPtr);
+#endif
   return result;
 }
 

diff  --git a/flang/runtime/lock.h b/flang/runtime/lock.h
index 5fdcf4745c21c2..61b06a62ff7c88 100644
--- a/flang/runtime/lock.h
+++ b/flang/runtime/lock.h
@@ -12,6 +12,7 @@
 #define FORTRAN_RUNTIME_LOCK_H_
 
 #include "terminator.h"
+#include "tools.h"
 
 // Avoid <mutex> if possible to avoid introduction of C++ runtime
 // library dependence.
@@ -35,7 +36,17 @@ namespace Fortran::runtime {
 
 class Lock {
 public:
-#if USE_PTHREADS
+#if RT_USE_PSEUDO_LOCK
+  // No lock implementation, e.g. for using together
+  // with RT_USE_PSEUDO_FILE_UNIT.
+  // The users of Lock class may use it under
+  // USE_PTHREADS and otherwise, so it has to provide
+  // all the interfaces.
+  void Take() {}
+  bool Try() { return true; }
+  void Drop() {}
+  bool TakeIfNoDeadlock() { return true; }
+#elif USE_PTHREADS
   Lock() { pthread_mutex_init(&mutex_, nullptr); }
   ~Lock() { pthread_mutex_destroy(&mutex_); }
   void Take() {
@@ -79,7 +90,9 @@ class Lock {
   }
 
 private:
-#if USE_PTHREADS
+#if RT_USE_PSEUDO_FILE_UNIT
+  // No state.
+#elif USE_PTHREADS
   pthread_mutex_t mutex_{};
   volatile bool isBusy_{false};
   volatile pthread_t holder_;

diff  --git a/flang/runtime/pseudo-unit.cpp b/flang/runtime/pseudo-unit.cpp
new file mode 100644
index 00000000000000..8b5f36e2233a47
--- /dev/null
+++ b/flang/runtime/pseudo-unit.cpp
@@ -0,0 +1,167 @@
+//===-- runtime/pseudo-unit.cpp -------------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+//
+// Implemenation of ExternalFileUnit and PseudoOpenFile for
+// RT_USE_PSEUDO_FILE_UNIT=1.
+//
+//===----------------------------------------------------------------------===//
+
+#include "tools.h"
+
+#if defined(RT_USE_PSEUDO_FILE_UNIT)
+
+#include "io-error.h"
+#include "unit.h"
+#include <cstdio>
+
+namespace Fortran::runtime::io {
+
+void FlushOutputOnCrash(const Terminator &) {}
+
+ExternalFileUnit *ExternalFileUnit::LookUp(int) {
+  Terminator{__FILE__, __LINE__}.Crash("%s: unsupported", RT_PRETTY_FUNCTION);
+}
+
+ExternalFileUnit *ExternalFileUnit::LookUpOrCreate(
+    int, const Terminator &, bool &) {
+  Terminator{__FILE__, __LINE__}.Crash("%s: unsupported", RT_PRETTY_FUNCTION);
+}
+
+ExternalFileUnit *ExternalFileUnit::LookUpOrCreateAnonymous(int unit,
+    Direction direction, Fortran::common::optional<bool>,
+    const Terminator &terminator) {
+  if (direction != Direction::Output) {
+    terminator.Crash("ExternalFileUnit only supports output IO");
+  }
+  return New<ExternalFileUnit>{terminator}(unit).release();
+}
+
+ExternalFileUnit *ExternalFileUnit::LookUp(const char *, std::size_t) {
+  Terminator{__FILE__, __LINE__}.Crash("%s: unsupported", RT_PRETTY_FUNCTION);
+}
+
+ExternalFileUnit &ExternalFileUnit::CreateNew(int, const Terminator &) {
+  Terminator{__FILE__, __LINE__}.Crash("%s: unsupported", RT_PRETTY_FUNCTION);
+}
+
+ExternalFileUnit *ExternalFileUnit::LookUpForClose(int) {
+  Terminator{__FILE__, __LINE__}.Crash("%s: unsupported", RT_PRETTY_FUNCTION);
+}
+
+ExternalFileUnit &ExternalFileUnit::NewUnit(const Terminator &, bool) {
+  Terminator{__FILE__, __LINE__}.Crash("%s: unsupported", RT_PRETTY_FUNCTION);
+}
+
+bool ExternalFileUnit::OpenUnit(Fortran::common::optional<OpenStatus> status,
+    Fortran::common::optional<Action>, Position, OwningPtr<char> &&,
+    std::size_t, Convert, IoErrorHandler &handler) {
+  handler.Crash("%s: unsupported", RT_PRETTY_FUNCTION);
+}
+
+void ExternalFileUnit::OpenAnonymousUnit(Fortran::common::optional<OpenStatus>,
+    Fortran::common::optional<Action>, Position, Convert convert,
+    IoErrorHandler &handler) {
+  handler.Crash("%s: unsupported", RT_PRETTY_FUNCTION);
+}
+
+void ExternalFileUnit::CloseUnit(CloseStatus, IoErrorHandler &handler) {
+  handler.Crash("%s: unsupported", RT_PRETTY_FUNCTION);
+}
+
+void ExternalFileUnit::DestroyClosed() {
+  Terminator{__FILE__, __LINE__}.Crash("%s: unsupported", RT_PRETTY_FUNCTION);
+}
+
+Iostat ExternalFileUnit::SetDirection(Direction direction) {
+  if (direction != Direction::Output) {
+    return IostatReadFromWriteOnly;
+  }
+  direction_ = direction;
+  return IostatOk;
+}
+
+void ExternalFileUnit::CloseAll(IoErrorHandler &) {}
+
+void ExternalFileUnit::FlushAll(IoErrorHandler &) {}
+
+int ExternalFileUnit::GetAsynchronousId(IoErrorHandler &handler) {
+  handler.Crash("%s: unsupported", RT_PRETTY_FUNCTION);
+}
+
+bool ExternalFileUnit::Wait(int) {
+  Terminator{__FILE__, __LINE__}.Crash("unsupported");
+}
+
+void PseudoOpenFile::set_mayAsynchronous(bool yes) {
+  if (yes) {
+    Terminator{__FILE__, __LINE__}.Crash("%s: unsupported", RT_PRETTY_FUNCTION);
+  }
+}
+
+Fortran::common::optional<PseudoOpenFile::FileOffset>
+PseudoOpenFile::knownSize() const {
+  Terminator{__FILE__, __LINE__}.Crash("unsupported");
+}
+
+void PseudoOpenFile::Open(OpenStatus, Fortran::common::optional<Action>,
+    Position, IoErrorHandler &handler) {
+  handler.Crash("%s: unsupported", RT_PRETTY_FUNCTION);
+}
+
+void PseudoOpenFile::Close(CloseStatus, IoErrorHandler &handler) {
+  handler.Crash("%s: unsupported", RT_PRETTY_FUNCTION);
+}
+
+std::size_t PseudoOpenFile::Read(
+    FileOffset, char *, std::size_t, std::size_t, IoErrorHandler &handler) {
+  handler.Crash("%s: unsupported", RT_PRETTY_FUNCTION);
+}
+
+std::size_t PseudoOpenFile::Write(FileOffset at, const char *buffer,
+    std::size_t bytes, IoErrorHandler &handler) {
+  if (at) {
+    handler.Crash("%s: unsupported", RT_PRETTY_FUNCTION);
+  }
+  // TODO: use persistent string buffer that can be reallocated
+  // as needed, and only freed at destruction of *this.
+  auto string{SizedNew<char>{handler}(bytes + 1)};
+  std::memcpy(string.get(), buffer, bytes);
+  string.get()[bytes] = '\0';
+  std::printf("%s", string.get());
+  return bytes;
+}
+
+void PseudoOpenFile::Truncate(FileOffset, IoErrorHandler &handler) {
+  handler.Crash("%s: unsupported", RT_PRETTY_FUNCTION);
+}
+
+int PseudoOpenFile::ReadAsynchronously(
+    FileOffset, char *, std::size_t, IoErrorHandler &handler) {
+  handler.Crash("%s: unsupported", RT_PRETTY_FUNCTION);
+}
+
+int PseudoOpenFile::WriteAsynchronously(
+    FileOffset, const char *, std::size_t, IoErrorHandler &handler) {
+  handler.Crash("%s: unsupported", RT_PRETTY_FUNCTION);
+}
+
+void PseudoOpenFile::Wait(int, IoErrorHandler &handler) {
+  handler.Crash("%s: unsupported", RT_PRETTY_FUNCTION);
+}
+
+void PseudoOpenFile::WaitAll(IoErrorHandler &handler) {
+  handler.Crash("%s: unsupported", RT_PRETTY_FUNCTION);
+}
+
+Position PseudoOpenFile::InquirePosition() const {
+  Terminator{__FILE__, __LINE__}.Crash("%s: unsupported", RT_PRETTY_FUNCTION);
+}
+
+} // namespace Fortran::runtime::io
+
+#endif // defined(RT_USE_PSEUDO_FILE_UNIT)

diff  --git a/flang/runtime/tools.h b/flang/runtime/tools.h
index df25eb8882335b..c70a1b438e3329 100644
--- a/flang/runtime/tools.h
+++ b/flang/runtime/tools.h
@@ -21,6 +21,27 @@
 #include <map>
 #include <type_traits>
 
+/// \macro RT_PRETTY_FUNCTION
+/// Gets a user-friendly looking function signature for the current scope
+/// using the best available method on each platform.  The exact format of the
+/// resulting string is implementation specific and non-portable, so this should
+/// only be used, for example, for logging or diagnostics.
+/// Copy of LLVM_PRETTY_FUNCTION
+#if defined(_MSC_VER)
+#define RT_PRETTY_FUNCTION __FUNCSIG__
+#elif defined(__GNUC__) || defined(__clang__)
+#define RT_PRETTY_FUNCTION __PRETTY_FUNCTION__
+#else
+#define RT_PRETTY_FUNCTION __func__
+#endif
+
+#if defined(RT_DEVICE_COMPILATION)
+// Use the pseudo lock and pseudo file unit implementations
+// for the device.
+#define RT_USE_PSEUDO_LOCK 1
+#define RT_USE_PSEUDO_FILE_UNIT 1
+#endif
+
 namespace Fortran::runtime {
 
 class Terminator;

diff  --git a/flang/runtime/unit.cpp b/flang/runtime/unit.cpp
index 82f0e68cc20a26..67f4775ae0a99b 100644
--- a/flang/runtime/unit.cpp
+++ b/flang/runtime/unit.cpp
@@ -5,293 +5,23 @@
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
-
+//
+// Implementation of ExternalFileUnit common for both
+// RT_USE_PSEUDO_FILE_UNIT=0 and RT_USE_PSEUDO_FILE_UNIT=1.
+//
+//===----------------------------------------------------------------------===//
 #include "unit.h"
 #include "io-error.h"
 #include "lock.h"
 #include "tools.h"
-#include "unit-map.h"
-#include "flang/Runtime/magic-numbers.h"
-#include <cstdio>
 #include <limits>
 #include <utility>
 
 namespace Fortran::runtime::io {
 
-// The per-unit data structures are created on demand so that Fortran I/O
-// should work without a Fortran main program.
-static Lock unitMapLock;
-static Lock createOpenLock;
-static UnitMap *unitMap{nullptr};
-static ExternalFileUnit *defaultInput{nullptr}; // unit 5
-static ExternalFileUnit *defaultOutput{nullptr}; // unit 6
-static ExternalFileUnit *errorOutput{nullptr}; // unit 0 extension
-
-void FlushOutputOnCrash(const Terminator &terminator) {
-  if (!defaultOutput && !errorOutput) {
-    return;
-  }
-  IoErrorHandler handler{terminator};
-  handler.HasIoStat(); // prevent nested crash if flush has error
-  CriticalSection critical{unitMapLock};
-  if (defaultOutput) {
-    defaultOutput->FlushOutput(handler);
-  }
-  if (errorOutput) {
-    errorOutput->FlushOutput(handler);
-  }
-}
-
-ExternalFileUnit *ExternalFileUnit::LookUp(int unit) {
-  return GetUnitMap().LookUp(unit);
-}
-
-ExternalFileUnit *ExternalFileUnit::LookUpOrCreate(
-    int unit, const Terminator &terminator, bool &wasExtant) {
-  return GetUnitMap().LookUpOrCreate(unit, terminator, wasExtant);
-}
-
-ExternalFileUnit *ExternalFileUnit::LookUpOrCreateAnonymous(int unit,
-    Direction dir, Fortran::common::optional<bool> isUnformatted,
-    const Terminator &terminator) {
-  // Make sure that the returned anonymous unit has been opened
-  // not just created in the unitMap.
-  CriticalSection critical{createOpenLock};
-  bool exists{false};
-  ExternalFileUnit *result{
-      GetUnitMap().LookUpOrCreate(unit, terminator, exists)};
-  if (result && !exists) {
-    IoErrorHandler handler{terminator};
-    result->OpenAnonymousUnit(
-        dir == Direction::Input ? OpenStatus::Unknown : OpenStatus::Replace,
-        Action::ReadWrite, Position::Rewind, Convert::Unknown, handler);
-    result->isUnformatted = isUnformatted;
-  }
-  return result;
-}
-
-ExternalFileUnit *ExternalFileUnit::LookUp(
-    const char *path, std::size_t pathLen) {
-  return GetUnitMap().LookUp(path, pathLen);
-}
-
-ExternalFileUnit &ExternalFileUnit::CreateNew(
-    int unit, const Terminator &terminator) {
-  bool wasExtant{false};
-  ExternalFileUnit *result{
-      GetUnitMap().LookUpOrCreate(unit, terminator, wasExtant)};
-  RUNTIME_CHECK(terminator, result && !wasExtant);
-  return *result;
-}
-
-ExternalFileUnit *ExternalFileUnit::LookUpForClose(int unit) {
-  return GetUnitMap().LookUpForClose(unit);
-}
-
-ExternalFileUnit &ExternalFileUnit::NewUnit(
-    const Terminator &terminator, bool forChildIo) {
-  ExternalFileUnit &unit{GetUnitMap().NewUnit(terminator)};
-  unit.createdForInternalChildIo_ = forChildIo;
-  return unit;
-}
-
-bool ExternalFileUnit::OpenUnit(Fortran::common::optional<OpenStatus> status,
-    Fortran::common::optional<Action> action, Position position,
-    OwningPtr<char> &&newPath, std::size_t newPathLength, Convert convert,
-    IoErrorHandler &handler) {
-  if (convert == Convert::Unknown) {
-    convert = executionEnvironment.conversion;
-  }
-  swapEndianness_ = convert == Convert::Swap ||
-      (convert == Convert::LittleEndian && !isHostLittleEndian) ||
-      (convert == Convert::BigEndian && isHostLittleEndian);
-  bool impliedClose{false};
-  if (IsConnected()) {
-    bool isSamePath{newPath.get() && path() && pathLength() == newPathLength &&
-        std::memcmp(path(), newPath.get(), newPathLength) == 0};
-    if (status && *status != OpenStatus::Old && isSamePath) {
-      handler.SignalError("OPEN statement for connected unit may not have "
-                          "explicit STATUS= other than 'OLD'");
-      return impliedClose;
-    }
-    if (!newPath.get() || isSamePath) {
-      // OPEN of existing unit, STATUS='OLD' or unspecified, not new FILE=
-      newPath.reset();
-      return impliedClose;
-    }
-    // Otherwise, OPEN on open unit with new FILE= implies CLOSE
-    DoImpliedEndfile(handler);
-    FlushOutput(handler);
-    TruncateFrame(0, handler);
-    Close(CloseStatus::Keep, handler);
-    impliedClose = true;
-  }
-  if (newPath.get() && newPathLength > 0) {
-    if (const auto *already{
-            GetUnitMap().LookUp(newPath.get(), newPathLength)}) {
-      handler.SignalError(IostatOpenAlreadyConnected,
-          "OPEN(UNIT=%d,FILE='%.*s'): file is already connected to unit %d",
-          unitNumber_, static_cast<int>(newPathLength), newPath.get(),
-          already->unitNumber_);
-      return impliedClose;
-    }
-  }
-  set_path(std::move(newPath), newPathLength);
-  Open(status.value_or(OpenStatus::Unknown), action, position, handler);
-  auto totalBytes{knownSize()};
-  if (access == Access::Direct) {
-    if (!openRecl) {
-      handler.SignalError(IostatOpenBadRecl,
-          "OPEN(UNIT=%d,ACCESS='DIRECT'): record length is not known",
-          unitNumber());
-    } else if (*openRecl <= 0) {
-      handler.SignalError(IostatOpenBadRecl,
-          "OPEN(UNIT=%d,ACCESS='DIRECT',RECL=%jd): record length is invalid",
-          unitNumber(), static_cast<std::intmax_t>(*openRecl));
-    } else if (totalBytes && (*totalBytes % *openRecl != 0)) {
-      handler.SignalError(IostatOpenBadRecl,
-          "OPEN(UNIT=%d,ACCESS='DIRECT',RECL=%jd): record length is not an "
-          "even divisor of the file size %jd",
-          unitNumber(), static_cast<std::intmax_t>(*openRecl),
-          static_cast<std::intmax_t>(*totalBytes));
-    }
-    recordLength = openRecl;
-  }
-  endfileRecordNumber.reset();
-  currentRecordNumber = 1;
-  if (totalBytes && access == Access::Direct && openRecl.value_or(0) > 0) {
-    endfileRecordNumber = 1 + (*totalBytes / *openRecl);
-  }
-  if (position == Position::Append) {
-    if (totalBytes) {
-      frameOffsetInFile_ = *totalBytes;
-    }
-    if (access != Access::Stream) {
-      if (!endfileRecordNumber) {
-        // Fake it so that we can backspace relative from the end
-        endfileRecordNumber = std::numeric_limits<std::int64_t>::max() - 2;
-      }
-      currentRecordNumber = *endfileRecordNumber;
-    }
-  }
-  return impliedClose;
-}
-
-void ExternalFileUnit::OpenAnonymousUnit(
-    Fortran::common::optional<OpenStatus> status,
-    Fortran::common::optional<Action> action, Position position,
-    Convert convert, IoErrorHandler &handler) {
-  // I/O to an unconnected unit reads/creates a local file, e.g. fort.7
-  std::size_t pathMaxLen{32};
-  auto path{SizedNew<char>{handler}(pathMaxLen)};
-  std::snprintf(path.get(), pathMaxLen, "fort.%d", unitNumber_);
-  OpenUnit(status, action, position, std::move(path), std::strlen(path.get()),
-      convert, handler);
-}
-
-void ExternalFileUnit::CloseUnit(CloseStatus status, IoErrorHandler &handler) {
-  DoImpliedEndfile(handler);
-  FlushOutput(handler);
-  Close(status, handler);
-}
-
-void ExternalFileUnit::DestroyClosed() {
-  GetUnitMap().DestroyClosed(*this); // destroys *this
-}
-
-Iostat ExternalFileUnit::SetDirection(Direction direction) {
-  if (direction == Direction::Input) {
-    if (mayRead()) {
-      direction_ = Direction::Input;
-      return IostatOk;
-    } else {
-      return IostatReadFromWriteOnly;
-    }
-  } else {
-    if (mayWrite()) {
-      direction_ = Direction::Output;
-      return IostatOk;
-    } else {
-      return IostatWriteToReadOnly;
-    }
-  }
-}
-
-UnitMap &ExternalFileUnit::CreateUnitMap() {
-  Terminator terminator{__FILE__, __LINE__};
-  IoErrorHandler handler{terminator};
-  UnitMap &newUnitMap{*New<UnitMap>{terminator}().release()};
-
-  bool wasExtant{false};
-  ExternalFileUnit &out{*newUnitMap.LookUpOrCreate(
-      FORTRAN_DEFAULT_OUTPUT_UNIT, terminator, wasExtant)};
-  RUNTIME_CHECK(terminator, !wasExtant);
-  out.Predefine(1);
-  handler.SignalError(out.SetDirection(Direction::Output));
-  out.isUnformatted = false;
-  defaultOutput = &out;
-
-  ExternalFileUnit &in{*newUnitMap.LookUpOrCreate(
-      FORTRAN_DEFAULT_INPUT_UNIT, terminator, wasExtant)};
-  RUNTIME_CHECK(terminator, !wasExtant);
-  in.Predefine(0);
-  handler.SignalError(in.SetDirection(Direction::Input));
-  in.isUnformatted = false;
-  defaultInput = ∈
-
-  ExternalFileUnit &error{
-      *newUnitMap.LookUpOrCreate(FORTRAN_ERROR_UNIT, terminator, wasExtant)};
-  RUNTIME_CHECK(terminator, !wasExtant);
-  error.Predefine(2);
-  handler.SignalError(error.SetDirection(Direction::Output));
-  error.isUnformatted = false;
-  errorOutput = &error;
-
-  return newUnitMap;
-}
-
-// A back-up atexit() handler for programs that don't terminate with a main
-// program END or a STOP statement or other Fortran-initiated program shutdown,
-// such as programs with a C main() that terminate normally.  It flushes all
-// external I/O units.  It is registered once the first time that any external
-// I/O is attempted.
-static void CloseAllExternalUnits() {
-  IoErrorHandler handler{"Fortran program termination"};
-  ExternalFileUnit::CloseAll(handler);
-}
-
-UnitMap &ExternalFileUnit::GetUnitMap() {
-  if (unitMap) {
-    return *unitMap;
-  }
-  {
-    CriticalSection critical{unitMapLock};
-    if (unitMap) {
-      return *unitMap;
-    }
-    unitMap = &CreateUnitMap();
-  }
-  std::atexit(CloseAllExternalUnits);
-  return *unitMap;
-}
-
-void ExternalFileUnit::CloseAll(IoErrorHandler &handler) {
-  CriticalSection critical{unitMapLock};
-  if (unitMap) {
-    unitMap->CloseAll(handler);
-    FreeMemoryAndNullify(unitMap);
-  }
-  defaultOutput = nullptr;
-  defaultInput = nullptr;
-  errorOutput = nullptr;
-}
-
-void ExternalFileUnit::FlushAll(IoErrorHandler &handler) {
-  CriticalSection critical{unitMapLock};
-  if (unitMap) {
-    unitMap->FlushAll(handler);
-  }
-}
+ExternalFileUnit *defaultInput{nullptr}; // unit 5
+ExternalFileUnit *defaultOutput{nullptr}; // unit 6
+ExternalFileUnit *errorOutput{nullptr}; // unit 0 extension
 
 static inline void SwapEndianness(
     char *data, std::size_t bytes, std::size_t elementBytes) {
@@ -999,39 +729,6 @@ void ExternalFileUnit::PopChildIo(ChildIo &child) {
   child_.reset(child.AcquirePrevious().release()); // deletes top child
 }
 
-int ExternalFileUnit::GetAsynchronousId(IoErrorHandler &handler) {
-  if (!mayAsynchronous()) {
-    handler.SignalError(IostatBadAsynchronous);
-    return -1;
-  } else {
-    for (int j{0}; 64 * j < maxAsyncIds; ++j) {
-      if (auto least{asyncIdAvailable_[j].LeastElement()}) {
-        asyncIdAvailable_[j].reset(*least);
-        return 64 * j + static_cast<int>(*least);
-      }
-    }
-    handler.SignalError(IostatTooManyAsyncOps);
-    return -1;
-  }
-}
-
-bool ExternalFileUnit::Wait(int id) {
-  if (static_cast<std::size_t>(id) >= maxAsyncIds ||
-      asyncIdAvailable_[id / 64].test(id % 64)) {
-    return false;
-  } else {
-    if (id == 0) { // means "all IDs"
-      for (int j{0}; 64 * j < maxAsyncIds; ++j) {
-        asyncIdAvailable_[j].set();
-      }
-      asyncIdAvailable_[0].reset(0);
-    } else {
-      asyncIdAvailable_[id / 64].set(id % 64);
-    }
-    return true;
-  }
-}
-
 std::int32_t ExternalFileUnit::ReadHeaderOrFooter(std::int64_t frameOffset) {
   std::int32_t word;
   char *wordPtr{reinterpret_cast<char *>(&word)};

diff  --git a/flang/runtime/unit.h b/flang/runtime/unit.h
index fc5bead7e1d930..5f854abd42f645 100644
--- a/flang/runtime/unit.h
+++ b/flang/runtime/unit.h
@@ -31,10 +31,67 @@ namespace Fortran::runtime::io {
 
 class UnitMap;
 class ChildIo;
+class ExternalFileUnit;
+
+// Predefined file units.
+extern ExternalFileUnit *defaultInput; // unit 5
+extern ExternalFileUnit *defaultOutput; // unit 6
+extern ExternalFileUnit *errorOutput; // unit 0 extension
+
+#if defined(RT_USE_PSEUDO_FILE_UNIT)
+// A flavor of OpenFile class that pretends to be a terminal,
+// and only provides basic buffering of the output
+// in an internal buffer, and Write's the output
+// using std::printf(). Since it does not rely on file system
+// APIs, it can be used to implement external output
+// for offload devices.
+class PseudoOpenFile {
+public:
+  using FileOffset = std::int64_t;
+
+  const char *path() const { return nullptr; }
+  std::size_t pathLength() const { return 0; }
+  void set_path(OwningPtr<char> &&, std::size_t bytes) {}
+  bool mayRead() const { return false; }
+  bool mayWrite() const { return true; }
+  bool mayPosition() const { return false; }
+  bool mayAsynchronous() const { return false; }
+  void set_mayAsynchronous(bool yes);
+  // Pretend to be a terminal to force the output
+  // at the end of IO statement.
+  bool isTerminal() const { return true; }
+  bool isWindowsTextFile() const { return false; }
+  Fortran::common::optional<FileOffset> knownSize() const;
+  bool IsConnected() const { return false; }
+  void Open(OpenStatus, Fortran::common::optional<Action>, Position,
+      IoErrorHandler &);
+  void Predefine(int fd) {}
+  void Close(CloseStatus, IoErrorHandler &);
+  std::size_t Read(FileOffset, char *, std::size_t minBytes,
+      std::size_t maxBytes, IoErrorHandler &);
+  std::size_t Write(FileOffset, const char *, std::size_t, IoErrorHandler &);
+  void Truncate(FileOffset, IoErrorHandler &);
+  int ReadAsynchronously(FileOffset, char *, std::size_t, IoErrorHandler &);
+  int WriteAsynchronously(
+      FileOffset, const char *, std::size_t, IoErrorHandler &);
+  void Wait(int id, IoErrorHandler &);
+  void WaitAll(IoErrorHandler &);
+  Position InquirePosition() const;
+};
+#endif // defined(RT_USE_PSEUDO_FILE_UNIT)
+
+#if !defined(RT_USE_PSEUDO_FILE_UNIT)
+using OpenFileClass = OpenFile;
+using FileFrameClass = FileFrame<ExternalFileUnit>;
+#else // defined(RT_USE_PSEUDO_FILE_UNIT)
+using OpenFileClass = PseudoOpenFile;
+// Use not so big buffer for the pseudo file unit frame.
+using FileFrameClass = FileFrame<ExternalFileUnit, 1024>;
+#endif // defined(RT_USE_PSEUDO_FILE_UNIT)
 
 class ExternalFileUnit : public ConnectionState,
-                         public OpenFile,
-                         public FileFrame<ExternalFileUnit> {
+                         public OpenFileClass,
+                         public FileFrameClass {
 public:
   static constexpr int maxAsyncIds{64 * 16};
 


        


More information about the flang-commits mailing list