Magic-Mirror/llvm-capstone
1
0
Fork 0
mirror of https://github.com/capstone-engine/llvm-capstone.git synced 2025-04-01 20:52:14 +00:00
Code Issues Actions 5 Packages Projects Releases Wiki Activity

[flang] Progress on Fortran I/O runtime

Browse Source 
Use internal units for internal I/O state

Replace use of virtual functions

reference_wrapper

Internal formatted output to array descriptor

Delete dead code

Begin list-directed internal output

Refactorings and renamings for clarity

List-directed external I/O (character)

COMPLEX list-directed output

Control list items

First cut at unformatted I/O

More OPEN statement work; rename class to ExternalFileUnit

Complete OPEN (exc. for POSITION=), add CLOSE()

OPEN(POSITION=)

Flush buffers on crash and for terminal output; clean up

Documentation

Fix backquote in documentation

Fix typo in comment

Begin implementation of input

Refactor binary floating-point properties to a new header, simplify numeric output editing

Dodge spurious GCC 7.2 build warning

Address review comments

Original-commit: flang-compiler/f18@9c4bba11cf
Reviewed-on: https://github.com/flang-compiler/f18/pull/982
This commit is contained in:
peter klausler 2020-02-04 16:55:45 -08:00
parent dbea781d19
commit 95696d563b
54 changed files with 2943 additions and 1192 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
flang/documentation/FortranForCProgrammers.md
View File

@ -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

341
flang/documentation/IORuntimeInternals.md Normal file
View File

