[flang] Initial buffer framing code

Address review comments

Integer output data editing (I,B,O,Z)

Full integer output formatting

Stub out some work in progress

Progress on E output data editing

E, D, EN, and ES output editing done

Fw.d output editing

Real G output editing

G output editing for reals

Make environment a distinct module

CHARACTER and LOGICAL output editing

Minimal decimal representations for E0, F0, G0 editing

Move real output editing code into its own file

Fix/dodge some GCC build problems

Prep work for external I/O statement state

External HELLO, WORLD

Fix build problem with GCC

Add virtual destructors where needed

Add new test

Original-commit: flang-compiler/f18@c3f1774f8e
Reviewed-on: https://github.com/flang-compiler/f18/pull/950

flang/lib/decimal/binary-to-decimal.cpp

@@ -108,7 +108,7 @@ template<int PREC, int LOG10RADIX>
 ConversionToDecimalResult
 BigRadixFloatingPointNumber<PREC, LOG10RADIX>::ConvertToDecimal(char *buffer,
     std::size_t n, enum DecimalConversionFlags flags, int maxDigits) const {
-  if (n < static_cast<std::size_t>(3 + digits_ * LOG10RADIX) || maxDigits < 1) {
+  if (n < static_cast<std::size_t>(3 + digits_ * LOG10RADIX)) {
     return {nullptr, 0, 0, Overflow};
   }
   char *start{buffer};
@@ -160,18 +160,21 @@ BigRadixFloatingPointNumber<PREC, LOG10RADIX>::ConvertToDecimal(char *buffer,
   while (p[-1] == '0') {
     --p;
   }
-  if (p <= start + maxDigits) {
+  char *end{start + maxDigits};
+  if (maxDigits == 0) {
+    p = end;
+  }
+  if (p <= end) {
     *p = '\0';
     return {buffer, static_cast<std::size_t>(p - buffer), expo, Exact};
   } else {
     // Apply a digit limit, possibly with rounding.
-    char *end{start + maxDigits};
     bool incr{false};
     switch (rounding_) {
     case RoundNearest:
     case RoundDefault:
-      incr =
-          *end > '5' || (*end == '5' && (p > end || ((p[-1] - '0') & 1) != 0));
+      incr = *end > '5' ||
+          (*end == '5' && (p > end + 1 || ((end[-1] - '0') & 1) != 0));
       break;
     case RoundUp: incr = !isNegative_; break;
     case RoundDown: incr = isNegative_; break;
@@ -190,6 +193,7 @@ BigRadixFloatingPointNumber<PREC, LOG10RADIX>::ConvertToDecimal(char *buffer,
         ++p[-1];
       }
     }
+
     *p = '\0';
     return {buffer, static_cast<std::size_t>(p - buffer), expo, Inexact};
   }

flang/runtime/CMakeLists.txt

@@ -8,8 +8,10 @@
 
 add_library(FortranRuntime
   ISO_Fortran_binding.cpp
+  buffer.cpp
   derived-type.cpp
   descriptor.cpp
+  environment.cpp
   file.cpp
   format.cpp
   io-api.cpp
@@ -22,6 +24,7 @@ add_library(FortranRuntime
   tools.cpp
   transformational.cpp
   type-code.cpp
+  unit.cpp
 )
 
 target_link_libraries(FortranRuntime

flang/runtime/buffer.cpp

@@ -0,0 +1,23 @@
+//===-- runtime/buffer.cpp --------------------------------------*- C++ -*-===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+
+#include "buffer.h"
+#include <algorithm>
+
+namespace Fortran::runtime::io {
+
+// Here's a very old trick for shifting circular buffer data cheaply
+// without a need for a temporary array.
+void LeftShiftBufferCircularly(
+    char *buffer, std::size_t bytes, std::size_t shift) {
+  // Assume that we start with "efgabcd" and the left shift is 3.
+  std::reverse(buffer, buffer + shift);  // "gfeabcd"
+  std::reverse(buffer, buffer + bytes);  // "dcbaefg"
+  std::reverse(buffer, buffer + bytes - shift);  // "abcdefg"
+}
+}

flang/runtime/buffer.h

@@ -0,0 +1,178 @@
+//===-- runtime/buffer.h ----------------------------------------*- C++ -*-===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+
+// External file buffering
+
+#ifndef FORTRAN_RUNTIME_BUFFER_H_
+#define FORTRAN_RUNTIME_BUFFER_H_
+
+#include "io-error.h"
+#include "memory.h"
+#include <algorithm>
+#include <cinttypes>
+#include <cstring>
+
+namespace Fortran::runtime::io {
+
+void LeftShiftBufferCircularly(char *, std::size_t bytes, std::size_t shift);
+
+// Maintains a view of a contiguous region of a file in a memory buffer.
+// The valid data in the buffer may be circular, but any active frame
+// will also be contiguous in memory.  The requirement stems from the need to
+// preserve read data that may be reused by means of Tn/TLn edit descriptors
+// without needing to position the file (which may not always be possible,
+// e.g. a socket) and a general desire to reduce system call counts.
+template<typename STORE> class FileFrame {
+public:
+  using FileOffset = std::int64_t;
+
+  ~FileFrame() { FreeMemoryAndNullify(buffer_); }
+
+  // The valid data in the buffer begins at buffer_[start_] and proceeds
+  // with possible wrap-around for length_ bytes.  The current frame
+  // is offset by frame_ bytes into that region and is guaranteed to
+  // be contiguous for at least as many bytes as were requested.
+
+  FileOffset FrameAt() const { return fileOffset_ + frame_; }
+  char *Frame() const { return buffer_ + start_ + frame_; }
+  std::size_t FrameLength() const {
+    return std::min(
+        static_cast<std::size_t>(length_ - frame_), size_ - (start_ + frame_));
+  }
+
+  // Returns a short frame at a non-fatal EOF.  Can return a long frame as well.
+  std::size_t ReadFrame(
+      FileOffset at, std::size_t bytes, IoErrorHandler &handler) {
+    Flush(handler);
+    Reallocate(bytes, handler);
+    if (at < fileOffset_ || at > fileOffset_ + length_) {
+      Reset(at);
+    }
+    frame_ = static_cast<std::size_t>(at - fileOffset_);
+    if (start_ + frame_ + bytes > size_) {
+      DiscardLeadingBytes(frame_, handler);
+      if (start_ + bytes > size_) {
+        // Frame would wrap around; shift current data (if any) to force
+        // contiguity.
+        RUNTIME_CHECK(handler, length_ < size_);
+        if (start_ + length_ <= size_) {
+          // [......abcde..] -> [abcde........]
+          std::memmove(buffer_, buffer_ + start_, length_);
+        } else {
+          // [cde........ab] -> [abcde........]
+          auto n{start_ + length_ - size_};  // 3 for cde
+          auto gap{size_ - length_};  // 13 - 5 = 8
+          RUNTIME_CHECK(handler, length_ >= n);
+          std::memmove(buffer_ + n, buffer_ + start_, length_ - n);  // cdeab
+          LeftShiftBufferCircularly(buffer_, length_, n);  // abcde
+        }
+        start_ = 0;
+      }
+    }
+    while (FrameLength() < bytes) {
+      auto next{start_ + length_};
+      RUNTIME_CHECK(handler, next < size_);
+      auto minBytes{bytes - FrameLength()};
+      auto maxBytes{size_ - next};
+      auto got{Store().Read(
+          fileOffset_ + length_, buffer_ + next, minBytes, maxBytes, handler)};
+      length_ += got;
+      RUNTIME_CHECK(handler, length_ < size_);
+      if (got < minBytes) {
+        break;  // error or EOF & program can handle it
+      }
+    }
+    return FrameLength();
+  }
+
+  void WriteFrame(FileOffset at, std::size_t bytes, IoErrorHandler &handler) {
+    if (!dirty_ || at < fileOffset_ || at > fileOffset_ + length_ ||
+        start_ + (at - fileOffset_) + bytes > size_) {
+      Flush(handler);
+      fileOffset_ = at;
+      Reallocate(bytes, handler);
+    }
+    dirty_ = true;
+    frame_ = at - fileOffset_;
+    length_ = std::max(length_, static_cast<std::int64_t>(frame_ + bytes));
+  }
+
+  void Flush(IoErrorHandler &handler) {
+    if (dirty_) {
+      while (length_ > 0) {
+        std::size_t chunk{std::min(static_cast<std::size_t>(length_),
+            static_cast<std::size_t>(size_ - start_))};
+        std::size_t put{
+            Store().Write(fileOffset_, buffer_ + start_, chunk, handler)};
+        length_ -= put;
+        start_ += put;
+        fileOffset_ += put;
+        if (put < chunk) {
+          break;
+        }
+      }
+      Reset(fileOffset_);
+    }
+  }
+
+private:
+  STORE &Store() { return static_cast<STORE &>(*this); }
+
+  void Reallocate(std::size_t bytes, Terminator &terminator) {
+    if (bytes > size_) {
+      char *old{buffer_};
+      auto oldSize{size_};
+      size_ = std::max(bytes, minBuffer);
+      buffer_ =
+          reinterpret_cast<char *>(AllocateMemoryOrCrash(terminator, size_));
+      auto chunk{
+          std::min(length_, static_cast<std::int64_t>(oldSize - start_))};
+      std::memcpy(buffer_, old + start_, chunk);
+      start_ = 0;
+      std::memcpy(buffer_ + chunk, old, length_ - chunk);
+      FreeMemory(old);
+    }
+  }
+
+  void Reset(FileOffset at) {
+    start_ = length_ = frame_ = 0;
+    fileOffset_ = at;
+    dirty_ = false;
+  }
+
+  void DiscardLeadingBytes(std::size_t n, Terminator &terminator) {
+    RUNTIME_CHECK(terminator, length_ >= n);
+    length_ -= n;
+    if (length_ == 0) {
+      start_ = 0;
+    } else {
+      start_ += n;
+      if (start_ >= size_) {
+        start_ -= size_;
+      }
+    }
+    if (frame_ >= n) {
+      frame_ -= n;
+    } else {
+      frame_ = 0;
+    }
+    fileOffset_ += n;
+  }
+
+  static constexpr std::size_t minBuffer{64 << 10};
+
+  char *buffer_{nullptr};
+  std::size_t size_{0};  // current allocated buffer size
+  FileOffset fileOffset_{0};  // file offset corresponding to buffer valid data
+  std::int64_t start_{0};  // buffer_[] offset of valid data
+  std::int64_t length_{0};  // valid data length (can wrap)
+  std::int64_t frame_{0};  // offset of current frame in valid data
+  bool dirty_{false};
+};
+}
+#endif  // FORTRAN_RUNTIME_BUFFER_H_

flang/runtime/environment.cpp

@@ -0,0 +1,37 @@
+//===-- runtime/environment.cpp ---------------------------------*- C++ -*-===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+
+#include "environment.h"
+#include <cstdlib>
+#include <limits>
+
+namespace Fortran::runtime {
+ExecutionEnvironment executionEnvironment;
+
+void ExecutionEnvironment::Configure(
+    int ac, const char *av[], const char *env[]) {
+  argc = ac;
+  argv = av;
+  envp = env;
+  listDirectedOutputLineLengthLimit = 79;  // PGI default
+  defaultOutputRoundingMode = common::RoundingMode::TiesToEven;  // RP=RN
+
+  if (auto *x{std::getenv("FORT_FMT_RECL")}) {
+    char *end;
+    auto n{std::strtol(x, &end, 10)};
+    if (n > 0 && n < std::numeric_limits<int>::max() && *end == '\0') {
+      listDirectedOutputLineLengthLimit = n;
+    } else {
+      std::fprintf(
+          stderr, "Fortran runtime: FORT_FMT_RECL=%s is invalid; ignored\n", x);
+    }
+  }
+
+  // TODO: Set RP/ROUND='PROCESSOR_DEFINED' from environment
+}
+}

flang/runtime/environment.h

@@ -0,0 +1,26 @@
+//===-- runtime/environment.h -----------------------------------*- C++ -*-===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_RUNTIME_ENVIRONMENT_H_
+#define FORTRAN_RUNTIME_ENVIRONMENT_H_
+
+#include "flang/common/Fortran.h"
+
+namespace Fortran::runtime {
+struct ExecutionEnvironment {
+  void Configure(int argc, const char *argv[], const char *envp[]);
+
+  int argc;
+  const char **argv;
+  const char **envp;
+  int listDirectedOutputLineLengthLimit;
+  common::RoundingMode defaultOutputRoundingMode;
+};
+extern ExecutionEnvironment executionEnvironment;
+}
+#endif  // FORTRAN_RUNTIME_ENVIRONMENT_H_

flang/runtime/file.cpp

@@ -22,13 +22,25 @@ void OpenFile::Open(const char *path, std::size_t pathLength,
     const char *status, std::size_t statusLength, const char *action,
     std::size_t actionLength, IoErrorHandler &handler) {
   CriticalSection criticalSection{lock_};
-  RUNTIME_CHECK(handler, fd_ < 0);
+  RUNTIME_CHECK(handler, fd_ < 0);  // TODO handle re-openings
   int flags{0};
   static const char *actions[]{"READ", "WRITE", "READWRITE", nullptr};
   switch (IdentifyValue(action, actionLength, actions)) {
-  case 0: flags = O_RDONLY; break;
-  case 1: flags = O_WRONLY; break;
-  case 2: flags = O_RDWR; break;
+  case 0:
+    flags = O_RDONLY;
+    mayRead_ = true;
+    mayWrite_ = false;
+    break;
+  case 1:
+    flags = O_WRONLY;
+    mayRead_ = false;
+    mayWrite_ = true;
+    break;
+  case 2:
+    mayRead_ = true;
+    mayWrite_ = true;
+    flags = O_RDWR;
+    break;
   default:
     handler.Crash(
         "Invalid ACTION='%.*s'", action, static_cast<int>(actionLength));
@@ -82,6 +94,7 @@ void OpenFile::Open(const char *path, std::size_t pathLength,
     }
   }
   path_ = SaveDefaultCharacter(path, pathLength, handler);
+  pathLength_ = pathLength;
   if (!path_.get()) {
     handler.Crash(
         "FILE= is required unless STATUS='OLD' and unit is connected");
@@ -94,6 +107,17 @@ void OpenFile::Open(const char *path, std::size_t pathLength,
   knownSize_.reset();
 }
 
+void OpenFile::Predefine(int fd) {
+  CriticalSection criticalSection{lock_};
+  fd_ = fd;
+  path_.reset();
+  pathLength_ = 0;
+  position_ = 0;
+  knownSize_.reset();
+  nextId_ = 0;
+  pending_.reset();
+}
+
 void OpenFile::Close(
     const char *status, std::size_t statusLength, IoErrorHandler &handler) {
   CriticalSection criticalSection{lock_};
@@ -123,7 +147,7 @@ void OpenFile::Close(
   }
 }
 
-std::size_t OpenFile::Read(Offset at, char *buffer, std::size_t minBytes,
+std::size_t OpenFile::Read(FileOffset at, char *buffer, std::size_t minBytes,
     std::size_t maxBytes, IoErrorHandler &handler) {
   if (maxBytes == 0) {
     return 0;
@@ -157,8 +181,8 @@ std::size_t OpenFile::Read(Offset at, char *buffer, std::size_t minBytes,
   return got;
 }
 
-std::size_t OpenFile::Write(
-    Offset at, const char *buffer, std::size_t bytes, IoErrorHandler &handler) {
+std::size_t OpenFile::Write(FileOffset at, const char *buffer,
+    std::size_t bytes, IoErrorHandler &handler) {
   if (bytes == 0) {
     return 0;
   }
@@ -187,7 +211,7 @@ std::size_t OpenFile::Write(
   return put;
 }
 
-void OpenFile::Truncate(Offset at, IoErrorHandler &handler) {
+void OpenFile::Truncate(FileOffset at, IoErrorHandler &handler) {
   CriticalSection criticalSection{lock_};
   CheckOpen(handler);
   if (!knownSize_ || *knownSize_ != at) {
@@ -202,7 +226,7 @@ void OpenFile::Truncate(Offset at, IoErrorHandler &handler) {
 // to be claimed by a later WAIT statement.
 // TODO: True asynchronicity
 int OpenFile::ReadAsynchronously(
-    Offset at, char *buffer, std::size_t bytes, IoErrorHandler &handler) {
+    FileOffset at, char *buffer, std::size_t bytes, IoErrorHandler &handler) {
   CriticalSection criticalSection{lock_};
   CheckOpen(handler);
   int iostat{0};
@@ -210,7 +234,7 @@ int OpenFile::ReadAsynchronously(
 #if _XOPEN_SOURCE >= 500 || _POSIX_C_SOURCE >= 200809L
     auto chunk{::pread(fd_, buffer + got, bytes - got, at)};
 #else
-    auto chunk{RawSeek(at) ? ::read(fd_, buffer + got, bytes - got) : -1};
+    auto chunk{Seek(at, handler) ? ::read(fd_, buffer + got, bytes - got) : -1};
 #endif
     if (chunk == 0) {
       iostat = FORTRAN_RUNTIME_IOSTAT_END;
@@ -231,8 +255,8 @@ int OpenFile::ReadAsynchronously(
 }
 
 // TODO: True asynchronicity
-int OpenFile::WriteAsynchronously(
-    Offset at, const char *buffer, std::size_t bytes, IoErrorHandler &handler) {
+int OpenFile::WriteAsynchronously(FileOffset at, const char *buffer,
+    std::size_t bytes, IoErrorHandler &handler) {
   CriticalSection criticalSection{lock_};
   CheckOpen(handler);
   int iostat{0};
@@ -240,7 +264,8 @@ int OpenFile::WriteAsynchronously(
 #if _XOPEN_SOURCE >= 500 || _POSIX_C_SOURCE >= 200809L
     auto chunk{::pwrite(fd_, buffer + put, bytes - put, at)};
 #else
-    auto chunk{RawSeek(at) ? ::write(fd_, buffer + put, bytes - put) : -1};
+    auto chunk{
+        Seek(at, handler) ? ::write(fd_, buffer + put, bytes - put) : -1};
 #endif
     if (chunk >= 0) {
       at += chunk;
@@ -298,7 +323,7 @@ void OpenFile::CheckOpen(Terminator &terminator) {
   RUNTIME_CHECK(terminator, fd_ >= 0);
 }
 
-bool OpenFile::Seek(Offset at, IoErrorHandler &handler) {
+bool OpenFile::Seek(FileOffset at, IoErrorHandler &handler) {
   if (at == position_) {
     return true;
   } else if (RawSeek(at)) {
@@ -310,7 +335,7 @@ bool OpenFile::Seek(Offset at, IoErrorHandler &handler) {
   }
 }
 
-bool OpenFile::RawSeek(Offset at) {
+bool OpenFile::RawSeek(FileOffset at) {
 #ifdef _LARGEFILE64_SOURCE
   return ::lseek64(fd_, at, SEEK_SET) == 0;
 #else

flang/runtime/file.h

@@ -14,7 +14,6 @@
 #include "io-error.h"
 #include "lock.h"
 #include "memory.h"
-#include "terminator.h"
 #include <cinttypes>
 #include <optional>
 
@@ -22,33 +21,43 @@ namespace Fortran::runtime::io {
 
 class OpenFile {
 public:
-  using Offset = std::uint64_t;
+  using FileOffset = std::int64_t;
 
-  Offset position() const { return position_; }
+  FileOffset position() const { return position_; }
 
   void Open(const char *path, std::size_t pathLength, const char *status,
       std::size_t statusLength, const char *action, std::size_t actionLength,
       IoErrorHandler &);
+  void Predefine(int fd);
   void Close(const char *action, std::size_t actionLength, IoErrorHandler &);
 
+  int fd() const { return fd_; }
+  bool mayRead() const { return mayRead_; }
+  bool mayWrite() const { return mayWrite_; }
+  bool mayPosition() const { return mayPosition_; }
+  void set_mayRead(bool yes) { mayRead_ = yes; }
+  void set_mayWrite(bool yes) { mayWrite_ = yes; }
+  void set_mayPosition(bool yes) { mayPosition_ = yes; }
+
   // Reads data into memory; returns amount acquired.  Synchronous.
   // Partial reads (less than minBytes) signify end-of-file.  If the
   // buffer is larger than minBytes, and extra returned data will be
   // preserved for future consumption, set maxBytes larger than minBytes
   // to reduce system calls  This routine handles EAGAIN/EWOULDBLOCK and EINTR.
-  std::size_t Read(Offset, char *, std::size_t minBytes, std::size_t maxBytes,
-      IoErrorHandler &);
+  std::size_t Read(FileOffset, char *, std::size_t minBytes,
+      std::size_t maxBytes, IoErrorHandler &);
 
   // Writes data.  Synchronous.  Partial writes indicate program-handled
   // error conditions.
-  std::size_t Write(Offset, const char *, std::size_t, IoErrorHandler &);
+  std::size_t Write(FileOffset, const char *, std::size_t, IoErrorHandler &);
 
   // Truncates the file
-  void Truncate(Offset, IoErrorHandler &);
+  void Truncate(FileOffset, IoErrorHandler &);
 
   // Asynchronous transfers
-  int ReadAsynchronously(Offset, char *, std::size_t, IoErrorHandler &);
-  int WriteAsynchronously(Offset, const char *, std::size_t, 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 &);
 
@@ -61,15 +70,19 @@ private:
 
   // lock_ must be held for these
   void CheckOpen(Terminator &);
-  bool Seek(Offset, IoErrorHandler &);
-  bool RawSeek(Offset);
+  bool Seek(FileOffset, IoErrorHandler &);
+  bool RawSeek(FileOffset);
   int PendingResult(Terminator &, int);
 
   Lock lock_;
   int fd_{-1};
   OwningPtr<char> path_;
-  Offset position_{0};
-  std::optional<Offset> knownSize_;
+  std::size_t pathLength_;
+  bool mayRead_{false};
+  bool mayWrite_{false};
+  bool mayPosition_{false};
+  FileOffset position_{0};
+  std::optional<FileOffset> knownSize_;
   int nextId_;
   OwningPtr<Pending> pending_;
 };

flang/runtime/format.cpp

@@ -8,43 +8,25 @@
 
 #include "format.h"
 #include "io-stmt.h"
+#include "main.h"
 #include "flang/common/format.h"
 #include "flang/decimal/decimal.h"
 #include <limits>
 
 namespace Fortran::runtime::io {
 
-// Default FormatContext virtual member functions
-void FormatContext::Emit(const char *, std::size_t) {
-  Crash("Cannot emit data from this FORMAT string");
-}
-void FormatContext::Emit(const char16_t *, std::size_t) {
-  Crash("Cannot emit data from this FORMAT string");
-}
-void FormatContext::Emit(const char32_t *, std::size_t) {
-  Crash("Cannot emit data from this FORMAT string");
-}
-void FormatContext::HandleSlash(int) {
-  Crash("A / control edit descriptor may not appear in this FORMAT string");
-}
-void FormatContext::HandleAbsolutePosition(int) {
-  Crash("A Tn control edit descriptor may not appear in this FORMAT string");
-}
-void FormatContext::HandleRelativePosition(int) {
-  Crash("An nX, TLn, or TRn control edit descriptor may not appear in this "
-        "FORMAT string");
-}
-
 template<typename CHAR>
 FormatControl<CHAR>::FormatControl(Terminator &terminator, const CHAR *format,
     std::size_t formatLength, int maxHeight)
   : maxHeight_{static_cast<std::uint8_t>(maxHeight)}, format_{format},
     formatLength_{static_cast<int>(formatLength)} {
-  // The additional two items are for the whole string and a
-  // repeated non-parenthesized edit descriptor.
-  if (maxHeight > std::numeric_limits<std::int8_t>::max()) {
+  if (maxHeight != maxHeight_) {
     terminator.Crash("internal Fortran runtime error: maxHeight %d", maxHeight);
   }
+  if (formatLength != static_cast<std::size_t>(formatLength_)) {
+    terminator.Crash(
+        "internal Fortran runtime error: formatLength %zd", formatLength);
+  }
   stack_[0].start = offset_;
   stack_[0].remaining = Iteration::unlimited;  // 13.4(8)
 }
@@ -95,8 +77,7 @@ int FormatControl<CHAR>::GetIntField(Terminator &terminator, CHAR firstCh) {
   return result;
 }
 
-static void HandleControl(
-    FormatContext &context, std::uint16_t &scale, char ch, char next, int n) {
+static void HandleControl(FormatContext &context, char ch, char next, int n) {
   MutableModes &modes{context.mutableModes()};
   switch (ch) {
   case 'B':
@@ -121,7 +102,7 @@ static void HandleControl(
     break;
   case 'P':
     if (!next) {
-      scale = n;  // kP - decimal scaling by 10**k (TODO)
+      modes.scale = n;  // kP - decimal scaling by 10**k
       return;
     }
     break;
@@ -134,6 +115,9 @@ static void HandleControl(
     case 'C':
       modes.roundingMode = common::RoundingMode::TiesAwayFromZero;
       return;
+    case 'P':
+      modes.roundingMode = executionEnvironment.defaultOutputRoundingMode;
+      return;
     default: break;
     }
     break;
@@ -269,13 +253,15 @@ int FormatControl<CHAR>::CueUpNextDataEdit(FormatContext &context, bool stop) {
     } else if (ch >= 'A' && ch <= 'Z') {
       int start{offset_ - 1};
       CHAR next{Capitalize(PeekNext())};
-      if (next < 'A' || next > 'Z') {
+      if (next >= 'A' && next <= 'Z') {
+        ++offset_;
+      } else {
         next = '\0';
       }
       if (ch == 'E' ||
           (!next &&
               (ch == 'A' || ch == 'I' || ch == 'B' || ch == 'O' || ch == 'Z' ||
-                  ch == 'F' || ch == 'D' || ch == 'G'))) {
+                  ch == 'F' || ch == 'D' || ch == 'G' || ch == 'L'))) {
         // Data edit descriptor found
         offset_ = start;
         return repeat && *repeat > 0 ? *repeat : 1;
@@ -284,8 +270,8 @@ int FormatControl<CHAR>::CueUpNextDataEdit(FormatContext &context, bool stop) {
         if (ch == 'T') {  // Tn, TLn, TRn
           repeat = GetIntField(context);
         }
-        HandleControl(context, scale_, static_cast<char>(ch),
-            static_cast<char>(next), repeat && *repeat > 0 ? *repeat : 1);
+        HandleControl(context, static_cast<char>(ch), static_cast<char>(next),
+            repeat ? *repeat : 1);
       }
     } else if (ch == '/') {
       context.HandleSlash(repeat && *repeat > 0 ? *repeat : 1);
@@ -316,7 +302,16 @@ void FormatControl<CHAR>::GetNext(
     edit.variation = '\0';
   }
 
-  edit.width = GetIntField(context);
+  if (edit.descriptor == 'A') {  // width is optional for A[w]
+    auto ch{PeekNext()};
+    if (ch >= '0' && ch <= '9') {
+      edit.width = GetIntField(context);
+    } else {
+      edit.width.reset();
+    }
+  } else {
+    edit.width = GetIntField(context);
+  }
   edit.modes = context.mutableModes();
   if (PeekNext() == '.') {
     ++offset_;

flang/runtime/format.h

@@ -11,6 +11,7 @@
 #ifndef FORTRAN_RUNTIME_FORMAT_H_
 #define FORTRAN_RUNTIME_FORMAT_H_
 
+#include "environment.h"
 #include "terminator.h"
 #include "flang/common/Fortran.h"
 #include <cinttypes>
@@ -26,16 +27,19 @@ enum EditingFlags {
 
 struct MutableModes {
   std::uint8_t editingFlags{0};  // BN, DP, SS
-  common::RoundingMode roundingMode{common::RoundingMode::TiesToEven};  // RN
+  common::RoundingMode roundingMode{
+      executionEnvironment
+          .defaultOutputRoundingMode};  // RP/ROUND='PROCESSOR_DEFAULT'
   bool pad{false};  // PAD= mode on READ
   char delim{'\0'};  // DELIM=
+  short scale{0};  // kP
 };
 
 // A single edit descriptor extracted from a FORMAT
 struct DataEdit {
   char descriptor;  // capitalized: one of A, I, B, O, Z, F, E(N/S/X), D, G
   char variation{'\0'};  // N, S, or X for EN, ES, EX
-  int width;  // the 'w' field
+  std::optional<int> width;  // the 'w' field; optional for A
   std::optional<int> digits;  // the 'm' or 'd' field
   std::optional<int> expoDigits;  // 'Ee' field
   MutableModes modes;
@@ -45,13 +49,14 @@ struct DataEdit {
 class FormatContext : virtual public Terminator {
 public:
   FormatContext() {}
+  virtual ~FormatContext() {}
   explicit FormatContext(const MutableModes &modes) : mutableModes_{modes} {}
-  virtual void Emit(const char *, std::size_t);
-  virtual void Emit(const char16_t *, std::size_t);
-  virtual void Emit(const char32_t *, std::size_t);
-  virtual void HandleSlash(int = 1);
-  virtual void HandleRelativePosition(int);
-  virtual void HandleAbsolutePosition(int);
+  virtual bool Emit(const char *, std::size_t) = 0;
+  virtual bool Emit(const char16_t *, std::size_t) = 0;
+  virtual bool Emit(const char32_t *, std::size_t) = 0;
+  virtual bool HandleSlash(int = 1) = 0;
+  virtual bool HandleRelativePosition(std::int64_t) = 0;
+  virtual bool HandleAbsolutePosition(std::int64_t) = 0;
   MutableModes &mutableModes() { return mutableModes_; }
 
 private:
@@ -63,6 +68,8 @@ private:
 // Errors are fatal.  See clause 13.4 in Fortran 2018 for background.
 template<typename CHAR = char> class FormatControl {
 public:
+  FormatControl() {}
+  // TODO: make 'format' a reference here and below
   FormatControl(Terminator &, const CHAR *format, std::size_t formatLength,
       int maxHeight = maxMaxHeight);
 
@@ -125,11 +132,10 @@ private:
   // Data members are arranged and typed so as to reduce size.
   // This structure may be allocated in stack space loaned by the
   // user program for internal I/O.
-  std::uint16_t scale_{0};  // kP
   const std::uint8_t maxHeight_{maxMaxHeight};
   std::uint8_t height_{0};
-  const CHAR *format_;
-  int formatLength_;
+  const CHAR *format_{nullptr};
+  int formatLength_{0};
   int offset_{0};  // next item is at format_[offset_]
 
   // must be last, may be incomplete

flang/runtime/io-api.cpp

@@ -6,11 +6,15 @@
 //
 //===----------------------------------------------------------------------===//
 
+// Implements the I/O statement API
+
 #include "io-api.h"
 #include "format.h"
 #include "io-stmt.h"
 #include "memory.h"
+#include "numeric-output.h"
 #include "terminator.h"
+#include "unit.h"
 #include <cstdlib>
 #include <memory>
 
@@ -25,7 +29,62 @@ Cookie IONAME(BeginInternalFormattedOutput)(char *internal,
       internalLength, format, formatLength, sourceFile, sourceLine);
 }
 
-enum Iostat IONAME(EndIoStatement)(Cookie io) {
-  return static_cast<enum Iostat>(io->EndIoStatement());
+Cookie IONAME(BeginExternalFormattedOutput)(const char *format,
+    std::size_t formatLength, ExternalUnit unitNumber, const char *sourceFile,
+    int sourceLine) {
+  Terminator terminator{sourceFile, sourceLine};
+  int unit{unitNumber == DefaultUnit ? 6 : unitNumber};
+  ExternalFile &file{ExternalFile::LookUpOrCrash(unit, terminator)};
+  return &file.BeginIoStatement<ExternalFormattedIoStatementState<false>>(
+      file, format, formatLength, sourceFile, sourceLine);
+}
+
+bool IONAME(OutputInteger64)(Cookie cookie, std::int64_t n) {
+  IoStatementState &io{*cookie};
+  DataEdit edit;
+  io.GetNext(edit);
+  return EditIntegerOutput(io, edit, n);
+}
+
+bool IONAME(OutputReal64)(Cookie cookie, double x) {
+  IoStatementState &io{*cookie};
+  DataEdit edit;
+  io.GetNext(edit);
+  return RealOutputEditing<double, 15, 53, 1024>{io, x}.Edit(edit);
+}
+
+bool IONAME(OutputAscii)(Cookie cookie, const char *x, std::size_t length) {
+  IoStatementState &io{*cookie};
+  DataEdit edit;
+  io.GetNext(edit);
+  if (edit.descriptor != 'A' && edit.descriptor != 'G') {
+    io.Crash(
+        "Data edit descriptor '%c' may not be used with a CHARACTER data item",
+        edit.descriptor);
+    return false;
+  }
+  int len{static_cast<int>(length)};
+  int width{edit.width.value_or(len)};
+  return EmitRepeated(io, ' ', std::max(0, width - len)) &&
+      io.Emit(x, std::min(width, len));
+}
+
+bool IONAME(OutputLogical)(Cookie cookie, bool truth) {
+  IoStatementState &io{*cookie};
+  DataEdit edit;
+  io.GetNext(edit);
+  if (edit.descriptor != 'L' && edit.descriptor != 'G') {
+    io.Crash(
+        "Data edit descriptor '%c' may not be used with a LOGICAL data item",
+        edit.descriptor);
+    return false;
+  }
+  return EmitRepeated(io, ' ', std::max(0, edit.width.value_or(1) - 1)) &&
+      io.Emit(truth ? "T" : "F", 1);
+}
+
+enum Iostat IONAME(EndIoStatement)(Cookie cookie) {
+  IoStatementState &io{*cookie};
+  return static_cast<enum Iostat>(io.EndIoStatement());
 }
 }

flang/runtime/io-stmt.cpp

@@ -8,81 +8,193 @@
 
 #include "io-stmt.h"
 #include "memory.h"
+#include "unit.h"
 #include <algorithm>
 #include <cstring>
 
 namespace Fortran::runtime::io {
 
+IoStatementState::IoStatementState(const char *sourceFile, int sourceLine)
+  : IoErrorHandler{sourceFile, sourceLine} {}
+
 int IoStatementState::EndIoStatement() { return GetIoStat(); }
 
-int InternalIoStatementState::EndIoStatement() {
-  auto result{GetIoStat()};
+// Defaults
+void IoStatementState::GetNext(DataEdit &, int) {
+  Crash("GetNext() called for I/O statement that is not a formatted data "
+        "transfer statement");
+}
+bool IoStatementState::Emit(const char *, std::size_t) {
+  Crash("Emit() called for I/O statement that is not an output statement");
+  return false;
+}
+bool IoStatementState::Emit(const char16_t *, std::size_t) {
+  Crash("Emit() called for I/O statement that is not an output statement");
+  return false;
+}
+bool IoStatementState::Emit(const char32_t *, std::size_t) {
+  Crash("Emit() called for I/O statement that is not an output statement");
+  return false;
+}
+bool IoStatementState::HandleSlash(int) {
+  Crash("HandleSlash() called for I/O statement that is not a formatted data "
+        "transfer statement");
+  return false;
+}
+bool IoStatementState::HandleRelativePosition(std::int64_t) {
+  Crash("HandleRelativePosition() called for I/O statement that is not a "
+        "formatted data transfer statement");
+  return false;
+}
+bool IoStatementState::HandleAbsolutePosition(std::int64_t) {
+  Crash("HandleAbsolutePosition() called for I/O statement that is not a "
+        "formatted data transfer statement");
+  return false;
+}
+
+template<bool isInput, typename CHAR>
+FixedRecordIoStatementState<isInput, CHAR>::FixedRecordIoStatementState(
+    Buffer buffer, std::size_t length, const char *sourceFile, int sourceLine)
+  : IoStatementState{sourceFile, sourceLine}, buffer_{buffer}, length_{length} {
+}
+
+template<bool isInput, typename CHAR>
+bool FixedRecordIoStatementState<isInput, CHAR>::Emit(
+    const CHAR *data, std::size_t chars) {
+  if constexpr (isInput) {
+    IoStatementState::Emit(data, chars);  // default Crash()
+    return false;
+  } else if (at_ + chars > length_) {
+    SignalEor();
+    if (at_ < length_) {
+      std::memcpy(buffer_ + at_, data, (length_ - at_) * sizeof(CHAR));
+      at_ = furthest_ = length_;
+    }
+    return false;
+  } else {
+    std::memcpy(buffer_ + at_, data, chars * sizeof(CHAR));
+    at_ += chars;
+    furthest_ = std::max(furthest_, at_);
+    return true;
+  }
+}
+
+template<bool isInput, typename CHAR>
+bool FixedRecordIoStatementState<isInput, CHAR>::HandleAbsolutePosition(
+    std::int64_t n) {
+  if (n < 0) {
+    n = 0;
+  }
+  n += leftTabLimit_;
+  bool ok{true};
+  if (static_cast<std::size_t>(n) > length_) {
+    SignalEor();
+    n = length_;
+    ok = false;
+  }
+  if constexpr (!isInput) {
+    if (static_cast<std::size_t>(n) > furthest_) {
+      std::fill_n(buffer_ + furthest_, n - furthest_, static_cast<CHAR>(' '));
+    }
+  }
+  at_ = n;
+  furthest_ = std::max(furthest_, at_);
+  return ok;
+}
+
+template<bool isInput, typename CHAR>
+bool FixedRecordIoStatementState<isInput, CHAR>::HandleRelativePosition(
+    std::int64_t n) {
+  return HandleAbsolutePosition(n + at_ - leftTabLimit_);
+}
+
+template<bool isInput, typename CHAR>
+int FixedRecordIoStatementState<isInput, CHAR>::EndIoStatement() {
+  if constexpr (!isInput) {
+    HandleAbsolutePosition(length_ - leftTabLimit_);  // fill
+  }
+  return GetIoStat();
+}
+
+template<bool isInput, typename CHAR>
+int InternalIoStatementState<isInput, CHAR>::EndIoStatement() {
+  auto result{FixedRecordIoStatementState<isInput, CHAR>::EndIoStatement()};
   if (free_) {
     FreeMemory(this);
   }
   return result;
 }
 
-InternalIoStatementState::InternalIoStatementState(
-    const char *sourceFile, int sourceLine)
-  : IoStatementState(sourceFile, sourceLine) {}
+template<bool isInput, typename CHAR>
+InternalIoStatementState<isInput, CHAR>::InternalIoStatementState(
+    Buffer buffer, std::size_t length, const char *sourceFile, int sourceLine)
+  : FixedRecordIoStatementState<isInput, CHAR>(
+        buffer, length, sourceFile, sourceLine) {}
 
 template<bool isInput, typename CHAR>
 InternalFormattedIoStatementState<isInput,
-    CHAR>::InternalFormattedIoStatementState(Buffer internal,
-    std::size_t internalLength, const CHAR *format, std::size_t formatLength,
-    const char *sourceFile, int sourceLine)
-  : InternalIoStatementState{sourceFile, sourceLine}, FormatContext{},
-    internal_{internal}, internalLength_{internalLength}, format_{*this, format,
-                                                              formatLength} {
-  std::fill_n(internal_, internalLength_, static_cast<CHAR>(' '));
-}
-
-template<bool isInput, typename CHAR>
-void InternalFormattedIoStatementState<isInput, CHAR>::Emit(
-    const CHAR *data, std::size_t chars) {
-  if constexpr (isInput) {
-    FormatContext::Emit(data, chars);  // default Crash()
-  } else if (at_ + chars > internalLength_) {
-    SignalEor();
-  } else {
-    std::memcpy(internal_ + at_, data, chars * sizeof(CHAR));
-    at_ += chars;
-  }
-}
-
-template<bool isInput, typename CHAR>
-void InternalFormattedIoStatementState<isInput, CHAR>::HandleAbsolutePosition(
-    int n) {
-  if (n < 0 || static_cast<std::size_t>(n) >= internalLength_) {
-    Crash("T%d control edit descriptor is out of range", n);
-  } else {
-    at_ = n;
-  }
-}
-
-template<bool isInput, typename CHAR>
-void InternalFormattedIoStatementState<isInput, CHAR>::HandleRelativePosition(
-    int n) {
-  if (n < 0) {
-    at_ -= std::min(at_, -static_cast<std::size_t>(n));
-  } else {
-    at_ += n;
-    if (at_ > internalLength_) {
-      Crash("TR%d control edit descriptor is out of range", n);
-    }
-  }
-}
+    CHAR>::InternalFormattedIoStatementState(Buffer buffer, std::size_t length,
+    const CHAR *format, std::size_t formatLength, const char *sourceFile,
+    int sourceLine)
+  : InternalIoStatementState<isInput, CHAR>{buffer, length, sourceFile,
+        sourceLine},
+    format_{*this, format, formatLength} {}
 
 template<bool isInput, typename CHAR>
 int InternalFormattedIoStatementState<isInput, CHAR>::EndIoStatement() {
   format_.FinishOutput(*this);
-  auto result{GetIoStat()};
-  if (free_) {
-    FreeMemory(this);
+  return InternalIoStatementState<isInput, CHAR>::EndIoStatement();
+}
+
+template<bool isInput, typename CHAR>
+ExternalFormattedIoStatementState<isInput,
+    CHAR>::ExternalFormattedIoStatementState(ExternalFile &file,
+    const CHAR *format, std::size_t formatLength, const char *sourceFile,
+    int sourceLine)
+  : IoStatementState{sourceFile, sourceLine}, file_{file}, format_{*this,
+                                                               format,
+                                                               formatLength} {}
+
+template<bool isInput, typename CHAR>
+bool ExternalFormattedIoStatementState<isInput, CHAR>::Emit(
+    const CHAR *data, std::size_t chars) {
+  // TODO: UTF-8 encoding of 2- and 4-byte characters
+  return file_.Emit(data, chars * sizeof(CHAR), *this);
+}
+
+template<bool isInput, typename CHAR>
+bool ExternalFormattedIoStatementState<isInput, CHAR>::HandleSlash(int n) {
+  while (n-- > 0) {
+    if (!file_.NextOutputRecord(*this)) {
+      return false;
+    }
   }
+  return true;
+}
+
+template<bool isInput, typename CHAR>
+bool ExternalFormattedIoStatementState<isInput, CHAR>::HandleAbsolutePosition(
+    std::int64_t n) {
+  return file_.HandleAbsolutePosition(n, *this);
+}
+
+template<bool isInput, typename CHAR>
+bool ExternalFormattedIoStatementState<isInput, CHAR>::HandleRelativePosition(
+    std::int64_t n) {
+  return file_.HandleRelativePosition(n, *this);
+}
+
+template<bool isInput, typename CHAR>
+int ExternalFormattedIoStatementState<isInput, CHAR>::EndIoStatement() {
+  format_.FinishOutput(*this);
+  if constexpr (!isInput) {
+    file_.NextOutputRecord(*this);  // TODO: non-advancing I/O
+  }
+  int result{GetIoStat()};
+  file_.EndIoStatement();  // annihilates *this in file_.u_
   return result;
 }
 
 template class InternalFormattedIoStatementState<false>;
+template class ExternalFormattedIoStatementState<false>;
 }

flang/runtime/io-stmt.h

@@ -18,47 +18,100 @@
 
 namespace Fortran::runtime::io {
 
-class IoStatementState : public IoErrorHandler {
+class ExternalFile;
+
+class IoStatementState : public IoErrorHandler, public FormatContext {
 public:
-  using IoErrorHandler::IoErrorHandler;
+  IoStatementState(const char *sourceFile, int sourceLine);
+  virtual ~IoStatementState() {}
+
   virtual int EndIoStatement();
 
-protected:
+  // Default (crashing) callback overrides for FormatContext
+  virtual void GetNext(DataEdit &, int maxRepeat = 1);
+  virtual bool Emit(const char *, std::size_t);
+  virtual bool Emit(const char16_t *, std::size_t);
+  virtual bool Emit(const char32_t *, std::size_t);
+  virtual bool HandleSlash(int);
+  virtual bool HandleRelativePosition(std::int64_t);
+  virtual bool HandleAbsolutePosition(std::int64_t);
 };
 
-class InternalIoStatementState : public IoStatementState {
+template<bool IsInput, typename CHAR = char>
+class FixedRecordIoStatementState : public IoStatementState {
+protected:
+  using Buffer = std::conditional_t<IsInput, const CHAR *, CHAR *>;
+
 public:
-  InternalIoStatementState(const char *sourceFile, int sourceLine);
+  FixedRecordIoStatementState(
+      Buffer, std::size_t, const char *sourceFile, int sourceLine);
+
+  virtual bool Emit(const CHAR *, std::size_t chars /* not bytes */);
+  // TODO virtual void HandleSlash(int);
+  virtual bool HandleRelativePosition(std::int64_t);
+  virtual bool HandleAbsolutePosition(std::int64_t);
+  virtual int EndIoStatement();
+
+private:
+  Buffer buffer_{nullptr};
+  std::size_t length_;  // RECL= or internal I/O character variable length
+  std::size_t leftTabLimit_{0};  // nonzero only when non-advancing
+  std::size_t at_{0};
+  std::size_t furthest_{0};
+};
+
+template<bool isInput, typename CHAR = char>
+class InternalIoStatementState
+  : public FixedRecordIoStatementState<isInput, CHAR> {
+public:
+  using typename FixedRecordIoStatementState<isInput, CHAR>::Buffer;
+  InternalIoStatementState(Buffer, std::size_t,
+      const char *sourceFile = nullptr, int sourceLine = 0);
   virtual int EndIoStatement();
 
 protected:
   bool free_{true};
 };
 
-template<bool IsInput, typename CHAR = char>
-class InternalFormattedIoStatementState : public InternalIoStatementState,
-                                          private FormatContext {
-private:
-  using Buffer = std::conditional_t<IsInput, const CHAR *, CHAR *>;
-
+template<bool isInput, typename CHAR = char>
+class InternalFormattedIoStatementState
+  : public InternalIoStatementState<isInput, CHAR> {
 public:
+  using typename InternalIoStatementState<isInput, CHAR>::Buffer;
   InternalFormattedIoStatementState(Buffer internal, std::size_t internalLength,
       const CHAR *format, std::size_t formatLength,
       const char *sourceFile = nullptr, int sourceLine = 0);
-  void Emit(const CHAR *, std::size_t chars);
-  // TODO pmk: void HandleSlash(int);
-  void HandleRelativePosition(int);
-  void HandleAbsolutePosition(int);
+  void GetNext(DataEdit &edit, int maxRepeat = 1) {
+    format_.GetNext(*this, edit, maxRepeat);
+  }
   int EndIoStatement();
 
 private:
-  Buffer internal_;
-  std::size_t internalLength_;
-  std::size_t at_{0};
   FormatControl<CHAR> format_;  // must be last, may be partial
 };
 
+template<bool isInput, typename CHAR = char>
+class ExternalFormattedIoStatementState : public IoStatementState {
+public:
+  ExternalFormattedIoStatementState(ExternalFile &, const CHAR *format,
+      std::size_t formatLength, const char *sourceFile = nullptr,
+      int sourceLine = 0);
+  void GetNext(DataEdit &edit, int maxRepeat = 1) {
+    format_.GetNext(*this, edit, maxRepeat);
+  }
+  bool Emit(const CHAR *, std::size_t chars /* not bytes */);
+  bool HandleSlash(int);
+  bool HandleRelativePosition(std::int64_t);
+  bool HandleAbsolutePosition(std::int64_t);
+  int EndIoStatement();
+
+private:
+  ExternalFile &file_;
+  FormatControl<CHAR> format_;
+};
+
 extern template class InternalFormattedIoStatementState<false>;
+extern template class ExternalFormattedIoStatementState<false>;
 
 }
 #endif  // FORTRAN_RUNTIME_IO_STMT_H_

flang/runtime/main.cpp

@@ -7,35 +7,12 @@
 //===----------------------------------------------------------------------===//
 
 #include "main.h"
-#include "io-stmt.h"
+#include "environment.h"
 #include "terminator.h"
+#include "unit.h"
 #include <cfenv>
 #include <cstdio>
 #include <cstdlib>
-#include <limits>
-
-namespace Fortran::runtime {
-ExecutionEnvironment executionEnvironment;
-
-void ExecutionEnvironment::Configure(
-    int ac, const char *av[], const char *env[]) {
-  argc = ac;
-  argv = av;
-  envp = env;
-  listDirectedOutputLineLengthLimit = 79;  // PGI default
-
-  if (auto *x{std::getenv("FORT_FMT_RECL")}) {
-    char *end;
-    auto n{std::strtol(x, &end, 10)};
-    if (n > 0 && n < std::numeric_limits<int>::max() && *end == '\0') {
-      listDirectedOutputLineLengthLimit = n;
-    } else {
-      std::fprintf(
-          stderr, "Fortran runtime: FORT_FMT_RECL=%s is invalid; ignored\n", x);
-    }
-  }
-}
-}
 
 static void ConfigureFloatingPoint() {
 #ifdef feclearexcept  // a macro in some environments; omit std::
@@ -56,5 +33,7 @@ void RTNAME(ProgramStart)(int argc, const char *argv[], const char *envp[]) {
   std::atexit(Fortran::runtime::NotifyOtherImagesOfNormalEnd);
   Fortran::runtime::executionEnvironment.Configure(argc, argv, envp);
   ConfigureFloatingPoint();
+  Fortran::runtime::Terminator terminator{"ProgramStart()"};
+  Fortran::runtime::io::ExternalFile::InitializePredefinedUnits(terminator);
 }
 }

flang/runtime/main.h

@@ -9,22 +9,11 @@
 #ifndef FORTRAN_RUNTIME_MAIN_H_
 #define FORTRAN_RUNTIME_MAIN_H_
 
+#include "c-or-cpp.h"
 #include "entry-names.h"
 
-namespace Fortran::runtime {
-struct ExecutionEnvironment {
-  void Configure(int argc, const char *argv[], const char *envp[]);
-
-  int argc;
-  const char **argv;
-  const char **envp;
-  int listDirectedOutputLineLengthLimit;
-};
-extern ExecutionEnvironment executionEnvironment;
-}
-
-extern "C" {
+EXTERN_C_BEGIN
 void RTNAME(ProgramStart)(int, const char *[], const char *[]);
-}
+EXTERN_C_END
 
 #endif  // FORTRAN_RUNTIME_MAIN_H_

flang/runtime/memory.cpp

@@ -25,9 +25,4 @@ void *AllocateMemoryOrCrash(Terminator &terminator, std::size_t bytes) {
 }
 
 void FreeMemory(void *p) { std::free(p); }
-
-void FreeMemoryAndNullify(void *&p) {
-  std::free(p);
-  p = nullptr;
-}
 }

flang/runtime/memory.h

@@ -18,15 +18,22 @@ namespace Fortran::runtime {
 
 class Terminator;
 
-void *AllocateMemoryOrCrash(Terminator &, std::size_t bytes);
-template<typename A> A &AllocateOrCrash(Terminator &t) {
+[[nodiscard]] void *AllocateMemoryOrCrash(Terminator &, std::size_t bytes);
+template<typename A>[[nodiscard]] A &AllocateOrCrash(Terminator &t) {
   return *reinterpret_cast<A *>(AllocateMemoryOrCrash(t, sizeof(A)));
 }
 void FreeMemory(void *);
-void FreeMemoryAndNullify(void *&);
+template<typename A> void FreeMemory(A *p) {
+  FreeMemory(reinterpret_cast<void *>(p));
+}
+template<typename A> void FreeMemoryAndNullify(A *&p) {
+  FreeMemory(p);
+  p = nullptr;
+}
 
 template<typename A> struct New {
-  template<typename... X> A &operator()(Terminator &terminator, X &&... x) {
+  template<typename... X>
+  [[nodiscard]] A &operator()(Terminator &terminator, X &&... x) {
     return *new (AllocateMemoryOrCrash(terminator, sizeof(A)))
         A{std::forward<X>(x)...};
   }
@@ -37,6 +44,22 @@ template<typename A> struct OwningPtrDeleter {
 };
 
 template<typename A> using OwningPtr = std::unique_ptr<A, OwningPtrDeleter<A>>;
+
+template<typename A> struct Allocator {
+  using value_type = A;
+  explicit Allocator(Terminator &t) : terminator{t} {}
+  template<typename B>
+  explicit constexpr Allocator(const Allocator<B> &that) noexcept
+    : terminator{that.terminator} {}
+  Allocator(const Allocator &) = default;
+  Allocator(Allocator &&) = default;
+  [[nodiscard]] constexpr A *allocate(std::size_t n) {
+    return reinterpret_cast<A *>(
+        AllocateMemoryOrCrash(terminator, n * sizeof(A)));
+  }
+  constexpr void deallocate(A *p, std::size_t) { FreeMemory(p); }
+  Terminator &terminator;
+};
 }
 
 #endif  // FORTRAN_RUNTIME_MEMORY_H_

flang/runtime/numeric-output.h

@@ -0,0 +1,449 @@
+//===-- runtime/numeric-output.h --------------------------------*- C++ -*-===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_RUNTIME_NUMERIC_OUTPUT_H_
+#define FORTRAN_RUNTIME_NUMERIC_OUTPUT_H_
+
+// Output data editing templates implementing the FORMAT data editing
+// descriptors E, EN, ES, EX, D, F, and G for REAL data (and COMPLEX
+// components, I and G for INTEGER, and B/O/Z for both.
+// See subclauses in 13.7.2.3 of Fortran 2018 for the
+// detailed specifications of these descriptors.
+// Drives the same binary-to-decimal formatting templates used
+// by the f18 compiler.
+
+#include "format.h"
+#include "flang/common/unsigned-const-division.h"
+#include "flang/decimal/decimal.h"
+
+namespace Fortran::runtime::io {
+
+class IoStatementState;
+
+// Utility subroutines
+static bool EmitRepeated(IoStatementState &io, char ch, int n) {
+  while (n-- > 0) {
+    if (!io.Emit(&ch, 1)) {
+      return false;
+    }
+  }
+  return true;
+}
+
+static bool EmitField(
+    IoStatementState &io, const char *p, std::size_t length, int width) {
+  if (width <= 0) {
+    width = static_cast<int>(length);
+  }
+  if (length > static_cast<std::size_t>(width)) {
+    return EmitRepeated(io, '*', width);
+  } else {
+    return EmitRepeated(io, ' ', static_cast<int>(width - length)) &&
+        io.Emit(p, length);
+  }
+}
+
+// I, B, O, Z, and (for INTEGER) G output editing.
+// edit is const here so that a repeated edit descriptor may safely serve
+// multiple array elements
+static bool EditIntegerOutput(
+    IoStatementState &io, const DataEdit &edit, std::int64_t n) {
+  char buffer[66], *end = &buffer[sizeof buffer], *p = end;
+  std::uint64_t un{static_cast<std::uint64_t>(n < 0 ? -n : n)};
+  int signChars{0};
+  switch (edit.descriptor) {
+  case 'G':
+  case 'I':
+    if (n < 0 || (edit.modes.editingFlags & signPlus)) {
+      signChars = 1;  // '-' or '+'
+    }
+    while (un > 0) {
+      auto quotient{common::DivideUnsignedBy<std::uint64_t, 10>(un)};
+      *--p = '0' + un - 10 * quotient;
+      un = quotient;
+    }
+    break;
+  case 'B':
+    for (; un > 0; un >>= 1) {
+      *--p = '0' + (un & 1);
+    }
+    break;
+  case 'O':
+    for (; un > 0; un >>= 3) {
+      *--p = '0' + (un & 7);
+    }
+    break;
+  case 'Z':
+    for (; un > 0; un >>= 4) {
+      int digit = un & 0xf;
+      *--p = digit >= 10 ? 'A' + (digit - 10) : '0' + digit;
+    }
+    break;
+  default:
+    io.Crash(
+        "Data edit descriptor '%c' may not be used with an INTEGER data item",
+        edit.descriptor);
+    return false;
+  }
+
+  int digits = end - p;
+  int leadingZeroes{0};
+  int editWidth{edit.width.value_or(0)};
+  if (edit.digits && digits <= *edit.digits) {  // Iw.m
+    if (*edit.digits == 0 && n == 0) {
+      // Iw.0 with zero value: output field must be blank.  For I0.0
+      // and a zero value, emit one blank character.
+      signChars = 0;  // in case of SP
+      editWidth = std::max(1, editWidth);
+    } else {
+      leadingZeroes = *edit.digits - digits;
+    }
+  } else if (n == 0) {
+    leadingZeroes = 1;
+  }
+  int total{signChars + leadingZeroes + digits};
+  if (edit.width > 0 && total > editWidth) {
+    return EmitRepeated(io, '*', editWidth);
+  }
+  if (total < editWidth) {
+    EmitRepeated(io, '*', editWidth - total);
+    return false;
+  }
+  if (signChars) {
+    if (!io.Emit(n < 0 ? "-" : "+", 1)) {
+      return false;
+    }
+  }
+  return EmitRepeated(io, '0', leadingZeroes) && io.Emit(p, digits);
+}
+
+// Encapsulates the state of a REAL output conversion.
+template<typename FLOAT = double, int decimalPrecision = 15,
+    int binaryPrecision = 53, std::size_t bufferSize = 1024>
+class RealOutputEditing {
+public:
+  RealOutputEditing(IoStatementState &io, FLOAT x) : io_{io}, x_{x} {}
+  bool Edit(const DataEdit &edit);
+
+private:
+  // The DataEdit arguments here are const references or copies so that
+  // the original DataEdit can safely serve multiple array elements if
+  // it has a repeat count.
+  bool EditEorDOutput(const DataEdit &);
+  bool EditFOutput(const DataEdit &);
+  DataEdit EditForGOutput(DataEdit);  // returns an E or F edit
+  bool EditEXOutput(const DataEdit &);
+
+  bool IsZero() const { return x_ == 0; }
+  const char *FormatExponent(int, const DataEdit &edit, int &length);
+
+  static enum decimal::FortranRounding SetRounding(
+      common::RoundingMode rounding) {
+    switch (rounding) {
+    case common::RoundingMode::TiesToEven: break;
+    case common::RoundingMode::Up: return decimal::RoundUp;
+    case common::RoundingMode::Down: return decimal::RoundDown;
+    case common::RoundingMode::ToZero: return decimal::RoundToZero;
+    case common::RoundingMode::TiesAwayFromZero:
+      return decimal::RoundCompatible;
+    }
+    return decimal::RoundNearest;  // arranged thus to dodge bogus G++ warning
+  }
+
+  static bool IsDecimalNumber(const char *p) {
+    if (!p) {
+      return false;
+    }
+    if (*p == '-' || *p == '+') {
+      ++p;
+    }
+    return *p >= '0' && *p <= '9';
+  }
+
+  decimal::ConversionToDecimalResult Convert(
+      int significantDigits, const DataEdit &, int flags = 0);
+
+  IoStatementState &io_;
+  FLOAT x_;
+  char buffer_[bufferSize];
+  int trailingBlanks_{0};  // created when G editing maps to F
+  char exponent_[16];
+};
+
+template<typename FLOAT, int decimalPrecision, int binaryPrecision,
+    std::size_t bufferSize>
+decimal::ConversionToDecimalResult RealOutputEditing<FLOAT, decimalPrecision,
+    binaryPrecision, bufferSize>::Convert(int significantDigits,
+    const DataEdit &edit, int flags) {
+  if (edit.modes.editingFlags & signPlus) {
+    flags |= decimal::AlwaysSign;
+  }
+  auto converted{decimal::ConvertToDecimal<binaryPrecision>(buffer_, bufferSize,
+      static_cast<enum decimal::DecimalConversionFlags>(flags),
+      significantDigits, SetRounding(edit.modes.roundingMode),
+      decimal::BinaryFloatingPointNumber<binaryPrecision>(x_))};
+  if (!converted.str) {  // overflow
+    io_.Crash("RealOutputEditing::Convert : buffer size %zd was insufficient",
+        bufferSize);
+  }
+  return converted;
+}
+
+// 13.7.2.3.3 in F'2018
+template<typename FLOAT, int decimalPrecision, int binaryPrecision,
+    std::size_t bufferSize>
+bool RealOutputEditing<FLOAT, decimalPrecision, binaryPrecision,
+    bufferSize>::EditEorDOutput(const DataEdit &edit) {
+  int editDigits{edit.digits.value_or(0)};  // 'd' field
+  int editWidth{edit.width.value_or(0)};  // 'w' field
+  int significantDigits{editDigits};
+  int flags{0};
+  if (editWidth == 0) {  // "the processor selects the field width"
+    if (edit.digits.has_value()) {  // E0.d
+      editWidth = editDigits + 6;  // -.666E+ee
+    } else {  // E0
+      flags |= decimal::Minimize;
+      significantDigits =
+          bufferSize - 5;  // sign, NUL, + 3 extra for EN scaling
+    }
+  }
+  bool isEN{edit.variation == 'N'};
+  bool isES{edit.variation == 'S'};
+  int scale{isEN || isES ? 1 : edit.modes.scale};  // 'kP' value
+  int zeroesAfterPoint{0};
+  if (scale < 0) {
+    zeroesAfterPoint = -scale;
+    significantDigits = std::max(0, significantDigits - zeroesAfterPoint);
+  } else if (scale > 0) {
+    ++significantDigits;
+    scale = std::min(scale, significantDigits + 1);
+  }
+  // In EN editing, multiple attempts may be necessary, so it's in a loop.
+  while (true) {
+    decimal::ConversionToDecimalResult converted{
+        Convert(significantDigits, edit, flags)};
+    if (converted.length > 0 && !IsDecimalNumber(converted.str)) {  // Inf, NaN
+      return EmitField(io_, converted.str, converted.length, editWidth);
+    }
+    if (!IsZero()) {
+      converted.decimalExponent -= scale;
+    }
+    if (isEN && scale < 3 && (converted.decimalExponent % 3) != 0) {
+      // EN mode: boost the scale and significant digits, try again; need
+      // an effective exponent field that's a multiple of three.
+      ++scale;
+      ++significantDigits;
+      continue;
+    }
+    // Format the exponent (see table 13.1 for all the cases)
+    int expoLength{0};
+    const char *exponent{
+        FormatExponent(converted.decimalExponent, edit, expoLength)};
+    int signLength{*converted.str == '-' || *converted.str == '+' ? 1 : 0};
+    int convertedDigits{static_cast<int>(converted.length) - signLength};
+    int zeroesBeforePoint{std::max(0, scale - convertedDigits)};
+    int digitsBeforePoint{std::max(0, scale - zeroesBeforePoint)};
+    int digitsAfterPoint{convertedDigits - digitsBeforePoint};
+    int trailingZeroes{flags & decimal::Minimize
+            ? 0
+            : std::max(0,
+                  significantDigits - (convertedDigits + zeroesBeforePoint))};
+    int totalLength{signLength + digitsBeforePoint + zeroesBeforePoint +
+        1 /*'.'*/ + zeroesAfterPoint + digitsAfterPoint + trailingZeroes +
+        expoLength};
+    int width{editWidth > 0 ? editWidth : totalLength};
+    if (totalLength > width) {
+      return EmitRepeated(io_, '*', width);
+    }
+    if (totalLength < width && digitsBeforePoint == 0 &&
+        zeroesBeforePoint == 0) {
+      zeroesBeforePoint = 1;
+      ++totalLength;
+    }
+    return EmitRepeated(io_, ' ', width - totalLength) &&
+        io_.Emit(converted.str, signLength + digitsBeforePoint) &&
+        EmitRepeated(io_, '0', zeroesBeforePoint) &&
+        io_.Emit(edit.modes.editingFlags & decimalComma ? "," : ".", 1) &&
+        EmitRepeated(io_, '0', zeroesAfterPoint) &&
+        io_.Emit(
+            converted.str + signLength + digitsBeforePoint, digitsAfterPoint) &&
+        EmitRepeated(io_, '0', trailingZeroes) &&
+        io_.Emit(exponent, expoLength);
+  }
+}
+
+// Formats the exponent (see table 13.1 for all the cases)
+template<typename FLOAT, int decimalPrecision, int binaryPrecision,
+    std::size_t bufferSize>
+const char *RealOutputEditing<FLOAT, decimalPrecision, binaryPrecision,
+    bufferSize>::FormatExponent(int expo, const DataEdit &edit, int &length) {
+  char *eEnd{&exponent_[sizeof exponent_]};
+  char *exponent{eEnd};
+  for (unsigned e{static_cast<unsigned>(std::abs(expo))}; e > 0;) {
+    unsigned quotient{common::DivideUnsignedBy<unsigned, 10>(e)};
+    *--exponent = '0' + e - 10 * quotient;
+    e = quotient;
+  }
+  if (edit.expoDigits) {
+    if (int ed{*edit.expoDigits}) {  // Ew.dEe with e > 0
+      while (exponent > exponent_ + 2 /*E+*/ && exponent + ed > eEnd) {
+        *--exponent = '0';
+      }
+    } else if (exponent == eEnd) {
+      *--exponent = '0';  // Ew.dE0 with zero-valued exponent
+    }
+  } else {  // ensure at least two exponent digits
+    while (exponent + 2 > eEnd) {
+      *--exponent = '0';
+    }
+  }
+  *--exponent = expo < 0 ? '-' : '+';
+  if (edit.expoDigits || exponent + 3 == eEnd) {
+    *--exponent = edit.descriptor == 'D' ? 'D' : 'E';  // not 'G'
+  }
+  length = eEnd - exponent;
+  return exponent;
+}
+
+// 13.7.2.3.2 in F'2018
+template<typename FLOAT, int decimalPrecision, int binaryPrecision,
+    std::size_t bufferSize>
+bool RealOutputEditing<FLOAT, decimalPrecision, binaryPrecision,
+    bufferSize>::EditFOutput(const DataEdit &edit) {
+  int fracDigits{edit.digits.value_or(0)};  // 'd' field
+  int extraDigits{0};
+  int editWidth{edit.width.value_or(0)};  // 'w' field
+  int flags{0};
+  if (editWidth == 0) {  // "the processor selects the field width"
+    if (!edit.digits.has_value()) {  // F0
+      flags |= decimal::Minimize;
+      fracDigits = bufferSize - 2;  // sign & NUL
+    }
+  }
+  // Multiple conversions may be needed to get the right number of
+  // effective rounded fractional digits.
+  while (true) {
+    decimal::ConversionToDecimalResult converted{
+        Convert(extraDigits + fracDigits, edit, flags)};
+    if (converted.length > 0 && !IsDecimalNumber(converted.str)) {  // Inf, NaN
+      return EmitField(io_, converted.str, converted.length, editWidth);
+    }
+    int scale{IsZero() ? -1 : edit.modes.scale};
+    int expo{converted.decimalExponent - scale};
+    if (expo > extraDigits) {
+      extraDigits = expo;
+      if (flags & decimal::Minimize) {
+        fracDigits = bufferSize - extraDigits - 2;  // sign & NUL
+      }
+      continue;  // try again
+    }
+    int signLength{*converted.str == '-' || *converted.str == '+' ? 1 : 0};
+    int convertedDigits{static_cast<int>(converted.length) - signLength};
+    int digitsBeforePoint{std::max(0, std::min(expo, convertedDigits))};
+    int zeroesBeforePoint{std::max(0, expo - digitsBeforePoint)};
+    int zeroesAfterPoint{std::max(0, -expo)};
+    int digitsAfterPoint{convertedDigits - digitsBeforePoint};
+    int trailingZeroes{flags & decimal::Minimize
+            ? 0
+            : std::max(0, fracDigits - (zeroesAfterPoint + digitsAfterPoint))};
+    if (digitsBeforePoint + zeroesBeforePoint + zeroesAfterPoint +
+            digitsAfterPoint + trailingZeroes ==
+        0) {
+      ++zeroesBeforePoint;  // "." -> "0."
+    }
+    int totalLength{signLength + digitsBeforePoint + zeroesBeforePoint +
+        1 /*'.'*/ + zeroesAfterPoint + digitsAfterPoint + trailingZeroes};
+    int width{editWidth > 0 ? editWidth : totalLength};
+    if (totalLength > width) {
+      return EmitRepeated(io_, '*', width);
+    }
+    if (totalLength < width && digitsBeforePoint + zeroesBeforePoint == 0) {
+      zeroesBeforePoint = 1;
+      ++totalLength;
+    }
+    return EmitRepeated(io_, ' ', width - totalLength) &&
+        io_.Emit(converted.str, signLength + digitsBeforePoint) &&
+        EmitRepeated(io_, '0', zeroesBeforePoint) &&
+        io_.Emit(edit.modes.editingFlags & decimalComma ? "," : ".", 1) &&
+        EmitRepeated(io_, '0', zeroesAfterPoint) &&
+        io_.Emit(
+            converted.str + signLength + digitsBeforePoint, digitsAfterPoint) &&
+        EmitRepeated(io_, '0', trailingZeroes) &&
+        EmitRepeated(io_, ' ', trailingBlanks_);
+  }
+}
+
+// 13.7.5.2.3 in F'2018
+template<typename FLOAT, int decimalPrecision, int binaryPrecision,
+    std::size_t bufferSize>
+DataEdit RealOutputEditing<FLOAT, decimalPrecision, binaryPrecision,
+    bufferSize>::EditForGOutput(DataEdit edit) {
+  edit.descriptor = 'E';
+  if (!edit.width.has_value() ||
+      (*edit.width > 0 && edit.digits.value_or(-1) == 0)) {
+    return edit;  // Gw.0 -> Ew.0 for w > 0
+  }
+  decimal::ConversionToDecimalResult converted{Convert(1, edit)};
+  if (!IsDecimalNumber(converted.str)) {  // Inf, NaN
+    return edit;
+  }
+  int expo{IsZero() ? 1 : converted.decimalExponent};  // 's'
+  int significantDigits{edit.digits.value_or(decimalPrecision)};  // 'd'
+  if (expo < 0 || expo > significantDigits) {
+    return edit;  // Ew.d
+  }
+  edit.descriptor = 'F';
+  edit.modes.scale = 0;  // kP is ignored for G when no exponent field
+  trailingBlanks_ = 0;
+  int editWidth{edit.width.value_or(0)};
+  if (editWidth > 0) {
+    int expoDigits{edit.expoDigits.value_or(0)};
+    trailingBlanks_ = expoDigits > 0 ? expoDigits + 2 : 4;  // 'n'
+    *edit.width = std::max(0, editWidth - trailingBlanks_);
+  }
+  if (edit.digits.has_value()) {
+    *edit.digits = std::max(0, *edit.digits - expo);
+  }
+  return edit;
+}
+
+// 13.7.5.2.6 in F'2018
+template<typename FLOAT, int decimalPrecision, int binaryPrecision,
+    std::size_t bufferSize>
+bool RealOutputEditing<FLOAT, decimalPrecision, binaryPrecision,
+    bufferSize>::EditEXOutput(const DataEdit &) {
+  io_.Crash("EX output editing is not yet implemented");  // TODO
+}
+
+template<typename FLOAT, int decimalPrecision, int binaryPrecision,
+    std::size_t bufferSize>
+bool RealOutputEditing<FLOAT, decimalPrecision, binaryPrecision,
+    bufferSize>::Edit(const DataEdit &edit) {
+  switch (edit.descriptor) {
+  case 'D': return EditEorDOutput(edit);
+  case 'E':
+    if (edit.variation == 'X') {
+      return EditEXOutput(edit);
+    } else {
+      return EditEorDOutput(edit);
+    }
+  case 'F': return EditFOutput(edit);
+  case 'B':
+  case 'O':
+  case 'Z':
+    return EditIntegerOutput(io_, edit, decimal::BinaryFloatingPointNumber<binaryPrecision>{x_}.raw);
+  case 'G': return Edit(EditForGOutput(edit));
+  default:
+    io_.Crash("Data edit descriptor '%c' may not be used with a REAL data item",
+        edit.descriptor);
+    return false;
+  }
+  return false;
+}
+}
+#endif  // FORTRAN_RUNTIME_NUMERIC_OUTPUT_H_

flang/runtime/stop.cpp

@@ -7,7 +7,9 @@
 //===----------------------------------------------------------------------===//
 
 #include "stop.h"
+#include "io-error.h"
 #include "terminator.h"
+#include "unit.h"
 #include <cfenv>
 #include <cstdio>
 #include <cstdlib>
@@ -66,4 +68,10 @@ static void DescribeIEEESignaledExceptions() {
   Fortran::runtime::NotifyOtherImagesOfFailImageStatement();
   std::exit(EXIT_FAILURE);
 }
+
+[[noreturn]] void RTNAME(ProgramEndStatement)() {
+  Fortran::runtime::io::IoErrorHandler handler{"END statement"};
+  Fortran::runtime::io::ExternalFile::CloseAll(handler);
+  std::exit(EXIT_SUCCESS);
+}
 }

flang/runtime/stop.h

@@ -21,6 +21,7 @@ NORETURN void RTNAME(StopStatement)(int code DEFAULT_VALUE(EXIT_SUCCESS),
 NORETURN void RTNAME(StopStatementText)(const char *,
     bool isErrorStop DEFAULT_VALUE(false), bool quiet DEFAULT_VALUE(false));
 NORETURN void RTNAME(FailImageStatement)(NO_ARGUMENTS);
+NORETURN void RTNAME(ProgramEndStatement)(NO_ARGUMENTS);
 
 EXTERN_C_END
 

flang/runtime/tools.h

@@ -8,7 +8,12 @@
 
 #ifndef FORTRAN_RUNTIME_TOOLS_H_
 #define FORTRAN_RUNTIME_TOOLS_H_
+
 #include "memory.h"
+#include <functional>
+#include <map>
+#include <type_traits>
+
 namespace Fortran::runtime {
 
 class Terminator;
@@ -21,5 +26,11 @@ OwningPtr<char> SaveDefaultCharacter(const char *, std::size_t, Terminator &);
 // or -1 when it has no match.
 int IdentifyValue(
     const char *value, std::size_t length, const char *possibilities[]);
+
+// A std::map<> customized to use the runtime's memory allocator
+template<typename KEY, typename VALUE>
+using MapAllocator = Allocator<std::pair<std::add_const_t<KEY>, VALUE>>;
+template<typename KEY, typename VALUE, typename COMPARE = std::less<KEY>>
+using Map = std::map<KEY, VALUE, COMPARE, MapAllocator<KEY, VALUE>>;
 }
 #endif  // FORTRAN_RUNTIME_TOOLS_H_

flang/runtime/unit.cpp

@@ -0,0 +1,137 @@
+//===-- runtime/unit.cpp ----------------------------------------*- C++ -*-===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+
+#include "unit.h"
+#include "lock.h"
+#include "memory.h"
+#include "tools.h"
+#include <cerrno>
+#include <type_traits>
+
+namespace Fortran::runtime::io {
+
+static Lock mapLock;
+static Terminator mapTerminator;
+static Map<int, ExternalFile> unitMap{MapAllocator<int, ExternalFile>{mapTerminator}};
+
+ExternalFile *ExternalFile::LookUp(int unit) {
+  CriticalSection criticalSection{mapLock};
+  auto iter{unitMap.find(unit)};
+  return iter == unitMap.end() ? nullptr : &iter->second;
+}
+
+ExternalFile &ExternalFile::LookUpOrCrash(int unit, Terminator &terminator) {
+  CriticalSection criticalSection{mapLock};
+  ExternalFile *file{LookUp(unit)};
+  if (!file) {
+    terminator.Crash("Not an open I/O unit number: %d", unit);
+  }
+  return *file;
+}
+
+ExternalFile &ExternalFile::Create(int unit, Terminator &terminator) {
+  CriticalSection criticalSection{mapLock};
+  auto pair{unitMap.emplace(unit, unit)};
+  if (!pair.second) {
+    terminator.Crash("Already opened I/O unit number: %d", unit);
+  }
+  return pair.first->second;
+}
+
+void ExternalFile::CloseUnit(IoErrorHandler &handler) {
+  CriticalSection criticalSection{mapLock};
+  Flush(handler);
+  auto iter{unitMap.find(unitNumber_)};
+  if (iter != unitMap.end()) {
+    unitMap.erase(iter);
+  }
+}
+
+void ExternalFile::InitializePredefinedUnits(Terminator &terminator) {
+  ExternalFile &out{ExternalFile::Create(6, terminator)};
+  out.Predefine(1);
+  out.set_mayRead(false);
+  out.set_mayWrite(true);
+  out.set_mayPosition(false);
+  ExternalFile &in{ExternalFile::Create(5, terminator)};
+  in.Predefine(0);
+  in.set_mayRead(true);
+  in.set_mayWrite(false);
+  in.set_mayPosition(false);
+  // TODO: Set UTF-8 mode from the environment
+}
+
+void ExternalFile::CloseAll(IoErrorHandler &handler) {
+  CriticalSection criticalSection{mapLock};
+  while (!unitMap.empty()) {
+    auto &pair{*unitMap.begin()};
+    pair.second.CloseUnit(handler);
+  }
+}
+
+bool ExternalFile::SetPositionInRecord(std::int64_t n, IoErrorHandler &handler) {
+  n = std::max(std::int64_t{0}, n);
+  bool ok{true};
+  if (n > recordLength.value_or(n)) {
+    handler.SignalEor();
+    n = *recordLength;
+    ok = false;
+  }
+  if (n > furthestPositionInRecord) {
+    if (!isReading_ && ok) {
+      WriteFrame(recordOffsetInFile, n, handler);
+      std::fill_n(Frame() + furthestPositionInRecord, n - furthestPositionInRecord, ' ');
+    }
+    furthestPositionInRecord = n;
+  }
+  positionInRecord = n;
+  return ok;
+}
+
+bool ExternalFile::Emit(const char *data, std::size_t bytes, IoErrorHandler &handler) {
+  auto furthestAfter{std::max(furthestPositionInRecord, positionInRecord + static_cast<std::int64_t>(bytes))};
+  WriteFrame(recordOffsetInFile, furthestAfter, handler);
+  std::memcpy(Frame() + positionInRecord, data, bytes);
+  positionInRecord += bytes;
+  furthestPositionInRecord = furthestAfter;
+  return true;
+}
+
+void ExternalFile::SetLeftTabLimit() {
+  leftTabLimit = furthestPositionInRecord;
+  positionInRecord = furthestPositionInRecord;
+}
+
+bool ExternalFile::NextOutputRecord(IoErrorHandler &handler) {
+  bool ok{true};
+  if (recordLength.has_value()) {  // fill fixed-size record
+    ok &= SetPositionInRecord(*recordLength, handler);
+  } else if (!unformatted && !isReading_) {
+    ok &= SetPositionInRecord(furthestPositionInRecord, handler) &&
+      Emit("\n", 1, handler);
+  }
+  recordOffsetInFile += furthestPositionInRecord;
+  ++currentRecordNumber;
+  positionInRecord = 0;
+  positionInRecord = furthestPositionInRecord = 0;
+  leftTabLimit.reset();
+  return ok;
+}
+
+bool ExternalFile::HandleAbsolutePosition(std::int64_t n, IoErrorHandler &handler) {
+  return SetPositionInRecord(std::max(n, std::int64_t{0}) + leftTabLimit.value_or(0), handler);
+}
+
+bool ExternalFile::HandleRelativePosition(std::int64_t n, IoErrorHandler &handler) {
+  return HandleAbsolutePosition(positionInRecord + n, handler);
+}
+
+void ExternalFile::EndIoStatement() {
+  u_.emplace<std::monostate>();
+}
+}

flang/runtime/unit.h

@@ -0,0 +1,114 @@
+//===-- runtime/unit.h ------------------------------------------*- C++ -*-===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+
+// Fortran I/O units
+
+#ifndef FORTRAN_RUNTIME_IO_UNIT_H_
+#define FORTRAN_RUNTIME_IO_UNIT_H_
+
+#include "buffer.h"
+#include "descriptor.h"
+#include "file.h"
+#include "format.h"
+#include "io-error.h"
+#include "io-stmt.h"
+#include "lock.h"
+#include "memory.h"
+#include "terminator.h"
+#include <cstdlib>
+#include <cstring>
+#include <optional>
+#include <variant>
+
+namespace Fortran::runtime::io {
+
+enum class Access { Sequential, Direct, Stream };
+
+inline bool IsRecordFile(Access a) { return a != Access::Stream; }
+
+// These characteristics of a connection are immutable after being
+// established in an OPEN statement.
+struct ConnectionAttributes {
+  Access access{Access::Sequential};  // ACCESS='SEQUENTIAL', 'DIRECT', 'STREAM'
+  std::optional<std::int64_t> recordLength;  // RECL= when fixed-length
+  bool unformatted{false};  // FORM='UNFORMATTED'
+  bool isUTF8{false};  // ENCODING='UTF-8'
+  bool asynchronousAllowed{false};  // ASYNCHRONOUS='YES'
+};
+
+struct ConnectionState : public ConnectionAttributes {
+  // Positions in a record file (sequential or direct, but not stream)
+  std::int64_t recordOffsetInFile{0};
+  std::int64_t currentRecordNumber{1};  // 1 is first
+  std::int64_t positionInRecord{0};  // offset in current record
+  std::int64_t furthestPositionInRecord{0};  // max(positionInRecord)
+  std::optional<std::int64_t> leftTabLimit;  // offset in current record
+  // nextRecord value captured after ENDFILE/REWIND/BACKSPACE statement
+  // on a sequential access file
+  std::optional<std::int64_t> endfileRecordNumber;
+  // Mutable modes set at OPEN() that can be overridden in READ/WRITE & FORMAT
+  MutableModes modes;  // BLANK=, DECIMAL=, SIGN=, ROUND=, PAD=, DELIM=, kP
+};
+
+class InternalUnit : public ConnectionState, public IoErrorHandler {
+public:
+  InternalUnit(Descriptor &, const char *sourceFile, int sourceLine)
+    : IoErrorHandler{sourceFile, sourceLine} {
+// TODO pmk    descriptor_.Establish(...);
+    descriptor_.GetLowerBounds(at_);
+    recordLength = descriptor_.ElementBytes();
+    endfileRecordNumber = descriptor_.Elements();
+  }
+  ~InternalUnit() {
+    if (!doNotFree_) {
+      std::free(this);
+    }
+  }
+
+private:
+  bool doNotFree_{false};
+  Descriptor descriptor_;
+  SubscriptValue at_[maxRank];
+};
+
+class ExternalFile : public ConnectionState,  // TODO: privatize these
+                     public OpenFile,
+                     public FileFrame<ExternalFile> {
+public:
+  explicit ExternalFile(int unitNumber) : unitNumber_{unitNumber} {}
+  static ExternalFile *LookUp(int unit);
+  static ExternalFile &LookUpOrCrash(int unit, Terminator &);
+  static ExternalFile &Create(int unit, Terminator &);
+  static void InitializePredefinedUnits(Terminator &);
+  static void CloseAll(IoErrorHandler &);
+
+  void CloseUnit(IoErrorHandler &);
+
+  // TODO: accessors & mutators for many OPEN() specifiers
+  template<typename A, typename... X> A &BeginIoStatement(X&&... xs) {
+    // TODO: lock_.Take() here, and keep it until EndIoStatement()?
+    // Nested I/O from derived types wouldn't work, though.
+    return u_.emplace<A>(std::forward<X>(xs)...);
+  }
+  void EndIoStatement();
+
+  bool SetPositionInRecord(std::int64_t, IoErrorHandler &);
+  bool Emit(const char *, std::size_t bytes, IoErrorHandler &);
+  void SetLeftTabLimit();
+  bool NextOutputRecord(IoErrorHandler &);
+  bool HandleAbsolutePosition(std::int64_t, IoErrorHandler &);
+  bool HandleRelativePosition(std::int64_t, IoErrorHandler &);
+private:
+  int unitNumber_{-1};
+  Lock lock_;
+  bool isReading_{false};
+  std::variant<std::monostate, ExternalFormattedIoStatementState<false>> u_;
+};
+
+}
+#endif  // FORTRAN_RUNTIME_IO_UNIT_H_

flang/test/runtime/CMakeLists.txt

@@ -29,3 +29,11 @@ target_link_libraries(hello-world
 )
 
 add_test(HelloWorld hello-world)
+
+add_executable(external-hello-world
+  external-hello.cpp
+)
+
+target_link_libraries(external-hello-world
+  FortranRuntime
+)

flang/test/runtime/external-hello.cpp

@@ -0,0 +1,15 @@
+#include "../../runtime/io-api.h"
+#include "../../runtime/main.h"
+#include "../../runtime/stop.h"
+#include <cstring>
+
+using namespace Fortran::runtime::io;
+
+int main(int argc, const char *argv[], const char *envp[]) {
+  static const char *format{"(12HHELLO, WORLD)"};
+  RTNAME(ProgramStart)(argc, argv, envp);
+  auto *io{IONAME(BeginExternalFormattedOutput)(format, std::strlen(format))};
+  IONAME(EndIoStatement)(io);
+  RTNAME(ProgramEndStatement)();
+  return 0;
+}

flang/test/runtime/format.cpp

@@ -1,4 +1,5 @@
-// Test basic FORMAT string traversal
+// Tests basic FORMAT string traversal
+
 #include "../runtime/format.h"
 #include "../runtime/terminator.h"
 #include <cstdarg>
@@ -17,17 +18,20 @@ using Results = std::list<std::string>;
 // Test harness context for format control
 struct TestFormatContext : virtual public Terminator, public FormatContext {
   TestFormatContext() : Terminator{"format.cpp", 1} {}
-  void Emit(const char *, std::size_t);
-  void HandleSlash(int = 1);
-  void HandleRelativePosition(int);
-  void HandleAbsolutePosition(int);
+  bool Emit(const char *, std::size_t);
+  bool Emit(const char16_t *, std::size_t);
+  bool Emit(const char32_t *, std::size_t);
+  bool HandleSlash(int = 1);
+  bool HandleRelativePosition(std::int64_t);
+  bool HandleAbsolutePosition(std::int64_t);
   void Report(const DataEdit &);
   void Check(Results &);
   Results results;
 };
 
 // Override the runtime's Crash() for testing purposes
-[[noreturn]] void Fortran::runtime::Terminator::Crash(const char *message, ...) {
+[[noreturn]] void Fortran::runtime::Terminator::Crash(
+    const char *message, ...) {
   std::va_list ap;
   va_start(ap, message);
   char buffer[1000];
@@ -36,27 +40,39 @@ struct TestFormatContext : virtual public Terminator, public FormatContext {
   throw std::string{buffer};
 }
 
-void TestFormatContext::Emit(const char *s, std::size_t len) {
+bool TestFormatContext::Emit(const char *s, std::size_t len) {
   std::string str{s, len};
   results.push_back("'"s + str + '\'');
+  return true;
+}
+bool TestFormatContext::Emit(const char16_t *, std::size_t) {
+  Crash("TestFormatContext::Emit(const char16_t *) called");
+  return false;
+}
+bool TestFormatContext::Emit(const char32_t *, std::size_t) {
+  Crash("TestFormatContext::Emit(const char32_t *) called");
+  return false;
 }
 
-void TestFormatContext::HandleSlash(int n) {
+bool TestFormatContext::HandleSlash(int n) {
   while (n-- > 0) {
     results.emplace_back("/");
   }
+  return true;
 }
 
-void TestFormatContext::HandleAbsolutePosition(int n) {
+bool TestFormatContext::HandleAbsolutePosition(std::int64_t n) {
   results.push_back("T"s + std::to_string(n));
+  return true;
 }
 
-void TestFormatContext::HandleRelativePosition(int n) {
+bool TestFormatContext::HandleRelativePosition(std::int64_t n) {
   if (n < 0) {
     results.push_back("TL"s + std::to_string(-n));
   } else {
     results.push_back(std::to_string(n) + 'X');
   }
+  return true;
 }
 
 void TestFormatContext::Report(const DataEdit &edit) {
@@ -67,7 +83,9 @@ void TestFormatContext::Report(const DataEdit &edit) {
   if (edit.variation) {
     str += edit.variation;
   }
-  str += std::to_string(edit.width);
+  if (edit.width) {
+    str += std::to_string(*edit.width);
+  }
   if (edit.digits) {
     str += "."s + std::to_string(*edit.digits);
   }

flang/test/runtime/hello.cpp

@@ -1,4 +1,4 @@
-// Basic tests of I/O API
+// Basic sanity tests of I/O API; exhaustive testing will be done in Fortran
 
 #include "../../runtime/io-api.h"
 #include <cstring>
@@ -8,21 +8,333 @@ using namespace Fortran::runtime::io;
 
 static int failures{0};
 
-int main() {
+static void test(const char *format, const char *expect, std::string &&got) {
+  std::string want{expect};
+  want.resize(got.length(), ' ');
+  if (got != want) {
+    std::cerr << '\'' << format << "' failed;\n     got '" << got
+              << "',\nexpected '" << want << "'\n";
+    ++failures;
+  }
+}
+
+static void hello() {
   char buffer[32];
-  const char *format1{"(12HHELLO, WORLD)"};
-  auto cookie{IONAME(BeginInternalFormattedOutput)(buffer, sizeof buffer, format1, std::strlen(format1))};
+  const char *format{"(6HHELLO,,A6,2X,I3,1X,'0x',Z8,1X,L1)"};
+  auto cookie{IONAME(BeginInternalFormattedOutput)(
+      buffer, sizeof buffer, format, std::strlen(format))};
+  IONAME(OutputAscii)(cookie, "WORLD", 5);
+  IONAME(OutputInteger64)(cookie, 678);
+  IONAME(OutputInteger64)(cookie, 0xfeedface);
+  IONAME(OutputLogical)(cookie, true);
   if (auto status{IONAME(EndIoStatement)(cookie)}) {
-    std::cerr << "format1 failed, status " << static_cast<int>(status) << '\n';
+    std::cerr << '\'' << format << "' failed, status "
+              << static_cast<int>(status) << '\n';
     ++failures;
+  } else {
+    test(format, "HELLO, WORLD  678 0xFEEDFACE T",
+        std::string{buffer, sizeof buffer});
   }
-  std::string got1{buffer, sizeof buffer};
-  std::string expect1{"HELLO, WORLD"};
-  expect1.resize(got1.length(), ' ');
-  if (got1 != expect1) {
-    std::cerr << "format1 failed, got '" << got1 << "', expected '" << expect1 << "'\n";
+}
+
+static void realTest(const char *format, double x, const char *expect) {
+  char buffer[800];
+  auto cookie{IONAME(BeginInternalFormattedOutput)(
+      buffer, sizeof buffer, format, std::strlen(format))};
+  IONAME(OutputReal64)(cookie, x);
+  if (auto status{IONAME(EndIoStatement)(cookie)}) {
+    std::cerr << '\'' << format << "' failed, status "
+              << static_cast<int>(status) << '\n';
     ++failures;
+  } else {
+    test(format, expect, std::string{buffer, sizeof buffer});
   }
+}
+
+int main() {
+  hello();
+
+  static const char *zeroes[][2]{
+      {"(E32.17,';')", "         0.00000000000000000E+00;"},
+      {"(F32.17,';')", "             0.00000000000000000;"},
+      {"(G32.17,';')", "          0.0000000000000000    ;"},
+      {"(DC,E32.17,';')", "         0,00000000000000000E+00;"},
+      {"(DC,F32.17,';')", "             0,00000000000000000;"},
+      {"(DC,G32.17,';')", "          0,0000000000000000    ;"},
+      {"(D32.17,';')", "         0.00000000000000000D+00;"},
+      {"(E32.17E1,';')", "          0.00000000000000000E+0;"},
+      {"(G32.17E1,';')", "           0.0000000000000000   ;"},
+      {"(E32.17E0,';')", "          0.00000000000000000E+0;"},
+      {"(G32.17E0,';')", "          0.0000000000000000    ;"},
+      {"(1P,E32.17,';')", "         0.00000000000000000E+00;"},
+      {"(1P,F32.17,';')", "             0.00000000000000000;"},
+      {"(1P,G32.17,';')", "          0.0000000000000000    ;"},
+      {"(2P,E32.17,';')", "         00.0000000000000000E+00;"},
+      {"(-1P,E32.17,';')", "         0.00000000000000000E+00;"},
+      {"(G0,';')", "0.;"}, {}};
+  for (int j{0}; zeroes[j][0]; ++j) {
+    realTest(zeroes[j][0], 0.0, zeroes[j][1]);
+  }
+
+  static const char *ones[][2]{
+      {"(E32.17,';')", "         0.10000000000000000E+01;"},
+      {"(F32.17,';')", "             1.00000000000000000;"},
+      {"(G32.17,';')", "          1.0000000000000000    ;"},
+      {"(E32.17E1,';')", "          0.10000000000000000E+1;"},
+      {"(G32.17E1,';')", "           1.0000000000000000   ;"},
+      {"(E32.17E0,';')", "          0.10000000000000000E+1;"},
+      {"(G32.17E0,';')", "          1.0000000000000000    ;"},
+      {"(E32.17E4,';')", "       0.10000000000000000E+0001;"},
+      {"(G32.17E4,';')", "        1.0000000000000000      ;"},
+      {"(1P,E32.17,';')", "         1.00000000000000000E+00;"},
+      {"(1P,F32.17,';')", "             0.10000000000000000;"},
+      {"(1P,G32.17,';')", "          1.0000000000000000    ;"},
+      {"(ES32.17,';')", "         1.00000000000000000E+00;"},
+      {"(2P,E32.17,';')", "         10.0000000000000000E-01;"},
+      {"(2P,G32.17,';')", "          1.0000000000000000    ;"},
+      {"(-1P,E32.17,';')", "         0.01000000000000000E+02;"},
+      {"(-1P,G32.17,';')", "          1.0000000000000000    ;"},
+      {"(G0,';')", "1.;"}, {}};
+  for (int j{0}; ones[j][0]; ++j) {
+    realTest(ones[j][0], 1.0, ones[j][1]);
+  }
+
+  realTest("(E32.17,';')", -1.0, "        -0.10000000000000000E+01;");
+  realTest("(F32.17,';')", -1.0, "            -1.00000000000000000;");
+  realTest("(G32.17,';')", -1.0, "         -1.0000000000000000    ;");
+  realTest("(G0,';')", -1.0, "-1.;");
+
+  volatile union {
+    double d;
+    std::uint64_t n;
+  } u;
+  u.n = 0x8000000000000000;  // -0
+  realTest("(E9.1,';')", u.d, " -0.0E+00;");
+  realTest("(F4.0,';')", u.d, " -0.;");
+  realTest("(G8.0,';')", u.d, "-0.0E+00;");
+  realTest("(G8.1,';')", u.d, " -0.    ;");
+  realTest("(G0,';')", u.d, "-0.;");
+  u.n = 0x7ff0000000000000;  // +Inf
+  realTest("(E9.1,';')", u.d, "      Inf;");
+  realTest("(F9.1,';')", u.d, "      Inf;");
+  realTest("(G9.1,';')", u.d, "      Inf;");
+  realTest("(SP,E9.1,';')", u.d, "     +Inf;");
+  realTest("(SP,F9.1,';')", u.d, "     +Inf;");
+  realTest("(SP,G9.1,';')", u.d, "     +Inf;");
+  realTest("(G0,';')", u.d, "Inf;");
+  u.n = 0xfff0000000000000;  // -Inf
+  realTest("(E9.1,';')", u.d, "     -Inf;");
+  realTest("(F9.1,';')", u.d, "     -Inf;");
+  realTest("(G9.1,';')", u.d, "     -Inf;");
+  realTest("(G0,';')", u.d, "-Inf;");
+  u.n = 0x7ff0000000000001;  // NaN
+  realTest("(E9.1,';')", u.d, "      NaN;");
+  realTest("(F9.1,';')", u.d, "      NaN;");
+  realTest("(G9.1,';')", u.d, "      NaN;");
+  realTest("(G0,';')", u.d, "NaN;");
+  u.n = 0xfff0000000000001;  // NaN (sign irrelevant)
+  realTest("(E9.1,';')", u.d, "      NaN;");
+  realTest("(F9.1,';')", u.d, "      NaN;");
+  realTest("(G9.1,';')", u.d, "      NaN;");
+  realTest("(SP,E9.1,';')", u.d, "      NaN;");
+  realTest("(SP,F9.1,';')", u.d, "      NaN;");
+  realTest("(SP,G9.1,';')", u.d, "      NaN;");
+  realTest("(G0,';')", u.d, "NaN;");
+
+  u.n = 0x3fb999999999999a;  // 0.1 rounded
+  realTest("(E62.55,';')", u.d,
+      " 0.1000000000000000055511151231257827021181583404541015625E+00;");
+  realTest("(E0.0,';')", u.d, "0.E+00;");
+  realTest("(E0.55,';')", u.d,
+      "0.1000000000000000055511151231257827021181583404541015625E+00;");
+  realTest("(E0,';')", u.d, ".1E+00;");
+  realTest("(F58.55,';')", u.d,
+      " 0.1000000000000000055511151231257827021181583404541015625;");
+  realTest("(F0.0,';')", u.d, "0.;");
+  realTest("(F0.55,';')", u.d,
+      ".1000000000000000055511151231257827021181583404541015625;");
+  realTest("(F0,';')", u.d, ".1;");
+  realTest("(G62.55,';')", u.d,
+      " 0.1000000000000000055511151231257827021181583404541015625    ;");
+  realTest("(G0.0,';')", u.d, "0.;");
+  realTest("(G0.55,';')", u.d,
+      ".1000000000000000055511151231257827021181583404541015625;");
+  realTest("(G0,';')", u.d, ".1;");
+
+  u.n = 0x3ff8000000000000;  // 1.5
+  realTest("(E9.2,';')", u.d, " 0.15E+01;");
+  realTest("(F4.1,';')", u.d, " 1.5;");
+  realTest("(G7.1,';')", u.d, " 2.    ;");
+  realTest("(RN,E8.1,';')", u.d, " 0.2E+01;");
+  realTest("(RN,F3.0,';')", u.d, " 2.;");
+  realTest("(RN,G7.0,';')", u.d, " 0.E+01;");
+  realTest("(RN,G7.1,';')", u.d, " 2.    ;");
+  realTest("(RD,E8.1,';')", u.d, " 0.1E+01;");
+  realTest("(RD,F3.0,';')", u.d, " 1.;");
+  realTest("(RD,G7.0,';')", u.d, " 0.E+01;");
+  realTest("(RD,G7.1,';')", u.d, " 1.    ;");
+  realTest("(RU,E8.1,';')", u.d, " 0.2E+01;");
+  realTest("(RU,G7.0,';')", u.d, " 0.E+01;");
+  realTest("(RU,G7.1,';')", u.d, " 2.    ;");
+  realTest("(RZ,E8.1,';')", u.d, " 0.1E+01;");
+  realTest("(RZ,F3.0,';')", u.d, " 1.;");
+  realTest("(RZ,G7.0,';')", u.d, " 0.E+01;");
+  realTest("(RZ,G7.1,';')", u.d, " 1.    ;");
+  realTest("(RC,E8.1,';')", u.d, " 0.2E+01;");
+  realTest("(RC,F3.0,';')", u.d, " 2.;");
+  realTest("(RC,G7.0,';')", u.d, " 0.E+01;");
+  realTest("(RC,G7.1,';')", u.d, " 2.    ;");
+
+  // TODO continue F and G editing tests on these data
+
+  u.n = 0xbff8000000000000;  // -1.5
+  realTest("(E9.2,';')", u.d, "-0.15E+01;");
+  realTest("(RN,E8.1,';')", u.d, "-0.2E+01;");
+  realTest("(RD,E8.1,';')", u.d, "-0.2E+01;");
+  realTest("(RU,E8.1,';')", u.d, "-0.1E+01;");
+  realTest("(RZ,E8.1,';')", u.d, "-0.1E+01;");
+  realTest("(RC,E8.1,';')", u.d, "-0.2E+01;");
+
+  u.n = 0x4004000000000000;  // 2.5
+  realTest("(E9.2,';')", u.d, " 0.25E+01;");
+  realTest("(RN,E8.1,';')", u.d, " 0.2E+01;");
+  realTest("(RD,E8.1,';')", u.d, " 0.2E+01;");
+  realTest("(RU,E8.1,';')", u.d, " 0.3E+01;");
+  realTest("(RZ,E8.1,';')", u.d, " 0.2E+01;");
+  realTest("(RC,E8.1,';')", u.d, " 0.3E+01;");
+
+  u.n = 0xc004000000000000;  // -2.5
+  realTest("(E9.2,';')", u.d, "-0.25E+01;");
+  realTest("(RN,E8.1,';')", u.d, "-0.2E+01;");
+  realTest("(RD,E8.1,';')", u.d, "-0.3E+01;");
+  realTest("(RU,E8.1,';')", u.d, "-0.2E+01;");
+  realTest("(RZ,E8.1,';')", u.d, "-0.2E+01;");
+  realTest("(RC,E8.1,';')", u.d, "-0.3E+01;");
+
+  u.n = 1;  // least positive nonzero subnormal
+  realTest("(E32.17,';')", u.d, "         0.49406564584124654-323;");
+  realTest("(ES32.17,';')", u.d, "         4.94065645841246544-324;");
+  realTest("(EN32.17,';')", u.d, "         4.94065645841246544-324;");
+  realTest("(E759.752,';')", u.d,
+      " 0."
+      "494065645841246544176568792868221372365059802614324764425585682500675507"
+      "270208751865299836361635992379796564695445717730926656710355939796398774"
+      "796010781878126300713190311404527845817167848982103688718636056998730723"
+      "050006387409153564984387312473397273169615140031715385398074126238565591"
+      "171026658556686768187039560310624931945271591492455329305456544401127480"
+      "129709999541931989409080416563324524757147869014726780159355238611550134"
+      "803526493472019379026810710749170333222684475333572083243193609238289345"
+      "836806010601150616980975307834227731832924790498252473077637592724787465"
+      "608477820373446969953364701797267771758512566055119913150489110145103786"
+      "273816725095583738973359899366480994116420570263709027924276754456522908"
+      "75386825064197182655334472656250-323;");
+  realTest("(G0,';')", u.d, ".5-323;");
+  realTest("(E757.750,';')", u.d,
+      " 0."
+      "494065645841246544176568792868221372365059802614324764425585682500675507"
+      "270208751865299836361635992379796564695445717730926656710355939796398774"
+      "796010781878126300713190311404527845817167848982103688718636056998730723"
+      "050006387409153564984387312473397273169615140031715385398074126238565591"
+      "171026658556686768187039560310624931945271591492455329305456544401127480"
+      "129709999541931989409080416563324524757147869014726780159355238611550134"
+      "803526493472019379026810710749170333222684475333572083243193609238289345"
+      "836806010601150616980975307834227731832924790498252473077637592724787465"
+      "608477820373446969953364701797267771758512566055119913150489110145103786"
+      "273816725095583738973359899366480994116420570263709027924276754456522908"
+      "753868250641971826553344726562-323;");
+  realTest("(RN,E757.750,';')", u.d,
+      " 0."
+      "494065645841246544176568792868221372365059802614324764425585682500675507"
+      "270208751865299836361635992379796564695445717730926656710355939796398774"
+      "796010781878126300713190311404527845817167848982103688718636056998730723"
+      "050006387409153564984387312473397273169615140031715385398074126238565591"
+      "171026658556686768187039560310624931945271591492455329305456544401127480"
+      "129709999541931989409080416563324524757147869014726780159355238611550134"
+      "803526493472019379026810710749170333222684475333572083243193609238289345"
+      "836806010601150616980975307834227731832924790498252473077637592724787465"
+      "608477820373446969953364701797267771758512566055119913150489110145103786"
+      "273816725095583738973359899366480994116420570263709027924276754456522908"
+      "753868250641971826553344726562-323;");
+  realTest("(RD,E757.750,';')", u.d,
+      " 0."
+      "494065645841246544176568792868221372365059802614324764425585682500675507"
+      "270208751865299836361635992379796564695445717730926656710355939796398774"
+      "796010781878126300713190311404527845817167848982103688718636056998730723"
+      "050006387409153564984387312473397273169615140031715385398074126238565591"
+      "171026658556686768187039560310624931945271591492455329305456544401127480"
+      "129709999541931989409080416563324524757147869014726780159355238611550134"
+      "803526493472019379026810710749170333222684475333572083243193609238289345"
+      "836806010601150616980975307834227731832924790498252473077637592724787465"
+      "608477820373446969953364701797267771758512566055119913150489110145103786"
+      "273816725095583738973359899366480994116420570263709027924276754456522908"
+      "753868250641971826553344726562-323;");
+  realTest("(RU,E757.750,';')", u.d,
+      " 0."
+      "494065645841246544176568792868221372365059802614324764425585682500675507"
+      "270208751865299836361635992379796564695445717730926656710355939796398774"
+      "796010781878126300713190311404527845817167848982103688718636056998730723"
+      "050006387409153564984387312473397273169615140031715385398074126238565591"
+      "171026658556686768187039560310624931945271591492455329305456544401127480"
+      "129709999541931989409080416563324524757147869014726780159355238611550134"
+      "803526493472019379026810710749170333222684475333572083243193609238289345"
+      "836806010601150616980975307834227731832924790498252473077637592724787465"
+      "608477820373446969953364701797267771758512566055119913150489110145103786"
+      "273816725095583738973359899366480994116420570263709027924276754456522908"
+      "753868250641971826553344726563-323;");
+  realTest("(RC,E757.750,';')", u.d,
+      " 0."
+      "494065645841246544176568792868221372365059802614324764425585682500675507"
+      "270208751865299836361635992379796564695445717730926656710355939796398774"
+      "796010781878126300713190311404527845817167848982103688718636056998730723"
+      "050006387409153564984387312473397273169615140031715385398074126238565591"
+      "171026658556686768187039560310624931945271591492455329305456544401127480"
+      "129709999541931989409080416563324524757147869014726780159355238611550134"
+      "803526493472019379026810710749170333222684475333572083243193609238289345"
+      "836806010601150616980975307834227731832924790498252473077637592724787465"
+      "608477820373446969953364701797267771758512566055119913150489110145103786"
+      "273816725095583738973359899366480994116420570263709027924276754456522908"
+      "753868250641971826553344726563-323;");
+
+  u.n = 0x10000000000000;  // least positive nonzero normal
+  realTest("(E723.716,';')", u.d,
+      " 0."
+      "222507385850720138309023271733240406421921598046233183055332741688720443"
+      "481391819585428315901251102056406733973103581100515243416155346010885601"
+      "238537771882113077799353200233047961014744258363607192156504694250373420"
+      "837525080665061665815894872049117996859163964850063590877011830487479978"
+      "088775374994945158045160505091539985658247081864511353793580499211598108"
+      "576605199243335211435239014879569960959128889160299264151106346631339366"
+      "347758651302937176204732563178148566435087212282863764204484681140761391"
+      "147706280168985324411002416144742161856716615054015428508471675290190316"
+      "132277889672970737312333408698898317506783884692609277397797285865965494"
+      "10913690954061364675687023986783152906809846172109246253967285156250-"
+      "307;");
+  realTest("(G0,';')", u.d, ".22250738585072014-307;");
+
+  u.n = 0x7fefffffffffffffuLL;  // greatest finite
+  realTest("(E32.17,';')", u.d, "         0.17976931348623157+309;");
+  realTest("(E317.310,';')", u.d,
+      " 0."
+      "179769313486231570814527423731704356798070567525844996598917476803157260"
+      "780028538760589558632766878171540458953514382464234321326889464182768467"
+      "546703537516986049910576551282076245490090389328944075868508455133942304"
+      "583236903222948165808559332123348274797826204144723168738177180919299881"
+      "2504040261841248583680+309;");
+  realTest("(ES317.310,';')", u.d,
+      " 1."
+      "797693134862315708145274237317043567980705675258449965989174768031572607"
+      "800285387605895586327668781715404589535143824642343213268894641827684675"
+      "467035375169860499105765512820762454900903893289440758685084551339423045"
+      "832369032229481658085593321233482747978262041447231687381771809192998812"
+      "5040402618412485836800+308;");
+  realTest("(EN319.310,';')", u.d,
+      " 179."
+      "769313486231570814527423731704356798070567525844996598917476803157260780"
+      "028538760589558632766878171540458953514382464234321326889464182768467546"
+      "703537516986049910576551282076245490090389328944075868508455133942304583"
+      "236903222948165808559332123348274797826204144723168738177180919299881250"
+      "4040261841248583680000+306;");
+  realTest("(G0,';')", u.d, ".17976931348623157+309;");
 
   if (failures == 0) {
     std::cout << "PASS\n";