-<!--===- documentation/FortranForCProgrammers.md
-
+<!--===- documentation/FortranForCProgrammers.md
+
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 For C Programmers
--- /dev/null
+<!--===- documentation/IORuntimeInternals.md
+
+ 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 Runtime Library Internal Design
+===========================================
+
+This note is meant to be an overview of the design of the *implementation*
+of the f18 Fortran compiler's runtime support library for I/O statements.
+
+The *interface* to the I/O runtime support library is defined in the
+C++ header file `runtime/io-api.h`.
+This interface was designed to minimize the amount of complexity exposed
+to its clients, which are of course the sequences of calls generated by
+the compiler to implement each I/O statement.
+By keeping this interface as simple as possible, we hope that we have
+lowered the risk of future incompatible changes that would necessitate
+recompilation of Fortran codes in order to link with later versions of
+the runtime library.
+As one will see in `io-api.h`, the interface is also directly callable
+from C and C++ programs.
+
+The I/O facilities of the Fortran 2018 language are specified in the
+language standard in its clauses 12 (I/O statements) and 13 (`FORMAT`).
+It's a complicated collection of language features:
+ * Files can comprise *records* or *streams*.
+ * Records can be fixed-length or variable-length.
+ * Record files can be accessed sequentially or directly (random access).
+ * Files can be *formatted*, or *unformatted* raw bits.
+ * `CHARACTER` scalars and arrays can be used as if they were
+fixed-length formatted sequential record files.
+ * Formatted I/O can be under control of a `FORMAT` statement
+or `FMT=` specifier, *list-directed* with default formatting chosen
+by the runtime, or `NAMELIST`, in which a collection of variables
+can be given a name and passed as a group to the runtime library.
+ * Sequential records of a file can be partially processed by one
+or more *non-advancing* I/O statements and eventually completed by
+another.
+ * `FORMAT` strings can manipulate the position in the current
+record arbitrarily, causing re-reading or overwriting.
+ * Floating-point output formatting supports more rounding modes
+than the IEEE standard for floating-point arithmetic.
+
+The Fortran I/O runtime support library is written in C++17, and
+uses some C++17 standard library facilities, but it is intended
+to not have any link-time dependences on the C++ runtime support
+library or any LLVM libraries.
+This is important because there are at least two C++ runtime support
+libraries, and we don't want Fortran application builders to have to
+build multiple versions of their codes; neither do we want to require
+them to ship LLVM libraries along with their products.
+
+Consequently, dynamic memory allocation in the Fortran runtime
+uses only C's `malloc()` and `free()` functions, and the few
+C++ standard class templates that we instantiate in the library have been
+modified with optional template arguments that override their
+allocators and deallocators.
+
+Conversions between the many binary floating-point formats supported
+by f18 and their decimal representations are performed with the same
+template library of fast conversion algorithms used to interpret
+floating-point values in Fortran source programs and to emit them
+to module files.
+
+Overview of Classes
+===================
+
+A suite of C++ classes and class templates are composed to construct
+the Fortran I/O runtime support library.
+They (mostly) reside in the C++ namespace `Fortran::runtime::io`.
+They are summarized here in a bottom-up order of dependence.
+
+The header and C++ implementation source file names of these
+classes are in the process of being vigorously rearranged and
+modified; use `grep` or an IDE to discover these classes in
+the source for now. (Sorry!)
+
+`Terminator`
+----------
+A general facility for the entire library, `Terminator` latches a
+source program statement location in terms of an unowned pointer to
+its source file path name and line number and uses them to construct
+a fatal error message if needed.
+It is used for both user program errors and internal runtime library crashes.
+
+`IoErrorHandler`
+--------------
+When I/O error conditions arise at runtime that the Fortran program
+might have the privilege to handle itself via `ERR=`, `END=`, or
+`EOR=` labels and/or by an `IOSTAT=` variable, this subclass of
+`Terminator` is used to either latch the error indication or to crash.
+It sorts out priorities in the case of multiple errors and determines
+the final `IOSTAT=` value at the end of an I/O statement.
+
+`MutableModes`
+------------
+Fortran's formatted I/O statements are affected by a suite of
+modes that can be configured by `OPEN` statements, overridden by
+data transfer I/O statement control lists, and further overridden
+between data items with control edit descriptors in a `FORMAT` string.
+These modes are represented with a `MutableModes` instance, and these
+are instantiated and copied where one would expect them to be in
+order to properly isolate their modifications.
+The modes in force at the time each data item is processed constitute
+a member of each `DataEdit`.
+
+`DataEdit`
+--------
+Represents a single data edit descriptor from a `FORMAT` statement
+or `FMT=` character value, with some hidden extensions to also
+support formatting of list-directed transfers.
+It holds an instance of `MutableModes`, and also has a repetition
+count for when an array appears as a data item in the *io-list*.
+For simplicity and efficiency, each data edit descriptor is
+encoded in the `DataEdit` as a simple capitalized character
+(or two) and some optional field widths.
+
+`FormatControl<>`
+---------------
+This class template traverses a `FORMAT` statement's contents (or `FMT=`
+character value) to extract data edit descriptors like `E20.14` to
+serve each item in an I/O data transfer statement's *io-list*,
+making callbacks to an instance of its class template argument
+along the way to effect character literal output and record
+positioning.
+The Fortran language standard defines formatted I/O as if the `FORMAT`
+string were driving the traversal of the data items in the *io-list*,
+but our implementation reverses that perspective to allow a more
+convenient (for the compiler) I/O runtime support library API design
+in which each data item is presented to the library with a distinct
+type-dependent call.
+
+Clients of `FormatControl` instantiations call its `GetNextDataEdit()`
+member function to acquire the next data edit descriptor to be processed
+from the format, and `FinishOutput()` to flush out any remaining
+output strings or record positionings at the end of the *io-list*.
+
+The `DefaultFormatControlCallbacks` structure summarizes the API
+expected by `FormatControl` from its class template actual arguments.
+
+`OpenFile`
+--------
+This class encapsulates all (I hope) the operating system interfaces
+used to interact with the host's filesystems for operations on
+external units.
+Asynchronous I/O interfaces are faked for now with synchronous
+operations and deferred results.
+
+`ConnectionState`
+---------------
+An active connection to an external or internal unit maintains
+the common parts of its state in this subclass of `ConnectionAttributes`.
+The base class holds state that should not change during the
+lifetime of the connection, while the subclass maintains state
+that may change during I/O statement execution.
+
+`InternalDescriptorUnit`
+----------------------
+When I/O is being performed from/to a Fortran `CHARACTER` array
+rather than an external file, this class manages the standard
+interoperable descriptor used to access its elements as records.
+It has the necessary interfaces to serve as an actual argument
+to the `FormatControl` class template.
+
+`FileFrame<>`
+-----------
+This CRTP class template isolates all of the complexity involved between
+an external unit's `OpenFile` and the buffering requirements
+imposed by the capabilities of Fortran `FORMAT` control edit
+descriptors that allow repositioning within the current record.
+Its interface enables its clients to define a "frame" (my term,
+not Fortran's) that is a contiguous range of bytes that are
+or may soon be in the file.
+This frame is defined as a file offset and a byte size.
+The `FileFrame` instance manages an internal circular buffer
+with two essential guarantees:
+
+1. The most recently requested frame is present in the buffer
+and contiguous in memory.
+1. Any extra data after the frame that may have been read from
+the external unit will be preserved, so that it's safe to
+read from a socket, pipe, or tape and not have to worry about
+repositioning and rereading.
+
+In end-of-file situations, it's possible that a request to read
+a frame may come up short.
+
+As a CRTP class template, `FileFrame` accesses the raw filesystem
+facilities it needs from `*this`.
+
+`ExternalFileUnit`
+----------------
+This class mixes in `ConnectionState`, `OpenFile`, and
+`FileFrame<ExternalFileUnit>` to represent the state of an open
+(or soon to be opened) external file descriptor as a Fortran
+I/O unit.
+It has the contextual APIs required to serve as a template actual
+argument to `FormatControl`.
+And it contains a `std::variant<>` suitable for holding the
+state of the active I/O statement in progress on the unit
+(see below).
+
+`ExternalFileUnit` instances reside in a `Map` that is allocated
+as a static variable and indexed by Fortran unit number.
+Static member functions `LookUp()`, `LookUpOrCrash()`, and `LookUpOrCreate()`
+probe the map to convert Fortran `UNIT=` numbers from I/O statements
+into references to active units.
+
+`IoStatementBase`
+---------------
+The subclasses of `IoStatementBase` each encapsulate and maintain
+the state of one active Fortran I/O statement across the several
+I/O runtime library API function calls it may comprise.
+The subclasses handle the distinctions between internal vs. external I/O,
+formatted vs. list-directed vs. unformatted I/O, input vs. output,
+and so on.
+
+`IoStatementBase` inherits default `FORMAT` processing callbacks and
+an `IoErrorHandler`.
+Each of the `IoStatementBase` classes that pertain to formatted I/O
+support the contextual callback interfaces needed by `FormatControl`,
+overriding the default callbacks of the base class, which crash if
+called inappropriately (e.g., if a `CLOSE` statement somehow
+passes a data item from an *io-list*).
+
+The lifetimes of these subclasses' instances each begin with a user
+program call to an I/O API routine with a name like `BeginExternalListOutput()`
+and persist until `EndIoStatement()` is called.
+
+To reduce dynamic memory allocation, *external* I/O statements allocate
+their per-statement state class instances in space reserved in the
+`ExternalFileUnit` instance.
+Internal I/O statements currently use dynamic allocation, but
+the I/O API supports a means whereby the code generated for the Fortran
+program may supply stack space to the I/O runtime support library
+for this purpose.
+
+`IoStatementState`
+----------------
+F18's Fortran I/O runtime support library defines and implements an API
+that uses a sequence of function calls to implement each Fortran I/O
+statement.
+The state of each I/O statement in progress is maintained in some
+subclass of `IoStatementBase`, as noted above.
+The purpose of `IoStatementState` is to provide generic access
+to the specific state classes without recourse to C++ `virtual`
+functions or function pointers, language features that may not be
+available to us in some important execution environments.
+`IoStatementState` comprises a `std::variant<>` of wrapped references
+to the various possibilities, and uses `std::visit()` to
+access them as needed by the I/O API calls that process each specifier
+in the I/O *control-list* and each item in the *io-list*.
+
+Pointers to `IoStatementState` instances are the `Cookie` type returned
+in the I/O API for `Begin...` I/O statement calls, passed back for
+the *control-list* specifiers and *io-list* data items, and consumed
+by the `EndIoStatement()` call at the end of the statement.
+
+Storage for `IoStatementState` is reserved in `ExternalFileUnit` for
+external I/O units, and in the various final subclasses for internal
+I/O statement states otherwise.
+
+Since Fortran permits a `CLOSE` statement to reference a nonexistent
+unit, the library has to treat that (expected to be rare) situation
+as a weird variation of internal I/O since there's no `ExternalFileUnit`
+available to hold its `IoStatementBase` subclass or `IoStatementState`.
+
+A Narrative Overview Of `PRINT *, 'HELLO, WORLD'`
+=================================================
+1. When the compiled Fortran program begins execution at the `main()`
+entry point exported from its main program, it calls `ProgramStart()`
+with its arguments and environment. `ProgramStart()` calls
+`ExternalFileUnit::InitializePredefinedUnits()` to create and
+initialize Fortran units 5 and 6 and connect them with the
+standard input and output file descriptors (respectively).
+1. The generated code calls `BeginExternalListOutput()` to
+start the sequence of calls that implement the `PRINT` statement.
+The default unit code is converted to 6 and passed to
+`ExternalFileUnit::LookUpOrCrash()`, which returns a reference to
+unit 6's instance.
+1. We check that the unit was opened for formatted I/O.
+1. `ExternalFileUnit::BeginIoStatement<>()` is called to initialize
+an instance of `ExternalListIoStatementState<false>` in the unit,
+point to it with an `IoStatementState`, and return a reference to
+that object whose address will be the `Cookie` for this statement.
+1. The generated code calls `OutputAscii()` with that cookie and the
+address and length of the string.
+1. `OutputAscii()` confirms that the cookie corresponds to an output
+statement and determines that it's list-directed.
+1. `ListDirectedStatementState<false>::EmitLeadingSpaceOrAdvance()`
+emits the required initial space on the new current output record
+by calling `IoStatementState::GetConnectionState()` to locate
+the connection state, determining from the record position state
+that the space is necessary, and calling `IoStatementState::Emit()`
+to cough it out. That call is redirected to `ExternalFileUnit::Emit()`,
+which calls `FileFrame<ExternalFileUnit>::WriteFrame()` to extend
+the frame of the current record and then `memcpy()` to fill its
+first byte with the space.
+1. Back in `OutputAscii()`, the mutable modes and connection state
+of the `IoStatementState` are queried to see whether we're in an
+`WRITE(UNIT=,FMT=,DELIM=)` statement with a delimited specifier.
+If we were, the library would emit the appropriate quote marks,
+double up any instances of that character in the text, and split the
+text over multiple records if it's long.
+1. But we don't have a delimiter, so `OutputAscii()` just carves
+up the text into record-sized chunks and emits them. There's just
+one chunk for our short `CHARACTER` string value in this example.
+It's passed to `IoStatementState::Emit()`, which (as above) is
+redirected to `ExternalFileUnit::Emit()`, which interacts with the
+frame to extend the frame and `memcpy` data into the buffer.
+1. A flag is set in `ListDirectedStatementState<false>` to remember
+that the last item emitted in this list-directed output statement
+was an undelimited `CHARACTER` value, so that if the next item is
+also an undelimited `CHARACTER`, no interposing space will be emitted
+between them.
+1. `OutputAscii()` return `true` to its caller.
+1. The generated code calls `EndIoStatement()`, which is redirected to
+`ExternalIoStatementState<false>`'s override of that function.
+As this is not a non-advancing I/O statement, `ExternalFileUnit::AdvanceRecord()`
+is called to end the record. Since this is a sequential formatted
+file, a newline is emitted.
+1. If unit 6 is connected to a terminal, the buffer is flushed.
+`FileFrame<ExternalFileUnit>::Flush()` drives `ExternalFileUnit::Write()`
+to push out the data in maximal contiguous chunks, dealing with any
+short writes that might occur, and collecting I/O errors along the way.
+This statement has no `ERR=` label or `IOSTAT=` specifier, so errors
+arriving at `IoErrorHandler::SignalErrno()` will cause an immediate
+crash.
+1. `ExternalIoStatementBase::EndIoStatement()` is called.
+It gets the final `IOSTAT=` value from `IoStatementBase::EndIoStatement()`,
+tells the `ExternalFileUnit` that no I/O statement remains active, and
+returns the I/O status value back to the program.
+1. Eventually, the program calls `ProgramEndStatement()`, which
+calls `ExternalFileUnit::CloseAll()`, which flushes and closes all
+open files. If the standard output were not a terminal, the output
+would be written now with the same sequence of calls as above.
+1. `exit(EXIT_SUCCESS)`.
--- /dev/null
+//===-- include/flang/common/real.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_COMMON_REAL_H_
+#define FORTRAN_COMMON_REAL_H_
+
+// Characteristics of IEEE-754 & related binary floating-point numbers.
+// The various representations are distinguished by their binary precisions
+// (number of explicit significand bits and any implicit MSB in the fraction).
+
+#include <cinttypes>
+
+namespace Fortran::common {
+
+// Total representation size in bits for each type
+static constexpr int BitsForBinaryPrecision(int binaryPrecision) {
+ switch (binaryPrecision) {
+ case 8: return 16; // IEEE single (truncated): 1+8+7
+ case 11: return 16; // IEEE half precision: 1+5+10
+ case 24: return 32; // IEEE single precision: 1+8+23
+ case 53: return 64; // IEEE double precision: 1+11+52
+ case 64: return 80; // x87 extended precision: 1+15+64
+ case 106: return 128; // "double-double": 2*(1+11+52)
+ case 112: return 128; // IEEE quad precision: 1+16+111
+ default: return -1;
+ }
+}
+
+// Number of significant decimal digits in the fraction of the
+// exact conversion of the least nonzero (subnormal) value
+// in each type; i.e., a 128-bit quad value can be formatted
+// exactly with FORMAT(E0.22981).
+static constexpr int MaxDecimalConversionDigits(int binaryPrecision) {
+ switch (binaryPrecision) {
+ case 8: return 93;
+ case 11: return 17;
+ case 24: return 105;
+ case 53: return 751;
+ case 64: return 11495;
+ case 106: return 2 * 751;
+ case 112: return 22981;
+ default: return -1;
+ }
+}
+
+template<int BINARY_PRECISION> class RealDetails {
+private:
+ // Converts bit widths to whole decimal digits
+ static constexpr int LogBaseTwoToLogBaseTen(int logb2) {
+ constexpr std::int64_t LogBaseTenOfTwoTimesTenToThe12th{301029995664};
+ constexpr std::int64_t TenToThe12th{1000000000000};
+ std::int64_t logb10{
+ (logb2 * LogBaseTenOfTwoTimesTenToThe12th) / TenToThe12th};
+ return static_cast<int>(logb10);
+ }
+
+public:
+ static constexpr int binaryPrecision{BINARY_PRECISION};
+ static constexpr int bits{BitsForBinaryPrecision(binaryPrecision)};
+ static constexpr bool isImplicitMSB{binaryPrecision != 64 /*x87*/};
+ static constexpr int significandBits{binaryPrecision - isImplicitMSB};
+ static constexpr int exponentBits{bits - significandBits - 1 /*sign*/};
+ static constexpr int maxExponent{(1 << exponentBits) - 1};
+ static constexpr int exponentBias{maxExponent / 2};
+
+ static constexpr int decimalPrecision{
+ LogBaseTwoToLogBaseTen(binaryPrecision - 1)};
+ static constexpr int decimalRange{LogBaseTwoToLogBaseTen(exponentBias - 1)};
+
+ // Number of significant decimal digits in the fraction of the
+ // exact conversion of the least nonzero subnormal.
+ static constexpr int maxDecimalConversionDigits{
+ MaxDecimalConversionDigits(binaryPrecision)};
+
+ static_assert(binaryPrecision > 0);
+ static_assert(exponentBits > 1);
+ static_assert(exponentBits <= 16);
+};
+
+}
+#endif // FORTRAN_COMMON_REAL_H_
// Access and manipulate the fields of an IEEE-754 binary
// floating-point value via a generalized template.
+#include "flang/common/real.h"
#include "flang/common/uint128.h"
#include <cinttypes>
#include <climits>
namespace Fortran::decimal {
-static constexpr int BitsForPrecision(int prec) {
- switch (prec) {
- case 8: return 16;
- case 11: return 16;
- case 24: return 32;
- case 53: return 64;
- case 64: return 80;
- case 112: return 128;
- default: return -1;
- }
-}
+template<int BINARY_PRECISION>
+struct BinaryFloatingPointNumber
+ : public common::RealDetails<BINARY_PRECISION> {
-// LOG10(2.)*1E12
-static constexpr std::int64_t ScaledLogBaseTenOfTwo{301029995664};
+ using Details = common::RealDetails<BINARY_PRECISION>;
+ using Details::bits;
+ using Details::decimalPrecision;
+ using Details::decimalRange;
+ using Details::exponentBias;
+ using Details::exponentBits;
+ using Details::isImplicitMSB;
+ using Details::maxDecimalConversionDigits;
+ using Details::maxExponent;
+ using Details::significandBits;
-template<int PRECISION> struct BinaryFloatingPointNumber {
- static constexpr int precision{PRECISION};
- static constexpr int bits{BitsForPrecision(precision)};
using RawType = common::HostUnsignedIntType<bits>;
static_assert(CHAR_BIT * sizeof(RawType) >= bits);
- static constexpr bool implicitMSB{precision != 64 /*x87*/};
- static constexpr int significandBits{precision - implicitMSB};
- static constexpr int exponentBits{bits - 1 - significandBits};
- static constexpr int maxExponent{(1 << exponentBits) - 1};
- static constexpr int exponentBias{maxExponent / 2};
static constexpr RawType significandMask{(RawType{1} << significandBits) - 1};
- static constexpr int RANGE{static_cast<int>(
- (exponentBias - 1) * ScaledLogBaseTenOfTwo / 1000000000000)};
constexpr BinaryFloatingPointNumber() {} // zero
constexpr BinaryFloatingPointNumber(
constexpr RawType Significand() const { return raw & significandMask; }
constexpr RawType Fraction() const {
RawType sig{Significand()};
- if (implicitMSB && BiasedExponent() > 0) {
+ if (isImplicitMSB && BiasedExponent() > 0) {
sig |= RawType{1} << significandBits;
}
return sig;
AlwaysSign = 2, /* emit leading '+' if not negative */
};
+/*
+ * When allocating decimal conversion output buffers, use the maximum
+ * number of significant decimal digits in the representation of the
+ * least nonzero value, and add this extra space for a sign, a NUL, and
+ * some extra due to the library working internally in base 10**16
+ * and computing its output size in multiples of 16.
+ */
+#define EXTRA_DECIMAL_CONVERSION_SPACE (1 + 1 + 16 - 1)
+
#ifdef __cplusplus
template<int PREC>
ConversionToDecimalResult ConvertToDecimal(char *, size_t,
static constexpr Rounding defaultRounding;
#if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__
-constexpr bool IsHostLittleEndian{false};
+constexpr bool isHostLittleEndian{false};
#elif __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__
-constexpr bool IsHostLittleEndian{true};
+constexpr bool isHostLittleEndian{true};
#else
#error host endianness is not known
#endif
extern template class Complex<Real<Integer<16>, 8>>;
extern template class Complex<Real<Integer<32>, 24>>;
extern template class Complex<Real<Integer<64>, 53>>;
-extern template class Complex<Real<Integer<80>, 64, false>>;
+extern template class Complex<Real<Integer<80>, 64>>;
extern template class Complex<Real<Integer<128>, 112>>;
}
#endif // FORTRAN_EVALUATE_COMPLEX_H_
// Member functions that correspond to Fortran intrinsic functions are
// named accordingly in ALL CAPS so that they can be referenced easily in
// the language standard.
-template<int BITS, bool IS_LITTLE_ENDIAN = IsHostLittleEndian,
+template<int BITS, bool IS_LITTLE_ENDIAN = isHostLittleEndian,
int PARTBITS = BITS <= 32 ? BITS : 32,
typename PART = HostUnsignedInt<PARTBITS>,
typename BIGPART = HostUnsignedInt<PARTBITS * 2>>
#include "formatting.h"
#include "integer.h"
#include "rounding-bits.h"
+#include "flang/common/real.h"
#include "flang/evaluate/common.h"
#include <cinttypes>
#include <limits>
// Models IEEE binary floating-point numbers (IEEE 754-2008,
// ISO/IEC/IEEE 60559.2011). The first argument to this
// class template must be (or look like) an instance of Integer<>;
-// the second specifies the number of effective bits in the fraction;
-// the third, if true, indicates that the most significant position of the
-// fraction is an implicit bit whose value is assumed to be 1 in a finite
-// normal number.
-template<typename WORD, int PREC, bool IMPLICIT_MSB = true> class Real {
+// the second specifies the number of effective bits (binary precision)
+// in the fraction.
+template<typename WORD, int PREC>
+class Real : public common::RealDetails<PREC> {
public:
using Word = WORD;
+ static constexpr int binaryPrecision{PREC};
+ using Details = common::RealDetails<PREC>;
+ using Details::exponentBias;
+ using Details::exponentBits;
+ using Details::isImplicitMSB;
+ using Details::maxExponent;
+ using Details::significandBits;
+
static constexpr int bits{Word::bits};
- static constexpr int precision{PREC};
- using Fraction = Integer<precision>; // all bits made explicit
- static constexpr bool implicitMSB{IMPLICIT_MSB};
- static constexpr int significandBits{precision - implicitMSB};
- static constexpr int exponentBits{bits - significandBits - 1 /*sign*/};
- static_assert(precision > 0);
- static_assert(exponentBits > 1);
- static_assert(exponentBits <= 16);
- static constexpr int maxExponent{(1 << exponentBits) - 1};
- static constexpr int exponentBias{maxExponent / 2};
-
- template<typename W, int P, bool I> friend class Real;
+ static_assert(bits >= Details::bits);
+ using Fraction = Integer<binaryPrecision>; // all bits made explicit
+
+ template<typename W, int P> friend class Real;
constexpr Real() {} // +0.0
constexpr Real(const Real &) = default;
static constexpr Real EPSILON() {
Real epsilon;
- epsilon.Normalize(false, exponentBias - precision, Fraction::MASKL(1));
+ epsilon.Normalize(
+ false, exponentBias - binaryPrecision, Fraction::MASKL(1));
return epsilon;
}
static constexpr Real HUGE() {
Real huge;
- huge.Normalize(false, maxExponent - 1, Fraction::MASKR(precision));
+ huge.Normalize(false, maxExponent - 1, Fraction::MASKR(binaryPrecision));
return huge;
}
static constexpr Real TINY() {
return tiny;
}
- static constexpr int DIGITS{precision};
- static constexpr int PRECISION{static_cast<int>(
- (precision - 1) * ScaledLogBaseTenOfTwo / 1000000000000)};
- static constexpr int RANGE{static_cast<int>(
- (exponentBias - 1) * ScaledLogBaseTenOfTwo / 1000000000000)};
+ static constexpr int DIGITS{binaryPrecision};
+ static constexpr int PRECISION{Details::decimalPrecision};
+ static constexpr int RANGE{Details::decimalRange};
static constexpr int MAXEXPONENT{maxExponent - 1 - exponentBias};
static constexpr int MINEXPONENT{1 - exponentBias};
}
ValueWithRealFlags<Real> result;
int exponent{exponentBias + absN.bits - leadz - 1};
- int bitsNeeded{absN.bits - (leadz + implicitMSB)};
+ int bitsNeeded{absN.bits - (leadz + isImplicitMSB)};
int bitsLost{bitsNeeded - significandBits};
if (bitsLost <= 0) {
Fraction fraction{Fraction::ConvertUnsigned(absN).value};
result.flags.set(
RealFlag::Overflow, exponent >= exponentBias + result.value.bits);
result.flags |= intPart.flags;
- int shift{exponent - exponentBias - precision + 1}; // positive -> left
+ int shift{
+ exponent - exponentBias - binaryPrecision + 1}; // positive -> left
result.value =
result.value.ConvertUnsigned(intPart.value.GetFraction().SHIFTR(-shift))
.value.SHIFTL(shift);
}
ValueWithRealFlags<Real> result;
int exponent{exponentBias + x.UnbiasedExponent()};
- int bitsLost{A::precision - precision};
+ int bitsLost{A::binaryPrecision - binaryPrecision};
if (exponent < 1) {
bitsLost += 1 - exponent;
exponent = 1;
// Extracts the fraction; any implied bit is made explicit.
constexpr Fraction GetFraction() const {
Fraction result{Fraction::ConvertUnsigned(word_).value};
- if constexpr (!implicitMSB) {
+ if constexpr (!isImplicitMSB) {
return result;
} else {
int exponent{Exponent()};
extern template class Real<Integer<16>, 8>; // the "other" half format
extern template class Real<Integer<32>, 24>; // IEEE single
extern template class Real<Integer<64>, 53>; // IEEE double
-extern template class Real<Integer<80>, 64, false>; // 80387 extended precision
+extern template class Real<Integer<80>, 64>; // 80387 extended precision
extern template class Real<Integer<128>, 112>; // IEEE quad
// N.B. No "double-double" support.
}
template<>
class Type<TypeCategory::Real, 10> : public TypeBase<TypeCategory::Real, 10> {
public:
- using Scalar = value::Real<value::Integer<80>, 64, false>;
+ using Scalar = value::Real<value::Integer<80>, 64>;
};
// REAL(KIND=16) is IEEE quad precision (128 bits)
// The base-2 logarithm of the least significant bit that can arise
// in a subnormal IEEE floating-point number.
- static constexpr int minLog2AnyBit{-Real::exponentBias - Real::precision};
+ static constexpr int minLog2AnyBit{
+ -Real::exponentBias - Real::binaryPrecision};
// The number of Digits needed to represent the smallest subnormal.
static constexpr int maxDigits{3 - minLog2AnyBit / log10Radix};
}
int twoPow{x.UnbiasedExponent()};
twoPow -= x.bits - 1;
- if (!x.implicitMSB) {
+ if (!x.isImplicitMSB) {
++twoPow;
}
int lshift{x.exponentBits};
}
template<int PREC>
-ConversionToDecimalResult ConvertToDecimal(char *buffer, size_t size,
+ConversionToDecimalResult ConvertToDecimal(char *buffer, std::size_t size,
enum DecimalConversionFlags flags, int digits,
enum FortranRounding rounding, BinaryFloatingPointNumber<PREC> x) {
if (x.IsNaN()) {
}
}
-template ConversionToDecimalResult ConvertToDecimal<8>(char *, size_t,
+template ConversionToDecimalResult ConvertToDecimal<8>(char *, std::size_t,
enum DecimalConversionFlags, int, enum FortranRounding,
BinaryFloatingPointNumber<8>);
-template ConversionToDecimalResult ConvertToDecimal<11>(char *, size_t,
+template ConversionToDecimalResult ConvertToDecimal<11>(char *, std::size_t,
enum DecimalConversionFlags, int, enum FortranRounding,
BinaryFloatingPointNumber<11>);
-template ConversionToDecimalResult ConvertToDecimal<24>(char *, size_t,
+template ConversionToDecimalResult ConvertToDecimal<24>(char *, std::size_t,
enum DecimalConversionFlags, int, enum FortranRounding,
BinaryFloatingPointNumber<24>);
-template ConversionToDecimalResult ConvertToDecimal<53>(char *, size_t,
+template ConversionToDecimalResult ConvertToDecimal<53>(char *, std::size_t,
enum DecimalConversionFlags, int, enum FortranRounding,
BinaryFloatingPointNumber<53>);
-template ConversionToDecimalResult ConvertToDecimal<64>(char *, size_t,
+template ConversionToDecimalResult ConvertToDecimal<64>(char *, std::size_t,
enum DecimalConversionFlags, int, enum FortranRounding,
BinaryFloatingPointNumber<64>);
-template ConversionToDecimalResult ConvertToDecimal<112>(char *, size_t,
+template ConversionToDecimalResult ConvertToDecimal<112>(char *, std::size_t,
enum DecimalConversionFlags, int, enum FortranRounding,
BinaryFloatingPointNumber<112>);
extern "C" {
-ConversionToDecimalResult ConvertFloatToDecimal(char *buffer, size_t size,
+ConversionToDecimalResult ConvertFloatToDecimal(char *buffer, std::size_t size,
enum DecimalConversionFlags flags, int digits,
enum FortranRounding rounding, float x) {
return Fortran::decimal::ConvertToDecimal(buffer, size, flags, digits,
rounding, Fortran::decimal::BinaryFloatingPointNumber<24>(x));
}
-ConversionToDecimalResult ConvertDoubleToDecimal(char *buffer, size_t size,
+ConversionToDecimalResult ConvertDoubleToDecimal(char *buffer, std::size_t size,
enum DecimalConversionFlags flags, int digits,
enum FortranRounding rounding, double x) {
return Fortran::decimal::ConvertToDecimal(buffer, size, flags, digits,
}
#if __x86_64__
-ConversionToDecimalResult ConvertLongDoubleToDecimal(char *buffer, size_t size,
- enum DecimalConversionFlags flags, int digits,
+ConversionToDecimalResult ConvertLongDoubleToDecimal(char *buffer,
+ std::size_t size, enum DecimalConversionFlags flags, int digits,
enum FortranRounding rounding, long double x) {
return Fortran::decimal::ConvertToDecimal(buffer, size, flags, digits,
rounding, Fortran::decimal::BinaryFloatingPointNumber<64>(x));
// The decimal->binary conversion routine will cope with
// returning 0 or Inf, but we must ensure that "expo" didn't
// overflow back around to something legal.
- expo = 10 * Real::RANGE;
+ expo = 10 * Real::decimalRange;
exponent_ = 0;
}
p = q; // exponent was valid
using Raw = typename Binary::RawType;
Raw raw = static_cast<Raw>(isNegative) << (Binary::bits - 1);
raw |= static_cast<Raw>(expo) << Binary::significandBits;
- if constexpr (Binary::implicitMSB) {
+ if constexpr (Binary::isImplicitMSB) {
fraction &= ~topBit;
}
raw |= fraction;
// it sits to the *left* of the digits: i.e., x = .D * 10.**E
exponent_ += digits_ * log10Radix;
// Sanity checks for ridiculous exponents
- static constexpr int crazy{2 * Real::RANGE + log10Radix};
+ static constexpr int crazy{2 * Real::decimalRange + log10Radix};
if (exponent_ < -crazy) { // underflow to +/-0.
return {Real{SignBit()}, Inexact};
} else if (exponent_ > crazy) { // overflow to +/-Inf.
}
}
-#if 0 // pmk
-std::optional<TypeAndShape> TypeAndShape::Characterize(
- const Expr<SomeType> &expr, FoldingContext &context) {
- if (const auto *symbol{UnwrapWholeSymbolDataRef(expr)}) {
- if (const auto *object{
- symbol->detailsIf<semantics::ObjectEntityDetails>()}) {
- return Characterize(*object);
- } else if (const auto *assoc{
- symbol->detailsIf<semantics::AssocEntityDetails>()}) {
- return Characterize(*assoc, context);
- }
- }
- if (auto type{expr.GetType()}) {
- if (auto shape{GetShape(context, expr)}) {
- TypeAndShape result{*type, std::move(*shape)};
- if (type->category() == TypeCategory::Character) {
- if (const auto *chExpr{UnwrapExpr<Expr<SomeCharacter>>(expr)}) {
- if (auto length{chExpr->LEN()}) {
- result.set_LEN(Expr<SomeInteger>{std::move(*length)});
- }
- }
- }
- return result;
- }
- }
- return std::nullopt;
-}
-#endif // pmk
-
bool TypeAndShape::IsCompatibleWith(parser::ContextualMessages &messages,
const TypeAndShape &that, const char *thisIs, const char *thatIs,
bool isElemental) const {
template class Complex<Real<Integer<16>, 8>>;
template class Complex<Real<Integer<32>, 24>>;
template class Complex<Real<Integer<64>, 53>>;
-template class Complex<Real<Integer<80>, 64, false>>;
+template class Complex<Real<Integer<80>, 64>>;
template class Complex<Real<Integer<128>, 112>>;
}
namespace Fortran::evaluate::value {
-template<typename W, int P, bool IM>
-Relation Real<W, P, IM>::Compare(const Real &y) const {
+template<typename W, int P> Relation Real<W, P>::Compare(const Real &y) const {
if (IsNotANumber() || y.IsNotANumber()) { // NaN vs x, x vs NaN
return Relation::Unordered;
} else if (IsInfinite()) {
}
}
-template<typename W, int P, bool IM>
-ValueWithRealFlags<Real<W, P, IM>> Real<W, P, IM>::Add(
+template<typename W, int P>
+ValueWithRealFlags<Real<W, P>> Real<W, P>::Add(
const Real &y, Rounding rounding) const {
ValueWithRealFlags<Real> result;
if (IsNotANumber() || y.IsNotANumber()) {
return result;
}
-template<typename W, int P, bool IM>
-ValueWithRealFlags<Real<W, P, IM>> Real<W, P, IM>::Multiply(
+template<typename W, int P>
+ValueWithRealFlags<Real<W, P>> Real<W, P>::Multiply(
const Real &y, Rounding rounding) const {
ValueWithRealFlags<Real> result;
if (IsNotANumber() || y.IsNotANumber()) {
return result;
}
-template<typename W, int P, bool IM>
-ValueWithRealFlags<Real<W, P, IM>> Real<W, P, IM>::Divide(
+template<typename W, int P>
+ValueWithRealFlags<Real<W, P>> Real<W, P>::Divide(
const Real &y, Rounding rounding) const {
ValueWithRealFlags<Real> result;
if (IsNotANumber() || y.IsNotANumber()) {
return result;
}
-template<typename W, int P, bool IM>
-ValueWithRealFlags<Real<W, P, IM>> Real<W, P, IM>::ToWholeNumber(
+template<typename W, int P>
+ValueWithRealFlags<Real<W, P>> Real<W, P>::ToWholeNumber(
common::RoundingMode mode) const {
ValueWithRealFlags<Real> result{*this};
if (IsNotANumber()) {
} else if (IsInfinite()) {
result.flags.set(RealFlag::Overflow);
} else {
- constexpr int noClipExponent{exponentBias + precision - 1};
+ constexpr int noClipExponent{exponentBias + binaryPrecision - 1};
if (Exponent() < noClipExponent) {
Real adjust; // ABS(EPSILON(adjust)) == 0.5
adjust.Normalize(IsSignBitSet(), noClipExponent, Fraction::MASKL(1));
return result;
}
-template<typename W, int P, bool IM>
-RealFlags Real<W, P, IM>::Normalize(bool negative, int exponent,
+template<typename W, int P>
+RealFlags Real<W, P>::Normalize(bool negative, int exponent,
const Fraction &fraction, Rounding rounding, RoundingBits *roundingBits) {
int lshift{fraction.LEADZ()};
if (lshift == fraction.bits /* fraction is zero */ &&
}
}
}
- if constexpr (implicitMSB) {
+ if constexpr (isImplicitMSB) {
word_ = word_.IBCLR(significandBits);
}
word_ = word_.IOR(Word{exponent}.SHIFTL(significandBits));
return {};
}
-template<typename W, int P, bool IM>
-RealFlags Real<W, P, IM>::Round(
+template<typename W, int P>
+RealFlags Real<W, P>::Round(
Rounding rounding, const RoundingBits &bits, bool multiply) {
int origExponent{Exponent()};
RealFlags flags;
int newExponent{origExponent};
if (sum.carry) {
// The fraction was all ones before rounding; sum.value is now zero
- sum.value = sum.value.IBSET(precision - 1);
+ sum.value = sum.value.IBSET(binaryPrecision - 1);
if (++newExponent >= maxExponent) {
flags.set(RealFlag::Overflow); // rounded away to an infinity
}
return flags;
}
-template<typename W, int P, bool IM>
-void Real<W, P, IM>::NormalizeAndRound(ValueWithRealFlags<Real> &result,
+template<typename W, int P>
+void Real<W, P>::NormalizeAndRound(ValueWithRealFlags<Real> &result,
bool isNegative, int exponent, const Fraction &fraction, Rounding rounding,
RoundingBits roundingBits, bool multiply) {
result.flags |= result.value.Normalize(
return result;
}
-template<typename W, int P, bool IM>
-ValueWithRealFlags<Real<W, P, IM>> Real<W, P, IM>::Read(
+template<typename W, int P>
+ValueWithRealFlags<Real<W, P>> Real<W, P>::Read(
const char *&p, Rounding rounding) {
auto converted{
decimal::ConvertToBinary<P>(p, MapRoundingMode(rounding.mode))};
- const auto *value{reinterpret_cast<Real<W, P, IM> *>(&converted.binary)};
+ const auto *value{reinterpret_cast<Real<W, P> *>(&converted.binary)};
return {*value, MapFlags(converted.flags)};
}
-template<typename W, int P, bool IM>
-std::string Real<W, P, IM>::DumpHexadecimal() const {
+template<typename W, int P> std::string Real<W, P>::DumpHexadecimal() const {
if (IsNotANumber()) {
return "NaN 0x"s + word_.Hexadecimal();
} else if (IsNegative()) {
}
}
-template<typename W, int P, bool IM>
-std::ostream &Real<W, P, IM>::AsFortran(
+template<typename W, int P>
+std::ostream &Real<W, P>::AsFortran(
std::ostream &o, int kind, bool minimal) const {
if (IsNotANumber()) {
o << "(0._" << kind << "/0.)";
template class Real<Integer<16>, 8>;
template class Real<Integer<32>, 24>;
template class Real<Integer<64>, 53>;
-template class Real<Integer<80>, 64, false>;
+template class Real<Integer<80>, 64>;
template class Real<Integer<128>, 112>;
}
integer, parameter :: current_team = -1, initial_team = -2, parent_team = -3
- integer, parameter :: input_unit = 5, output_unit = 6, error_unit = 0
+ integer, parameter :: input_unit = 5, output_unit = 6
+ integer, parameter :: error_unit = output_unit
integer, parameter :: iostat_end = -1, iostat_eor = -2
integer, parameter :: iostat_inquire_internal_unit = -1
add_library(FortranRuntime
ISO_Fortran_binding.cpp
buffer.cpp
+ connection.cpp
derived-type.cpp
descriptor.cpp
environment.cpp
file.cpp
format.cpp
+ internal-unit.cpp
io-api.cpp
io-error.cpp
io-stmt.cpp
main.cpp
memory.cpp
+ numeric-output.cpp
stop.cpp
terminator.cpp
tools.cpp
}
dirty_ = true;
frame_ = at - fileOffset_;
- length_ = std::max(length_, static_cast<std::int64_t>(frame_ + bytes));
+ length_ = std::max<std::int64_t>(length_, 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 chunk{std::min<std::size_t>(length_, size_ - start_)};
std::size_t put{
Store().Write(fileOffset_, buffer_ + start_, chunk, handler)};
length_ -= put;
private:
STORE &Store() { return static_cast<STORE &>(*this); }
- void Reallocate(std::size_t bytes, Terminator &terminator) {
+ void Reallocate(std::size_t bytes, const 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_))};
+ auto chunk{std::min<std::int64_t>(length_, oldSize - start_)};
std::memcpy(buffer_, old + start_, chunk);
start_ = 0;
std::memcpy(buffer_ + chunk, old, length_ - chunk);
dirty_ = false;
}
- void DiscardLeadingBytes(std::size_t n, Terminator &terminator) {
+ void DiscardLeadingBytes(std::size_t n, const Terminator &terminator) {
RUNTIME_CHECK(terminator, length_ >= n);
length_ -= n;
if (length_ == 0) {
--- /dev/null
+//===-- runtime/connection.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 "connection.h"
+#include "environment.h"
+
+namespace Fortran::runtime::io {
+
+std::size_t ConnectionState::RemainingSpaceInRecord() const {
+ return recordLength.value_or(
+ executionEnvironment.listDirectedOutputLineLengthLimit) -
+ positionInRecord;
+}
+}
--- /dev/null
+//===-- runtime/connection.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 connection state (internal & external)
+
+#ifndef FORTRAN_RUNTIME_IO_CONNECTION_H_
+#define FORTRAN_RUNTIME_IO_CONNECTION_H_
+
+#include "format.h"
+#include <cinttypes>
+#include <optional>
+
+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::size_t> recordLength; // RECL= when fixed-length
+ bool isUnformatted{false}; // FORM='UNFORMATTED'
+ bool isUTF8{false}; // ENCODING='UTF-8'
+};
+
+struct ConnectionState : public ConnectionAttributes {
+ std::size_t RemainingSpaceInRecord() const;
+ // 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)
+ bool nonAdvancing{false}; // ADVANCE='NO'
+ // Set at end of non-advancing I/O data transfer
+ std::optional<std::int64_t> leftTabLimit; // offset in current record
+ // currentRecordNumber 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
+};
+}
+#endif // FORTRAN_RUNTIME_IO_CONNECTION_H_
#include "flang/common/idioms.h"
#include <cassert>
#include <cstdlib>
+#include <cstring>
namespace Fortran::runtime {
+Descriptor::Descriptor(const Descriptor &that) {
+ std::memcpy(this, &that, that.SizeInBytes());
+}
+
Descriptor::~Descriptor() {
if (raw_.attribute != CFI_attribute_pointer) {
Deallocate();
raw_.base_addr = nullptr;
raw_.f18Addendum = false;
}
+ Descriptor(const Descriptor &);
~Descriptor();
//===----------------------------------------------------------------------===//
#include "environment.h"
+#include <cstdio>
#include <cstdlib>
#include <limits>
argv = av;
envp = env;
listDirectedOutputLineLengthLimit = 79; // PGI default
- defaultOutputRoundingMode = common::RoundingMode::TiesToEven; // RP=RN
+ defaultOutputRoundingMode =
+ decimal::FortranRounding::RoundNearest; // RP(==RN)
if (auto *x{std::getenv("FORT_FMT_RECL")}) {
char *end;
#ifndef FORTRAN_RUNTIME_ENVIRONMENT_H_
#define FORTRAN_RUNTIME_ENVIRONMENT_H_
-#include "flang/common/Fortran.h"
+#include "flang/decimal/decimal.h"
namespace Fortran::runtime {
struct ExecutionEnvironment {
const char **argv;
const char **envp;
int listDirectedOutputLineLengthLimit;
- common::RoundingMode defaultOutputRoundingMode;
+ enum decimal::FortranRounding defaultOutputRoundingMode;
};
extern ExecutionEnvironment executionEnvironment;
}
+
#endif // FORTRAN_RUNTIME_ENVIRONMENT_H_
#include "file.h"
#include "magic-numbers.h"
#include "memory.h"
-#include "tools.h"
#include <cerrno>
#include <cstring>
#include <fcntl.h>
namespace Fortran::runtime::io {
-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); // 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;
- 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));
- }
- if (!status) {
- status = "UNKNOWN", statusLength = 7;
- }
- static const char *statuses[]{
- "OLD", "NEW", "SCRATCH", "REPLACE", "UNKNOWN", nullptr};
- switch (IdentifyValue(status, statusLength, statuses)) {
- case 0: // STATUS='OLD'
- if (!path && fd_ >= 0) {
- // TODO: Update OpenFile in situ; can ACTION be changed?
+void OpenFile::set_path(OwningPtr<char> &&path, std::size_t bytes) {
+ path_ = std::move(path);
+ pathLength_ = bytes;
+}
+
+void OpenFile::Open(
+ OpenStatus status, Position position, IoErrorHandler &handler) {
+ int flags{mayRead_ ? mayWrite_ ? O_RDWR : O_RDONLY : O_WRONLY};
+ switch (status) {
+ case OpenStatus::Old:
+ if (fd_ >= 0) {
return;
}
break;
- case 1: // STATUS='NEW'
- flags |= O_CREAT | O_EXCL;
- break;
- case 2: // STATUS='SCRATCH'
+ case OpenStatus::New: flags |= O_CREAT | O_EXCL; break;
+ case OpenStatus::Scratch:
if (path_.get()) {
handler.Crash("FILE= must not appear with STATUS='SCRATCH'");
path_.reset();
::unlink(path);
}
return;
- case 3: // STATUS='REPLACE'
- flags |= O_CREAT | O_TRUNC;
- break;
- case 4: // STATUS='UNKNOWN'
+ case OpenStatus::Replace: flags |= O_CREAT | O_TRUNC; break;
+ case OpenStatus::Unknown:
if (fd_ >= 0) {
return;
}
flags |= O_CREAT;
break;
- default:
- handler.Crash(
- "Invalid STATUS='%.*s'", status, static_cast<int>(statusLength));
}
// If we reach this point, we're opening a new file
if (fd_ >= 0) {
- if (::close(fd_) != 0) {
+ if (fd_ <= 2) {
+ // don't actually close a standard file descriptor, we might need it
+ } else if (::close(fd_) != 0) {
handler.SignalErrno();
}
}
- path_ = SaveDefaultCharacter(path, pathLength, handler);
- pathLength_ = pathLength;
if (!path_.get()) {
handler.Crash(
"FILE= is required unless STATUS='OLD' and unit is connected");
}
pending_.reset();
knownSize_.reset();
+ if (position == Position::Append && !RawSeekToEnd()) {
+ handler.SignalErrno();
+ }
+ isTerminal_ = ::isatty(fd_) == 1;
}
void OpenFile::Predefine(int fd) {
pending_.reset();
}
-void OpenFile::Close(
- const char *status, std::size_t statusLength, IoErrorHandler &handler) {
+void OpenFile::Close(CloseStatus status, IoErrorHandler &handler) {
CriticalSection criticalSection{lock_};
CheckOpen(handler);
pending_.reset();
knownSize_.reset();
- static const char *statuses[]{"KEEP", "DELETE", nullptr};
- switch (IdentifyValue(status, statusLength, statuses)) {
- case 0: break;
- case 1:
+ switch (status) {
+ case CloseStatus::Keep: break;
+ case CloseStatus::Delete:
if (path_.get()) {
::unlink(path_.get());
}
break;
- default:
- if (status) {
- handler.Crash(
- "Invalid STATUS='%.*s'", status, static_cast<int>(statusLength));
- }
}
path_.reset();
if (fd_ >= 0) {
}
}
-void OpenFile::CheckOpen(Terminator &terminator) {
+void OpenFile::CheckOpen(const Terminator &terminator) {
RUNTIME_CHECK(terminator, fd_ >= 0);
}
bool OpenFile::RawSeek(FileOffset at) {
#ifdef _LARGEFILE64_SOURCE
- return ::lseek64(fd_, at, SEEK_SET) == 0;
+ return ::lseek64(fd_, at, SEEK_SET) == at;
#else
- return ::lseek(fd_, at, SEEK_SET) == 0;
+ return ::lseek(fd_, at, SEEK_SET) == at;
#endif
}
-int OpenFile::PendingResult(Terminator &terminator, int iostat) {
+bool OpenFile::RawSeekToEnd() {
+#ifdef _LARGEFILE64_SOURCE
+ std::int64_t at{::lseek64(fd_, 0, SEEK_END)};
+#else
+ std::int64_t at{::lseek(fd_, 0, SEEK_END)};
+#endif
+ if (at >= 0) {
+ knownSize_ = at;
+ return true;
+ } else {
+ return false;
+ }
+}
+
+int OpenFile::PendingResult(const Terminator &terminator, int iostat) {
int id{nextId_++};
pending_.reset(&New<Pending>{}(terminator, id, iostat, std::move(pending_)));
return id;
namespace Fortran::runtime::io {
+enum class OpenStatus { Old, New, Scratch, Replace, Unknown };
+enum class CloseStatus { Keep, Delete };
+enum class Position { AsIs, Rewind, Append };
+
class OpenFile {
public:
using FileOffset = std::int64_t;
- 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_; }
+ Lock &lock() { return lock_; }
+ const char *path() const { return path_.get(); }
+ void set_path(OwningPtr<char> &&, std::size_t bytes);
+ std::size_t pathLength() const { return pathLength_; }
bool mayRead() const { return mayRead_; }
- bool mayWrite() const { return mayWrite_; }
- bool mayPosition() const { return mayPosition_; }
void set_mayRead(bool yes) { mayRead_ = yes; }
+ bool mayWrite() const { return mayWrite_; }
void set_mayWrite(bool yes) { mayWrite_ = yes; }
+ bool mayAsynchronous() const { return mayAsynchronous_; }
+ void set_mayAsynchronous(bool yes) { mayAsynchronous_ = yes; }
+ bool mayPosition() const { return mayPosition_; }
void set_mayPosition(bool yes) { mayPosition_ = yes; }
+ FileOffset position() const { return position_; }
+ bool isTerminal() const { return isTerminal_; }
+
+ bool IsOpen() const { return fd_ >= 0; }
+ void Open(OpenStatus, Position, IoErrorHandler &);
+ void Predefine(int fd);
+ void Close(CloseStatus, IoErrorHandler &);
// Reads data into memory; returns amount acquired. Synchronous.
// Partial reads (less than minBytes) signify end-of-file. If the
};
// lock_ must be held for these
- void CheckOpen(Terminator &);
+ void CheckOpen(const Terminator &);
bool Seek(FileOffset, IoErrorHandler &);
bool RawSeek(FileOffset);
- int PendingResult(Terminator &, int);
+ bool RawSeekToEnd();
+ int PendingResult(const Terminator &, int);
Lock lock_;
int fd_{-1};
bool mayRead_{false};
bool mayWrite_{false};
bool mayPosition_{false};
+ bool mayAsynchronous_{false};
FileOffset position_{0};
std::optional<FileOffset> knownSize_;
+ bool isTerminal_{false};
+
int nextId_;
OwningPtr<Pending> pending_;
};
--- /dev/null
+//===-- runtime/format-implementation.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
+//
+//===----------------------------------------------------------------------===//
+
+// Implements out-of-line member functions of template class FormatControl
+
+#ifndef FORTRAN_RUNTIME_FORMAT_IMPLEMENTATION_H_
+#define FORTRAN_RUNTIME_FORMAT_IMPLEMENTATION_H_
+
+#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 {
+
+template<typename CONTEXT>
+FormatControl<CONTEXT>::FormatControl(const Terminator &terminator,
+ const CharType *format, std::size_t formatLength, int maxHeight)
+ : maxHeight_{static_cast<std::uint8_t>(maxHeight)}, format_{format},
+ formatLength_{static_cast<int>(formatLength)} {
+ 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)
+}
+
+template<typename CONTEXT>
+int FormatControl<CONTEXT>::GetMaxParenthesisNesting(
+ const Terminator &terminator, const CharType *format,
+ std::size_t formatLength) {
+ using Validator = common::FormatValidator<CharType>;
+ typename Validator::Reporter reporter{
+ [&](const common::FormatMessage &message) {
+ terminator.Crash(message.text, message.arg);
+ return false; // crashes on error above
+ }};
+ Validator validator{format, formatLength, reporter};
+ validator.Check();
+ return validator.maxNesting();
+}
+
+template<typename CONTEXT>
+int FormatControl<CONTEXT>::GetIntField(
+ const Terminator &terminator, CharType firstCh) {
+ CharType ch{firstCh ? firstCh : PeekNext()};
+ if (ch != '-' && ch != '+' && (ch < '0' || ch > '9')) {
+ terminator.Crash(
+ "Invalid FORMAT: integer expected at '%c'", static_cast<char>(ch));
+ }
+ int result{0};
+ bool negate{ch == '-'};
+ if (negate) {
+ firstCh = '\0';
+ ch = PeekNext();
+ }
+ while (ch >= '0' && ch <= '9') {
+ if (result >
+ std::numeric_limits<int>::max() / 10 - (static_cast<int>(ch) - '0')) {
+ terminator.Crash("FORMAT integer field out of range");
+ }
+ result = 10 * result + ch - '0';
+ if (firstCh) {
+ firstCh = '\0';
+ } else {
+ ++offset_;
+ }
+ ch = PeekNext();
+ }
+ if (negate && (result *= -1) > 0) {
+ terminator.Crash("FORMAT integer field out of range");
+ }
+ return result;
+}
+
+template<typename CONTEXT>
+static void HandleControl(CONTEXT &context, char ch, char next, int n) {
+ MutableModes &modes{context.mutableModes()};
+ switch (ch) {
+ case 'B':
+ if (next == 'Z') {
+ modes.editingFlags |= blankZero;
+ return;
+ }
+ if (next == 'N') {
+ modes.editingFlags &= ~blankZero;
+ return;
+ }
+ break;
+ case 'D':
+ if (next == 'C') {
+ modes.editingFlags |= decimalComma;
+ return;
+ }
+ if (next == 'P') {
+ modes.editingFlags &= ~decimalComma;
+ return;
+ }
+ break;
+ case 'P':
+ if (!next) {
+ modes.scale = n; // kP - decimal scaling by 10**k
+ return;
+ }
+ break;
+ case 'R':
+ switch (next) {
+ case 'N': modes.round = decimal::RoundNearest; return;
+ case 'Z': modes.round = decimal::RoundToZero; return;
+ case 'U': modes.round = decimal::RoundUp; return;
+ case 'D': modes.round = decimal::RoundDown; return;
+ case 'C': modes.round = decimal::RoundCompatible; return;
+ case 'P':
+ modes.round = executionEnvironment.defaultOutputRoundingMode;
+ return;
+ default: break;
+ }
+ break;
+ case 'X':
+ if (!next) {
+ context.HandleRelativePosition(n);
+ return;
+ }
+ break;
+ case 'S':
+ if (next == 'P') {
+ modes.editingFlags |= signPlus;
+ return;
+ }
+ if (!next || next == 'S') {
+ modes.editingFlags &= ~signPlus;
+ return;
+ }
+ break;
+ case 'T': {
+ if (!next) { // Tn
+ context.HandleAbsolutePosition(n - 1); // convert 1-based to 0-based
+ return;
+ }
+ if (next == 'L' || next == 'R') { // TLn & TRn
+ context.HandleRelativePosition(next == 'L' ? -n : n);
+ return;
+ }
+ } break;
+ default: break;
+ }
+ if (next) {
+ context.Crash("Unknown '%c%c' edit descriptor in FORMAT", ch, next);
+ } else {
+ context.Crash("Unknown '%c' edit descriptor in FORMAT", ch);
+ }
+}
+
+// Locates the next data edit descriptor in the format.
+// Handles all repetition counts and control edit descriptors.
+// Generally assumes that the format string has survived the common
+// format validator gauntlet.
+template<typename CONTEXT>
+int FormatControl<CONTEXT>::CueUpNextDataEdit(Context &context, bool stop) {
+ int unlimitedLoopCheck{-1};
+ while (true) {
+ std::optional<int> repeat;
+ bool unlimited{false};
+ CharType ch{Capitalize(GetNextChar(context))};
+ while (ch == ',' || ch == ':') {
+ // Skip commas, and don't complain if they're missing; the format
+ // validator does that.
+ if (stop && ch == ':') {
+ return 0;
+ }
+ ch = Capitalize(GetNextChar(context));
+ }
+ if (ch == '-' || ch == '+' || (ch >= '0' && ch <= '9')) {
+ repeat = GetIntField(context, ch);
+ ch = GetNextChar(context);
+ } else if (ch == '*') {
+ unlimited = true;
+ ch = GetNextChar(context);
+ if (ch != '(') {
+ context.Crash("Invalid FORMAT: '*' may appear only before '('");
+ }
+ }
+ if (ch == '(') {
+ if (height_ >= maxHeight_) {
+ context.Crash("FORMAT stack overflow: too many nested parentheses");
+ }
+ stack_[height_].start = offset_ - 1; // the '('
+ if (unlimited || height_ == 0) {
+ stack_[height_].remaining = Iteration::unlimited;
+ unlimitedLoopCheck = offset_ - 1;
+ } else if (repeat) {
+ if (*repeat <= 0) {
+ *repeat = 1; // error recovery
+ }
+ stack_[height_].remaining = *repeat - 1;
+ } else {
+ stack_[height_].remaining = 0;
+ }
+ ++height_;
+ } else if (height_ == 0) {
+ context.Crash("FORMAT lacks initial '('");
+ } else if (ch == ')') {
+ if (height_ == 1) {
+ if (stop) {
+ return 0; // end of FORMAT and no data items remain
+ }
+ context.AdvanceRecord(); // implied / before rightmost )
+ }
+ if (stack_[height_ - 1].remaining == Iteration::unlimited) {
+ offset_ = stack_[height_ - 1].start + 1;
+ if (offset_ == unlimitedLoopCheck) {
+ context.Crash(
+ "Unlimited repetition in FORMAT lacks data edit descriptors");
+ }
+ } else if (stack_[height_ - 1].remaining-- > 0) {
+ offset_ = stack_[height_ - 1].start + 1;
+ } else {
+ --height_;
+ }
+ } else if (ch == '\'' || ch == '"') {
+ // Quoted 'character literal'
+ CharType quote{ch};
+ auto start{offset_};
+ while (offset_ < formatLength_ && format_[offset_] != quote) {
+ ++offset_;
+ }
+ if (offset_ >= formatLength_) {
+ context.Crash("FORMAT missing closing quote on character literal");
+ }
+ ++offset_;
+ std::size_t chars{
+ static_cast<std::size_t>(&format_[offset_] - &format_[start])};
+ if (PeekNext() == quote) {
+ // subtle: handle doubled quote character in a literal by including
+ // the first in the output, then treating the second as the start
+ // of another character literal.
+ } else {
+ --chars;
+ }
+ context.Emit(format_ + start, chars);
+ } else if (ch == 'H') {
+ // 9HHOLLERITH
+ if (!repeat || *repeat < 1 || offset_ + *repeat > formatLength_) {
+ context.Crash("Invalid width on Hollerith in FORMAT");
+ }
+ context.Emit(format_ + offset_, static_cast<std::size_t>(*repeat));
+ offset_ += *repeat;
+ } else if (ch >= 'A' && ch <= 'Z') {
+ int start{offset_ - 1};
+ CharType next{Capitalize(PeekNext())};
+ 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 == 'L'))) {
+ // Data edit descriptor found
+ offset_ = start;
+ return repeat && *repeat > 0 ? *repeat : 1;
+ } else {
+ // Control edit descriptor
+ if (ch == 'T') { // Tn, TLn, TRn
+ repeat = GetIntField(context);
+ }
+ HandleControl(context, static_cast<char>(ch), static_cast<char>(next),
+ repeat ? *repeat : 1);
+ }
+ } else if (ch == '/') {
+ context.AdvanceRecord(repeat && *repeat > 0 ? *repeat : 1);
+ } else {
+ context.Crash("Invalid character '%c' in FORMAT", static_cast<char>(ch));
+ }
+ }
+}
+
+template<typename CONTEXT>
+DataEdit FormatControl<CONTEXT>::GetNextDataEdit(
+ Context &context, int maxRepeat) {
+
+ // TODO: DT editing
+
+ // Return the next data edit descriptor
+ int repeat{CueUpNextDataEdit(context)};
+ auto start{offset_};
+ DataEdit edit;
+ edit.descriptor = static_cast<char>(Capitalize(GetNextChar(context)));
+ if (edit.descriptor == 'E') {
+ edit.variation = static_cast<char>(Capitalize(PeekNext()));
+ if (edit.variation >= 'A' && edit.variation <= 'Z') {
+ ++offset_;
+ }
+ }
+
+ 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 = GetIntField(context);
+ }
+ edit.modes = context.mutableModes();
+ if (PeekNext() == '.') {
+ ++offset_;
+ edit.digits = GetIntField(context);
+ CharType ch{PeekNext()};
+ if (ch == 'e' || ch == 'E' || ch == 'd' || ch == 'D') {
+ ++offset_;
+ edit.expoDigits = GetIntField(context);
+ }
+ }
+
+ // Handle repeated nonparenthesized edit descriptors
+ if (repeat > 1) {
+ stack_[height_].start = start; // after repeat count
+ stack_[height_].remaining = repeat; // full count
+ ++height_;
+ }
+ edit.repeat = 1;
+ if (height_ > 1) {
+ int start{stack_[height_ - 1].start};
+ if (format_[start] != '(') {
+ if (stack_[height_ - 1].remaining > maxRepeat) {
+ edit.repeat = maxRepeat;
+ stack_[height_ - 1].remaining -= maxRepeat;
+ offset_ = start; // repeat same edit descriptor next time
+ } else {
+ edit.repeat = stack_[height_ - 1].remaining;
+ --height_;
+ }
+ }
+ }
+ return edit;
+}
+
+template<typename CONTEXT>
+void FormatControl<CONTEXT>::FinishOutput(Context &context) {
+ CueUpNextDataEdit(context, true /* stop at colon or end of FORMAT */);
+}
+}
+#endif // FORTRAN_RUNTIME_FORMAT_IMPLEMENTATION_H_
//
//===----------------------------------------------------------------------===//
-#include "format.h"
-#include "io-stmt.h"
-#include "main.h"
-#include "flang/common/format.h"
-#include "flang/decimal/decimal.h"
-#include <limits>
+#include "format-implementation.h"
namespace Fortran::runtime::io {
-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)} {
- 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)
-}
-
-template<typename CHAR>
-int FormatControl<CHAR>::GetMaxParenthesisNesting(
- Terminator &terminator, const CHAR *format, std::size_t formatLength) {
- using Validator = common::FormatValidator<CHAR>;
- typename Validator::Reporter reporter{
- [&](const common::FormatMessage &message) {
- terminator.Crash(message.text, message.arg);
- return false; // crashes on error above
- }};
- Validator validator{format, formatLength, reporter};
- validator.Check();
- return validator.maxNesting();
-}
-
-template<typename CHAR>
-int FormatControl<CHAR>::GetIntField(Terminator &terminator, CHAR firstCh) {
- CHAR ch{firstCh ? firstCh : PeekNext()};
- if (ch != '-' && ch != '+' && (ch < '0' || ch > '9')) {
- terminator.Crash(
- "Invalid FORMAT: integer expected at '%c'", static_cast<char>(ch));
- }
- int result{0};
- bool negate{ch == '-'};
- if (negate) {
- firstCh = '\0';
- ch = PeekNext();
- }
- while (ch >= '0' && ch <= '9') {
- if (result >
- std::numeric_limits<int>::max() / 10 - (static_cast<int>(ch) - '0')) {
- terminator.Crash("FORMAT integer field out of range");
- }
- result = 10 * result + ch - '0';
- if (firstCh) {
- firstCh = '\0';
- } else {
- ++offset_;
- }
- ch = PeekNext();
- }
- if (negate && (result *= -1) > 0) {
- terminator.Crash("FORMAT integer field out of range");
- }
- return result;
-}
-
-static void HandleControl(FormatContext &context, char ch, char next, int n) {
- MutableModes &modes{context.mutableModes()};
- switch (ch) {
- case 'B':
- if (next == 'Z') {
- modes.editingFlags |= blankZero;
- return;
- }
- if (next == 'N') {
- modes.editingFlags &= ~blankZero;
- return;
- }
- break;
- case 'D':
- if (next == 'C') {
- modes.editingFlags |= decimalComma;
- return;
- }
- if (next == 'P') {
- modes.editingFlags &= ~decimalComma;
- return;
- }
- break;
- case 'P':
- if (!next) {
- modes.scale = n; // kP - decimal scaling by 10**k
- return;
- }
- break;
- case 'R':
- switch (next) {
- case 'N': modes.roundingMode = common::RoundingMode::TiesToEven; return;
- case 'Z': modes.roundingMode = common::RoundingMode::ToZero; return;
- case 'U': modes.roundingMode = common::RoundingMode::Up; return;
- case 'D': modes.roundingMode = common::RoundingMode::Down; return;
- case 'C':
- modes.roundingMode = common::RoundingMode::TiesAwayFromZero;
- return;
- case 'P':
- modes.roundingMode = executionEnvironment.defaultOutputRoundingMode;
- return;
- default: break;
- }
- break;
- case 'X':
- if (!next) {
- context.HandleRelativePosition(n);
- return;
- }
- break;
- case 'S':
- if (next == 'P') {
- modes.editingFlags |= signPlus;
- return;
- }
- if (!next || next == 'S') {
- modes.editingFlags &= ~signPlus;
- return;
- }
- break;
- case 'T': {
- if (!next) { // Tn
- context.HandleAbsolutePosition(n);
- return;
- }
- if (next == 'L' || next == 'R') { // TLn & TRn
- context.HandleRelativePosition(next == 'L' ? -n : n);
- return;
- }
- } break;
- default: break;
- }
- if (next) {
- context.Crash("Unknown '%c%c' edit descriptor in FORMAT", ch, next);
- } else {
- context.Crash("Unknown '%c' edit descriptor in FORMAT", ch);
- }
-}
-
-// Locates the next data edit descriptor in the format.
-// Handles all repetition counts and control edit descriptors.
-// Generally assumes that the format string has survived the common
-// format validator gauntlet.
-template<typename CHAR>
-int FormatControl<CHAR>::CueUpNextDataEdit(FormatContext &context, bool stop) {
- int unlimitedLoopCheck{-1};
- while (true) {
- std::optional<int> repeat;
- bool unlimited{false};
- CHAR ch{Capitalize(GetNextChar(context))};
- while (ch == ',' || ch == ':') {
- // Skip commas, and don't complain if they're missing; the format
- // validator does that.
- if (stop && ch == ':') {
- return 0;
- }
- ch = Capitalize(GetNextChar(context));
- }
- if (ch == '-' || ch == '+' || (ch >= '0' && ch <= '9')) {
- repeat = GetIntField(context, ch);
- ch = GetNextChar(context);
- } else if (ch == '*') {
- unlimited = true;
- ch = GetNextChar(context);
- if (ch != '(') {
- context.Crash("Invalid FORMAT: '*' may appear only before '('");
- }
- }
- if (ch == '(') {
- if (height_ >= maxHeight_) {
- context.Crash("FORMAT stack overflow: too many nested parentheses");
- }
- stack_[height_].start = offset_ - 1; // the '('
- if (unlimited || height_ == 0) {
- stack_[height_].remaining = Iteration::unlimited;
- unlimitedLoopCheck = offset_ - 1;
- } else if (repeat) {
- if (*repeat <= 0) {
- *repeat = 1; // error recovery
- }
- stack_[height_].remaining = *repeat - 1;
- } else {
- stack_[height_].remaining = 0;
- }
- ++height_;
- } else if (height_ == 0) {
- context.Crash("FORMAT lacks initial '('");
- } else if (ch == ')') {
- if (height_ == 1) {
- if (stop) {
- return 0; // end of FORMAT and no data items remain
- }
- context.HandleSlash(); // implied / before rightmost )
- }
- if (stack_[height_ - 1].remaining == Iteration::unlimited) {
- offset_ = stack_[height_ - 1].start + 1;
- if (offset_ == unlimitedLoopCheck) {
- context.Crash(
- "Unlimited repetition in FORMAT lacks data edit descriptors");
- }
- } else if (stack_[height_ - 1].remaining-- > 0) {
- offset_ = stack_[height_ - 1].start + 1;
- } else {
- --height_;
- }
- } else if (ch == '\'' || ch == '"') {
- // Quoted 'character literal'
- CHAR quote{ch};
- auto start{offset_};
- while (offset_ < formatLength_ && format_[offset_] != quote) {
- ++offset_;
- }
- if (offset_ >= formatLength_) {
- context.Crash("FORMAT missing closing quote on character literal");
- }
- ++offset_;
- std::size_t chars{
- static_cast<std::size_t>(&format_[offset_] - &format_[start])};
- if (PeekNext() == quote) {
- // subtle: handle doubled quote character in a literal by including
- // the first in the output, then treating the second as the start
- // of another character literal.
- } else {
- --chars;
- }
- context.Emit(format_ + start, chars);
- } else if (ch == 'H') {
- // 9HHOLLERITH
- if (!repeat || *repeat < 1 || offset_ + *repeat > formatLength_) {
- context.Crash("Invalid width on Hollerith in FORMAT");
- }
- context.Emit(format_ + offset_, static_cast<std::size_t>(*repeat));
- offset_ += *repeat;
- } else if (ch >= 'A' && ch <= 'Z') {
- int start{offset_ - 1};
- CHAR next{Capitalize(PeekNext())};
- 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 == 'L'))) {
- // Data edit descriptor found
- offset_ = start;
- return repeat && *repeat > 0 ? *repeat : 1;
- } else {
- // Control edit descriptor
- if (ch == 'T') { // Tn, TLn, TRn
- repeat = GetIntField(context);
- }
- HandleControl(context, static_cast<char>(ch), static_cast<char>(next),
- repeat ? *repeat : 1);
- }
- } else if (ch == '/') {
- context.HandleSlash(repeat && *repeat > 0 ? *repeat : 1);
- } else {
- context.Crash("Invalid character '%c' in FORMAT", static_cast<char>(ch));
- }
- }
-}
-
-template<typename CHAR>
-void FormatControl<CHAR>::GetNext(
- FormatContext &context, DataEdit &edit, int maxRepeat) {
-
- // TODO: DT editing
-
- // Return the next data edit descriptor
- int repeat{CueUpNextDataEdit(context)};
- auto start{offset_};
- edit.descriptor = static_cast<char>(Capitalize(GetNextChar(context)));
- if (edit.descriptor == 'E') {
- edit.variation = static_cast<char>(Capitalize(PeekNext()));
- if (edit.variation >= 'A' && edit.variation <= 'Z') {
- ++offset_;
- } else {
- edit.variation = '\0';
- }
- } else {
- edit.variation = '\0';
- }
-
- 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_;
- edit.digits = GetIntField(context);
- CHAR ch{PeekNext()};
- if (ch == 'e' || ch == 'E' || ch == 'd' || ch == 'D') {
- ++offset_;
- edit.expoDigits = GetIntField(context);
- } else {
- edit.expoDigits.reset();
- }
- } else {
- edit.digits.reset();
- edit.expoDigits.reset();
- }
-
- // Handle repeated nonparenthesized edit descriptors
- if (repeat > 1) {
- stack_[height_].start = start; // after repeat count
- stack_[height_].remaining = repeat; // full count
- ++height_;
- }
- edit.repeat = 1;
- if (height_ > 1) {
- int start{stack_[height_ - 1].start};
- if (format_[start] != '(') {
- if (stack_[height_ - 1].remaining > maxRepeat) {
- edit.repeat = maxRepeat;
- stack_[height_ - 1].remaining -= maxRepeat;
- offset_ = start; // repeat same edit descriptor next time
- } else {
- edit.repeat = stack_[height_ - 1].remaining;
- --height_;
- }
- }
- }
-}
-
-template<typename CHAR>
-void FormatControl<CHAR>::FinishOutput(FormatContext &context) {
- CueUpNextDataEdit(context, true /* stop at colon or end of FORMAT */);
-}
-
-template class FormatControl<char>;
-template class FormatControl<char16_t>;
-template class FormatControl<char32_t>;
+DataEdit DefaultFormatControlCallbacks::GetNextDataEdit(int) {
+ Crash("DefaultFormatControlCallbacks::GetNextDataEdit() called for "
+ "non-formatted I/O statement");
+ return {};
+}
+bool DefaultFormatControlCallbacks::Emit(const char *, std::size_t) {
+ Crash("DefaultFormatControlCallbacks::Emit(char) called for non-output I/O "
+ "statement");
+ return {};
+}
+bool DefaultFormatControlCallbacks::Emit(const char16_t *, std::size_t) {
+ Crash("DefaultFormatControlCallbacks::Emit(char16_t) called for non-output "
+ "I/O statement");
+ return {};
+}
+bool DefaultFormatControlCallbacks::Emit(const char32_t *, std::size_t) {
+ Crash("DefaultFormatControlCallbacks::Emit(char32_t) called for non-output "
+ "I/O statement");
+ return {};
+}
+bool DefaultFormatControlCallbacks::AdvanceRecord(int) {
+ Crash("DefaultFormatControlCallbacks::AdvanceRecord() called unexpectedly");
+ return {};
+}
+bool DefaultFormatControlCallbacks::HandleAbsolutePosition(std::int64_t) {
+ Crash("DefaultFormatControlCallbacks::HandleAbsolutePosition() called for "
+ "non-formatted "
+ "I/O statement");
+ return {};
+}
+bool DefaultFormatControlCallbacks::HandleRelativePosition(std::int64_t) {
+ Crash("DefaultFormatControlCallbacks::HandleRelativePosition() called for "
+ "non-formatted "
+ "I/O statement");
+ return {};
+}
+
+template class FormatControl<InternalFormattedIoStatementState<false>>;
+template class FormatControl<InternalFormattedIoStatementState<true>>;
+template class FormatControl<ExternalFormattedIoStatementState<false>>;
}
#define FORTRAN_RUNTIME_FORMAT_H_
#include "environment.h"
+#include "io-error.h"
#include "terminator.h"
#include "flang/common/Fortran.h"
+#include "flang/decimal/decimal.h"
#include <cinttypes>
#include <optional>
struct MutableModes {
std::uint8_t editingFlags{0}; // BN, DP, SS
- common::RoundingMode roundingMode{
+ enum decimal::FortranRounding round{
executionEnvironment
.defaultOutputRoundingMode}; // RP/ROUND='PROCESSOR_DEFAULT'
bool pad{false}; // PAD= mode on READ
// 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
+
+ // Special internal data edit descriptors to distinguish list-directed I/O
+ static constexpr char ListDirected{'g'}; // non-COMPLEX list-directed
+ static constexpr char ListDirectedRealPart{'r'}; // emit "(r," or "(r;"
+ static constexpr char ListDirectedImaginaryPart{'z'}; // emit "z)"
+ constexpr bool IsListDirected() const {
+ return descriptor == ListDirected || descriptor == ListDirectedRealPart ||
+ descriptor == ListDirectedImaginaryPart;
+ }
+
char variation{'\0'}; // N, S, or X for EN, ES, EX
std::optional<int> width; // the 'w' field; optional for A
std::optional<int> digits; // the 'm' or 'd' field
int repeat{1};
};
-class FormatContext : virtual public Terminator {
-public:
- FormatContext() {}
- virtual ~FormatContext() {}
- explicit FormatContext(const MutableModes &modes) : mutableModes_{modes} {}
- 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:
- MutableModes mutableModes_;
+// FormatControl<A> requires that A have these member functions;
+// these default implementations just crash if called.
+struct DefaultFormatControlCallbacks : public IoErrorHandler {
+ using IoErrorHandler::IoErrorHandler;
+ DataEdit GetNextDataEdit(int = 1);
+ bool Emit(const char *, std::size_t);
+ bool Emit(const char16_t *, std::size_t);
+ bool Emit(const char32_t *, std::size_t);
+ bool AdvanceRecord(int = 1);
+ bool HandleAbsolutePosition(std::int64_t);
+ bool HandleRelativePosition(std::int64_t);
};
// Generates a sequence of DataEdits from a FORMAT statement or
// default-CHARACTER string. Driven by I/O item list processing.
// Errors are fatal. See clause 13.4 in Fortran 2018 for background.
-template<typename CHAR = char> class FormatControl {
+template<typename CONTEXT> class FormatControl {
public:
+ using Context = CONTEXT;
+ using CharType = typename Context::CharType;
+
FormatControl() {}
- // TODO: make 'format' a reference here and below
- FormatControl(Terminator &, const CHAR *format, std::size_t formatLength,
- int maxHeight = maxMaxHeight);
+ FormatControl(const Terminator &, const CharType *format,
+ std::size_t formatLength, int maxHeight = maxMaxHeight);
// Determines the max parenthesis nesting level by scanning and validating
// the FORMAT string.
static int GetMaxParenthesisNesting(
- Terminator &, const CHAR *format, std::size_t formatLength);
+ const Terminator &, const CharType *format, std::size_t formatLength);
// For attempting to allocate in a user-supplied stack area
static std::size_t GetNeededSize(int maxHeight) {
// Extracts the next data edit descriptor, handling control edit descriptors
// along the way.
- void GetNext(FormatContext &, DataEdit &, int maxRepeat = 1);
+ DataEdit GetNextDataEdit(Context &, int maxRepeat = 1);
// Emit any remaining character literals after the last data item.
- void FinishOutput(FormatContext &);
+ void FinishOutput(Context &);
private:
static constexpr std::uint8_t maxMaxHeight{100};
++offset_;
}
}
- CHAR PeekNext() {
+ CharType PeekNext() {
SkipBlanks();
return offset_ < formatLength_ ? format_[offset_] : '\0';
}
- CHAR GetNextChar(Terminator &terminator) {
+ CharType GetNextChar(const Terminator &terminator) {
SkipBlanks();
if (offset_ >= formatLength_) {
terminator.Crash("FORMAT missing at least one ')'");
}
return format_[offset_++];
}
- int GetIntField(Terminator &, CHAR firstCh = '\0');
+ int GetIntField(const Terminator &, CharType firstCh = '\0');
// Advances through the FORMAT until the next data edit
// descriptor has been found; handles control edit descriptors
// along the way. Returns the repeat count that appeared
// before the descriptor (defaulting to 1) and leaves offset_
// pointing to the data edit.
- int CueUpNextDataEdit(FormatContext &, bool stop = false);
+ int CueUpNextDataEdit(Context &, bool stop = false);
- static constexpr CHAR Capitalize(CHAR ch) {
+ static constexpr CharType Capitalize(CharType ch) {
return ch >= 'a' && ch <= 'z' ? ch + 'A' - 'a' : ch;
}
// user program for internal I/O.
const std::uint8_t maxHeight_{maxMaxHeight};
std::uint8_t height_{0};
- const CHAR *format_{nullptr};
+ const CharType *format_{nullptr};
int formatLength_{0};
int offset_{0}; // next item is at format_[offset_]
// must be last, may be incomplete
Iteration stack_[maxMaxHeight];
};
-
-extern template class FormatControl<char>;
-extern template class FormatControl<char16_t>;
-extern template class FormatControl<char32_t>;
}
#endif // FORTRAN_RUNTIME_FORMAT_H_
--- /dev/null
+//===-- runtime/internal-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 "internal-unit.h"
+#include "descriptor.h"
+#include "io-error.h"
+#include <algorithm>
+#include <type_traits>
+
+namespace Fortran::runtime::io {
+
+template<bool isInput>
+InternalDescriptorUnit<isInput>::InternalDescriptorUnit(
+ Scalar scalar, std::size_t length) {
+ recordLength = length;
+ endfileRecordNumber = 2;
+ void *pointer{reinterpret_cast<void *>(const_cast<char *>(scalar))};
+ descriptor().Establish(TypeCode{CFI_type_char}, length, pointer, 0, nullptr,
+ CFI_attribute_pointer);
+}
+
+template<bool isInput>
+InternalDescriptorUnit<isInput>::InternalDescriptorUnit(
+ const Descriptor &that, const Terminator &terminator) {
+ RUNTIME_CHECK(terminator, that.type().IsCharacter());
+ Descriptor &d{descriptor()};
+ RUNTIME_CHECK(
+ terminator, that.SizeInBytes() <= d.SizeInBytes(maxRank, true, 0));
+ new (&d) Descriptor{that};
+ d.Check();
+ recordLength = d.ElementBytes();
+ endfileRecordNumber = d.Elements() + 1;
+ d.GetLowerBounds(at_);
+}
+
+template<bool isInput> void InternalDescriptorUnit<isInput>::EndIoStatement() {
+ if constexpr (!isInput) {
+ // blank fill
+ while (currentRecordNumber < endfileRecordNumber.value_or(0)) {
+ char *record{descriptor().template Element<char>(at_)};
+ std::fill_n(record + furthestPositionInRecord,
+ recordLength.value_or(0) - furthestPositionInRecord, ' ');
+ furthestPositionInRecord = 0;
+ ++currentRecordNumber;
+ descriptor().IncrementSubscripts(at_);
+ }
+ }
+}
+
+template<bool isInput>
+bool InternalDescriptorUnit<isInput>::Emit(
+ const char *data, std::size_t bytes, IoErrorHandler &handler) {
+ if constexpr (isInput) {
+ handler.Crash(
+ "InternalDescriptorUnit<true>::Emit() called for an input statement");
+ return false;
+ }
+ if (currentRecordNumber >= endfileRecordNumber.value_or(0)) {
+ handler.SignalEnd();
+ return false;
+ }
+ char *record{descriptor().template Element<char>(at_)};
+ auto furthestAfter{std::max(furthestPositionInRecord,
+ positionInRecord + static_cast<std::int64_t>(bytes))};
+ bool ok{true};
+ if (furthestAfter > static_cast<std::int64_t>(recordLength.value_or(0))) {
+ handler.SignalEor();
+ furthestAfter = recordLength.value_or(0);
+ bytes = std::max(std::int64_t{0}, furthestAfter - positionInRecord);
+ ok = false;
+ }
+ std::memcpy(record + positionInRecord, data, bytes);
+ positionInRecord += bytes;
+ furthestPositionInRecord = furthestAfter;
+ return ok;
+}
+
+template<bool isInput>
+bool InternalDescriptorUnit<isInput>::AdvanceRecord(IoErrorHandler &handler) {
+ if (currentRecordNumber >= endfileRecordNumber.value_or(0)) {
+ handler.SignalEnd();
+ return false;
+ }
+ if (!HandleAbsolutePosition(recordLength.value_or(0), handler)) {
+ return false;
+ }
+ ++currentRecordNumber;
+ descriptor().IncrementSubscripts(at_);
+ positionInRecord = 0;
+ furthestPositionInRecord = 0;
+ return true;
+}
+
+template<bool isInput>
+bool InternalDescriptorUnit<isInput>::HandleAbsolutePosition(
+ std::int64_t n, IoErrorHandler &handler) {
+ n = std::max<std::int64_t>(0, n);
+ bool ok{true};
+ if (n > static_cast<std::int64_t>(recordLength.value_or(n))) {
+ handler.SignalEor();
+ n = *recordLength;
+ ok = false;
+ }
+ if (n > furthestPositionInRecord && ok) {
+ if constexpr (!isInput) {
+ char *record{descriptor().template Element<char>(at_)};
+ std::fill_n(
+ record + furthestPositionInRecord, n - furthestPositionInRecord, ' ');
+ }
+ furthestPositionInRecord = n;
+ }
+ positionInRecord = n;
+ return ok;
+}
+
+template<bool isInput>
+bool InternalDescriptorUnit<isInput>::HandleRelativePosition(
+ std::int64_t n, IoErrorHandler &handler) {
+ return HandleAbsolutePosition(positionInRecord + n, handler);
+}
+
+template class InternalDescriptorUnit<false>;
+template class InternalDescriptorUnit<true>;
+}
--- /dev/null
+//===-- runtime/internal-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 internal I/O "units"
+
+#ifndef FORTRAN_RUNTIME_IO_INTERNAL_UNIT_H_
+#define FORTRAN_RUNTIME_IO_INTERNAL_UNIT_H_
+
+#include "connection.h"
+#include "descriptor.h"
+#include <cinttypes>
+#include <type_traits>
+
+namespace Fortran::runtime::io {
+
+class IoErrorHandler;
+
+// Points to (but does not own) a CHARACTER scalar or array for internal I/O.
+// Does not buffer.
+template<bool isInput> class InternalDescriptorUnit : public ConnectionState {
+public:
+ using Scalar = std::conditional_t<isInput, const char *, char *>;
+ InternalDescriptorUnit(Scalar, std::size_t);
+ InternalDescriptorUnit(const Descriptor &, const Terminator &);
+ void EndIoStatement();
+
+ bool Emit(const char *, std::size_t bytes, IoErrorHandler &);
+ bool AdvanceRecord(IoErrorHandler &);
+ bool HandleAbsolutePosition(std::int64_t, IoErrorHandler &);
+ bool HandleRelativePosition(std::int64_t, IoErrorHandler &);
+
+private:
+ Descriptor &descriptor() { return staticDescriptor_.descriptor(); }
+ StaticDescriptor<maxRank, true /*addendum*/> staticDescriptor_;
+ SubscriptValue at_[maxRank];
+};
+
+extern template class InternalDescriptorUnit<false>;
+extern template class InternalDescriptorUnit<true>;
+}
+#endif // FORTRAN_RUNTIME_IO_INTERNAL_UNIT_H_
-//===-- runtime/io.cpp ------------------------------------------*- C++ -*-===//
+//===-- runtime/io-api.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.
// Implements the I/O statement API
#include "io-api.h"
+#include "environment.h"
#include "format.h"
#include "io-stmt.h"
#include "memory.h"
#include "numeric-output.h"
#include "terminator.h"
+#include "tools.h"
#include "unit.h"
#include <cstdlib>
#include <memory>
namespace Fortran::runtime::io {
+Cookie IONAME(BeginInternalArrayListOutput)(const Descriptor &descriptor,
+ void ** /*scratchArea*/, std::size_t /*scratchBytes*/,
+ const char *sourceFile, int sourceLine) {
+ Terminator oom{sourceFile, sourceLine};
+ return &New<InternalListIoStatementState<false>>{}(
+ oom, descriptor, sourceFile, sourceLine)
+ .ioStatementState();
+}
+
+Cookie IONAME(BeginInternalArrayFormattedOutput)(const Descriptor &descriptor,
+ const char *format, std::size_t formatLength, void ** /*scratchArea*/,
+ std::size_t /*scratchBytes*/, const char *sourceFile, int sourceLine) {
+ Terminator oom{sourceFile, sourceLine};
+ return &New<InternalFormattedIoStatementState<false>>{}(
+ oom, descriptor, format, formatLength, sourceFile, sourceLine)
+ .ioStatementState();
+}
+
+Cookie IONAME(BeginInternalListOutput)(char *internal,
+ std::size_t internalLength, void ** /*scratchArea*/,
+ std::size_t /*scratchBytes*/, const char *sourceFile, int sourceLine) {
+ Terminator oom{sourceFile, sourceLine};
+ return &New<InternalListIoStatementState<false>>{}(
+ oom, internal, internalLength, sourceFile, sourceLine)
+ .ioStatementState();
+}
+
Cookie IONAME(BeginInternalFormattedOutput)(char *internal,
std::size_t internalLength, const char *format, std::size_t formatLength,
void ** /*scratchArea*/, std::size_t /*scratchBytes*/,
const char *sourceFile, int sourceLine) {
Terminator oom{sourceFile, sourceLine};
return &New<InternalFormattedIoStatementState<false>>{}(oom, internal,
- internalLength, format, formatLength, sourceFile, sourceLine);
+ internalLength, format, formatLength, sourceFile, sourceLine)
+ .ioStatementState();
+}
+
+Cookie IONAME(BeginInternalFormattedInput)(char *internal,
+ std::size_t internalLength, const char *format, std::size_t formatLength,
+ void ** /*scratchArea*/, std::size_t /*scratchBytes*/,
+ const char *sourceFile, int sourceLine) {
+ Terminator oom{sourceFile, sourceLine};
+ return &New<InternalFormattedIoStatementState<true>>{}(oom, internal,
+ internalLength, format, formatLength, sourceFile, sourceLine)
+ .ioStatementState();
+}
+
+Cookie IONAME(BeginExternalListOutput)(
+ ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
+ Terminator terminator{sourceFile, sourceLine};
+ int unit{unitNumber == DefaultUnit ? 6 : unitNumber};
+ ExternalFileUnit &file{ExternalFileUnit::LookUpOrCrash(unit, terminator)};
+ if (file.isUnformatted) {
+ terminator.Crash("List-directed output attempted to unformatted file");
+ }
+ return &file.BeginIoStatement<ExternalListIoStatementState<false>>(
+ file, sourceFile, sourceLine);
}
Cookie IONAME(BeginExternalFormattedOutput)(const char *format,
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);
+ ExternalFileUnit &file{ExternalFileUnit::LookUpOrCrash(unit, terminator)};
+ if (file.isUnformatted) {
+ terminator.Crash("Formatted output attempted to unformatted file");
+ }
+ IoStatementState &io{
+ file.BeginIoStatement<ExternalFormattedIoStatementState<false>>(
+ file, format, formatLength, sourceFile, sourceLine)};
+ return &io;
+}
+
+Cookie IONAME(BeginUnformattedOutput)(
+ ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
+ Terminator terminator{sourceFile, sourceLine};
+ ExternalFileUnit &file{
+ ExternalFileUnit::LookUpOrCrash(unitNumber, terminator)};
+ if (!file.isUnformatted) {
+ terminator.Crash("Unformatted output attempted to formatted file");
+ }
+ IoStatementState &io{
+ file.BeginIoStatement<UnformattedIoStatementState<false>>(
+ file, sourceFile, sourceLine)};
+ if (file.access == Access::Sequential && !file.recordLength.has_value()) {
+ // Filled in by UnformattedIoStatementState<false>::EndIoStatement()
+ io.Emit("\0\0\0\0", 4); // placeholder for record length header
+ }
+ return &io;
+}
+
+Cookie IONAME(BeginOpenUnit)( // OPEN(without NEWUNIT=)
+ ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
+ bool wasExtant{false};
+ ExternalFileUnit &unit{
+ ExternalFileUnit::LookUpOrCreate(unitNumber, &wasExtant)};
+ return &unit.BeginIoStatement<OpenStatementState>(
+ unit, wasExtant, sourceFile, sourceLine);
+}
+
+Cookie IONAME(BeginOpenNewUnit)( // OPEN(NEWUNIT=j)
+ const char *sourceFile, int sourceLine) {
+ return IONAME(BeginOpenUnit)(
+ ExternalFileUnit::NewUnit(), sourceFile, sourceLine);
+}
+
+Cookie IONAME(BeginClose)(
+ ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
+ if (ExternalFileUnit * unit{ExternalFileUnit::LookUp(unitNumber)}) {
+ return &unit->BeginIoStatement<CloseStatementState>(
+ *unit, sourceFile, sourceLine);
+ } else {
+ // CLOSE(UNIT=bad unit) is just a no-op
+ Terminator oom{sourceFile, sourceLine};
+ return &New<NoopCloseStatementState>{}(oom, sourceFile, sourceLine)
+ .ioStatementState();
+ }
+}
+
+// Control list items
+
+void IONAME(EnableHandlers)(
+ Cookie cookie, bool hasIoStat, bool hasErr, bool hasEnd, bool hasEor) {
+ IoErrorHandler &handler{cookie->GetIoErrorHandler()};
+ if (hasIoStat) {
+ handler.HasIoStat();
+ }
+ if (hasErr) {
+ handler.HasErrLabel();
+ }
+ if (hasEnd) {
+ handler.HasEndLabel();
+ }
+ if (hasEor) {
+ handler.HasEorLabel();
+ }
+}
+
+static bool YesOrNo(const char *keyword, std::size_t length, const char *what,
+ const Terminator &terminator) {
+ static const char *keywords[]{"YES", "NO", nullptr};
+ switch (IdentifyValue(keyword, length, keywords)) {
+ case 0: return true;
+ case 1: return false;
+ default:
+ terminator.Crash(
+ "Invalid %s='%.*s'", what, static_cast<int>(length), keyword);
+ return false;
+ }
+}
+
+bool IONAME(SetAdvance)(
+ Cookie cookie, const char *keyword, std::size_t length) {
+ IoStatementState &io{*cookie};
+ ConnectionState &connection{io.GetConnectionState()};
+ connection.nonAdvancing =
+ !YesOrNo(keyword, length, "ADVANCE", io.GetIoErrorHandler());
+ return true;
+}
+
+bool IONAME(SetBlank)(Cookie cookie, const char *keyword, std::size_t length) {
+ IoStatementState &io{*cookie};
+ ConnectionState &connection{io.GetConnectionState()};
+ static const char *keywords[]{"NULL", "ZERO", nullptr};
+ switch (IdentifyValue(keyword, length, keywords)) {
+ case 0: connection.modes.editingFlags &= ~blankZero; return true;
+ case 1: connection.modes.editingFlags |= blankZero; return true;
+ default:
+ io.GetIoErrorHandler().Crash(
+ "Invalid BLANK='%.*s'", static_cast<int>(length), keyword);
+ return false;
+ }
+}
+
+bool IONAME(SetDecimal)(
+ Cookie cookie, const char *keyword, std::size_t length) {
+ IoStatementState &io{*cookie};
+ ConnectionState &connection{io.GetConnectionState()};
+ static const char *keywords[]{"COMMA", "POINT", nullptr};
+ switch (IdentifyValue(keyword, length, keywords)) {
+ case 0: connection.modes.editingFlags |= decimalComma; return true;
+ case 1: connection.modes.editingFlags &= ~decimalComma; return true;
+ default:
+ io.GetIoErrorHandler().Crash(
+ "Invalid DECIMAL='%.*s'", static_cast<int>(length), keyword);
+ return false;
+ }
+}
+
+bool IONAME(SetDelim)(Cookie cookie, const char *keyword, std::size_t length) {
+ IoStatementState &io{*cookie};
+ ConnectionState &connection{io.GetConnectionState()};
+ static const char *keywords[]{"APOSTROPHE", "QUOTE", "NONE", nullptr};
+ switch (IdentifyValue(keyword, length, keywords)) {
+ case 0: connection.modes.delim = '\''; return true;
+ case 1: connection.modes.delim = '"'; return true;
+ case 2: connection.modes.delim = '\0'; return true;
+ default:
+ io.GetIoErrorHandler().Crash(
+ "Invalid DELIM='%.*s'", static_cast<int>(length), keyword);
+ return false;
+ }
+}
+
+bool IONAME(SetPad)(Cookie cookie, const char *keyword, std::size_t length) {
+ IoStatementState &io{*cookie};
+ ConnectionState &connection{io.GetConnectionState()};
+ connection.modes.pad =
+ YesOrNo(keyword, length, "PAD", io.GetIoErrorHandler());
+ return true;
+}
+
+// TODO: SetPos (stream I/O)
+// TODO: SetRec (direct I/O)
+
+bool IONAME(SetRound)(Cookie cookie, const char *keyword, std::size_t length) {
+ IoStatementState &io{*cookie};
+ ConnectionState &connection{io.GetConnectionState()};
+ static const char *keywords[]{"UP", "DOWN", "ZERO", "NEAREST", "COMPATIBLE",
+ "PROCESSOR_DEFINED", nullptr};
+ switch (IdentifyValue(keyword, length, keywords)) {
+ case 0: connection.modes.round = decimal::RoundUp; return true;
+ case 1: connection.modes.round = decimal::RoundDown; return true;
+ case 2: connection.modes.round = decimal::RoundToZero; return true;
+ case 3: connection.modes.round = decimal::RoundNearest; return true;
+ case 4: connection.modes.round = decimal::RoundCompatible; return true;
+ case 5:
+ connection.modes.round = executionEnvironment.defaultOutputRoundingMode;
+ return true;
+ default:
+ io.GetIoErrorHandler().Crash(
+ "Invalid ROUND='%.*s'", static_cast<int>(length), keyword);
+ return false;
+ }
+}
+
+bool IONAME(SetSign)(Cookie cookie, const char *keyword, std::size_t length) {
+ IoStatementState &io{*cookie};
+ ConnectionState &connection{io.GetConnectionState()};
+ static const char *keywords[]{"PLUS", "YES", "PROCESSOR_DEFINED", nullptr};
+ switch (IdentifyValue(keyword, length, keywords)) {
+ case 0: connection.modes.editingFlags |= signPlus; return true;
+ case 1:
+ case 2: // processor default is SS
+ connection.modes.editingFlags &= ~signPlus;
+ return true;
+ default:
+ io.GetIoErrorHandler().Crash(
+ "Invalid SIGN='%.*s'", static_cast<int>(length), keyword);
+ return false;
+ }
+}
+
+bool IONAME(SetAccess)(Cookie cookie, const char *keyword, std::size_t length) {
+ IoStatementState &io{*cookie};
+ auto *open{io.get_if<OpenStatementState>()};
+ if (!open) {
+ io.GetIoErrorHandler().Crash(
+ "SetAccess() called when not in an OPEN statement");
+ }
+ ConnectionState &connection{open->GetConnectionState()};
+ Access access{connection.access};
+ static const char *keywords[]{"SEQUENTIAL", "DIRECT", "STREAM", nullptr};
+ switch (IdentifyValue(keyword, length, keywords)) {
+ case 0: access = Access::Sequential; break;
+ case 1: access = Access::Direct; break;
+ case 2: access = Access::Stream; break;
+ default:
+ open->Crash("Invalid ACCESS='%.*s'", static_cast<int>(length), keyword);
+ }
+ if (access != connection.access) {
+ if (open->wasExtant()) {
+ open->Crash("ACCESS= may not be changed on an open unit");
+ }
+ connection.access = access;
+ }
+ return true;
+}
+
+bool IONAME(SetAction)(Cookie cookie, const char *keyword, std::size_t length) {
+ IoStatementState &io{*cookie};
+ auto *open{io.get_if<OpenStatementState>()};
+ if (!open) {
+ io.GetIoErrorHandler().Crash(
+ "SetAction() called when not in an OPEN statement");
+ }
+ bool mayRead{true};
+ bool mayWrite{true};
+ static const char *keywords[]{"READ", "WRITE", "READWRITE", nullptr};
+ switch (IdentifyValue(keyword, length, keywords)) {
+ case 0: mayWrite = false; break;
+ case 1: mayRead = false; break;
+ case 2: break;
+ default:
+ open->Crash("Invalid ACTION='%.*s'", static_cast<int>(length), keyword);
+ return false;
+ }
+ if (mayRead != open->unit().mayRead() ||
+ mayWrite != open->unit().mayWrite()) {
+ if (open->wasExtant()) {
+ open->Crash("ACTION= may not be changed on an open unit");
+ }
+ open->unit().set_mayRead(mayRead);
+ open->unit().set_mayWrite(mayWrite);
+ }
+ return true;
+}
+
+bool IONAME(SetAsynchronous)(
+ Cookie cookie, const char *keyword, std::size_t length) {
+ IoStatementState &io{*cookie};
+ auto *open{io.get_if<OpenStatementState>()};
+ if (!open) {
+ io.GetIoErrorHandler().Crash(
+ "SetAsynchronous() called when not in an OPEN statement");
+ }
+ static const char *keywords[]{"YES", "NO", nullptr};
+ switch (IdentifyValue(keyword, length, keywords)) {
+ case 0: open->unit().set_mayAsynchronous(true); return true;
+ case 1: open->unit().set_mayAsynchronous(false); return true;
+ default:
+ open->Crash(
+ "Invalid ASYNCHRONOUS='%.*s'", static_cast<int>(length), keyword);
+ return false;
+ }
+}
+
+bool IONAME(SetEncoding)(
+ Cookie cookie, const char *keyword, std::size_t length) {
+ IoStatementState &io{*cookie};
+ auto *open{io.get_if<OpenStatementState>()};
+ if (!open) {
+ io.GetIoErrorHandler().Crash(
+ "SetEncoding() called when not in an OPEN statement");
+ }
+ bool isUTF8{false};
+ static const char *keywords[]{"UTF-8", "DEFAULT", nullptr};
+ switch (IdentifyValue(keyword, length, keywords)) {
+ case 0: isUTF8 = true; break;
+ case 1: isUTF8 = false; break;
+ default:
+ open->Crash("Invalid ENCODING='%.*s'", static_cast<int>(length), keyword);
+ }
+ if (isUTF8 != open->unit().isUTF8) {
+ if (open->wasExtant()) {
+ open->Crash("ENCODING= may not be changed on an open unit");
+ }
+ open->unit().isUTF8 = isUTF8;
+ }
+ return true;
+}
+
+bool IONAME(SetForm)(Cookie cookie, const char *keyword, std::size_t length) {
+ IoStatementState &io{*cookie};
+ auto *open{io.get_if<OpenStatementState>()};
+ if (!open) {
+ io.GetIoErrorHandler().Crash(
+ "SetEncoding() called when not in an OPEN statement");
+ }
+ bool isUnformatted{false};
+ static const char *keywords[]{"FORMATTED", "UNFORMATTED", nullptr};
+ switch (IdentifyValue(keyword, length, keywords)) {
+ case 0: isUnformatted = false; break;
+ case 1: isUnformatted = true; break;
+ default:
+ open->Crash("Invalid FORM='%.*s'", static_cast<int>(length), keyword);
+ }
+ if (isUnformatted != open->unit().isUnformatted) {
+ if (open->wasExtant()) {
+ open->Crash("FORM= may not be changed on an open unit");
+ }
+ open->unit().isUnformatted = isUnformatted;
+ }
+ return true;
+}
+
+bool IONAME(SetPosition)(
+ Cookie cookie, const char *keyword, std::size_t length) {
+ IoStatementState &io{*cookie};
+ auto *open{io.get_if<OpenStatementState>()};
+ if (!open) {
+ io.GetIoErrorHandler().Crash(
+ "SetPosition() called when not in an OPEN statement");
+ }
+ static const char *positions[]{"ASIS", "REWIND", "APPEND", nullptr};
+ switch (IdentifyValue(keyword, length, positions)) {
+ case 0: open->set_position(Position::AsIs); return true;
+ case 1: open->set_position(Position::Rewind); return true;
+ case 2: open->set_position(Position::Append); return true;
+ default:
+ io.GetIoErrorHandler().Crash(
+ "Invalid POSITION='%.*s'", static_cast<int>(length), keyword);
+ }
+ return true;
+}
+
+bool IONAME(SetRecl)(Cookie cookie, std::size_t n) {
+ IoStatementState &io{*cookie};
+ auto *open{io.get_if<OpenStatementState>()};
+ if (!open) {
+ io.GetIoErrorHandler().Crash(
+ "SetRecl() called when not in an OPEN statement");
+ }
+ if (open->wasExtant() && open->unit().recordLength.has_value() &&
+ *open->unit().recordLength != n) {
+ open->Crash("RECL= may not be changed for an open unit");
+ }
+ open->unit().recordLength = n;
+ return true;
+}
+
+bool IONAME(SetStatus)(Cookie cookie, const char *keyword, std::size_t length) {
+ IoStatementState &io{*cookie};
+ if (auto *open{io.get_if<OpenStatementState>()}) {
+ static const char *statuses[]{
+ "OLD", "NEW", "SCRATCH", "REPLACE", "UNKNOWN", nullptr};
+ switch (IdentifyValue(keyword, length, statuses)) {
+ case 0: open->set_status(OpenStatus::Old); return true;
+ case 1: open->set_status(OpenStatus::New); return true;
+ case 2: open->set_status(OpenStatus::Scratch); return true;
+ case 3: open->set_status(OpenStatus::Replace); return true;
+ case 4: open->set_status(OpenStatus::Unknown); return true;
+ default:
+ io.GetIoErrorHandler().Crash(
+ "Invalid STATUS='%.*s'", static_cast<int>(length), keyword);
+ }
+ return false;
+ }
+ if (auto *close{io.get_if<CloseStatementState>()}) {
+ static const char *statuses[]{"KEEP", "DELETE", nullptr};
+ switch (IdentifyValue(keyword, length, statuses)) {
+ case 0: close->set_status(CloseStatus::Keep); return true;
+ case 1: close->set_status(CloseStatus::Delete); return true;
+ default:
+ io.GetIoErrorHandler().Crash(
+ "Invalid STATUS='%.*s'", static_cast<int>(length), keyword);
+ }
+ return false;
+ }
+ if (io.get_if<NoopCloseStatementState>()) {
+ return true; // don't bother validating STATUS= in a no-op CLOSE
+ }
+ io.GetIoErrorHandler().Crash(
+ "SetStatus() called when not in an OPEN or CLOSE statement");
+}
+
+bool IONAME(SetFile)(
+ Cookie cookie, const char *path, std::size_t chars, int kind) {
+ IoStatementState &io{*cookie};
+ if (auto *open{io.get_if<OpenStatementState>()}) {
+ open->set_path(path, chars, kind);
+ return true;
+ }
+ io.GetIoErrorHandler().Crash(
+ "SetFile() called when not in an OPEN statement");
+ return false;
+}
+
+static bool SetInteger(int &x, int kind, int value) {
+ switch (kind) {
+ case 1: reinterpret_cast<std::int8_t &>(x) = value; return true;
+ case 2: reinterpret_cast<std::int16_t &>(x) = value; return true;
+ case 4: x = value; return true;
+ case 8: reinterpret_cast<std::int64_t &>(x) = value; return true;
+ default: return false;
+ }
+}
+
+bool IONAME(GetNewUnit)(Cookie cookie, int &unit, int kind) {
+ IoStatementState &io{*cookie};
+ auto *open{io.get_if<OpenStatementState>()};
+ if (!open) {
+ io.GetIoErrorHandler().Crash(
+ "GetNewUnit() called when not in an OPEN statement");
+ }
+ if (!SetInteger(unit, kind, open->unit().unitNumber())) {
+ open->Crash("GetNewUnit(): Bad INTEGER kind(%d) for result");
+ }
+ return true;
+}
+
+// Data transfers
+// TODO: Input
+
+bool IONAME(OutputDescriptor)(Cookie cookie, const Descriptor &) {
+ IoStatementState &io{*cookie};
+ io.GetIoErrorHandler().Crash(
+ "OutputDescriptor: not yet implemented"); // TODO
+}
+
+bool IONAME(OutputUnformattedBlock)(
+ Cookie cookie, const char *x, std::size_t length) {
+ IoStatementState &io{*cookie};
+ if (auto *unf{io.get_if<UnformattedIoStatementState<false>>()}) {
+ return unf->Emit(x, length);
+ }
+ io.GetIoErrorHandler().Crash("OutputUnformatted() called for an I/O "
+ "statement that is not unformatted output");
+ return false;
}
bool IONAME(OutputInteger64)(Cookie cookie, std::int64_t n) {
IoStatementState &io{*cookie};
- DataEdit edit;
- io.GetNext(edit);
- return EditIntegerOutput(io, edit, n);
+ if (!io.get_if<OutputStatementState>()) {
+ io.GetIoErrorHandler().Crash(
+ "OutputInteger64() called for a non-output I/O statement");
+ return false;
+ }
+ return EditIntegerOutput(io, io.GetNextDataEdit(), 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);
+ if (!io.get_if<OutputStatementState>()) {
+ io.GetIoErrorHandler().Crash(
+ "OutputReal64() called for a non-output I/O statement");
+ return false;
+ }
+ return RealOutputEditing<53>{io, x}.Edit(io.GetNextDataEdit());
+}
+
+bool IONAME(OutputComplex64)(Cookie cookie, double r, double z) {
+ IoStatementState &io{*cookie};
+ if (io.get_if<ListDirectedStatementState<false>>()) {
+ DataEdit real, imaginary;
+ real.descriptor = DataEdit::ListDirectedRealPart;
+ imaginary.descriptor = DataEdit::ListDirectedImaginaryPart;
+ return RealOutputEditing<53>{io, r}.Edit(real) &&
+ RealOutputEditing<53>{io, z}.Edit(imaginary);
+ }
+ return IONAME(OutputReal64)(cookie, r) && IONAME(OutputReal64)(cookie, z);
}
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);
+ if (!io.get_if<OutputStatementState>()) {
+ io.GetIoErrorHandler().Crash(
+ "OutputAscii() called for a non-output I/O statement");
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 ok{true};
+ if (auto *list{io.get_if<ListDirectedStatementState<false>>()}) {
+ // List-directed default CHARACTER output
+ ok &= list->EmitLeadingSpaceOrAdvance(io, length, true);
+ MutableModes &modes{io.mutableModes()};
+ ConnectionState &connection{io.GetConnectionState()};
+ if (modes.delim) {
+ ok &= io.Emit(&modes.delim, 1);
+ for (std::size_t j{0}; j < length; ++j) {
+ if (list->NeedAdvance(connection, 2)) {
+ ok &= io.Emit(&modes.delim, 1) && io.AdvanceRecord() &&
+ io.Emit(&modes.delim, 1);
+ }
+ if (x[j] == modes.delim) {
+ ok &= io.EmitRepeated(modes.delim, 2);
+ } else {
+ ok &= io.Emit(&x[j], 1);
+ }
+ }
+ ok &= io.Emit(&modes.delim, 1);
+ } else {
+ std::size_t put{0};
+ while (put < length) {
+ auto chunk{std::min(length - put, connection.RemainingSpaceInRecord())};
+ ok &= io.Emit(x + put, chunk);
+ put += chunk;
+ if (put < length) {
+ ok &= io.AdvanceRecord() && io.Emit(" ", 1);
+ }
+ }
+ list->lastWasUndelimitedCharacter = true;
+ }
+ } else {
+ // Formatted default CHARACTER output
+ DataEdit edit{io.GetNextDataEdit()};
+ if (edit.descriptor != 'A' && edit.descriptor != 'G') {
+ io.GetIoErrorHandler().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)};
+ ok &= io.EmitRepeated(' ', std::max(0, width - len)) &&
+ io.Emit(x, std::min(width, len));
+ }
+ return ok;
}
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);
+ if (!io.get_if<OutputStatementState>()) {
+ io.GetIoErrorHandler().Crash(
+ "OutputLogical() called for a non-output I/O statement");
return false;
}
- return EmitRepeated(io, ' ', std::max(0, edit.width.value_or(1) - 1)) &&
- io.Emit(truth ? "T" : "F", 1);
+ if (auto *unf{io.get_if<UnformattedIoStatementState<false>>()}) {
+ char x = truth;
+ return unf->Emit(&x, 1);
+ }
+ bool ok{true};
+ if (auto *list{io.get_if<ListDirectedStatementState<false>>()}) {
+ ok &= list->EmitLeadingSpaceOrAdvance(io, 1);
+ } else {
+ DataEdit edit{io.GetNextDataEdit()};
+ if (edit.descriptor != 'L' && edit.descriptor != 'G') {
+ io.GetIoErrorHandler().Crash(
+ "Data edit descriptor '%c' may not be used with a LOGICAL data item",
+ edit.descriptor);
+ return false;
+ }
+ ok &= io.EmitRepeated(' ', std::max(0, edit.width.value_or(1) - 1));
+ }
+ return ok && io.Emit(truth ? "T" : "F", 1);
}
enum Iostat IONAME(EndIoStatement)(Cookie cookie) {
}
// Internal I/O to/from character arrays &/or non-default-kind character
-// requires a descriptor, which must remain unchanged until the I/O
-// statement is complete.
+// requires a descriptor, which is copied.
Cookie IONAME(BeginInternalArrayListOutput)(const Descriptor &,
void **scratchArea = nullptr, std::size_t scratchBytes = 0,
const char *sourceFile = nullptr, int sourceLine = 0);
// }
// }
// if (EndIoStatement(cookie) == FORTRAN_RUTIME_IOSTAT_END) goto label666;
-void IONAME(EnableHandlers)(Cookie, bool HasIostat = false, bool HasErr = false,
- bool HasEnd = false, bool HasEor = false);
+void IONAME(EnableHandlers)(Cookie, bool hasIoStat = false, bool hasErr = false,
+ bool hasEnd = false, bool hasEor = false);
// Control list options. These return false on a error that the
// Begin...() call has specified will be handled by the caller.
// SetFile() may pass a CHARACTER argument of non-default kind,
// and such filenames are converted to UTF-8 before being
// presented to the filesystem.
-bool IONAME(SetFile)(Cookie, const char *, std::size_t, int kind = 1);
+bool IONAME(SetFile)(Cookie, const char *, std::size_t chars, int kind = 1);
-// GetNewUnit() must not be called until after all Set...()
-// connection list specifiers have been called after
-// BeginOpenNewUnit().
-bool IONAME(GetNewUnit)(Cookie, int &, int kind = 4); // NEWUNIT=
+// Acquires the runtime-created unit number for OPEN(NEWUNIT=)
+bool IONAME(GetNewUnit)(Cookie, int &, int kind = 4);
// READ(SIZE=), after all input items
bool IONAME(GetSize)(Cookie, std::int64_t, int kind = 8);
namespace Fortran::runtime::io {
-class IoErrorHandler : virtual public Terminator {
+class IoErrorHandler : public Terminator {
public:
using Terminator::Terminator;
+ explicit IoErrorHandler(const Terminator &that) : Terminator{that} {}
void Begin(const char *sourceFileName, int sourceLine);
void HasIoStat() { flags_ |= hasIoStat; }
void HasErrLabel() { flags_ |= hasErr; }
//===----------------------------------------------------------------------===//
#include "io-stmt.h"
+#include "connection.h"
+#include "format.h"
#include "memory.h"
+#include "tools.h"
#include "unit.h"
#include <algorithm>
#include <cstring>
+#include <limits>
namespace Fortran::runtime::io {
-IoStatementState::IoStatementState(const char *sourceFile, int sourceLine)
- : IoErrorHandler{sourceFile, sourceLine} {}
+int IoStatementBase::EndIoStatement() { return GetIoStat(); }
-int IoStatementState::EndIoStatement() { return 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;
+DataEdit IoStatementBase::GetNextDataEdit(int) {
+ Crash("IoStatementBase::GetNextDataEdit() called for non-formatted I/O "
+ "statement");
}
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} {
-}
+InternalIoStatementState<isInput, CHAR>::InternalIoStatementState(
+ Buffer scalar, std::size_t length, const char *sourceFile, int sourceLine)
+ : IoStatementBase{sourceFile, sourceLine}, unit_{scalar, length} {}
+
+template<bool isInput, typename CHAR>
+InternalIoStatementState<isInput, CHAR>::InternalIoStatementState(
+ const Descriptor &d, const char *sourceFile, int sourceLine)
+ : IoStatementBase{sourceFile, sourceLine}, unit_{d, *this} {}
template<bool isInput, typename CHAR>
-bool FixedRecordIoStatementState<isInput, CHAR>::Emit(
- const CHAR *data, std::size_t chars) {
+bool InternalIoStatementState<isInput, CHAR>::Emit(
+ const CharType *data, std::size_t chars) {
if constexpr (isInput) {
- IoStatementState::Emit(data, chars); // default Crash()
+ Crash("InternalIoStatementState<true>::Emit() called for input statement");
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;
}
+ return unit_.Emit(data, chars, *this);
}
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>(' '));
+bool InternalIoStatementState<isInput, CHAR>::AdvanceRecord(int n) {
+ while (n-- > 0) {
+ if (!unit_.AdvanceRecord(*this)) {
+ return false;
}
}
- 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_);
+ return true;
}
template<bool isInput, typename CHAR>
-int FixedRecordIoStatementState<isInput, CHAR>::EndIoStatement() {
+int InternalIoStatementState<isInput, CHAR>::EndIoStatement() {
if constexpr (!isInput) {
- HandleAbsolutePosition(length_ - leftTabLimit_); // fill
+ unit_.EndIoStatement(); // fill
}
- return GetIoStat();
-}
-
-template<bool isInput, typename CHAR>
-int InternalIoStatementState<isInput, CHAR>::EndIoStatement() {
- auto result{FixedRecordIoStatementState<isInput, CHAR>::EndIoStatement()};
+ auto result{IoStatementBase::EndIoStatement()};
if (free_) {
FreeMemory(this);
}
}
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} {}
+ ioStatementState_{*this}, format_{*this, format, formatLength} {}
+
+template<bool isInput, typename CHAR>
+InternalFormattedIoStatementState<isInput,
+ CHAR>::InternalFormattedIoStatementState(const Descriptor &d,
+ const CHAR *format, std::size_t formatLength, const char *sourceFile,
+ int sourceLine)
+ : InternalIoStatementState<isInput, CHAR>{d, sourceFile, sourceLine},
+ ioStatementState_{*this}, format_{*this, format, formatLength} {}
template<bool isInput, typename CHAR>
int InternalFormattedIoStatementState<isInput, CHAR>::EndIoStatement() {
- format_.FinishOutput(*this);
+ if constexpr (!isInput) {
+ 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} {}
+bool InternalFormattedIoStatementState<isInput, CHAR>::HandleAbsolutePosition(
+ std::int64_t n) {
+ return unit_.HandleAbsolutePosition(n, *this);
+}
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);
+bool InternalFormattedIoStatementState<isInput, CHAR>::HandleRelativePosition(
+ std::int64_t n) {
+ return unit_.HandleRelativePosition(n, *this);
}
template<bool isInput, typename CHAR>
-bool ExternalFormattedIoStatementState<isInput, CHAR>::HandleSlash(int n) {
+InternalListIoStatementState<isInput, CHAR>::InternalListIoStatementState(
+ Buffer buffer, std::size_t length, const char *sourceFile, int sourceLine)
+ : InternalIoStatementState<isInput, CharType>{buffer, length, sourceFile,
+ sourceLine},
+ ioStatementState_{*this} {}
+
+template<bool isInput, typename CHAR>
+InternalListIoStatementState<isInput, CHAR>::InternalListIoStatementState(
+ const Descriptor &d, const char *sourceFile, int sourceLine)
+ : InternalIoStatementState<isInput, CharType>{d, sourceFile, sourceLine},
+ ioStatementState_{*this} {}
+
+ExternalIoStatementBase::ExternalIoStatementBase(
+ ExternalFileUnit &unit, const char *sourceFile, int sourceLine)
+ : IoStatementBase{sourceFile, sourceLine}, unit_{unit} {}
+
+MutableModes &ExternalIoStatementBase::mutableModes() { return unit_.modes; }
+
+ConnectionState &ExternalIoStatementBase::GetConnectionState() { return unit_; }
+
+int ExternalIoStatementBase::EndIoStatement() {
+ if (unit_.nonAdvancing) {
+ unit_.leftTabLimit = unit_.furthestPositionInRecord;
+ unit_.nonAdvancing = false;
+ } else {
+ unit_.leftTabLimit.reset();
+ }
+ auto result{IoStatementBase::EndIoStatement()};
+ unit_.EndIoStatement(); // annihilates *this in unit_.u_
+ return result;
+}
+
+void OpenStatementState::set_path(
+ const char *path, std::size_t length, int kind) {
+ if (kind != 1) { // TODO
+ Crash("OPEN: FILE= with unimplemented: CHARACTER(KIND=%d)", kind);
+ }
+ std::size_t bytes{length * kind}; // TODO: UTF-8 encoding of Unicode path
+ path_ = SaveDefaultCharacter(path, bytes, *this);
+ pathLength_ = length;
+}
+
+int OpenStatementState::EndIoStatement() {
+ if (wasExtant_ && status_ != OpenStatus::Old) {
+ Crash("OPEN statement for connected unit must have STATUS='OLD'");
+ }
+ unit().OpenUnit(status_, position_, std::move(path_), pathLength_, *this);
+ return IoStatementBase::EndIoStatement();
+}
+
+int CloseStatementState::EndIoStatement() {
+ unit().CloseUnit(status_, *this);
+ return IoStatementBase::EndIoStatement();
+}
+
+int NoopCloseStatementState::EndIoStatement() {
+ auto result{IoStatementBase::EndIoStatement()};
+ FreeMemory(this);
+ return result;
+}
+
+template<bool isInput> int ExternalIoStatementState<isInput>::EndIoStatement() {
+ if constexpr (!isInput) {
+ if (!unit().nonAdvancing) {
+ unit().AdvanceRecord(*this);
+ }
+ unit().FlushIfTerminal(*this);
+ }
+ return ExternalIoStatementBase::EndIoStatement();
+}
+
+template<bool isInput>
+bool ExternalIoStatementState<isInput>::Emit(
+ const char *data, std::size_t chars) {
+ if (isInput) {
+ Crash("ExternalIoStatementState::Emit called for input statement");
+ }
+ return unit().Emit(data, chars * sizeof(*data), *this);
+}
+
+template<bool isInput>
+bool ExternalIoStatementState<isInput>::Emit(
+ const char16_t *data, std::size_t chars) {
+ if (isInput) {
+ Crash("ExternalIoStatementState::Emit called for input statement");
+ }
+ // TODO: UTF-8 encoding
+ return unit().Emit(
+ reinterpret_cast<const char *>(data), chars * sizeof(*data), *this);
+}
+
+template<bool isInput>
+bool ExternalIoStatementState<isInput>::Emit(
+ const char32_t *data, std::size_t chars) {
+ if (isInput) {
+ Crash("ExternalIoStatementState::Emit called for input statement");
+ }
+ // TODO: UTF-8 encoding
+ return unit().Emit(
+ reinterpret_cast<const char *>(data), chars * sizeof(*data), *this);
+}
+
+template<bool isInput>
+bool ExternalIoStatementState<isInput>::AdvanceRecord(int n) {
while (n-- > 0) {
- if (!file_.NextOutputRecord(*this)) {
+ if (!unit().AdvanceRecord(*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>
+bool ExternalIoStatementState<isInput>::HandleAbsolutePosition(std::int64_t n) {
+ return unit().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>
+bool ExternalIoStatementState<isInput>::HandleRelativePosition(std::int64_t n) {
+ return unit().HandleRelativePosition(n, *this);
}
template<bool isInput, typename CHAR>
+ExternalFormattedIoStatementState<isInput,
+ CHAR>::ExternalFormattedIoStatementState(ExternalFileUnit &unit,
+ const CHAR *format, std::size_t formatLength, const char *sourceFile,
+ int sourceLine)
+ : ExternalIoStatementState<isInput>{unit, sourceFile, sourceLine},
+ mutableModes_{unit.modes}, format_{*this, format, formatLength} {}
+
+template<bool isInput, typename CHAR>
int ExternalFormattedIoStatementState<isInput, CHAR>::EndIoStatement() {
format_.FinishOutput(*this);
- if constexpr (!isInput) {
- file_.NextOutputRecord(*this); // TODO: non-advancing I/O
+ return ExternalIoStatementState<isInput>::EndIoStatement();
+}
+
+DataEdit IoStatementState::GetNextDataEdit(int n) {
+ return std::visit([&](auto &x) { return x.get().GetNextDataEdit(n); }, u_);
+}
+
+bool IoStatementState::Emit(const char *data, std::size_t n) {
+ return std::visit([=](auto &x) { return x.get().Emit(data, n); }, u_);
+}
+
+bool IoStatementState::AdvanceRecord(int n) {
+ return std::visit([=](auto &x) { return x.get().AdvanceRecord(n); }, u_);
+}
+
+int IoStatementState::EndIoStatement() {
+ return std::visit([](auto &x) { return x.get().EndIoStatement(); }, u_);
+}
+
+ConnectionState &IoStatementState::GetConnectionState() {
+ return std::visit(
+ [](auto &x) -> ConnectionState & { return x.get().GetConnectionState(); },
+ u_);
+}
+
+MutableModes &IoStatementState::mutableModes() {
+ return std::visit(
+ [](auto &x) -> MutableModes & { return x.get().mutableModes(); }, u_);
+}
+
+IoErrorHandler &IoStatementState::GetIoErrorHandler() const {
+ return std::visit(
+ [](auto &x) -> IoErrorHandler & {
+ return static_cast<IoErrorHandler &>(x.get());
+ },
+ u_);
+}
+
+bool IoStatementState::EmitRepeated(char ch, std::size_t n) {
+ return std::visit(
+ [=](auto &x) {
+ for (std::size_t j{0}; j < n; ++j) {
+ if (!x.get().Emit(&ch, 1)) {
+ return false;
+ }
+ }
+ return true;
+ },
+ u_);
+}
+
+bool IoStatementState::EmitField(
+ const char *p, std::size_t length, std::size_t width) {
+ if (width <= 0) {
+ width = static_cast<int>(length);
}
- int result{GetIoStat()};
- file_.EndIoStatement(); // annihilates *this in file_.u_
- return result;
+ if (length > static_cast<std::size_t>(width)) {
+ return EmitRepeated('*', width);
+ } else {
+ return EmitRepeated(' ', static_cast<int>(width - length)) &&
+ Emit(p, length);
+ }
+}
+
+bool ListDirectedStatementState<false>::NeedAdvance(
+ const ConnectionState &connection, std::size_t width) const {
+ return connection.positionInRecord > 0 &&
+ width > connection.RemainingSpaceInRecord();
+}
+
+bool ListDirectedStatementState<false>::EmitLeadingSpaceOrAdvance(
+ IoStatementState &io, std::size_t length, bool isCharacter) {
+ if (length == 0) {
+ return true;
+ }
+ const ConnectionState &connection{io.GetConnectionState()};
+ int space{connection.positionInRecord == 0 ||
+ !(isCharacter && lastWasUndelimitedCharacter)};
+ lastWasUndelimitedCharacter = false;
+ if (NeedAdvance(connection, space + length)) {
+ return io.AdvanceRecord();
+ }
+ if (space) {
+ return io.Emit(" ", 1);
+ }
+ return true;
+}
+
+template<bool isInput>
+int UnformattedIoStatementState<isInput>::EndIoStatement() {
+ auto &ext{static_cast<ExternalIoStatementState<isInput> &>(*this)};
+ ExternalFileUnit &unit{ext.unit()};
+ if (unit.access == Access::Sequential && !unit.recordLength.has_value()) {
+ // Overwrite the first four bytes of the record with its length,
+ // and also append the length. These four bytes were skipped over
+ // in BeginUnformattedOutput().
+ // TODO: Break very large records up into subrecords with negative
+ // headers &/or footers
+ union {
+ std::uint32_t u;
+ char c[sizeof u];
+ } u;
+ u.u = unit.furthestPositionInRecord - sizeof u.c;
+ // TODO: Convert record length to little-endian on big-endian host?
+ if (!(ext.Emit(u.c, sizeof u.c) && ext.HandleAbsolutePosition(0) &&
+ ext.Emit(u.c, sizeof u.c) && ext.AdvanceRecord())) {
+ return false;
+ }
+ }
+ return ext.EndIoStatement();
}
+template class InternalIoStatementState<false>;
+template class InternalIoStatementState<true>;
template class InternalFormattedIoStatementState<false>;
+template class InternalFormattedIoStatementState<true>;
+template class InternalListIoStatementState<false>;
+template class ExternalIoStatementState<false>;
template class ExternalFormattedIoStatementState<false>;
+template class ExternalListIoStatementState<false>;
+template class UnformattedIoStatementState<false>;
}
//
//===----------------------------------------------------------------------===//
-// Represents state of an I/O statement in progress
+// Representations of the state of an I/O statement in progress
#ifndef FORTRAN_RUNTIME_IO_STMT_H_
#define FORTRAN_RUNTIME_IO_STMT_H_
#include "descriptor.h"
+#include "file.h"
#include "format.h"
+#include "internal-unit.h"
#include "io-error.h"
+#include <functional>
#include <type_traits>
+#include <variant>
namespace Fortran::runtime::io {
-class ExternalFile;
+struct ConnectionState;
+class ExternalFileUnit;
-class IoStatementState : public IoErrorHandler, public FormatContext {
+class OpenStatementState;
+class CloseStatementState;
+class NoopCloseStatementState;
+template<bool isInput, typename CHAR = char>
+class InternalFormattedIoStatementState;
+template<bool isInput, typename CHAR = char> class InternalListIoStatementState;
+template<bool isInput, typename CHAR = char>
+class ExternalFormattedIoStatementState;
+template<bool isInput> class ExternalListIoStatementState;
+template<bool isInput> class UnformattedIoStatementState;
+
+// The Cookie type in the I/O API is a pointer (for C) to this class.
+class IoStatementState {
public:
- 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<typename A> explicit IoStatementState(A &x) : u_{x} {}
-template<bool IsInput, typename CHAR = char>
-class FixedRecordIoStatementState : public IoStatementState {
-protected:
- using Buffer = std::conditional_t<IsInput, const CHAR *, CHAR *>;
+ // These member functions each project themselves into the active alternative.
+ // They're used by per-data-item routines in the I/O API(e.g., OutputReal64)
+ // to interact with the state of the I/O statement in progress.
+ // This design avoids virtual member functions and function pointers,
+ // which may not have good support in some use cases.
+ DataEdit GetNextDataEdit(int = 1);
+ bool Emit(const char *, std::size_t);
+ bool AdvanceRecord(int = 1);
+ int EndIoStatement();
+ ConnectionState &GetConnectionState();
+ MutableModes &mutableModes();
-public:
- FixedRecordIoStatementState(
- Buffer, std::size_t, const char *sourceFile, int sourceLine);
+ // N.B.: this also works with base classes
+ template<typename A> A *get_if() const {
+ return std::visit(
+ [](auto &x) -> A * {
+ if constexpr (std::is_convertible_v<decltype(x.get()), A &>) {
+ return &x.get();
+ }
+ return nullptr;
+ },
+ u_);
+ }
+ IoErrorHandler &GetIoErrorHandler() const;
- 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();
+ bool EmitRepeated(char, std::size_t);
+ bool EmitField(const char *, std::size_t length, std::size_t width);
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};
+ std::variant<std::reference_wrapper<OpenStatementState>,
+ std::reference_wrapper<CloseStatementState>,
+ std::reference_wrapper<NoopCloseStatementState>,
+ std::reference_wrapper<InternalFormattedIoStatementState<false>>,
+ std::reference_wrapper<InternalFormattedIoStatementState<true>>,
+ std::reference_wrapper<InternalListIoStatementState<false>>,
+ std::reference_wrapper<ExternalFormattedIoStatementState<false>>,
+ std::reference_wrapper<ExternalListIoStatementState<false>>,
+ std::reference_wrapper<UnformattedIoStatementState<false>>>
+ u_;
+};
+
+// Base class for all per-I/O statement state classes.
+// Inherits IoErrorHandler from its base.
+struct IoStatementBase : public DefaultFormatControlCallbacks {
+ using DefaultFormatControlCallbacks::DefaultFormatControlCallbacks;
+ int EndIoStatement();
+ DataEdit GetNextDataEdit(int = 1); // crashing default
+};
+
+struct InputStatementState {};
+struct OutputStatementState {};
+template<bool isInput>
+using IoDirectionState =
+ std::conditional_t<isInput, InputStatementState, OutputStatementState>;
+
+struct FormattedStatementState {};
+
+template<bool isInput> struct ListDirectedStatementState {};
+template<> struct ListDirectedStatementState<false /*output*/> {
+ static std::size_t RemainingSpaceInRecord(const ConnectionState &);
+ bool NeedAdvance(const ConnectionState &, std::size_t) const;
+ bool EmitLeadingSpaceOrAdvance(
+ IoStatementState &, std::size_t, bool isCharacter = false);
+ bool lastWasUndelimitedCharacter{false};
};
template<bool isInput, typename CHAR = char>
-class InternalIoStatementState
- : public FixedRecordIoStatementState<isInput, CHAR> {
+class InternalIoStatementState : public IoStatementBase,
+ public IoDirectionState<isInput> {
public:
- using typename FixedRecordIoStatementState<isInput, CHAR>::Buffer;
+ using CharType = CHAR;
+ using Buffer = std::conditional_t<isInput, const CharType *, CharType *>;
InternalIoStatementState(Buffer, std::size_t,
const char *sourceFile = nullptr, int sourceLine = 0);
- virtual int EndIoStatement();
+ InternalIoStatementState(
+ const Descriptor &, const char *sourceFile = nullptr, int sourceLine = 0);
+ int EndIoStatement();
+ bool Emit(const CharType *, std::size_t chars /* not bytes */);
+ bool AdvanceRecord(int = 1);
+ ConnectionState &GetConnectionState() { return unit_; }
+ MutableModes &mutableModes() { return unit_.modes; }
protected:
bool free_{true};
+ InternalDescriptorUnit<isInput> unit_;
};
-template<bool isInput, typename CHAR = char>
+template<bool isInput, typename CHAR>
class InternalFormattedIoStatementState
- : public InternalIoStatementState<isInput, CHAR> {
+ : public InternalIoStatementState<isInput, CHAR>,
+ public FormattedStatementState {
public:
- using typename InternalIoStatementState<isInput, CHAR>::Buffer;
+ using CharType = CHAR;
+ using typename InternalIoStatementState<isInput, CharType>::Buffer;
InternalFormattedIoStatementState(Buffer internal, std::size_t internalLength,
- const CHAR *format, std::size_t formatLength,
+ const CharType *format, std::size_t formatLength,
const char *sourceFile = nullptr, int sourceLine = 0);
- void GetNext(DataEdit &edit, int maxRepeat = 1) {
- format_.GetNext(*this, edit, maxRepeat);
+ InternalFormattedIoStatementState(const Descriptor &, const CharType *format,
+ std::size_t formatLength, const char *sourceFile = nullptr,
+ int sourceLine = 0);
+ IoStatementState &ioStatementState() { return ioStatementState_; }
+ int EndIoStatement();
+ DataEdit GetNextDataEdit(int maxRepeat = 1) {
+ return format_.GetNextDataEdit(*this, maxRepeat);
}
+ bool HandleRelativePosition(std::int64_t);
+ bool HandleAbsolutePosition(std::int64_t);
+
+private:
+ IoStatementState ioStatementState_; // points to *this
+ using InternalIoStatementState<isInput, CharType>::unit_;
+ // format_ *must* be last; it may be partial someday
+ FormatControl<InternalFormattedIoStatementState> format_;
+};
+
+template<bool isInput, typename CHAR>
+class InternalListIoStatementState
+ : public InternalIoStatementState<isInput, CHAR>,
+ public ListDirectedStatementState<isInput> {
+public:
+ using CharType = CHAR;
+ using typename InternalIoStatementState<isInput, CharType>::Buffer;
+ InternalListIoStatementState(Buffer internal, std::size_t internalLength,
+ const char *sourceFile = nullptr, int sourceLine = 0);
+ InternalListIoStatementState(
+ const Descriptor &, const char *sourceFile = nullptr, int sourceLine = 0);
+ IoStatementState &ioStatementState() { return ioStatementState_; }
+ DataEdit GetNextDataEdit(int maxRepeat = 1) {
+ DataEdit edit;
+ edit.descriptor = DataEdit::ListDirected;
+ edit.repeat = maxRepeat;
+ edit.modes = InternalIoStatementState<isInput, CharType>::mutableModes();
+ return edit;
+ }
+
+private:
+ using InternalIoStatementState<isInput, CharType>::unit_;
+ IoStatementState ioStatementState_; // points to *this
+};
+
+class ExternalIoStatementBase : public IoStatementBase {
+public:
+ ExternalIoStatementBase(
+ ExternalFileUnit &, const char *sourceFile = nullptr, int sourceLine = 0);
+ ExternalFileUnit &unit() { return unit_; }
+ MutableModes &mutableModes();
+ ConnectionState &GetConnectionState();
int EndIoStatement();
private:
- FormatControl<CHAR> format_; // must be last, may be partial
+ ExternalFileUnit &unit_;
};
-template<bool isInput, typename CHAR = char>
-class ExternalFormattedIoStatementState : public IoStatementState {
+template<bool isInput>
+class ExternalIoStatementState : public ExternalIoStatementBase,
+ public IoDirectionState<isInput> {
public:
- ExternalFormattedIoStatementState(ExternalFile &, const CHAR *format,
+ using ExternalIoStatementBase::ExternalIoStatementBase;
+ int EndIoStatement();
+ bool Emit(const char *, std::size_t chars /* not bytes */);
+ bool Emit(const char16_t *, std::size_t chars /* not bytes */);
+ bool Emit(const char32_t *, std::size_t chars /* not bytes */);
+ bool AdvanceRecord(int = 1);
+ bool HandleRelativePosition(std::int64_t);
+ bool HandleAbsolutePosition(std::int64_t);
+};
+
+template<bool isInput, typename CHAR>
+class ExternalFormattedIoStatementState
+ : public ExternalIoStatementState<isInput>,
+ public FormattedStatementState {
+public:
+ using CharType = CHAR;
+ ExternalFormattedIoStatementState(ExternalFileUnit &, const CharType *format,
std::size_t formatLength, const char *sourceFile = nullptr,
int sourceLine = 0);
- void GetNext(DataEdit &edit, int maxRepeat = 1) {
- format_.GetNext(*this, edit, maxRepeat);
+ MutableModes &mutableModes() { return mutableModes_; }
+ int EndIoStatement();
+ DataEdit GetNextDataEdit(int maxRepeat = 1) {
+ return format_.GetNextDataEdit(*this, maxRepeat);
}
- bool Emit(const CHAR *, std::size_t chars /* not bytes */);
- bool HandleSlash(int);
- bool HandleRelativePosition(std::int64_t);
- bool HandleAbsolutePosition(std::int64_t);
+
+private:
+ // These are forked from ConnectionState's modes at the beginning
+ // of each formatted I/O statement so they may be overridden by control
+ // edit descriptors during the statement.
+ MutableModes mutableModes_;
+ FormatControl<ExternalFormattedIoStatementState> format_;
+};
+
+template<bool isInput>
+class ExternalListIoStatementState
+ : public ExternalIoStatementState<isInput>,
+ public ListDirectedStatementState<isInput> {
+public:
+ using ExternalIoStatementState<isInput>::ExternalIoStatementState;
+ DataEdit GetNextDataEdit(int maxRepeat = 1) {
+ DataEdit edit;
+ edit.descriptor = DataEdit::ListDirected;
+ edit.repeat = maxRepeat;
+ edit.modes = ExternalIoStatementState<isInput>::mutableModes();
+ return edit;
+ }
+};
+
+template<bool isInput>
+class UnformattedIoStatementState : public ExternalIoStatementState<isInput> {
+public:
+ using ExternalIoStatementState<isInput>::ExternalIoStatementState;
+ int EndIoStatement();
+};
+
+class OpenStatementState : public ExternalIoStatementBase {
+public:
+ OpenStatementState(ExternalFileUnit &unit, bool wasExtant,
+ const char *sourceFile = nullptr, int sourceLine = 0)
+ : ExternalIoStatementBase{unit, sourceFile, sourceLine}, wasExtant_{
+ wasExtant} {}
+ bool wasExtant() const { return wasExtant_; }
+ void set_status(OpenStatus status) { status_ = status; }
+ void set_path(const char *, std::size_t, int kind); // FILE=
+ void set_position(Position position) { position_ = position; } // POSITION=
+ int EndIoStatement();
+
+private:
+ bool wasExtant_;
+ OpenStatus status_{OpenStatus::Unknown};
+ Position position_{Position::AsIs};
+ OwningPtr<char> path_;
+ std::size_t pathLength_;
+};
+
+class CloseStatementState : public ExternalIoStatementBase {
+public:
+ CloseStatementState(ExternalFileUnit &unit, const char *sourceFile = nullptr,
+ int sourceLine = 0)
+ : ExternalIoStatementBase{unit, sourceFile, sourceLine} {}
+ void set_status(CloseStatus status) { status_ = status; }
+ int EndIoStatement();
+
+private:
+ CloseStatus status_{CloseStatus::Keep};
+};
+
+class NoopCloseStatementState : public IoStatementBase {
+public:
+ NoopCloseStatementState(const char *sourceFile, int sourceLine)
+ : IoStatementBase{sourceFile, sourceLine}, ioStatementState_{*this} {}
+ IoStatementState &ioStatementState() { return ioStatementState_; }
+ void set_status(CloseStatus) {} // discards
+ MutableModes &mutableModes() { return connection_.modes; }
+ ConnectionState &GetConnectionState() { return connection_; }
int EndIoStatement();
private:
- ExternalFile &file_;
- FormatControl<CHAR> format_;
+ IoStatementState ioStatementState_; // points to *this
+ ConnectionState connection_;
};
+extern template class InternalIoStatementState<false>;
+extern template class InternalIoStatementState<true>;
extern template class InternalFormattedIoStatementState<false>;
+extern template class InternalFormattedIoStatementState<true>;
+extern template class InternalListIoStatementState<false>;
+extern template class ExternalIoStatementState<false>;
extern template class ExternalFormattedIoStatementState<false>;
+extern template class ExternalListIoStatementState<false>;
+extern template class UnformattedIoStatementState<false>;
+extern template class FormatControl<InternalFormattedIoStatementState<false>>;
+extern template class FormatControl<InternalFormattedIoStatementState<true>>;
+extern template class FormatControl<ExternalFormattedIoStatementState<false>>;
}
#endif // FORTRAN_RUNTIME_IO_STMT_H_
bool Try() { return pthread_mutex_trylock(&mutex_) != 0; }
void Drop() { pthread_mutex_unlock(&mutex_); }
- void CheckLocked(Terminator &terminator) {
+ void CheckLocked(const Terminator &terminator) {
if (Try()) {
Drop();
terminator.Crash("Lock::CheckLocked() failed");
std::atexit(Fortran::runtime::NotifyOtherImagesOfNormalEnd);
Fortran::runtime::executionEnvironment.Configure(argc, argv, envp);
ConfigureFloatingPoint();
- Fortran::runtime::Terminator terminator{"ProgramStart()"};
- Fortran::runtime::io::ExternalFile::InitializePredefinedUnits(terminator);
+ Fortran::runtime::io::ExternalFileUnit::InitializePredefinedUnits();
}
}
namespace Fortran::runtime {
-void *AllocateMemoryOrCrash(Terminator &terminator, std::size_t bytes) {
+void *AllocateMemoryOrCrash(const Terminator &terminator, std::size_t bytes) {
if (void *p{std::malloc(bytes)}) {
return p;
}
class Terminator;
-[[nodiscard]] void *AllocateMemoryOrCrash(Terminator &, std::size_t bytes);
-template<typename A>[[nodiscard]] A &AllocateOrCrash(Terminator &t) {
+[[nodiscard]] void *AllocateMemoryOrCrash(
+ const Terminator &, std::size_t bytes);
+template<typename A>[[nodiscard]] A &AllocateOrCrash(const Terminator &t) {
return *reinterpret_cast<A *>(AllocateMemoryOrCrash(t, sizeof(A)));
}
void FreeMemory(void *);
template<typename A> struct New {
template<typename... X>
- [[nodiscard]] A &operator()(Terminator &terminator, X &&... x) {
+ [[nodiscard]] A &operator()(const Terminator &terminator, X &&... x) {
return *new (AllocateMemoryOrCrash(terminator, sizeof(A)))
A{std::forward<X>(x)...};
}
template<typename A> struct Allocator {
using value_type = A;
- explicit Allocator(Terminator &t) : terminator{t} {}
+ explicit Allocator(const Terminator &t) : terminator{t} {}
template<typename B>
explicit constexpr Allocator(const Allocator<B> &that) noexcept
: terminator{that.terminator} {}
AllocateMemoryOrCrash(terminator, n * sizeof(A)));
}
constexpr void deallocate(A *p, std::size_t) { FreeMemory(p); }
- Terminator &terminator;
+ const Terminator &terminator;
};
}
--- /dev/null
+//===-- runtime/numeric-output.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 "numeric-output.h"
+#include "flang/common/unsigned-const-division.h"
+
+namespace Fortran::runtime::io {
+
+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 DataEdit::ListDirected:
+ 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.GetIoErrorHandler().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 (editWidth > 0 && total > editWidth) {
+ return io.EmitRepeated('*', editWidth);
+ }
+ int leadingSpaces{std::max(0, editWidth - total)};
+ if (edit.IsListDirected()) {
+ if (static_cast<std::size_t>(total) >
+ io.GetConnectionState().RemainingSpaceInRecord() &&
+ !io.AdvanceRecord()) {
+ return false;
+ }
+ leadingSpaces = 1;
+ }
+ return io.EmitRepeated(' ', leadingSpaces) &&
+ io.Emit(n < 0 ? "-" : "+", signChars) &&
+ io.EmitRepeated('0', leadingZeroes) && io.Emit(p, digits);
+}
+
+// Formats the exponent (see table 13.1 for all the cases)
+const char *RealOutputEditingBase::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;
+}
+
+bool RealOutputEditingBase::EmitPrefix(
+ const DataEdit &edit, std::size_t length, std::size_t width) {
+ if (edit.IsListDirected()) {
+ int prefixLength{edit.descriptor == DataEdit::ListDirectedRealPart
+ ? 2
+ : edit.descriptor == DataEdit::ListDirectedImaginaryPart ? 0 : 1};
+ int suffixLength{edit.descriptor == DataEdit::ListDirectedRealPart ||
+ edit.descriptor == DataEdit::ListDirectedImaginaryPart
+ ? 1
+ : 0};
+ length += prefixLength + suffixLength;
+ ConnectionState &connection{io_.GetConnectionState()};
+ return (connection.positionInRecord == 0 ||
+ length <= connection.RemainingSpaceInRecord() ||
+ io_.AdvanceRecord()) &&
+ io_.Emit(" (", prefixLength);
+ } else if (width > length) {
+ return io_.EmitRepeated(' ', width - length);
+ } else {
+ return true;
+ }
+}
+
+bool RealOutputEditingBase::EmitSuffix(const DataEdit &edit) {
+ if (edit.descriptor == DataEdit::ListDirectedRealPart) {
+ return io_.Emit(edit.modes.editingFlags & decimalComma ? ";" : ",", 1);
+ } else if (edit.descriptor == DataEdit::ListDirectedImaginaryPart) {
+ return io_.Emit(")", 1);
+ } else {
+ return true;
+ }
+}
+
+}
// 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.
+// List-directed output (13.10.4) for numeric types is also done here.
+// Drives the same fast binary-to-decimal formatting templates used
+// in the f18 front-end.
#include "format.h"
-#include "flang/common/unsigned-const-division.h"
+#include "io-stmt.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;
-}
+// I, B, O, Z, and G output editing for INTEGER.
+// edit is const here (and elsewhere in this header) so that one
+// edit descriptor with a repeat factor may safely serve to edit
+// multiple elements of an array.
+bool EditIntegerOutput(IoStatementState &, const DataEdit &, std::int64_t);
-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);
- }
-}
+// Encapsulates the state of a REAL output conversion.
+class RealOutputEditingBase {
+protected:
+ explicit RealOutputEditingBase(IoStatementState &io) : io_{io} {}
-// 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);
+ static bool IsDecimalNumber(const char *p) {
+ if (!p) {
+ return false;
}
- break;
- case 'Z':
- for (; un > 0; un >>= 4) {
- int digit = un & 0xf;
- *--p = digit >= 10 ? 'A' + (digit - 10) : '0' + digit;
+ if (*p == '-' || *p == '+') {
+ ++p;
}
- break;
- default:
- io.Crash(
- "Data edit descriptor '%c' may not be used with an INTEGER data item",
- edit.descriptor);
- return false;
+ return *p >= '0' && *p <= '9';
}
- 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);
-}
+ const char *FormatExponent(int, const DataEdit &edit, int &length);
+ bool EmitPrefix(const DataEdit &, std::size_t length, std::size_t width);
+ bool EmitSuffix(const DataEdit &);
-// 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 {
+ IoStatementState &io_;
+ int trailingBlanks_{0}; // created when Gw editing maps to Fw
+ char exponent_[16];
+};
+
+template<int binaryPrecision = 53>
+class RealOutputEditing : public RealOutputEditingBase {
public:
- RealOutputEditing(IoStatementState &io, FLOAT x) : io_{io}, x_{x} {}
- bool Edit(const DataEdit &edit);
+ template<typename A>
+ RealOutputEditing(IoStatementState &io, A x)
+ : RealOutputEditingBase{io}, x_{x} {}
+ bool Edit(const DataEdit &);
private:
+ using BinaryFloatingPoint =
+ decimal::BinaryFloatingPointNumber<binaryPrecision>;
+
// The DataEdit arguments here are const references or copies so that
- // the original DataEdit can safely serve multiple array elements if
+ // the original DataEdit can safely serve multiple array elements when
// 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 EditListDirectedOutput(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';
- }
+ bool IsZero() const { return x_.IsZero(); }
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];
+ BinaryFloatingPoint x_;
+ char buffer_[BinaryFloatingPoint::maxDecimalConversionDigits +
+ EXTRA_DECIMAL_CONVERSION_SPACE];
};
-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) {
+template<int binaryPrecision>
+decimal::ConversionToDecimalResult RealOutputEditing<binaryPrecision>::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_))};
+ auto converted{decimal::ConvertToDecimal<binaryPrecision>(buffer_,
+ sizeof buffer_, static_cast<enum decimal::DecimalConversionFlags>(flags),
+ significantDigits, edit.modes.round, x_)};
if (!converted.str) { // overflow
- io_.Crash("RealOutputEditing::Convert : buffer size %zd was insufficient",
- bufferSize);
+ io_.GetIoErrorHandler().Crash(
+ "RealOutputEditing::Convert : buffer size %zd was insufficient",
+ sizeof buffer_);
}
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) {
+template<int binaryPrecision>
+bool RealOutputEditing<binaryPrecision>::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};
} else { // E0
flags |= decimal::Minimize;
significantDigits =
- bufferSize - 5; // sign, NUL, + 3 extra for EN scaling
+ sizeof buffer_ - 5; // sign, NUL, + 3 extra for EN scaling
}
}
bool isEN{edit.variation == 'N'};
decimal::ConversionToDecimalResult converted{
Convert(significantDigits, edit, flags)};
if (converted.length > 0 && !IsDecimalNumber(converted.str)) { // Inf, NaN
- return EmitField(io_, converted.str, converted.length, editWidth);
+ return EmitPrefix(edit, converted.length, editWidth) &&
+ io_.Emit(converted.str, converted.length) && EmitSuffix(edit);
}
if (!IsZero()) {
converted.decimalExponent -= scale;
expoLength};
int width{editWidth > 0 ? editWidth : totalLength};
if (totalLength > width) {
- return EmitRepeated(io_, '*', width);
+ return io_.EmitRepeated('*', width);
}
if (totalLength < width && digitsBeforePoint == 0 &&
zeroesBeforePoint == 0) {
zeroesBeforePoint = 1;
++totalLength;
}
- return EmitRepeated(io_, ' ', width - totalLength) &&
+ return EmitPrefix(edit, totalLength, width) &&
io_.Emit(converted.str, signLength + digitsBeforePoint) &&
- EmitRepeated(io_, '0', zeroesBeforePoint) &&
+ io_.EmitRepeated('0', zeroesBeforePoint) &&
io_.Emit(edit.modes.editingFlags & decimalComma ? "," : ".", 1) &&
- EmitRepeated(io_, '0', zeroesAfterPoint) &&
+ io_.EmitRepeated('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';
- }
+ io_.EmitRepeated('0', trailingZeroes) &&
+ io_.Emit(exponent, expoLength) && EmitSuffix(edit);
}
- *--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) {
+template<int binaryPrecision>
+bool RealOutputEditing<binaryPrecision>::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
if (editWidth == 0) { // "the processor selects the field width"
if (!edit.digits.has_value()) { // F0
flags |= decimal::Minimize;
- fracDigits = bufferSize - 2; // sign & NUL
+ fracDigits = sizeof buffer_ - 2; // sign & NUL
}
}
// Multiple conversions may be needed to get the right number of
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);
+ return EmitPrefix(edit, converted.length, editWidth) &&
+ io_.Emit(converted.str, converted.length) && EmitSuffix(edit);
}
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
+ fracDigits = sizeof buffer_ - extraDigits - 2; // sign & NUL
}
continue; // try again
}
1 /*'.'*/ + zeroesAfterPoint + digitsAfterPoint + trailingZeroes};
int width{editWidth > 0 ? editWidth : totalLength};
if (totalLength > width) {
- return EmitRepeated(io_, '*', width);
+ return io_.EmitRepeated('*', width);
}
if (totalLength < width && digitsBeforePoint + zeroesBeforePoint == 0) {
zeroesBeforePoint = 1;
++totalLength;
}
- return EmitRepeated(io_, ' ', width - totalLength) &&
+ return EmitPrefix(edit, totalLength, width) &&
io_.Emit(converted.str, signLength + digitsBeforePoint) &&
- EmitRepeated(io_, '0', zeroesBeforePoint) &&
+ io_.EmitRepeated('0', zeroesBeforePoint) &&
io_.Emit(edit.modes.editingFlags & decimalComma ? "," : ".", 1) &&
- EmitRepeated(io_, '0', zeroesAfterPoint) &&
+ io_.EmitRepeated('0', zeroesAfterPoint) &&
io_.Emit(
converted.str + signLength + digitsBeforePoint, digitsAfterPoint) &&
- EmitRepeated(io_, '0', trailingZeroes) &&
- EmitRepeated(io_, ' ', trailingBlanks_);
+ io_.EmitRepeated('0', trailingZeroes) &&
+ io_.EmitRepeated(' ', trailingBlanks_) && EmitSuffix(edit);
}
}
// 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) {
+template<int binaryPrecision>
+DataEdit RealOutputEditing<binaryPrecision>::EditForGOutput(DataEdit edit) {
edit.descriptor = 'E';
if (!edit.width.has_value() ||
(*edit.width > 0 && edit.digits.value_or(-1) == 0)) {
return edit;
}
int expo{IsZero() ? 1 : converted.decimalExponent}; // 's'
- int significantDigits{edit.digits.value_or(decimalPrecision)}; // 'd'
+ int significantDigits{
+ edit.digits.value_or(BinaryFloatingPoint::decimalPrecision)}; // 'd'
if (expo < 0 || expo > significantDigits) {
return edit; // Ew.d
}
return edit;
}
+// 13.10.4 in F'2018
+template<int binaryPrecision>
+bool RealOutputEditing<binaryPrecision>::EditListDirectedOutput(
+ const DataEdit &edit) {
+ decimal::ConversionToDecimalResult converted{Convert(1, edit)};
+ if (!IsDecimalNumber(converted.str)) { // Inf, NaN
+ return EditEorDOutput(edit);
+ }
+ int expo{converted.decimalExponent};
+ if (expo < 0 || expo > BinaryFloatingPoint::decimalPrecision) {
+ DataEdit copy{edit};
+ copy.modes.scale = 1; // 1P
+ return EditEorDOutput(copy);
+ }
+ return EditFOutput(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<int binaryPrecision>
+bool RealOutputEditing<binaryPrecision>::EditEXOutput(const DataEdit &) {
+ io_.GetIoErrorHandler().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) {
+template<int binaryPrecision>
+bool RealOutputEditing<binaryPrecision>::Edit(const DataEdit &edit) {
switch (edit.descriptor) {
case 'D': return EditEorDOutput(edit);
case 'E':
case 'B':
case 'O':
case 'Z':
- return EditIntegerOutput(io_, edit, decimal::BinaryFloatingPointNumber<binaryPrecision>{x_}.raw);
+ 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",
+ if (edit.IsListDirected()) {
+ return EditListDirectedOutput(edit);
+ }
+ io_.GetIoErrorHandler().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_
[[noreturn]] void RTNAME(ProgramEndStatement)() {
Fortran::runtime::io::IoErrorHandler handler{"END statement"};
- Fortran::runtime::io::ExternalFile::CloseAll(handler);
+ Fortran::runtime::io::ExternalFileUnit::CloseAll(handler);
std::exit(EXIT_SUCCESS);
}
}
namespace Fortran::runtime {
-[[noreturn]] void Terminator::Crash(const char *message, ...) {
+[[noreturn]] void Terminator::Crash(const char *message, ...) const {
va_list ap;
va_start(ap, message);
CrashArgs(message, ap);
}
-[[noreturn]] void Terminator::CrashArgs(const char *message, va_list &ap) {
+[[noreturn]] void Terminator::CrashArgs(
+ const char *message, va_list &ap) const {
std::fputs("\nfatal Fortran runtime error", stderr);
if (sourceFileName_) {
std::fprintf(stderr, "(%s", sourceFileName_);
std::vfprintf(stderr, message, ap);
fputc('\n', stderr);
va_end(ap);
+ io::FlushOutputOnCrash(*this);
NotifyOtherImagesOfErrorTermination();
std::abort();
}
[[noreturn]] void Terminator::CheckFailed(
- const char *predicate, const char *file, int line) {
+ const char *predicate, const char *file, int line) const {
Crash("Internal error: RUNTIME_CHECK(%s) failed at %s(%d)", predicate, file,
line);
}
-void NotifyOtherImagesOfNormalEnd() {
- // TODO
-}
-void NotifyOtherImagesOfFailImageStatement() {
- // TODO
-}
-void NotifyOtherImagesOfErrorTermination() {
- // TODO
-}
+// TODO: These will be defined in the coarray runtime library
+void NotifyOtherImagesOfNormalEnd() {}
+void NotifyOtherImagesOfFailImageStatement() {}
+void NotifyOtherImagesOfErrorTermination() {}
}
class Terminator {
public:
Terminator() {}
+ Terminator(const Terminator &) = default;
explicit Terminator(const char *sourceFileName, int sourceLine = 0)
: sourceFileName_{sourceFileName}, sourceLine_{sourceLine} {}
void SetLocation(const char *sourceFileName = nullptr, int sourceLine = 0) {
sourceFileName_ = sourceFileName;
sourceLine_ = sourceLine;
}
- [[noreturn]] void Crash(const char *message, ...);
- [[noreturn]] void CrashArgs(const char *message, va_list &);
+ [[noreturn]] void Crash(const char *message, ...) const;
+ [[noreturn]] void CrashArgs(const char *message, va_list &) const;
[[noreturn]] void CheckFailed(
- const char *predicate, const char *file, int line);
+ const char *predicate, const char *file, int line) const;
private:
const char *sourceFileName_{nullptr};
void NotifyOtherImagesOfFailImageStatement();
void NotifyOtherImagesOfErrorTermination();
}
+
+namespace Fortran::runtime::io {
+void FlushOutputOnCrash(const Terminator &);
+}
+
#endif // FORTRAN_RUNTIME_TERMINATOR_H_
namespace Fortran::runtime {
OwningPtr<char> SaveDefaultCharacter(
- const char *s, std::size_t length, Terminator &terminator) {
+ const char *s, std::size_t length, const Terminator &terminator) {
if (s) {
auto *p{static_cast<char *>(AllocateMemoryOrCrash(terminator, length + 1))};
std::memcpy(p, s, length);
class Terminator;
-OwningPtr<char> SaveDefaultCharacter(const char *, std::size_t, Terminator &);
+OwningPtr<char> SaveDefaultCharacter(
+ const char *, std::size_t, const Terminator &);
// For validating and recognizing default CHARACTER values in a
// case-insensitive manner. Returns the zero-based index into the
#include "lock.h"
#include "memory.h"
#include "tools.h"
-#include <cerrno>
+#include <algorithm>
#include <type_traits>
namespace Fortran::runtime::io {
static Lock mapLock;
static Terminator mapTerminator;
-static Map<int, ExternalFile> unitMap{MapAllocator<int, ExternalFile>{mapTerminator}};
+static Map<int, ExternalFileUnit> unitMap{
+ MapAllocator<int, ExternalFileUnit>{mapTerminator}};
+static ExternalFileUnit *defaultOutput{nullptr};
+
+void FlushOutputOnCrash(const Terminator &terminator) {
+ if (defaultOutput) {
+ IoErrorHandler handler{terminator};
+ handler.HasIoStat(); // prevent nested crash if flush has error
+ defaultOutput->Flush(handler);
+ }
+}
-ExternalFile *ExternalFile::LookUp(int unit) {
+ExternalFileUnit *ExternalFileUnit::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) {
+ExternalFileUnit &ExternalFileUnit::LookUpOrCrash(
+ int unit, const Terminator &terminator) {
CriticalSection criticalSection{mapLock};
- ExternalFile *file{LookUp(unit)};
+ ExternalFileUnit *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) {
+ExternalFileUnit &ExternalFileUnit::LookUpOrCreate(int unit, bool *wasExtant) {
CriticalSection criticalSection{mapLock};
auto pair{unitMap.emplace(unit, unit)};
- if (!pair.second) {
- terminator.Crash("Already opened I/O unit number: %d", unit);
+ if (wasExtant) {
+ *wasExtant = !pair.second;
}
return pair.first->second;
}
-void ExternalFile::CloseUnit(IoErrorHandler &handler) {
+int ExternalFileUnit::NewUnit() {
+ CriticalSection criticalSection{mapLock};
+ static int nextNewUnit{-1000}; // see 12.5.6.12 in Fortran 2018
+ return --nextNewUnit;
+}
+
+void ExternalFileUnit::OpenUnit(OpenStatus status, Position position,
+ OwningPtr<char> &&newPath, std::size_t newPathLength,
+ IoErrorHandler &handler) {
+ CriticalSection criticalSection{lock()};
+ if (IsOpen()) {
+ if (status == OpenStatus::Old &&
+ (!newPath.get() ||
+ (path() && pathLength() == newPathLength &&
+ std::memcmp(path(), newPath.get(), newPathLength) == 0))) {
+ // OPEN of existing unit, STATUS='OLD', not new FILE=
+ newPath.reset();
+ return;
+ }
+ // Otherwise, OPEN on open unit with new FILE= implies CLOSE
+ Flush(handler);
+ Close(CloseStatus::Keep, handler);
+ }
+ set_path(std::move(newPath), newPathLength);
+ Open(status, position, handler);
+}
+
+void ExternalFileUnit::CloseUnit(CloseStatus status, IoErrorHandler &handler) {
+ {
+ CriticalSection criticalSection{lock()};
+ Flush(handler);
+ Close(status, 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)};
+void ExternalFileUnit::InitializePredefinedUnits() {
+ ExternalFileUnit &out{ExternalFileUnit::LookUpOrCreate(6)};
out.Predefine(1);
out.set_mayRead(false);
out.set_mayWrite(true);
out.set_mayPosition(false);
- ExternalFile &in{ExternalFile::Create(5, terminator)};
+ defaultOutput = &out;
+ ExternalFileUnit &in{ExternalFileUnit::LookUpOrCreate(5)};
in.Predefine(0);
in.set_mayRead(true);
in.set_mayWrite(false);
// TODO: Set UTF-8 mode from the environment
}
-void ExternalFile::CloseAll(IoErrorHandler &handler) {
+void ExternalFileUnit::CloseAll(IoErrorHandler &handler) {
CriticalSection criticalSection{mapLock};
+ defaultOutput = nullptr;
while (!unitMap.empty()) {
auto &pair{*unitMap.begin()};
- pair.second.CloseUnit(handler);
+ pair.second.CloseUnit(CloseStatus::Keep, handler);
}
}
-bool ExternalFile::SetPositionInRecord(std::int64_t n, IoErrorHandler &handler) {
- n = std::max(std::int64_t{0}, n);
+bool ExternalFileUnit::SetPositionInRecord(
+ std::int64_t n, IoErrorHandler &handler) {
+ n = std::max<std::int64_t>(0, n);
bool ok{true};
- if (n > recordLength.value_or(n)) {
+ if (n > static_cast<std::int64_t>(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, ' ');
+ std::fill_n(Frame() + furthestPositionInRecord,
+ n - furthestPositionInRecord, ' ');
}
furthestPositionInRecord = 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))};
+bool ExternalFileUnit::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;
return true;
}
-void ExternalFile::SetLeftTabLimit() {
+void ExternalFileUnit::SetLeftTabLimit() {
leftTabLimit = furthestPositionInRecord;
positionInRecord = furthestPositionInRecord;
}
-bool ExternalFile::NextOutputRecord(IoErrorHandler &handler) {
+bool ExternalFileUnit::AdvanceRecord(IoErrorHandler &handler) {
bool ok{true};
if (recordLength.has_value()) { // fill fixed-size record
ok &= SetPositionInRecord(*recordLength, handler);
- } else if (!unformatted && !isReading_) {
+ } else if (!isUnformatted && !isReading_) {
ok &= SetPositionInRecord(furthestPositionInRecord, handler) &&
- Emit("\n", 1, handler);
+ Emit("\n", 1, handler);
}
recordOffsetInFile += furthestPositionInRecord;
++currentRecordNumber;
positionInRecord = 0;
- positionInRecord = furthestPositionInRecord = 0;
+ 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 ExternalFileUnit::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) {
+bool ExternalFileUnit::HandleRelativePosition(
+ std::int64_t n, IoErrorHandler &handler) {
return HandleAbsolutePosition(positionInRecord + n, handler);
}
-void ExternalFile::EndIoStatement() {
+void ExternalFileUnit::FlushIfTerminal(IoErrorHandler &handler) {
+ if (isTerminal()) {
+ Flush(handler);
+ }
+}
+
+void ExternalFileUnit::EndIoStatement() {
+ io_.reset();
u_.emplace<std::monostate>();
}
}
//
//===----------------------------------------------------------------------===//
-// Fortran I/O units
+// Fortran external I/O units
#ifndef FORTRAN_RUNTIME_IO_UNIT_H_
#define FORTRAN_RUNTIME_IO_UNIT_H_
#include "buffer.h"
-#include "descriptor.h"
+#include "connection.h"
#include "file.h"
#include "format.h"
#include "io-error.h"
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 {
+class ExternalFileUnit : public ConnectionState,
+ public OpenFile,
+ public FileFrame<ExternalFileUnit> {
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);
- }
- }
+ explicit ExternalFileUnit(int unitNumber) : unitNumber_{unitNumber} {}
+ int unitNumber() const { return unitNumber_; }
-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 ExternalFileUnit *LookUp(int unit);
+ static ExternalFileUnit &LookUpOrCrash(int unit, const Terminator &);
+ static ExternalFileUnit &LookUpOrCreate(int unit, bool *wasExtant = nullptr);
+ static int NewUnit();
+ static void InitializePredefinedUnits();
static void CloseAll(IoErrorHandler &);
- void CloseUnit(IoErrorHandler &);
+ void OpenUnit(OpenStatus, Position, OwningPtr<char> &&path,
+ std::size_t pathLength, IoErrorHandler &);
+ void CloseUnit(CloseStatus, 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()?
+ template<typename A, typename... X>
+ IoStatementState &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)...);
+ A &state{u_.emplace<A>(std::forward<X>(xs)...)};
+ if constexpr (!std::is_same_v<A, OpenStatementState>) {
+ state.mutableModes() = ConnectionState::modes;
+ }
+ io_.emplace(state);
+ return *io_;
}
- void EndIoStatement();
- bool SetPositionInRecord(std::int64_t, IoErrorHandler &);
bool Emit(const char *, std::size_t bytes, IoErrorHandler &);
void SetLeftTabLimit();
- bool NextOutputRecord(IoErrorHandler &);
+ bool AdvanceRecord(IoErrorHandler &);
bool HandleAbsolutePosition(std::int64_t, IoErrorHandler &);
bool HandleRelativePosition(std::int64_t, IoErrorHandler &);
+
+ void FlushIfTerminal(IoErrorHandler &);
+ void EndIoStatement();
+
private:
+ bool SetPositionInRecord(std::int64_t, IoErrorHandler &);
+
int unitNumber_{-1};
- Lock lock_;
bool isReading_{false};
- std::variant<std::monostate, ExternalFormattedIoStatementState<false>> u_;
+ // When an I/O statement is in progress on this unit, holds its state.
+ std::variant<std::monostate, OpenStatementState, CloseStatementState,
+ ExternalFormattedIoStatementState<false>,
+ ExternalListIoStatementState<false>, UnformattedIoStatementState<false>>
+ u_;
+ // Points to the active alternative, if any, in u_, for use as a Cookie
+ std::optional<IoStatementState> io_;
};
}
TEST(nan.Compare(zero) == Relation::Unordered)(desc);
TEST(nan.Compare(minusZero) == Relation::Unordered)(desc);
TEST(nan.Compare(nan) == Relation::Unordered)(desc);
- int significandBits{R::precision - R::implicitMSB};
+ int significandBits{R::binaryPrecision - R::isImplicitMSB};
int exponentBits{R::bits - significandBits - 1};
std::uint64_t maxExponent{(std::uint64_t{1} << exponentBits) - 1};
MATCH(nan.Exponent(), maxExponent)(desc);
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))};
+ auto *io{IONAME(BeginExternalListOutput)()};
+ const char str[]{"Hello, world!"};
+ IONAME(OutputAscii)(io, str, std::strlen(str));
+ IONAME(OutputInteger64)(io, 678);
+ IONAME(OutputReal64)(io, 0.0);
+ IONAME(OutputReal64)(io, 2.0 / 3.0);
+ IONAME(OutputReal64)(io, 1.0e99);
+ IONAME(OutputReal64)(io, 1.0 / 0.0);
+ IONAME(OutputReal64)(io, -1.0 / 0.0);
+ IONAME(OutputReal64)(io, 0.0 / 0.0);
+ IONAME(OutputComplex64)(io, 123.0, -234.0);
+ IONAME(OutputLogical)(io, false);
+ IONAME(OutputLogical)(io, true);
IONAME(EndIoStatement)(io);
RTNAME(ProgramEndStatement)();
return 0;
// Tests basic FORMAT string traversal
-#include "../runtime/format.h"
+#include "../runtime/format-implementation.h"
#include "../runtime/terminator.h"
#include <cstdarg>
#include <cstring>
#include <iostream>
-#include <list>
#include <string>
+#include <vector>
using namespace Fortran::runtime;
using namespace Fortran::runtime::io;
using namespace std::literals::string_literals;
static int failures{0};
-using Results = std::list<std::string>;
+using Results = std::vector<std::string>;
-// Test harness context for format control
-struct TestFormatContext : virtual public Terminator, public FormatContext {
+// A test harness context for testing FormatControl
+class TestFormatContext : public Terminator {
+public:
+ using CharType = char;
TestFormatContext() : Terminator{"format.cpp", 1} {}
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 AdvanceRecord(int = 1);
bool HandleRelativePosition(std::int64_t);
bool HandleAbsolutePosition(std::int64_t);
void Report(const DataEdit &);
void Check(Results &);
Results results;
+ MutableModes &mutableModes() { return mutableModes_; }
+
+private:
+ MutableModes mutableModes_;
};
// Override the runtime's Crash() for testing purposes
[[noreturn]] void Fortran::runtime::Terminator::Crash(
- const char *message, ...) {
+ const char *message, ...) const {
std::va_list ap;
va_start(ap, message);
char buffer[1000];
return false;
}
-bool TestFormatContext::HandleSlash(int n) {
+bool TestFormatContext::AdvanceRecord(int n) {
while (n-- > 0) {
results.emplace_back("/");
}
static void Test(int n, const char *format, Results &&expect, int repeat = 1) {
TestFormatContext context;
- FormatControl control{context, format, std::strlen(format)};
+ FormatControl<TestFormatContext> control{
+ context, format, std::strlen(format)};
try {
for (int j{0}; j < n; ++j) {
- DataEdit edit;
- control.GetNext(context, edit, repeat);
- context.Report(edit);
+ context.Report(control.GetNextDataEdit(context, repeat));
}
control.FinishOutput(context);
} catch (const std::string &crash) {
// Basic sanity tests of I/O API; exhaustive testing will be done in Fortran
+#include "../../runtime/descriptor.h"
#include "../../runtime/io-api.h"
#include <cstring>
#include <iostream>
+using namespace Fortran::runtime;
using namespace Fortran::runtime::io;
static int failures{0};
IONAME(OutputInteger64)(cookie, 0xfeedface);
IONAME(OutputLogical)(cookie, true);
if (auto status{IONAME(EndIoStatement)(cookie)}) {
- std::cerr << '\'' << format << "' failed, status "
+ std::cerr << "hello: '" << format << "' failed, status "
<< static_cast<int>(status) << '\n';
++failures;
} else {
}
}
+static void multiline() {
+ char buffer[4][32];
+ StaticDescriptor<1> staticDescriptor[2];
+ Descriptor &whole{staticDescriptor[0].descriptor()};
+ SubscriptValue extent[]{4};
+ whole.Establish(TypeCode{CFI_type_char}, sizeof buffer[0], &buffer, 1, extent,
+ CFI_attribute_pointer);
+ // whole.Dump(std::cout);
+ whole.Check();
+ Descriptor §ion{staticDescriptor[1].descriptor()};
+ SubscriptValue lowers[]{0}, uppers[]{3}, strides[]{1};
+ section.Establish(whole.type(), whole.ElementBytes(), nullptr, 1, extent,
+ CFI_attribute_pointer);
+ // section.Dump(std::cout);
+ section.Check();
+ if (auto error{
+ CFI_section(§ion.raw(), &whole.raw(), lowers, uppers, strides)}) {
+ std::cerr << "multiline: CFI_section failed: " << error << '\n';
+ ++failures;
+ return;
+ }
+ section.Dump(std::cout);
+ section.Check();
+ const char *format{"('?abcde,',T1,'>',T9,A,TL12,A,TR25,'<'//G0,25X,'done')"};
+ auto cookie{IONAME(BeginInternalArrayFormattedOutput)(
+ section, format, std::strlen(format))};
+ IONAME(OutputAscii)(cookie, "WORLD", 5);
+ IONAME(OutputAscii)(cookie, "HELLO", 5);
+ IONAME(OutputInteger64)(cookie, 789);
+ if (auto status{IONAME(EndIoStatement)(cookie)}) {
+ std::cerr << "multiline: '" << format << "' failed, status "
+ << static_cast<int>(status) << '\n';
+ ++failures;
+ } else {
+ test(format,
+ ">HELLO, WORLD <"
+ " "
+ "789 done"
+ " ",
+ std::string{buffer[0], sizeof buffer});
+ }
+}
+
static void realTest(const char *format, double x, const char *expect) {
char buffer[800];
auto cookie{IONAME(BeginInternalFormattedOutput)(
int main() {
hello();
+ multiline();
static const char *zeroes[][2]{
{"(E32.17,';')", " 0.00000000000000000E+00;"},
projects / platform / upstream / llvm.git / commitdiff