diff options
Diffstat (limited to 'flang')
54 files changed, 2928 insertions, 1177 deletions
diff --git a/flang/documentation/FortranForCProgrammers.md b/flang/documentation/FortranForCProgrammers.md index db8345477ba5..6038c7ce348a 100644 --- a/flang/documentation/FortranForCProgrammers.md +++ b/flang/documentation/FortranForCProgrammers.md @@ -1,9 +1,9 @@ -<!--===- 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 diff --git a/flang/documentation/IORuntimeInternals.md b/flang/documentation/IORuntimeInternals.md new file mode 100644 index 000000000000..70dd0941ac76 --- /dev/null +++ b/flang/documentation/IORuntimeInternals.md @@ -0,0 +1,341 @@ +<!--===- 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)`. diff --git a/flang/include/flang/common/real.h b/flang/include/flang/common/real.h new file mode 100644 index 000000000000..d15de663a92b --- /dev/null +++ b/flang/include/flang/common/real.h @@ -0,0 +1,86 @@ +//===-- 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_ diff --git a/flang/include/flang/decimal/binary-floating-point.h b/flang/include/flang/decimal/binary-floating-point.h index 3da4a336c50e..bf467c5cbb70 100644 --- a/flang/include/flang/decimal/binary-floating-point.h +++ b/flang/include/flang/decimal/binary-floating-point.h @@ -12,6 +12,7 @@ // 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> @@ -20,34 +21,24 @@ 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( @@ -76,7 +67,7 @@ template<int PRECISION> struct 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; diff --git a/flang/include/flang/decimal/decimal.h b/flang/include/flang/decimal/decimal.h index 812d08fe8d09..c9aad161f4dd 100644 --- a/flang/include/flang/decimal/decimal.h +++ b/flang/include/flang/decimal/decimal.h @@ -62,6 +62,15 @@ enum DecimalConversionFlags { 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, diff --git a/flang/include/flang/evaluate/common.h b/flang/include/flang/evaluate/common.h index f24e93d7cd33..b7ea530e712f 100644 --- a/flang/include/flang/evaluate/common.h +++ b/flang/include/flang/evaluate/common.h @@ -130,9 +130,9 @@ struct Rounding { 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 diff --git a/flang/include/flang/evaluate/complex.h b/flang/include/flang/evaluate/complex.h index 201cbcea60ab..16559e9f0962 100644 --- a/flang/include/flang/evaluate/complex.h +++ b/flang/include/flang/evaluate/complex.h @@ -95,7 +95,7 @@ extern template class Complex<Real<Integer<16>, 11>>; 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_ diff --git a/flang/include/flang/evaluate/integer.h b/flang/include/flang/evaluate/integer.h index 1bff2bb7b7ca..46478f7e6106 100644 --- a/flang/include/flang/evaluate/integer.h +++ b/flang/include/flang/evaluate/integer.h @@ -49,7 +49,7 @@ namespace Fortran::evaluate::value { // 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>> diff --git a/flang/include/flang/evaluate/real.h b/flang/include/flang/evaluate/real.h index 84e2d556baf3..bcc73cb54b73 100644 --- a/flang/include/flang/evaluate/real.h +++ b/flang/include/flang/evaluate/real.h @@ -12,6 +12,7 @@ #include "formatting.h" #include "integer.h" #include "rounding-bits.h" +#include "flang/common/real.h" #include "flang/evaluate/common.h" #include <cinttypes> #include <limits> @@ -30,26 +31,25 @@ static constexpr std::int64_t ScaledLogBaseTenOfTwo{301029995664}; // 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; @@ -130,12 +130,13 @@ public: 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() { @@ -144,11 +145,9 @@ public: 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}; @@ -190,7 +189,7 @@ public: } 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}; @@ -224,7 +223,8 @@ public: 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); @@ -252,7 +252,7 @@ public: } 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; @@ -282,7 +282,7 @@ public: // 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()}; @@ -366,7 +366,7 @@ extern template class Real<Integer<16>, 11>; // IEEE half format 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. } diff --git a/flang/include/flang/evaluate/type.h b/flang/include/flang/evaluate/type.h index 29dde4eeb1a4..a558928d4893 100644 --- a/flang/include/flang/evaluate/type.h +++ b/flang/include/flang/evaluate/type.h @@ -268,7 +268,7 @@ public: 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) diff --git a/flang/lib/decimal/big-radix-floating-point.h b/flang/lib/decimal/big-radix-floating-point.h index 51eb9ec8c5b6..35f0a2e8c31f 100644 --- a/flang/lib/decimal/big-radix-floating-point.h +++ b/flang/lib/decimal/big-radix-floating-point.h @@ -58,7 +58,8 @@ private: // 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}; diff --git a/flang/lib/decimal/binary-to-decimal.cpp b/flang/lib/decimal/binary-to-decimal.cpp index ba061856b089..d15aab5ff638 100644 --- a/flang/lib/decimal/binary-to-decimal.cpp +++ b/flang/lib/decimal/binary-to-decimal.cpp @@ -25,7 +25,7 @@ BigRadixFloatingPointNumber<PREC, LOG10RADIX>::BigRadixFloatingPointNumber( } int twoPow{x.UnbiasedExponent()}; twoPow -= x.bits - 1; - if (!x.implicitMSB) { + if (!x.isImplicitMSB) { ++twoPow; } int lshift{x.exponentBits}; @@ -317,7 +317,7 @@ void BigRadixFloatingPointNumber<PREC, } 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()) { @@ -355,34 +355,34 @@ ConversionToDecimalResult ConvertToDecimal(char *buffer, size_t size, } } -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, @@ -390,8 +390,8 @@ ConversionToDecimalResult ConvertDoubleToDecimal(char *buffer, size_t size, } #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)); diff --git a/flang/lib/decimal/decimal-to-binary.cpp b/flang/lib/decimal/decimal-to-binary.cpp index de15833098f5..a07cd570d8c3 100644 --- a/flang/lib/decimal/decimal-to-binary.cpp +++ b/flang/lib/decimal/decimal-to-binary.cpp @@ -122,7 +122,7 @@ bool BigRadixFloatingPointNumber<PREC, LOG10RADIX>::ParseNumber( // 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 @@ -256,7 +256,7 @@ ConversionToBinaryResult<PREC> IntermediateFloat<PREC>::ToBinary( 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; @@ -278,7 +278,7 @@ BigRadixFloatingPointNumber<PREC, LOG10RADIX>::ConvertToBinary() { // 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. diff --git a/flang/lib/evaluate/characteristics.cpp b/flang/lib/evaluate/characteristics.cpp index ac18b5a1730b..3197c46863fa 100644 --- a/flang/lib/evaluate/characteristics.cpp +++ b/flang/lib/evaluate/characteristics.cpp @@ -121,35 +121,6 @@ std::optional<TypeAndShape> TypeAndShape::Characterize( } } -#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 { diff --git a/flang/lib/evaluate/complex.cpp b/flang/lib/evaluate/complex.cpp index 210fd1fb54c5..a2dca42e4e0b 100644 --- a/flang/lib/evaluate/complex.cpp +++ b/flang/lib/evaluate/complex.cpp @@ -100,6 +100,6 @@ template class Complex<Real<Integer<16>, 11>>; 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>>; } diff --git a/flang/lib/evaluate/real.cpp b/flang/lib/evaluate/real.cpp index ec9ab1dd4373..29ad1e0aa5a3 100644 --- a/flang/lib/evaluate/real.cpp +++ b/flang/lib/evaluate/real.cpp @@ -15,8 +15,7 @@ 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()) { @@ -53,8 +52,8 @@ Relation Real<W, P, IM>::Compare(const Real &y) const { } } -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()) { @@ -133,8 +132,8 @@ ValueWithRealFlags<Real<W, P, IM>> Real<W, P, IM>::Add( 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()) { @@ -193,8 +192,8 @@ ValueWithRealFlags<Real<W, P, IM>> Real<W, P, IM>::Multiply( 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()) { @@ -261,8 +260,8 @@ ValueWithRealFlags<Real<W, P, IM>> Real<W, P, IM>::Divide( 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()) { @@ -271,7 +270,7 @@ ValueWithRealFlags<Real<W, P, IM>> Real<W, P, IM>::ToWholeNumber( } 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)); @@ -287,8 +286,8 @@ ValueWithRealFlags<Real<W, P, IM>> Real<W, P, IM>::ToWholeNumber( 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 */ && @@ -337,7 +336,7 @@ RealFlags Real<W, P, IM>::Normalize(bool negative, int exponent, } } } - if constexpr (implicitMSB) { + if constexpr (isImplicitMSB) { word_ = word_.IBCLR(significandBits); } word_ = word_.IOR(Word{exponent}.SHIFTL(significandBits)); @@ -347,8 +346,8 @@ RealFlags Real<W, P, IM>::Normalize(bool negative, int exponent, 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; @@ -363,7 +362,7 @@ RealFlags Real<W, P, IM>::Round( 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 } @@ -388,8 +387,8 @@ RealFlags Real<W, P, IM>::Round( 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( @@ -423,17 +422,16 @@ inline RealFlags MapFlags(decimal::ConversionResultFlags flags) { 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()) { @@ -479,8 +477,8 @@ std::string Real<W, P, IM>::DumpHexadecimal() const { } } -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.)"; @@ -521,6 +519,6 @@ template class Real<Integer<16>, 11>; 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>; } diff --git a/flang/module/iso_fortran_env.f90 b/flang/module/iso_fortran_env.f90 index 01676cd7f894..957c3ec88131 100644 --- a/flang/module/iso_fortran_env.f90 +++ b/flang/module/iso_fortran_env.f90 @@ -128,7 +128,8 @@ module iso_fortran_env 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 diff --git a/flang/runtime/CMakeLists.txt b/flang/runtime/CMakeLists.txt index 4c1ecf0be736..571775ce8984 100644 --- a/flang/runtime/CMakeLists.txt +++ b/flang/runtime/CMakeLists.txt @@ -9,16 +9,19 @@ 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 diff --git a/flang/runtime/buffer.h b/flang/runtime/buffer.h index 57c740fabfa8..a956a3bbae1d 100644 --- a/flang/runtime/buffer.h +++ b/flang/runtime/buffer.h @@ -97,14 +97,13 @@ public: } 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; @@ -121,15 +120,14 @@ public: 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); @@ -143,7 +141,7 @@ private: 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) { diff --git a/flang/runtime/connection.cpp b/flang/runtime/connection.cpp new file mode 100644 index 000000000000..ff15a40819ab --- /dev/null +++ b/flang/runtime/connection.cpp @@ -0,0 +1,19 @@ +//===-- 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; +} +} diff --git a/flang/runtime/connection.h b/flang/runtime/connection.h new file mode 100644 index 000000000000..85372dfa610d --- /dev/null +++ b/flang/runtime/connection.h @@ -0,0 +1,50 @@ +//===-- 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_ diff --git a/flang/runtime/descriptor.cpp b/flang/runtime/descriptor.cpp index c8895dd6d246..ca065246d522 100644 --- a/flang/runtime/descriptor.cpp +++ b/flang/runtime/descriptor.cpp @@ -10,9 +10,14 @@ #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(); diff --git a/flang/runtime/descriptor.h b/flang/runtime/descriptor.h index 3a4f2ce3a29c..bb8a428c83ec 100644 --- a/flang/runtime/descriptor.h +++ b/flang/runtime/descriptor.h @@ -125,6 +125,7 @@ public: raw_.base_addr = nullptr; raw_.f18Addendum = false; } + Descriptor(const Descriptor &); ~Descriptor(); diff --git a/flang/runtime/environment.cpp b/flang/runtime/environment.cpp index 5ce55ab47459..735312b9f57c 100644 --- a/flang/runtime/environment.cpp +++ b/flang/runtime/environment.cpp @@ -7,6 +7,7 @@ //===----------------------------------------------------------------------===// #include "environment.h" +#include <cstdio> #include <cstdlib> #include <limits> @@ -19,7 +20,8 @@ void ExecutionEnvironment::Configure( 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; diff --git a/flang/runtime/environment.h b/flang/runtime/environment.h index 25a98959b741..056a13829b2a 100644 --- a/flang/runtime/environment.h +++ b/flang/runtime/environment.h @@ -9,7 +9,7 @@ #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 { @@ -19,8 +19,9 @@ 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_ diff --git a/flang/runtime/file.cpp b/flang/runtime/file.cpp index f9c18c741734..9ee4ae3c4318 100644 --- a/flang/runtime/file.cpp +++ b/flang/runtime/file.cpp @@ -9,7 +9,6 @@ #include "file.h" #include "magic-numbers.h" #include "memory.h" -#include "tools.h" #include <cerrno> #include <cstring> #include <fcntl.h> @@ -18,49 +17,22 @@ 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(); @@ -74,27 +46,22 @@ void OpenFile::Open(const char *path, std::size_t pathLength, ::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"); @@ -105,6 +72,10 @@ void OpenFile::Open(const char *path, std::size_t pathLength, } pending_.reset(); knownSize_.reset(); + if (position == Position::Append && !RawSeekToEnd()) { + handler.SignalErrno(); + } + isTerminal_ = ::isatty(fd_) == 1; } void OpenFile::Predefine(int fd) { @@ -118,25 +89,18 @@ 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) { @@ -319,7 +283,7 @@ void OpenFile::WaitAll(IoErrorHandler &handler) { } } -void OpenFile::CheckOpen(Terminator &terminator) { +void OpenFile::CheckOpen(const Terminator &terminator) { RUNTIME_CHECK(terminator, fd_ >= 0); } @@ -337,13 +301,27 @@ bool OpenFile::Seek(FileOffset at, IoErrorHandler &handler) { 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; diff --git a/flang/runtime/file.h b/flang/runtime/file.h index d5e521756653..9ed1c250364a 100644 --- a/flang/runtime/file.h +++ b/flang/runtime/file.h @@ -19,25 +19,33 @@ 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 @@ -69,10 +77,11 @@ private: }; // 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}; @@ -81,8 +90,11 @@ private: 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_; }; diff --git a/flang/runtime/format-implementation.h b/flang/runtime/format-implementation.h new file mode 100644 index 000000000000..cb5fc2dfd8b5 --- /dev/null +++ b/flang/runtime/format-implementation.h @@ -0,0 +1,355 @@ +//===-- 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_ diff --git a/flang/runtime/format.cpp b/flang/runtime/format.cpp index f31139ebb5ac..91a6b6749514 100644 --- a/flang/runtime/format.cpp +++ b/flang/runtime/format.cpp @@ -6,356 +6,48 @@ // //===----------------------------------------------------------------------===// -#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>>; } diff --git a/flang/runtime/format.h b/flang/runtime/format.h index c954c7f3872f..c072b3b9805d 100644 --- a/flang/runtime/format.h +++ b/flang/runtime/format.h @@ -12,8 +12,10 @@ #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> @@ -27,7 +29,7 @@ enum EditingFlags { 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 @@ -38,6 +40,16 @@ struct MutableModes { // 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 @@ -46,37 +58,35 @@ struct DataEdit { 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) { @@ -86,10 +96,10 @@ public: // 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}; @@ -105,27 +115,27 @@ private: ++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; } @@ -134,16 +144,12 @@ private: // 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_ diff --git a/flang/runtime/internal-unit.cpp b/flang/runtime/internal-unit.cpp new file mode 100644 index 000000000000..737f0856e33f --- /dev/null +++ b/flang/runtime/internal-unit.cpp @@ -0,0 +1,129 @@ +//===-- 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>; +} diff --git a/flang/runtime/internal-unit.h b/flang/runtime/internal-unit.h new file mode 100644 index 000000000000..837ddc6f588f --- /dev/null +++ b/flang/runtime/internal-unit.h @@ -0,0 +1,46 @@ +//===-- 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_ diff --git a/flang/runtime/io-api.cpp b/flang/runtime/io-api.cpp index d5840a03b75d..969315a49fa7 100644 --- a/flang/runtime/io-api.cpp +++ b/flang/runtime/io-api.cpp @@ -1,4 +1,4 @@ -//===-- 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. @@ -9,24 +9,76 @@ // 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, @@ -34,53 +86,557 @@ 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) { diff --git a/flang/runtime/io-api.h b/flang/runtime/io-api.h index 1c1f81ea4c6f..417c0b5a3981 100644 --- a/flang/runtime/io-api.h +++ b/flang/runtime/io-api.h @@ -51,8 +51,7 @@ constexpr std::size_t RecommendedInternalIoScratchAreaBytes( } // 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); @@ -172,8 +171,8 @@ Cookie IONAME(BeginInquireIoLength)( // } // } // 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. @@ -253,12 +252,10 @@ bool IONAME(SetStatus)(Cookie, const char *, std::size_t); // 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); diff --git a/flang/runtime/io-error.h b/flang/runtime/io-error.h index 6cab725186e3..80f5fa817910 100644 --- a/flang/runtime/io-error.h +++ b/flang/runtime/io-error.h @@ -18,9 +18,10 @@ 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; } diff --git a/flang/runtime/io-stmt.cpp b/flang/runtime/io-stmt.cpp index e54a67a328e2..adc9bae6c150 100644 --- a/flang/runtime/io-stmt.cpp +++ b/flang/runtime/io-stmt.cpp @@ -7,118 +7,60 @@ //===----------------------------------------------------------------------===// #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); } @@ -126,75 +68,295 @@ int InternalIoStatementState<isInput, CHAR>::EndIoStatement() { } 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>; } diff --git a/flang/runtime/io-stmt.h b/flang/runtime/io-stmt.h index 002f38e82596..17549388b060 100644 --- a/flang/runtime/io-stmt.h +++ b/flang/runtime/io-stmt.h @@ -6,112 +6,312 @@ // //===----------------------------------------------------------------------===// -// 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_ diff --git a/flang/runtime/lock.h b/flang/runtime/lock.h index 19f0cea79b01..a26c96542c88 100644 --- a/flang/runtime/lock.h +++ b/flang/runtime/lock.h @@ -23,7 +23,7 @@ public: 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"); diff --git a/flang/runtime/main.cpp b/flang/runtime/main.cpp index 8c2caa570df5..e7f4200b2777 100644 --- a/flang/runtime/main.cpp +++ b/flang/runtime/main.cpp @@ -33,7 +33,6 @@ void RTNAME(ProgramStart)(int argc, const char *argv[], const char *envp[]) { std::atexit(Fortran::runtime::NotifyOtherImagesOfNormalEnd); Fortran::runtime::executionEnvironment.Configure(argc, argv, envp); ConfigureFloatingPoint(); - Fortran::runtime::Terminator terminator{"ProgramStart()"}; - Fortran::runtime::io::ExternalFile::InitializePredefinedUnits(terminator); + Fortran::runtime::io::ExternalFileUnit::InitializePredefinedUnits(); } } diff --git a/flang/runtime/memory.cpp b/flang/runtime/memory.cpp index ac456a5dd9d1..84fd35da48ef 100644 --- a/flang/runtime/memory.cpp +++ b/flang/runtime/memory.cpp @@ -12,7 +12,7 @@ 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; } diff --git a/flang/runtime/memory.h b/flang/runtime/memory.h index d41f5f95407e..1bd5bca1b78a 100644 --- a/flang/runtime/memory.h +++ b/flang/runtime/memory.h @@ -18,8 +18,9 @@ namespace Fortran::runtime { 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 *); @@ -33,7 +34,7 @@ template<typename A> void FreeMemoryAndNullify(A *&p) { 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)...}; } @@ -47,7 +48,7 @@ template<typename A> using OwningPtr = std::unique_ptr<A, OwningPtrDeleter<A>>; template<typename A> struct Allocator { using value_type = A; - explicit Allocator(Terminator &t) : terminator{t} {} + explicit Allocator(const Terminator &t) : terminator{t} {} template<typename B> explicit constexpr Allocator(const Allocator<B> &that) noexcept : terminator{that.terminator} {} @@ -58,7 +59,7 @@ template<typename A> struct Allocator { AllocateMemoryOrCrash(terminator, n * sizeof(A))); } constexpr void deallocate(A *p, std::size_t) { FreeMemory(p); } - Terminator &terminator; + const Terminator &terminator; }; } diff --git a/flang/runtime/numeric-output.cpp b/flang/runtime/numeric-output.cpp new file mode 100644 index 000000000000..daef7aba879a --- /dev/null +++ b/flang/runtime/numeric-output.cpp @@ -0,0 +1,152 @@ +//===-- 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; + } +} + +} diff --git a/flang/runtime/numeric-output.h b/flang/runtime/numeric-output.h index a0f40c700b7b..f8c5437ca31b 100644 --- a/flang/runtime/numeric-output.h +++ b/flang/runtime/numeric-output.h @@ -14,191 +14,99 @@ // 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}; @@ -209,7 +117,7 @@ bool RealOutputEditing<FLOAT, decimalPrecision, binaryPrecision, } 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'}; @@ -228,7 +136,8 @@ bool RealOutputEditing<FLOAT, decimalPrecision, binaryPrecision, 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; @@ -258,63 +167,28 @@ bool RealOutputEditing<FLOAT, decimalPrecision, binaryPrecision, 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 @@ -322,7 +196,7 @@ bool RealOutputEditing<FLOAT, decimalPrecision, binaryPrecision, 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 @@ -331,14 +205,15 @@ bool RealOutputEditing<FLOAT, decimalPrecision, binaryPrecision, 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 } @@ -360,29 +235,27 @@ bool RealOutputEditing<FLOAT, decimalPrecision, binaryPrecision, 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)) { @@ -393,7 +266,8 @@ DataEdit RealOutputEditing<FLOAT, decimalPrecision, binaryPrecision, 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 } @@ -412,18 +286,32 @@ DataEdit RealOutputEditing<FLOAT, decimalPrecision, binaryPrecision, 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': @@ -436,14 +324,20 @@ bool RealOutputEditing<FLOAT, decimalPrecision, binaryPrecision, 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_ diff --git a/flang/runtime/stop.cpp b/flang/runtime/stop.cpp index 85bf9c4a14ac..46ad558dfe4c 100644 --- a/flang/runtime/stop.cpp +++ b/flang/runtime/stop.cpp @@ -71,7 +71,7 @@ static void DescribeIEEESignaledExceptions() { [[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); } } diff --git a/flang/runtime/terminator.cpp b/flang/runtime/terminator.cpp index c516af3c854a..74594ba65d84 100644 --- a/flang/runtime/terminator.cpp +++ b/flang/runtime/terminator.cpp @@ -12,13 +12,14 @@ 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_); @@ -31,23 +32,19 @@ namespace Fortran::runtime { 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() {} } diff --git a/flang/runtime/terminator.h b/flang/runtime/terminator.h index 5fe381e5167a..8cfc5cc8b123 100644 --- a/flang/runtime/terminator.h +++ b/flang/runtime/terminator.h @@ -21,16 +21,17 @@ namespace Fortran::runtime { 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}; @@ -47,4 +48,9 @@ void NotifyOtherImagesOfNormalEnd(); void NotifyOtherImagesOfFailImageStatement(); void NotifyOtherImagesOfErrorTermination(); } + +namespace Fortran::runtime::io { +void FlushOutputOnCrash(const Terminator &); +} + #endif // FORTRAN_RUNTIME_TERMINATOR_H_ diff --git a/flang/runtime/tools.cpp b/flang/runtime/tools.cpp index 43a0f68b0fe8..b254baf07b46 100644 --- a/flang/runtime/tools.cpp +++ b/flang/runtime/tools.cpp @@ -12,7 +12,7 @@ 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); diff --git a/flang/runtime/tools.h b/flang/runtime/tools.h index d1b90b1ad3c9..99571782dc07 100644 --- a/flang/runtime/tools.h +++ b/flang/runtime/tools.h @@ -18,7 +18,8 @@ namespace Fortran::runtime { 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 diff --git a/flang/runtime/unit.cpp b/flang/runtime/unit.cpp index f7a342ccbb73..277d36b39a08 100644 --- a/flang/runtime/unit.cpp +++ b/flang/runtime/unit.cpp @@ -10,55 +10,98 @@ #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); @@ -66,18 +109,20 @@ void ExternalFile::InitializePredefinedUnits(Terminator &terminator) { // 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; @@ -85,7 +130,8 @@ bool ExternalFile::SetPositionInRecord(std::int64_t n, IoErrorHandler &handler) 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; } @@ -93,8 +139,10 @@ bool ExternalFile::SetPositionInRecord(std::int64_t n, IoErrorHandler &handler) 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; @@ -102,36 +150,46 @@ bool ExternalFile::Emit(const char *data, std::size_t bytes, IoErrorHandler &han 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>(); } } diff --git a/flang/runtime/unit.h b/flang/runtime/unit.h index a6b80b22587e..62f664b8f32a 100644 --- a/flang/runtime/unit.h +++ b/flang/runtime/unit.h @@ -6,13 +6,13 @@ // //===----------------------------------------------------------------------===// -// 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" @@ -27,87 +27,57 @@ 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_; }; } diff --git a/flang/test/evaluate/real.cpp b/flang/test/evaluate/real.cpp index 919bc3ca87c7..85101e513726 100644 --- a/flang/test/evaluate/real.cpp +++ b/flang/test/evaluate/real.cpp @@ -91,7 +91,7 @@ template<typename R> void basicTests(int rm, Rounding rounding) { 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); diff --git a/flang/test/runtime/external-hello.cpp b/flang/test/runtime/external-hello.cpp index af7151f6c44e..400d345e1b39 100644 --- a/flang/test/runtime/external-hello.cpp +++ b/flang/test/runtime/external-hello.cpp @@ -6,9 +6,20 @@ 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; diff --git a/flang/test/runtime/format.cpp b/flang/test/runtime/format.cpp index 31e3261d8f88..05ec9d3e280b 100644 --- a/flang/test/runtime/format.cpp +++ b/flang/test/runtime/format.cpp @@ -1,37 +1,43 @@ // 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]; @@ -54,7 +60,7 @@ bool TestFormatContext::Emit(const char32_t *, std::size_t) { return false; } -bool TestFormatContext::HandleSlash(int n) { +bool TestFormatContext::AdvanceRecord(int n) { while (n-- > 0) { results.emplace_back("/"); } @@ -115,12 +121,11 @@ void TestFormatContext::Check(Results &expect) { 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) { diff --git a/flang/test/runtime/hello.cpp b/flang/test/runtime/hello.cpp index 86354a36de5e..4bb65acd565e 100644 --- a/flang/test/runtime/hello.cpp +++ b/flang/test/runtime/hello.cpp @@ -1,9 +1,11 @@ // 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}; @@ -28,7 +30,7 @@ static void hello() { 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 { @@ -37,6 +39,49 @@ static void hello() { } } +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)( @@ -53,6 +98,7 @@ static void realTest(const char *format, double x, const char *expect) { int main() { hello(); + multiline(); static const char *zeroes[][2]{ {"(E32.17,';')", " 0.00000000000000000E+00;"}, |