@ -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)`.

86
flang/include/flang/common/real.h Normal file
View File

@ -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_

39
flang/include/flang/decimal/binary-floating-point.h
View File

@ -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;

9
flang/include/flang/decimal/decimal.h
View File

@ -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,

4
flang/include/flang/evaluate/common.h
View File

@ -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

2
flang/include/flang/evaluate/complex.h
View File

@ -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_

2
flang/include/flang/evaluate/integer.h
View File

@ -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>>

58
flang/include/flang/evaluate/real.h
View File

@ -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 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};
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;
template<typename W, int P, bool I> friend class Real;
static constexpr int bits{Word::bits};
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.
}

2
flang/include/flang/evaluate/type.h
View File

@ -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)

3
flang/lib/decimal/big-radix-floating-point.h
View File

@ -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};

24
flang/lib/decimal/binary-to-decimal.cpp
View File

@ -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));

6
flang/lib/decimal/decimal-to-binary.cpp
View File

@ -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.

29
flang/lib/evaluate/characteristics.cpp
View File

@ -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 {

2
flang/lib/evaluate/complex.cpp
View File

@ -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>>;
}

52
flang/lib/evaluate/real.cpp
View File

@ -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>;
}

3
flang/module/iso_fortran_env.f90
View File

@ -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

3
flang/runtime/CMakeLists.txt
View File

@ -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

12
flang/runtime/buffer.h
View File

@ -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) {

19
flang/runtime/connection.cpp Normal file
View File

@ -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;
}
}

50
flang/runtime/connection.h Normal file
View File

@ -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_

5
flang/runtime/descriptor.cpp
View File

@ -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();

1
flang/runtime/descriptor.h
View File

@ -125,6 +125,7 @@ public:
raw_.base_addr = nullptr;
raw_.f18Addendum = false;
}
Descriptor(const Descriptor &);
~Descriptor();

4
flang/runtime/environment.cpp
View File

@ -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;

5
flang/runtime/environment.h
View File

@ -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_

110
flang/runtime/file.cpp
View File

@ -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;

38
flang/runtime/file.h
View File

@ -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_;
};

355
flang/runtime/format-implementation.h Normal file
View File

@ -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_

386
flang/runtime/format.cpp
View File

@ -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)
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<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>;
template class FormatControl<InternalFormattedIoStatementState<false>>;
template class FormatControl<InternalFormattedIoStatementState<true>>;
template class FormatControl<ExternalFormattedIoStatementState<false>>;
}

72
flang/runtime/format.h
View File

@ -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_

129
flang/runtime/internal-unit.cpp Normal file
View File

@ -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>;
}

46
flang/runtime/internal-unit.h Normal file
View File

@ -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_

614
flang/runtime/io-api.cpp
View File

@ -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) {

15
flang/runtime/io-api.h
View File

@ -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);

3
flang/runtime/io-error.h
View File

@ -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; }

414
flang/runtime/io-stmt.cpp
View File

@ -7,130 +7,66 @@
//===----------------------------------------------------------------------===//
#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>
bool FixedRecordIoStatementState<isInput, CHAR>::Emit(
const CHAR *data, std::size_t chars) {
InternalIoStatementState<isInput, CHAR>::InternalIoStatementState(
const Descriptor &d, const char *sourceFile, int sourceLine)
: IoStatementBase{sourceFile, sourceLine}, unit_{d, *this} {}
template<bool isInput, typename CHAR>
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_);
}
template<bool isInput, typename CHAR>
int FixedRecordIoStatementState<isInput, CHAR>::EndIoStatement() {
if constexpr (!isInput) {
HandleAbsolutePosition(length_ - leftTabLimit_); // fill
}
return GetIoStat();
return true;
}
template<bool isInput, typename CHAR>
int InternalIoStatementState<isInput, CHAR>::EndIoStatement() {
auto result{FixedRecordIoStatementState<isInput, CHAR>::EndIoStatement()};
if constexpr (!isInput) {
unit_.EndIoStatement(); // fill
}
auto result{IoStatementBase::EndIoStatement()};
if (free_) {
FreeMemory(this);
}
return result;
}
template<bool isInput, typename CHAR>
InternalIoStatementState<isInput, CHAR>::InternalIoStatementState(
Buffer buffer, std::size_t length, const char *sourceFile, int sourceLine)
: FixedRecordIoStatementState<isInput, CHAR>(
buffer, length, sourceFile, sourceLine) {}
template<bool isInput, typename CHAR>
InternalFormattedIoStatementState<isInput,
CHAR>::InternalFormattedIoStatementState(Buffer buffer, std::size_t length,
@ -138,63 +74,289 @@ InternalFormattedIoStatementState<isInput,
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} {}
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>::HandleAbsolutePosition(
std::int64_t n) {
return unit_.HandleAbsolutePosition(n, *this);
}
template<bool isInput, typename CHAR>
bool ExternalFormattedIoStatementState<isInput, CHAR>::HandleSlash(int n) {
bool InternalFormattedIoStatementState<isInput, CHAR>::HandleRelativePosition(
std::int64_t n) {
return unit_.HandleRelativePosition(n, *this);
}
template<bool isInput, typename CHAR>
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>
bool ExternalIoStatementState<isInput>::HandleRelativePosition(std::int64_t n) {
return unit().HandleRelativePosition(n, *this);
}
template<bool isInput, typename CHAR>
bool ExternalFormattedIoStatementState<isInput, CHAR>::HandleRelativePosition(
std::int64_t n) {
return file_.HandleRelativePosition(n, *this);
}
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
}
int result{GetIoStat()};
file_.EndIoStatement(); // annihilates *this in file_.u_
return result;
return ExternalIoStatementState<isInput>::EndIoStatement();
}
template class InternalFormattedIoStatementState<false>;
template class ExternalFormattedIoStatementState<false>;
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);
}
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>;
}

322
flang/runtime/io-stmt.h
View File

@ -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() {}
template<typename A> explicit IoStatementState(A &x) : u_{x} {}
virtual int EndIoStatement();
// 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();
// 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);
};
// 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;
template<bool IsInput, typename CHAR = char>
class FixedRecordIoStatementState : public IoStatementState {
protected:
using Buffer = std::conditional_t<IsInput, const CHAR *, CHAR *>;
public:
FixedRecordIoStatementState(
Buffer, std::size_t, const char *sourceFile, int sourceLine);
virtual bool Emit(const CHAR *, std::size_t chars /* not bytes */);
// TODO virtual void HandleSlash(int);
virtual bool HandleRelativePosition(std::int64_t);
virtual bool HandleAbsolutePosition(std::int64_t);
virtual int EndIoStatement();
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);
}
int EndIoStatement();
private:
FormatControl<CHAR> format_; // must be last, may be partial
};
template<bool isInput, typename CHAR = char>
class ExternalFormattedIoStatementState : public IoStatementState {
public:
ExternalFormattedIoStatementState(ExternalFile &, const CHAR *format,
InternalFormattedIoStatementState(const Descriptor &, 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);
IoStatementState &ioStatementState() { return ioStatementState_; }
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:
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:
ExternalFile &file_;
FormatControl<CHAR> format_;
ExternalFileUnit &unit_;
};
template<bool isInput>
class ExternalIoStatementState : public ExternalIoStatementBase,
public IoDirectionState<isInput> {
public:
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);
MutableModes &mutableModes() { return mutableModes_; }
int EndIoStatement();
DataEdit GetNextDataEdit(int maxRepeat = 1) {
return format_.GetNextDataEdit(*this, maxRepeat);
}
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:
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_

2
flang/runtime/lock.h
View File

@ -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");

3
flang/runtime/main.cpp
View File

@ -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();
}
}

2
flang/runtime/memory.cpp
View File

@ -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;
}

11
flang/runtime/memory.h
View File

@ -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;
};
}

152
flang/runtime/numeric-output.cpp Normal file
View File

@ -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;
}
}
}

336
flang/runtime/numeric-output.h
View File

@ -14,146 +14,28 @@
// 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;
}
static bool EmitField(
IoStatementState &io, const char *p, std::size_t length, int width) {
if (width <= 0) {
width = static_cast<int>(length);
}
if (length > static_cast<std::size_t>(width)) {
return EmitRepeated(io, '*', width);
} else {
return EmitRepeated(io, ' ', static_cast<int>(width - length)) &&
io.Emit(p, length);
}
}
// I, B, O, Z, and (for INTEGER) G output editing.
// edit is const here so that a repeated edit descriptor may safely serve
// multiple array elements
static bool EditIntegerOutput(
IoStatementState &io, const DataEdit &edit, std::int64_t n) {
char buffer[66], *end = &buffer[sizeof buffer], *p = end;
std::uint64_t un{static_cast<std::uint64_t>(n < 0 ? -n : n)};
int signChars{0};
switch (edit.descriptor) {
case 'G':
case 'I':
if (n < 0 || (edit.modes.editingFlags & signPlus)) {
signChars = 1; // '-' or '+'
}
while (un > 0) {
auto quotient{common::DivideUnsignedBy<std::uint64_t, 10>(un)};
*--p = '0' + un - 10 * quotient;
un = quotient;
}
break;
case 'B':
for (; un > 0; un >>= 1) {
*--p = '0' + (un & 1);
}
break;
case 'O':
for (; un > 0; un >>= 3) {
*--p = '0' + (un & 7);
}
break;
case 'Z':
for (; un > 0; un >>= 4) {
int digit = un & 0xf;
*--p = digit >= 10 ? 'A' + (digit - 10) : '0' + digit;
}
break;
default:
io.Crash(
"Data edit descriptor '%c' may not be used with an INTEGER data item",
edit.descriptor);
return false;
}
int digits = end - p;
int leadingZeroes{0};
int editWidth{edit.width.value_or(0)};
if (edit.digits && digits <= *edit.digits) { // Iw.m
if (*edit.digits == 0 && n == 0) {
// Iw.0 with zero value: output field must be blank. For I0.0
// and a zero value, emit one blank character.
signChars = 0; // in case of SP
editWidth = std::max(1, editWidth);
} else {
leadingZeroes = *edit.digits - digits;
}
} else if (n == 0) {
leadingZeroes = 1;
}
int total{signChars + leadingZeroes + digits};
if (edit.width > 0 && total > editWidth) {
return EmitRepeated(io, '*', editWidth);
}
if (total < editWidth) {
EmitRepeated(io, '*', editWidth - total);
return false;
}
if (signChars) {
if (!io.Emit(n < 0 ? "-" : "+", 1)) {
return false;
}
}
return EmitRepeated(io, '0', leadingZeroes) && io.Emit(p, digits);
}
// 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);
// Encapsulates the state of a REAL output conversion.
template<typename FLOAT = double, int decimalPrecision = 15,
int binaryPrecision = 53, std::size_t bufferSize = 1024>
class RealOutputEditing {
public:
RealOutputEditing(IoStatementState &io, FLOAT x) : io_{io}, x_{x} {}
bool Edit(const DataEdit &edit);
private:
// The DataEdit arguments here are const references or copies so that
// the original DataEdit can safely serve multiple array elements if
// it has a repeat count.
bool EditEorDOutput(const DataEdit &);
bool EditFOutput(const DataEdit &);
DataEdit EditForGOutput(DataEdit); // returns an E or F edit
bool EditEXOutput(const DataEdit &);
bool IsZero() const { return x_ == 0; }
const char *FormatExponent(int, const DataEdit &edit, int &length);
static enum decimal::FortranRounding SetRounding(
common::RoundingMode rounding) {
switch (rounding) {
case common::RoundingMode::TiesToEven: break;
case common::RoundingMode::Up: return decimal::RoundUp;
case common::RoundingMode::Down: return decimal::RoundDown;
case common::RoundingMode::ToZero: return decimal::RoundToZero;
case common::RoundingMode::TiesAwayFromZero:
return decimal::RoundCompatible;
}
return decimal::RoundNearest; // arranged thus to dodge bogus G++ warning
}
class RealOutputEditingBase {
protected:
explicit RealOutputEditingBase(IoStatementState &io) : io_{io} {}
static bool IsDecimalNumber(const char *p) {
if (!p) {
@ -165,40 +47,66 @@ private:
return *p >= '0' && *p <= '9';
}
decimal::ConversionToDecimalResult Convert(
int significantDigits, const DataEdit &, int flags = 0);
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 &);
IoStatementState &io_;
FLOAT x_;
char buffer_[bufferSize];
int trailingBlanks_{0}; // created when G editing maps to F
int trailingBlanks_{0}; // created when Gw editing maps to Fw
char exponent_[16];
};
template<typename FLOAT, int decimalPrecision, int binaryPrecision,
std::size_t bufferSize>
decimal::ConversionToDecimalResult RealOutputEditing<FLOAT, decimalPrecision,
binaryPrecision, bufferSize>::Convert(int significantDigits,
const DataEdit &edit, int flags) {
template<int binaryPrecision = 53>
class RealOutputEditing : public RealOutputEditingBase {
public:
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 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_.IsZero(); }
decimal::ConversionToDecimalResult Convert(
int significantDigits, const DataEdit &, int flags = 0);
BinaryFloatingPoint x_;
char buffer_[BinaryFloatingPoint::maxDecimalConversionDigits +
EXTRA_DECIMAL_CONVERSION_SPACE];
};
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);
io_.EmitRepeated('0', trailingZeroes) &&
io_.Emit(exponent, expoLength) && EmitSuffix(edit);
}
}
// Formats the exponent (see table 13.1 for all the cases)
template<typename FLOAT, int decimalPrecision, int binaryPrecision,
std::size_t bufferSize>
const char *RealOutputEditing<FLOAT, decimalPrecision, binaryPrecision,
bufferSize>::FormatExponent(int expo, const DataEdit &edit, int &length) {
char *eEnd{&exponent_[sizeof exponent_]};
char *exponent{eEnd};
for (unsigned e{static_cast<unsigned>(std::abs(expo))}; e > 0;) {
unsigned quotient{common::DivideUnsignedBy<unsigned, 10>(e)};
*--exponent = '0' + e - 10 * quotient;
e = quotient;
}
if (edit.expoDigits) {
if (int ed{*edit.expoDigits}) { // Ew.dEe with e > 0
while (exponent > exponent_ + 2 /*E+*/ && exponent + ed > eEnd) {
*--exponent = '0';
}
} else if (exponent == eEnd) {
*--exponent = '0'; // Ew.dE0 with zero-valued exponent
}
} else { // ensure at least two exponent digits
while (exponent + 2 > eEnd) {
*--exponent = '0';
}
}
*--exponent = expo < 0 ? '-' : '+';
if (edit.expoDigits || exponent + 3 == eEnd) {
*--exponent = edit.descriptor == 'D' ? 'D' : 'E'; // not 'G'
}
length = eEnd - exponent;
return exponent;
}
// 13.7.2.3.2 in F'2018
template<typename FLOAT, int decimalPrecision, int binaryPrecision,
std::size_t bufferSize>
bool RealOutputEditing<FLOAT, decimalPrecision, binaryPrecision,
bufferSize>::EditFOutput(const DataEdit &edit) {
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.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
// 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);
}
template<typename FLOAT, int decimalPrecision, int binaryPrecision,
std::size_t bufferSize>
bool RealOutputEditing<FLOAT, decimalPrecision, binaryPrecision,
bufferSize>::Edit(const DataEdit &edit) {
// 13.7.5.2.6 in F'2018
template<int binaryPrecision>
bool RealOutputEditing<binaryPrecision>::EditEXOutput(const DataEdit &) {
io_.GetIoErrorHandler().Crash(
"EX output editing is not yet implemented"); // TODO
}
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_

2
flang/runtime/stop.cpp
View File

@ -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);
}
}

21
flang/runtime/terminator.cpp
View File

@ -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() {}
}

12
flang/runtime/terminator.h
View File

@ -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_

2
flang/runtime/tools.cpp
View File

@ -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);

3
flang/runtime/tools.h
View File

@ -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

118
flang/runtime/unit.cpp
View File

@ -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};
ExternalFile *ExternalFile::LookUp(int unit) {
void FlushOutputOnCrash(const Terminator &terminator) {
if (defaultOutput) {
IoErrorHandler handler{terminator};
handler.HasIoStat(); // prevent nested crash if flush has error
defaultOutput->Flush(handler);
}
}
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>();
}
}

106
flang/runtime/unit.h
View File

@ -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_;
};
}

2
flang/test/evaluate/real.cpp
View File

@ -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);

15
flang/test/runtime/external-hello.cpp
View File

@ -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;

29
flang/test/runtime/format.cpp
View File

@ -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) {

48
flang/test/runtime/hello.cpp
View File

@ -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 &section{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(&section.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;"},