Skip to content

Commit cc180f4

Browse files
klauslerklausler
committed
[flang] Support for character array formats
A character array can be used as a format in an I/O data transfer statement, with the interpretation that its elements are concatenated in element order to constitute the format. Support in the runtime with an extra optional descriptor argument to six I/O API calls; support in semantics by removing an earlier check for a simply contiguous array presented as a format. Some work needs to be done in lowering to pass a character array descriptor to the I/O runtime API when present Differential Revision: https://reviews.llvm.org/D132167
1 parent ad8eb85 commit cc180f4

File tree

8 files changed

+106
-56
lines changed

8 files changed

+106
-56
lines changed

‎flang/include/flang/Runtime/io-api.h

Lines changed: 10 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -59,6 +59,8 @@ extern "C" {
5959
// Cookie cookie{BeginExternalListOutput(DefaultUnit,__FILE__,__LINE__)};
6060
// OutputInteger32(cookie, 666);
6161
// EndIoStatement(cookie);
62+
// Formatted I/O with explicit formats can supply the format as a
63+
// const char * pointer with a length, or with a descriptor.
6264

6365
// Internal I/O initiation
6466
// Internal I/O can loan the runtime library an optional block of memory
@@ -86,11 +88,11 @@ Cookie IONAME(BeginInternalArrayListInput)(const Descriptor &,
8688
Cookie IONAME(BeginInternalArrayFormattedOutput)(const Descriptor &,
8789
const char *format, std::size_t formatLength, void **scratchArea = nullptr,
8890
std::size_t scratchBytes = 0, const char *sourceFile = nullptr,
89-
int sourceLine = 0);
91+
int sourceLine = 0, const Descriptor *formatDescriptor = nullptr);
9092
Cookie IONAME(BeginInternalArrayFormattedInput)(const Descriptor &,
9193
const char *format, std::size_t formatLength, void **scratchArea = nullptr,
9294
std::size_t scratchBytes = 0, const char *sourceFile = nullptr,
93-
int sourceLine = 0);
95+
int sourceLine = 0, const Descriptor *formatDescriptor = nullptr);
9496

9597
// Internal I/O to/from a default-kind character scalar can avoid a
9698
// descriptor.
@@ -105,11 +107,13 @@ Cookie IONAME(BeginInternalListInput)(const char *internal,
105107
Cookie IONAME(BeginInternalFormattedOutput)(char *internal,
106108
std::size_t internalLength, const char *format, std::size_t formatLength,
107109
void **scratchArea = nullptr, std::size_t scratchBytes = 0,
108-
const char *sourceFile = nullptr, int sourceLine = 0);
110+
const char *sourceFile = nullptr, int sourceLine = 0,
111+
const Descriptor *formatDescriptor = nullptr);
109112
Cookie IONAME(BeginInternalFormattedInput)(const char *internal,
110113
std::size_t internalLength, const char *format, std::size_t formatLength,
111114
void **scratchArea = nullptr, std::size_t scratchBytes = 0,
112-
const char *sourceFile = nullptr, int sourceLine = 0);
115+
const char *sourceFile = nullptr, int sourceLine = 0,
116+
const Descriptor *formatDescriptor = nullptr);
113117

