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};
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;
++p[-1];
}
}
+
*p = '\0';
return {buffer, static_cast<std::size_t>(p - buffer), expo, Inexact};
}
add_library(FortranRuntime
ISO_Fortran_binding.cpp
+ buffer.cpp
derived-type.cpp
descriptor.cpp
+ environment.cpp
file.cpp
format.cpp
io-api.cpp
tools.cpp
transformational.cpp
type-code.cpp
+ unit.cpp
)
target_link_libraries(FortranRuntime
--- /dev/null
+//===-- 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"
+}
+}
--- /dev/null
+//===-- 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_
--- /dev/null
+//===-- 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
+}
+}
--- /dev/null
+//===-- 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_
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));
}
}
path_ = SaveDefaultCharacter(path, pathLength, handler);
+ pathLength_ = pathLength;
if (!path_.get()) {
handler.Crash(
"FILE= is required unless STATUS='OLD' and unit is connected");
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_};
}
}
-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;
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;
}
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) {
// 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};
#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;
}
// 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};
#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;
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)) {
}
}
-bool OpenFile::RawSeek(Offset at) {
+bool OpenFile::RawSeek(FileOffset at) {
#ifdef _LARGEFILE64_SOURCE
return ::lseek64(fd_, at, SEEK_SET) == 0;
#else
#include "io-error.h"
#include "lock.h"
#include "memory.h"
-#include "terminator.h"
#include <cinttypes>
#include <optional>
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 &);
// 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_;
};
#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)
}
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':
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;
case 'C':
modes.roundingMode = common::RoundingMode::TiesAwayFromZero;
return;
+ case 'P':
+ modes.roundingMode = executionEnvironment.defaultOutputRoundingMode;
+ return;
default: break;
}
break;
} 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;
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);
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_;
#ifndef FORTRAN_RUNTIME_FORMAT_H_
#define FORTRAN_RUNTIME_FORMAT_H_
+#include "environment.h"
#include "terminator.h"
#include "flang/common/Fortran.h"
#include <cinttypes>
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;
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:
// 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);
// 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
//
//===----------------------------------------------------------------------===//
+// 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>
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());
}
}
#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()};
- if (free_) {
- FreeMemory(this);
- }
- return result;
+// 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;
}
-
-InternalIoStatementState::InternalIoStatementState(
- const char *sourceFile, int sourceLine)
- : IoStatementState(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>(' '));
+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>
-void InternalFormattedIoStatementState<isInput, CHAR>::Emit(
+bool FixedRecordIoStatementState<isInput, CHAR>::Emit(
const CHAR *data, std::size_t chars) {
if constexpr (isInput) {
- FormatContext::Emit(data, chars); // default Crash()
- } else if (at_ + chars > internalLength_) {
+ 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(internal_ + at_, data, chars * sizeof(CHAR));
+ std::memcpy(buffer_ + at_, data, chars * sizeof(CHAR));
at_ += chars;
+ furthest_ = std::max(furthest_, at_);
+ return true;
}
}
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;
+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>
-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);
- }
+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 InternalFormattedIoStatementState<isInput, CHAR>::EndIoStatement() {
- format_.FinishOutput(*this);
- auto result{GetIoStat()};
+int InternalIoStatementState<isInput, CHAR>::EndIoStatement() {
+ auto result{FixedRecordIoStatementState<isInput, CHAR>::EndIoStatement()};
if (free_) {
FreeMemory(this);
}
return result;
}
+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 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);
+ 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>;
}
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();
+ // 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);
+};
+
+template<bool IsInput, typename CHAR = char>
+class FixedRecordIoStatementState : public IoStatementState {
protected:
+ using Buffer = std::conditional_t<IsInput, const CHAR *, CHAR *>;
+
+public:
+ 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};
};
-class InternalIoStatementState : public IoStatementState {
+template<bool isInput, typename CHAR = char>
+class InternalIoStatementState
+ : public FixedRecordIoStatementState<isInput, CHAR> {
public:
- InternalIoStatementState(const char *sourceFile, int sourceLine);
+ 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_
//===----------------------------------------------------------------------===//
#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::
std::atexit(Fortran::runtime::NotifyOtherImagesOfNormalEnd);
Fortran::runtime::executionEnvironment.Configure(argc, argv, envp);
ConfigureFloatingPoint();
+ Fortran::runtime::Terminator terminator{"ProgramStart()"};
+ Fortran::runtime::io::ExternalFile::InitializePredefinedUnits(terminator);
}
}
#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_
}
void FreeMemory(void *p) { std::free(p); }
-
-void FreeMemoryAndNullify(void *&p) {
- std::free(p);
- p = nullptr;
-}
}
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)...};
}
};
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_
--- /dev/null
+//===-- 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_
//===----------------------------------------------------------------------===//
#include "stop.h"
+#include "io-error.h"
#include "terminator.h"
+#include "unit.h"
#include <cfenv>
#include <cstdio>
#include <cstdlib>
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);
+}
}
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
#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;
// 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_
--- /dev/null
+//===-- 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>();
+}
+}
--- /dev/null
+//===-- 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_
)
add_test(HelloWorld hello-world)
+
+add_executable(external-hello-world
+ external-hello.cpp
+)
+
+target_link_libraries(external-hello-world
+ FortranRuntime
+)
--- /dev/null
+#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;
+}
-// Test basic FORMAT string traversal
+// Tests basic FORMAT string traversal
+
#include "../runtime/format.h"
#include "../runtime/terminator.h"
#include <cstdarg>
// 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];
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) {
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);
}
-// 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>
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";
} else {
projects / platform / upstream / llvm.git / commitdiff