114118
// External unit numbers must fit in default integers. When the integer
115119
// provided as UNIT is of a wider type than the default integer, it could
@@ -134,10 +138,10 @@ Cookie IONAME(BeginExternalListInput)(ExternalUnit = DefaultUnit,
134138
const char *sourceFile = nullptr, int sourceLine = 0);
135139
Cookie IONAME(BeginExternalFormattedOutput)(const char *format, std::size_t,
136140
ExternalUnit = DefaultUnit, const char *sourceFile = nullptr,
137-
int sourceLine = 0);
141+
int sourceLine = 0, const Descriptor *formatDescriptor = nullptr);
138142
Cookie IONAME(BeginExternalFormattedInput)(const char *format, std::size_t,
139143
ExternalUnit = DefaultUnit, const char *sourceFile = nullptr,
140-
int sourceLine = 0);
144+
int sourceLine = 0, const Descriptor *formatDescriptor = nullptr);
141145
Cookie IONAME(BeginUnformattedOutput)(ExternalUnit = DefaultUnit,
142146
const char *sourceFile = nullptr, int sourceLine = 0);
143147
Cookie IONAME(BeginUnformattedInput)(ExternalUnit = DefaultUnit,

‎flang/lib/Semantics/check-io.cpp

Lines changed: 0 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -252,13 +252,6 @@ void IoChecker::Enter(const parser::Format &spec) {
252252
"Format expression must be default character or default scalar integer"_err_en_US);
253253
return;
254254
}
255-
if (expr->Rank() > 0 &&
256-
!IsSimplyContiguous(*expr, context_.foldingContext())) {
257-
// The runtime APIs don't allow arbitrary descriptors for formats.
258-
context_.Say(format.source,
259-
"Format expression must be a simply contiguous array if not scalar"_err_en_US);
260-
return;
261-
}
262255
flags_.set(Flag::CharFmt);
263256
const std::optional<std::string> constantFormat{
264257
GetConstExpr<std::string>(format)};

‎flang/runtime/format-implementation.h

Lines changed: 31 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -14,20 +14,47 @@
1414
#include "emit-encoded.h"
1515
#include "format.h"
1616
#include "io-stmt.h"
17+
#include "memory.h"
1718
#include "flang/Common/format.h"
1819
#include "flang/Decimal/decimal.h"
1920
#include "flang/Runtime/main.h"
2021
#include <algorithm>
22+
#include <cstring>
2123
#include <limits>
2224

2325
namespace Fortran::runtime::io {
2426

2527
template <typename CONTEXT>
2628
FormatControl<CONTEXT>::FormatControl(const Terminator &terminator,
27-
const CharType *format, std::size_t formatLength, int maxHeight)
29+
const CharType *format, std::size_t formatLength,
30+
const Descriptor *formatDescriptor, int maxHeight)
2831
: maxHeight_{static_cast<std::uint8_t>(maxHeight)}, format_{format},
2932
formatLength_{static_cast<int>(formatLength)} {
3033
RUNTIME_CHECK(terminator, maxHeight == maxHeight_);
34+
if (!format && formatDescriptor) {
35+
// The format is a character array passed via a descriptor.
36+
formatLength = formatDescriptor->SizeInBytes() / sizeof(CharType);
37+
formatLength_ = static_cast<int>(formatLength);
38+
if (formatDescriptor->IsContiguous()) {
39+
// Treat the contiguous array as a single character value.
40+
format = const_cast<const CharType *>(
41+
reinterpret_cast<CharType *>(formatDescriptor->raw().base_addr));
42+
} else {
43+
// Concatenate its elements into a temporary array.
44+
char *p{reinterpret_cast<char *>(
45+
AllocateMemoryOrCrash(terminator, formatLength * sizeof(CharType)))};
46+
format = p;
47+
SubscriptValue at[maxRank];
48+
formatDescriptor->GetLowerBounds(at);
49+
auto elementBytes{formatDescriptor->ElementBytes()};
50+
for (std::size_t j{0}; j < formatLength; ++j) {
51+
std::memcpy(p, formatDescriptor->Element<char>(at), elementBytes);
52+
p += elementBytes;
53+
formatDescriptor->IncrementSubscripts(at);
54+
}
55+
freeFormat_ = true;
56+
}
57+
}
3158
RUNTIME_CHECK(
3259
terminator, formatLength == static_cast<std::size_t>(formatLength_));
3360
stack_[0].start = offset_;
@@ -474,6 +501,9 @@ DataEdit FormatControl<CONTEXT>::GetNextDataEdit(
474501
template <typename CONTEXT>
475502
void FormatControl<CONTEXT>::Finish(Context &context) {
476503
CueUpNextDataEdit(context, true /* stop at colon or end of FORMAT */);
504+
if (freeFormat_) {
505+
FreeMemory(const_cast<CharType *>(format_));
506+
}
477507
}
478508
} // namespace Fortran::runtime::io
479509
#endif // FORTRAN_RUNTIME_FORMAT_IMPLEMENTATION_H_

‎flang/runtime/format.h

Lines changed: 8 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,10 @@
1818
#include <cinttypes>
1919
#include <optional>
2020

21+
namespace Fortran::runtime {
22+
class Descriptor;
23+
} // namespace Fortran::runtime
24+
2125
namespace Fortran::runtime::io {
2226

2327
class IoStatementState;
@@ -86,7 +90,8 @@ template <typename CONTEXT> class FormatControl {
8690

8791
FormatControl() {}
8892
FormatControl(const Terminator &, const CharType *format,
89-
std::size_t formatLength, int maxHeight = maxMaxHeight);
93+
std::size_t formatLength, const Descriptor *formatDescriptor = nullptr,
94+
int maxHeight = maxMaxHeight);
9095

9196
// For attempting to allocate in a user-supplied stack area
9297
static std::size_t GetNeededSize(int maxHeight) {
@@ -177,8 +182,9 @@ template <typename CONTEXT> class FormatControl {
177182
// user program for internal I/O.
178183
const std::uint8_t maxHeight_{maxMaxHeight};
179184
std::uint8_t height_{0};
185+
bool freeFormat_{false};
180186
const CharType *format_{nullptr};
181-
int formatLength_{0};
187+
int formatLength_{0}; // in units of characters
182188
int offset_{0}; // next item is at format_[offset_]
183189

184190
// must be last, may be incomplete

‎flang/runtime/io-api.cpp

Lines changed: 35 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -70,26 +70,31 @@ Cookie IONAME(BeginInternalArrayListInput)(const Descriptor &descriptor,
7070
template <Direction DIR>
7171
Cookie BeginInternalArrayFormattedIO(const Descriptor &descriptor,
7272
const char *format, std::size_t formatLength, void ** /*scratchArea*/,
73-
std::size_t /*scratchBytes*/, const char *sourceFile, int sourceLine) {
73+
std::size_t /*scratchBytes*/, const char *sourceFile, int sourceLine,
74+
const Descriptor *formatDescriptor) {
7475
Terminator oom{sourceFile, sourceLine};
75-
return &New<InternalFormattedIoStatementState<DIR>>{oom}(
76-
descriptor, format, formatLength, sourceFile, sourceLine)
76+
return &New<InternalFormattedIoStatementState<DIR>>{oom}(descriptor, format,
77+
formatLength, sourceFile, sourceLine, formatDescriptor)
7778
.release()
7879
->ioStatementState();
7980
}
8081

8182
Cookie IONAME(BeginInternalArrayFormattedOutput)(const Descriptor &descriptor,
8283
const char *format, std::size_t formatLength, void **scratchArea,
83-
std::size_t scratchBytes, const char *sourceFile, int sourceLine) {
84+
std::size_t scratchBytes, const char *sourceFile, int sourceLine,
85+
const Descriptor *formatDescriptor) {
8486
return BeginInternalArrayFormattedIO<Direction::Output>(descriptor, format,
85-
formatLength, scratchArea, scratchBytes, sourceFile, sourceLine);
87+
formatLength, scratchArea, scratchBytes, sourceFile, sourceLine,
88+
formatDescriptor);
8689
}
8790

8891
Cookie IONAME(BeginInternalArrayFormattedInput)(const Descriptor &descriptor,
8992
const char *format, std::size_t formatLength, void **scratchArea,
90-
std::size_t scratchBytes, const char *sourceFile, int sourceLine) {
93+
std::size_t scratchBytes, const char *sourceFile, int sourceLine,
94+
const Descriptor *formatDescriptor) {
9195
return BeginInternalArrayFormattedIO<Direction::Input>(descriptor, format,
92-
formatLength, scratchArea, scratchBytes, sourceFile, sourceLine);
96+
formatLength, scratchArea, scratchBytes, sourceFile, sourceLine,
97+
formatDescriptor);
9398
}
9499

95100
template <Direction DIR>
@@ -123,28 +128,32 @@ Cookie BeginInternalFormattedIO(
123128
std::conditional_t<DIR == Direction::Input, const char, char> *internal,
124129
std::size_t internalLength, const char *format, std::size_t formatLength,
125130
void ** /*scratchArea*/, std::size_t /*scratchBytes*/,
126-
const char *sourceFile, int sourceLine) {
131+
const char *sourceFile, int sourceLine,
132+
const Descriptor *formatDescriptor) {
127133
Terminator oom{sourceFile, sourceLine};
128-
return &New<InternalFormattedIoStatementState<DIR>>{oom}(
129-
internal, internalLength, format, formatLength, sourceFile, sourceLine)
134+
return &New<InternalFormattedIoStatementState<DIR>>{oom}(internal,
135+
internalLength, format, formatLength, sourceFile, sourceLine,
136+
formatDescriptor)
130137
.release()
131138
->ioStatementState();
132139
}
133140

134141
Cookie IONAME(BeginInternalFormattedOutput)(char *internal,
135142
std::size_t internalLength, const char *format, std::size_t formatLength,
136143
void **scratchArea, std::size_t scratchBytes, const char *sourceFile,
137-
int sourceLine) {
144+
int sourceLine, const Descriptor *formatDescriptor) {
138145
return BeginInternalFormattedIO<Direction::Output>(internal, internalLength,
139-
format, formatLength, scratchArea, scratchBytes, sourceFile, sourceLine);
146+
format, formatLength, scratchArea, scratchBytes, sourceFile, sourceLine,
147+
formatDescriptor);
140148
}
141149

142150
Cookie IONAME(BeginInternalFormattedInput)(const char *internal,
143151
std::size_t internalLength, const char *format, std::size_t formatLength,
144152
void **scratchArea, std::size_t scratchBytes, const char *sourceFile,
145-
int sourceLine) {
153+
int sourceLine, const Descriptor *formatDescriptor) {
146154
return BeginInternalFormattedIO<Direction::Input>(internal, internalLength,
147-
format, formatLength, scratchArea, scratchBytes, sourceFile, sourceLine);
155+
format, formatLength, scratchArea, scratchBytes, sourceFile, sourceLine,
156+
formatDescriptor);
148157
}
149158

150159
static Cookie NoopUnit(const Terminator &terminator, int unitNumber,
@@ -235,7 +244,8 @@ Cookie IONAME(BeginExternalListInput)(
235244

236245
template <Direction DIR>
237246
Cookie BeginExternalFormattedIO(const char *format, std::size_t formatLength,
238-
ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
247+
ExternalUnit unitNumber, const char *sourceFile, int sourceLine,
248+
const Descriptor *formatDescriptor) {
239249
Terminator terminator{sourceFile, sourceLine};
240250
if (unitNumber == DefaultUnit) {
241251
unitNumber = DIR == Direction::Input ? 5 : 6;
@@ -259,7 +269,8 @@ Cookie BeginExternalFormattedIO(const char *format, std::size_t formatLength,
259269
}
260270
if (iostat == IostatOk) {
261271
return &child->BeginIoStatement<ChildFormattedIoStatementState<DIR>>(
262-
*child, format, formatLength, sourceFile, sourceLine);
272+
*child, format, formatLength, sourceFile, sourceLine,
273+
formatDescriptor);
263274
} else {
264275
return &child->BeginIoStatement<ErroneousIoStatementState>(
265276
iostat, nullptr /* no unit */, sourceFile, sourceLine);
@@ -270,7 +281,8 @@ Cookie BeginExternalFormattedIO(const char *format, std::size_t formatLength,
270281
}
271282
if (iostat == IostatOk) {
272283
return &unit->BeginIoStatement<ExternalFormattedIoStatementState<DIR>>(
273-
terminator, *unit, format, formatLength, sourceFile, sourceLine);
284+
terminator, *unit, format, formatLength, sourceFile, sourceLine,
285+
formatDescriptor);
274286
} else {
275287
return &unit->BeginIoStatement<ErroneousIoStatementState>(
276288
terminator, iostat, unit, sourceFile, sourceLine);
@@ -280,16 +292,16 @@ Cookie BeginExternalFormattedIO(const char *format, std::size_t formatLength,
280292

281293
Cookie IONAME(BeginExternalFormattedOutput)(const char *format,
282294
std::size_t formatLength, ExternalUnit unitNumber, const char *sourceFile,
283-
int sourceLine) {
284-
return BeginExternalFormattedIO<Direction::Output>(
285-
format, formatLength, unitNumber, sourceFile, sourceLine);
295+
int sourceLine, const Descriptor *formatDescriptor) {
296+
return BeginExternalFormattedIO<Direction::Output>(format, formatLength,
297+
unitNumber, sourceFile, sourceLine, formatDescriptor);
286298
}
287299

288300
Cookie IONAME(BeginExternalFormattedInput)(const char *format,
289301
std::size_t formatLength, ExternalUnit unitNumber, const char *sourceFile,
290-
int sourceLine) {
291-
return BeginExternalFormattedIO<Direction::Input>(
292-
format, formatLength, unitNumber, sourceFile, sourceLine);
302+
int sourceLine, const Descriptor *formatDescriptor) {
303+
return BeginExternalFormattedIO<Direction::Input>(format, formatLength,
304+
unitNumber, sourceFile, sourceLine, formatDescriptor);
293305
}
294306

295307
template <Direction DIR>

‎flang/runtime/io-stmt.cpp

Lines changed: 12 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -140,16 +140,19 @@ void InternalIoStatementState<DIR>::HandleRelativePosition(std::int64_t n) {
140140
template <Direction DIR, typename CHAR>
141141
InternalFormattedIoStatementState<DIR, CHAR>::InternalFormattedIoStatementState(
142142
Buffer buffer, std::size_t length, const CharType *format,
143-
std::size_t formatLength, const char *sourceFile, int sourceLine)
143+
std::size_t formatLength, const char *sourceFile, int sourceLine,
144+
const Descriptor *formatDescriptor)
144145
: InternalIoStatementState<DIR>{buffer, length, sourceFile, sourceLine},
145-
ioStatementState_{*this}, format_{*this, format, formatLength} {}
146+
ioStatementState_{*this}, format_{*this, format, formatLength,
147+
formatDescriptor} {}
146148

147149
template <Direction DIR, typename CHAR>
148150
InternalFormattedIoStatementState<DIR, CHAR>::InternalFormattedIoStatementState(
149151
const Descriptor &d, const CharType *format, std::size_t formatLength,
150-
const char *sourceFile, int sourceLine)
152+
const char *sourceFile, int sourceLine, const Descriptor *formatDescriptor)
151153
: InternalIoStatementState<DIR>{d, sourceFile, sourceLine},
152-
ioStatementState_{*this}, format_{*this, format, formatLength} {}
154+
ioStatementState_{*this}, format_{*this, format, formatLength,
155+
formatDescriptor} {}
153156

154157
template <Direction DIR, typename CHAR>
155158
void InternalFormattedIoStatementState<DIR, CHAR>::CompleteOperation() {
@@ -395,9 +398,9 @@ void ExternalIoStatementState<DIR>::FinishReadingRecord() {
395398
template <Direction DIR, typename CHAR>
396399
ExternalFormattedIoStatementState<DIR, CHAR>::ExternalFormattedIoStatementState(
397400
ExternalFileUnit &unit, const CHAR *format, std::size_t formatLength,
398-
const char *sourceFile, int sourceLine)
401+
const char *sourceFile, int sourceLine, const Descriptor *formatDescriptor)
399402
: ExternalIoStatementState<DIR>{unit, sourceFile, sourceLine},
400-
format_{*this, format, formatLength} {}
403+
format_{*this, format, formatLength, formatDescriptor} {}
401404

402405
template <Direction DIR, typename CHAR>
403406
void ExternalFormattedIoStatementState<DIR, CHAR>::CompleteOperation() {
@@ -850,10 +853,11 @@ void ChildIoStatementState<DIR>::HandleRelativePosition(std::int64_t n) {
850853
template <Direction DIR, typename CHAR>
851854
ChildFormattedIoStatementState<DIR, CHAR>::ChildFormattedIoStatementState(
852855
ChildIo &child, const CHAR *format, std::size_t formatLength,
853-
const char *sourceFile, int sourceLine)
856+
const char *sourceFile, int sourceLine, const Descriptor *formatDescriptor)
854857
: ChildIoStatementState<DIR>{child, sourceFile, sourceLine},
855858
mutableModes_{child.parent().mutableModes()}, format_{*this, format,
856-
formatLength} {}
859+
formatLength,
860+
formatDescriptor} {}
857861

858862
template <Direction DIR, typename CHAR>
859863
void ChildFormattedIoStatementState<DIR, CHAR>::CompleteOperation() {

‎flang/runtime/io-stmt.h

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -358,10 +358,11 @@ class InternalFormattedIoStatementState
358358
using typename InternalIoStatementState<DIR>::Buffer;
359359
InternalFormattedIoStatementState(Buffer internal, std::size_t internalLength,
360360
const CharType *format, std::size_t formatLength,
361-
const char *sourceFile = nullptr, int sourceLine = 0);
361+
const char *sourceFile = nullptr, int sourceLine = 0,
362+
const Descriptor *formatDescriptor = nullptr);
362363
InternalFormattedIoStatementState(const Descriptor &, const CharType *format,
363364
std::size_t formatLength, const char *sourceFile = nullptr,
364-
int sourceLine = 0);
365+
int sourceLine = 0, const Descriptor *formatDescriptor = nullptr);
365366
IoStatementState &ioStatementState() { return ioStatementState_; }
366367
void CompleteOperation();
367368
int EndIoStatement();
@@ -444,7 +445,7 @@ class ExternalFormattedIoStatementState
444445
using CharType = CHAR;
445446
ExternalFormattedIoStatementState(ExternalFileUnit &, const CharType *format,
446447
std::size_t formatLength, const char *sourceFile = nullptr,
447-
int sourceLine = 0);
448+
int sourceLine = 0, const Descriptor *formatDescriptor = nullptr);
448449
void CompleteOperation();
449450
int EndIoStatement();
450451
std::optional<DataEdit> GetNextDataEdit(
@@ -500,7 +501,7 @@ class ChildFormattedIoStatementState : public ChildIoStatementState<DIR>,
500501
using CharType = CHAR;
501502
ChildFormattedIoStatementState(ChildIo &, const CharType *format,
502503
std::size_t formatLength, const char *sourceFile = nullptr,
503-
int sourceLine = 0);
504+
int sourceLine = 0, const Descriptor *formatDescriptor = nullptr);
504505
MutableModes &mutableModes() { return mutableModes_; }
505506
void CompleteOperation();
506507
int EndIoStatement();

‎flang/test/Semantics/assign06.f90

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -11,8 +11,8 @@ subroutine test(n)
1111
integer(kind=1) :: badlab1
1212
real :: badlab2
1313
integer :: badlab3(1)
14-
real, pointer :: badlab4(:) ! not contiguous
15-
real, pointer, contiguous :: oklab4(:)
14+
character, pointer :: badlab4(:) ! not contiguous
15+
character, pointer, contiguous :: oklab4(:)
1616
assign 1 to lab ! ok
1717
assign 1 to implicitlab1 ! ok
1818
!ERROR: 'badlab1' must be a default integer scalar variable
@@ -44,9 +44,9 @@ subroutine test(n)
4444
!Legacy extension cases
4545
write(*,fmt=badlab2)
4646
write(*,fmt=badlab3)
47-
!ERROR: Format expression must be a simply contiguous array if not scalar
48-
write(*,fmt=badlab4)
49-
write(*,fmt=badlab5) ! ok legacy extension
47+
!Array cases
48+
write(*,fmt=badlab4) ! ok
49+
write(*,fmt=badlab5) ! ok
5050
1 continue
5151
3 format('yes')
5252
end subroutine test

0 commit comments

Comments
 (0)