Warning: This file is not a C or C++ file. It does not have highlighting.

1//===-- include/flang-rt/runtime/format-implementation.h --------*- C++ -*-===//
2//
3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4// See https://llvm.org/LICENSE.txt for license information.
5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6//
7//===----------------------------------------------------------------------===//
8
9// Implements out-of-line member functions of template class FormatControl
10
11#ifndef FLANG_RT_RUNTIME_FORMAT_IMPLEMENTATION_H_
12#define FLANG_RT_RUNTIME_FORMAT_IMPLEMENTATION_H_
13
14#include "emit-encoded.h"
15#include "format.h"
16#include "io-stmt.h"
17#include "memory.h"
18#include "flang/Common/format.h"
19#include "flang/Decimal/decimal.h"
20#include "flang/Runtime/main.h"
21#include <algorithm>
22#include <cstring>
23#include <limits>
24
25namespace Fortran::runtime::io {
26
27template <typename CONTEXT>
28RT_API_ATTRS FormatControl<CONTEXT>::FormatControl(const Terminator &terminator,
29 const CharType *format, std::size_t formatLength,
30 const Descriptor *formatDescriptor, int maxHeight)
31 : maxHeight_{static_cast<std::uint8_t>(maxHeight)}, format_{format},
32 formatLength_{static_cast<int>(formatLength)} {
33 RUNTIME_CHECK(terminator, maxHeight == maxHeight_);
34 if (!format && formatDescriptor) {
35 // The format is a character array passed via a descriptor.
36 std::size_t elements{formatDescriptor->Elements()};
37 std::size_t elementBytes{formatDescriptor->ElementBytes()};
38 formatLength = elements * elementBytes / sizeof(CharType);
39 formatLength_ = static_cast<int>(formatLength);
40 if (formatDescriptor->IsContiguous()) {
41 // Treat the contiguous array as a single character value.
42 format_ = const_cast<const CharType *>(
43 reinterpret_cast<CharType *>(formatDescriptor->raw().base_addr));
44 } else {
45 // Concatenate its elements into a temporary array.
46 char *p{reinterpret_cast<char *>(
47 AllocateMemoryOrCrash(terminator, formatLength * sizeof(CharType)))};
48 format_ = p;
49 SubscriptValue at[maxRank];
50 formatDescriptor->GetLowerBounds(at);
51 for (std::size_t j{0}; j < elements; ++j) {
52 std::memcpy(p, formatDescriptor->Element<char>(at), elementBytes);
53 p += elementBytes;
54 formatDescriptor->IncrementSubscripts(at);
55 }
56 freeFormat_ = true;
57 }
58 }
59 RUNTIME_CHECK(
60 terminator, formatLength == static_cast<std::size_t>(formatLength_));
61 stack_[0].start = offset_;
62 stack_[0].remaining = Iteration::unlimited; // 13.4(8)
63}
64
65template <typename CONTEXT>
66RT_API_ATTRS int FormatControl<CONTEXT>::GetIntField(
67 IoErrorHandler &handler, CharType firstCh, bool *hadError) {
68 CharType ch{firstCh ? firstCh : PeekNext()};
69 bool negate{ch == '-'};
70 if (negate || ch == '+') {
71 if (firstCh) {
72 firstCh = '\0';
73 } else {
74 ++offset_;
75 }
76 ch = PeekNext();
77 }
78 if (ch < '0' || ch > '9') {
79 handler.SignalError(IostatErrorInFormat,
80 "Invalid FORMAT: integer expected at '%c'", static_cast<char>(ch));
81 if (hadError) {
82 *hadError = true;
83 }
84 return 0;
85 }
86 int result{0};
87 while (ch >= '0' && ch <= '9') {
88 constexpr int tenth{std::numeric_limits<int>::max() / 10};
89 if (result > tenth ||
90 ch - '0' > std::numeric_limits<int>::max() - 10 * result) {
91 handler.SignalError(
92 IostatErrorInFormat, "FORMAT integer field out of range");
93 if (hadError) {
94 *hadError = true;
95 }
96 return result;
97 }
98 result = 10 * result + ch - '0';
99 if (firstCh) {
100 firstCh = '\0';
101 } else {
102 ++offset_;
103 }
104 ch = PeekNext();
105 }
106 if (negate && (result *= -1) > 0) {
107 handler.SignalError(
108 IostatErrorInFormat, "FORMAT integer field out of range");
109 if (hadError) {
110 *hadError = true;
111 }
112 }
113 return result;
114}
115
116// Xn, TRn, TLn
117template <typename CONTEXT>
118static RT_API_ATTRS bool RelativeTabbing(CONTEXT &context, int n) {
119 ConnectionState &connection{context.GetConnectionState()};
120 if constexpr (std::is_same_v<CONTEXT,
121 ExternalFormattedIoStatementState<Direction::Input>> ||
122 std::is_same_v<CONTEXT,
123 ExternalFormattedIoStatementState<Direction::Output>>) {
124 if (n != 0 && connection.isUTF8) {
125 const char *p{};
126 if (n > 0) { // Xn or TRn
127 // Skip 'n' multi-byte characters. If that's more than are in the
128 // current record, that's valid -- the program can position past the
129 // end and then reposition back with Tn or TLn.
130 std::size_t bytesLeft{context.ViewBytesInRecord(p, true)};
131 for (; n > 0 && bytesLeft && p; --n) {
132 std::size_t byteCount{MeasureUTF8Bytes(*p)};
133 if (byteCount > bytesLeft) {
134 break;
135 }
136 context.HandleRelativePosition(byteCount);
137 bytesLeft -= byteCount;
138 // Don't call GotChar(byteCount), these don't count towards SIZE=
139 p += byteCount;
140 }
141 } else { // n < 0: TLn
142 n = -n;
143 if (std::int64_t excess{connection.positionInRecord -
144 connection.recordLength.value_or(connection.positionInRecord)};
145 excess > 0) {
146 // Have tabbed past the end of the record
147 if (excess >= n) {
148 context.HandleRelativePosition(-n);
149 return true;
150 }
151 context.HandleRelativePosition(-excess);
152 n -= excess;
153 }
154 std::size_t bytesLeft{context.ViewBytesInRecord(p, false)};
155 // Go back 'n' multi-byte characters.
156 for (; n > 0 && bytesLeft && p; --n) {
157 std::size_t byteCount{MeasurePreviousUTF8Bytes(p, bytesLeft)};
158 context.HandleRelativePosition(-byteCount);
159 bytesLeft -= byteCount;
160 p -= byteCount;
161 }
162 }
163 }
164 }
165 if (connection.internalIoCharKind > 1) {
166 n *= connection.internalIoCharKind;
167 }
168 context.HandleRelativePosition(n);
169 return true;
170}
171
172// Tn
173template <typename CONTEXT>
174static RT_API_ATTRS bool AbsoluteTabbing(CONTEXT &context, int n) {
175 ConnectionState &connection{context.GetConnectionState()};
176 n = n > 0 ? n - 1 : 0; // convert 1-based position to 0-based offset
177 if constexpr (std::is_same_v<CONTEXT,
178 ExternalFormattedIoStatementState<Direction::Input>> ||
179 std::is_same_v<CONTEXT,
180 ExternalFormattedIoStatementState<Direction::Output>>) {
181 if (connection.isUTF8) {
182 // Reset to the beginning of the record, then TR(n-1)
183 connection.HandleAbsolutePosition(0);
184 return RelativeTabbing(context, n);
185 }
186 }
187 if (connection.internalIoCharKind > 1) {
188 n *= connection.internalIoCharKind;
189 }
190 context.HandleAbsolutePosition(n);
191 return true;
192}
193
194template <typename CONTEXT>
195static RT_API_ATTRS void HandleControl(
196 CONTEXT &context, char ch, char next, int n) {
197 MutableModes &modes{context.mutableModes()};
198 switch (ch) {
199 case 'B':
200 if (next == 'Z') {
201 modes.editingFlags |= blankZero;
202 return;
203 }
204 if (next == 'N') {
205 modes.editingFlags &= ~blankZero;
206 return;
207 }
208 break;
209 case 'D':
210 if (next == 'C') {
211 modes.editingFlags |= decimalComma;
212 return;
213 }
214 if (next == 'P') {
215 modes.editingFlags &= ~decimalComma;
216 return;
217 }
218 break;
219 case 'P':
220 if (!next) {
221 modes.scale = n; // kP - decimal scaling by 10**k
222 return;
223 }
224 break;
225 case 'R':
226 switch (next) {
227 case 'N':
228 modes.round = decimal::RoundNearest;
229 return;
230 case 'Z':
231 modes.round = decimal::RoundToZero;
232 return;
233 case 'U':
234 modes.round = decimal::RoundUp;
235 return;
236 case 'D':
237 modes.round = decimal::RoundDown;
238 return;
239 case 'C':
240 modes.round = decimal::RoundCompatible;
241 return;
242 case 'P':
243 modes.round = executionEnvironment.defaultOutputRoundingMode;
244 return;
245 default:
246 break;
247 }
248 break;
249 case 'X':
250 if (!next && RelativeTabbing(context, n)) {
251 return;
252 }
253 break;
254 case 'S':
255 if (next == 'P') {
256 modes.editingFlags |= signPlus;
257 return;
258 }
259 if (!next || next == 'S') {
260 modes.editingFlags &= ~signPlus;
261 return;
262 }
263 break;
264 case 'T': {
265 if (!next) { // Tn
266 if (AbsoluteTabbing(context, n)) {
267 return;
268 }
269 } else if (next == 'R' || next == 'L') { // TRn / TLn
270 if (RelativeTabbing(context, next == 'L' ? -n : n)) {
271 return;
272 }
273 }
274 } break;
275 default:
276 break;
277 }
278 if (next) {
279 context.SignalError(IostatErrorInFormat,
280 "Unknown '%c%c' edit descriptor in FORMAT", ch, next);
281 } else {
282 context.SignalError(
283 IostatErrorInFormat, "Unknown '%c' edit descriptor in FORMAT", ch);
284 }
285}
286
287// Locates the next data edit descriptor in the format.
288// Handles all repetition counts and control edit descriptors.
289// Generally assumes that the format string has survived the common
290// format validator gauntlet.
291template <typename CONTEXT>
292RT_API_ATTRS int FormatControl<CONTEXT>::CueUpNextDataEdit(
293 Context &context, bool stop) {
294 bool hitUnlimitedLoopEnd{false};
295 // Do repetitions remain on an unparenthesized data edit?
296 while (height_ > 1 && format_[stack_[height_ - 1].start] != '(') {
297 offset_ = stack_[height_ - 1].start;
298 int repeat{stack_[height_ - 1].remaining};
299 --height_;
300 if (repeat > 0) {
301 return repeat;
302 }
303 }
304 while (true) {
305 Fortran::common::optional<int> repeat;
306 bool unlimited{false};
307 auto maybeReversionPoint{offset_};
308 CharType ch{GetNextChar(context)};
309 while (ch == ',' || ch == ':') {
310 // Skip commas, and don't complain if they're missing; the format
311 // validator does that.
312 if (stop && ch == ':') {
313 return 0;
314 }
315 ch = GetNextChar(context);
316 }
317 if (ch == '-' || ch == '+' || (ch >= '0' && ch <= '9')) {
318 bool hadSign{ch == '-' || ch == '+'};
319 repeat = GetIntField(context, ch);
320 ch = GetNextChar(context);
321 if (hadSign && ch != 'p' && ch != 'P') {
322 ReportBadFormat(context,
323 "Invalid FORMAT: signed integer may appear only before 'P",
324 maybeReversionPoint);
325 return 0;
326 }
327 } else if (ch == '*') {
328 unlimited = true;
329 ch = GetNextChar(context);
330 if (ch != '(') {
331 ReportBadFormat(context,
332 "Invalid FORMAT: '*' may appear only before '('",
333 maybeReversionPoint);
334 return 0;
335 }
336 if (height_ != 1) {
337 ReportBadFormat(context,
338 "Invalid FORMAT: '*' must be nested in exactly one set of "
339 "parentheses",
340 maybeReversionPoint);
341 return 0;
342 }
343 }
344 ch = Capitalize(ch);
345 if (ch == '(') {
346 if (height_ >= maxHeight_) {
347 ReportBadFormat(context,
348 "FORMAT stack overflow: too many nested parentheses",
349 maybeReversionPoint);
350 return 0;
351 }
352 stack_[height_].start = offset_ - 1; // the '('
353 RUNTIME_CHECK(context, format_[stack_[height_].start] == '(');
354 if (unlimited || height_ == 0) {
355 stack_[height_].remaining = Iteration::unlimited;
356 } else if (repeat) {
357 if (*repeat <= 0) {
358 *repeat = 1; // error recovery
359 }
360 stack_[height_].remaining = *repeat - 1;
361 } else {
362 stack_[height_].remaining = 0;
363 }
364 if (height_ == 1 && !hitEnd_) {
365 // Subtle point (F'2018 13.4 para 9): the last parenthesized group
366 // at height 1 becomes the restart point after control reaches the
367 // end of the format, including its repeat count.
368 stack_[0].start = maybeReversionPoint;
369 }
370 ++height_;
371 } else if (height_ == 0) {
372 ReportBadFormat(context, "FORMAT lacks initial '('", maybeReversionPoint);
373 return 0;
374 } else if (ch == ')') {
375 if (height_ == 1) {
376 hitEnd_ = true;
377 if (stop) {
378 return 0; // end of FORMAT and no data items remain
379 }
380 context.AdvanceRecord(); // implied / before rightmost )
381 }
382 auto restart{stack_[height_ - 1].start};
383 if (format_[restart] == '(') {
384 ++restart;
385 }
386 if (stack_[height_ - 1].remaining == Iteration::unlimited) {
387 if (height_ > 1 && GetNextChar(context) != ')') {
388 ReportBadFormat(context,
389 "Unlimited repetition in FORMAT may not be followed by more "
390 "items",
391 restart);
392 return 0;
393 }
394 if (hitUnlimitedLoopEnd) {
395 ReportBadFormat(context,
396 "Unlimited repetition in FORMAT lacks data edit descriptors",
397 restart);
398 return 0;
399 }
400 hitUnlimitedLoopEnd = true;
401 offset_ = restart;
402 } else if (stack_[height_ - 1].remaining-- > 0) {
403 offset_ = restart;
404 } else {
405 --height_;
406 }
407 } else if (ch == '\'' || ch == '"') {
408 // Quoted 'character literal'
409 CharType quote{ch};
410 auto start{offset_};
411 while (offset_ < formatLength_ && format_[offset_] != quote) {
412 ++offset_;
413 }
414 if (offset_ >= formatLength_) {
415 ReportBadFormat(context,
416 "FORMAT missing closing quote on character literal",
417 maybeReversionPoint);
418 return 0;
419 }
420 ++offset_;
421 std::size_t chars{
422 static_cast<std::size_t>(&format_[offset_] - &format_[start])};
423 if (offset_ < formatLength_ && format_[offset_] == quote) {
424 // subtle: handle doubled quote character in a literal by including
425 // the first in the output, then treating the second as the start
426 // of another character literal.
427 } else {
428 --chars;
429 }
430 if constexpr (std::is_base_of_v<InputStatementState, CONTEXT>) {
431 context.HandleRelativePosition(chars);
432 } else {
433 EmitAscii(context, format_ + start, chars);
434 }
435 } else if (ch == 'H') {
436 // 9HHOLLERITH
437 if (!repeat || *repeat < 1 || offset_ + *repeat > formatLength_) {
438 ReportBadFormat(context, "Invalid width on Hollerith in FORMAT",
439 maybeReversionPoint);
440 return 0;
441 }
442 if constexpr (std::is_base_of_v<InputStatementState, CONTEXT>) {
443 context.HandleRelativePosition(static_cast<std::size_t>(*repeat));
444 } else {
445 EmitAscii(
446 context, format_ + offset_, static_cast<std::size_t>(*repeat));
447 }
448 offset_ += *repeat;
449 } else if (ch >= 'A' && ch <= 'Z') {
450 int start{offset_ - 1};
451 CharType next{'\0'};
452 if (ch != 'P') { // 1PE5.2 - comma not required (C1302)
453 CharType peek{Capitalize(PeekNext())};
454 if (peek >= 'A' && peek <= 'Z') {
455 if ((ch == 'A' && peek == 'T' /* anticipate F'202X AT editing */) ||
456 ch == 'B' || ch == 'D' || ch == 'E' || ch == 'R' || ch == 'S' ||
457 ch == 'T') {
458 // Assume a two-letter edit descriptor
459 next = peek;
460 ++offset_;
461 } else {
462 // extension: assume a comma between 'ch' and 'peek'
463 }
464 }
465 }
466 if ((!next &&
467 (ch == 'A' || ch == 'I' || ch == 'B' || ch == 'E' || ch == 'D' ||
468 ch == 'O' || ch == 'Z' || ch == 'F' || ch == 'G' ||
469 ch == 'L')) ||
470 (ch == 'E' && (next == 'N' || next == 'S' || next == 'X')) ||
471 (ch == 'D' && next == 'T')) {
472 // Data edit descriptor found
473 offset_ = start;
474 return repeat && *repeat > 0 ? *repeat : 1;
475 } else {
476 // Control edit descriptor
477 if (ch == 'T') { // Tn, TLn, TRn
478 repeat = GetIntField(context);
479 }
480 HandleControl(context, static_cast<char>(ch), static_cast<char>(next),
481 repeat ? *repeat : 1);
482 }
483 } else if (ch == '/') {
484 context.AdvanceRecord(repeat && *repeat > 0 ? *repeat : 1);
485 } else if (ch == '$' || ch == '\\') {
486 context.mutableModes().nonAdvancing = true;
487 } else if (ch == '\t' || ch == '\v') {
488 // Tabs (extension)
489 // TODO: any other raw characters?
490 EmitAscii(context, format_ + offset_ - 1, 1);
491 } else {
492 ReportBadFormat(
493 context, "Invalid character in FORMAT", maybeReversionPoint);
494 return 0;
495 }
496 }
497}
498
499// Returns the next data edit descriptor
500template <typename CONTEXT>
501RT_API_ATTRS Fortran::common::optional<DataEdit>
502FormatControl<CONTEXT>::GetNextDataEdit(Context &context, int maxRepeat) {
503 int repeat{CueUpNextDataEdit(context)};
504 auto start{offset_};
505 DataEdit edit;
506 edit.modes = context.mutableModes();
507 // Handle repeated nonparenthesized edit descriptors
508 edit.repeat = std::min(repeat, maxRepeat); // 0 if maxRepeat==0
509 if (repeat > maxRepeat) {
510 stack_[height_].start = start; // after repeat count
511 stack_[height_].remaining = repeat - edit.repeat;
512 ++height_;
513 }
514 edit.descriptor = static_cast<char>(Capitalize(GetNextChar(context)));
515 if (edit.descriptor == 'D' && Capitalize(PeekNext()) == 'T') {
516 // DT['iotype'][(v_list)] defined I/O
517 edit.descriptor = DataEdit::DefinedDerivedType;
518 ++offset_;
519 if (auto quote{static_cast<char>(PeekNext())};
520 quote == '\'' || quote == '"') {
521 // Capture the quoted 'iotype'
522 bool ok{false};
523 for (++offset_; offset_ < formatLength_;) {
524 auto ch{static_cast<char>(format_[offset_++])};
525 if (ch == quote &&
526 (offset_ == formatLength_ ||
527 static_cast<char>(format_[offset_]) != quote)) {
528 ok = true;
529 break; // that was terminating quote
530 }
531 if (edit.ioTypeChars >= edit.maxIoTypeChars) {
532 ReportBadFormat(context, "Excessive DT'iotype' in FORMAT", start);
533 return Fortran::common::nullopt;
534 }
535 edit.ioType[edit.ioTypeChars++] = ch;
536 if (ch == quote) {
537 ++offset_;
538 }
539 }
540 if (!ok) {
541 ReportBadFormat(context, "Unclosed DT'iotype' in FORMAT", start);
542 return Fortran::common::nullopt;
543 }
544 }
545 if (PeekNext() == '(') {
546 // Capture the v_list arguments
547 bool ok{false};
548 for (++offset_; offset_ < formatLength_;) {
549 bool hadError{false};
550 int n{GetIntField(context, '\0', &hadError)};
551 if (hadError) {
552 ok = false;
553 break;
554 }
555 if (edit.vListEntries >= edit.maxVListEntries) {
556 ReportBadFormat(context, "Excessive DT(v_list) in FORMAT", start);
557 return Fortran::common::nullopt;
558 }
559 edit.vList[edit.vListEntries++] = n;
560 auto ch{static_cast<char>(GetNextChar(context))};
561 if (ch != ',') {
562 ok = ch == ')';
563 break;
564 }
565 }
566 if (!ok) {
567 ReportBadFormat(context, "Unclosed DT(v_list) in FORMAT", start);
568 return Fortran::common::nullopt;
569 }
570 }
571 } else { // not DT'iotype'
572 if (edit.descriptor == 'E') {
573 if (auto next{static_cast<char>(Capitalize(PeekNext()))};
574 next == 'N' || next == 'S' || next == 'X') {
575 edit.variation = next;
576 ++offset_;
577 }
578 }
579 // Width is optional for A[w] in the standard and optional
580 // for Lw in most compilers.
581 // Intel & (presumably, from bug report) Fujitsu allow
582 // a missing 'w' & 'd'/'m' for other edit descriptors -- but not
583 // 'd'/'m' with a missing 'w' -- and so interpret "(E)" as "(E0)".
584 if (CharType ch{PeekNext()}; (ch >= '0' && ch <= '9') || ch == '.') {
585 edit.width = GetIntField(context);
586 if constexpr (std::is_base_of_v<InputStatementState, CONTEXT>) {
587 if (edit.width.value_or(-1) == 0) {
588 ReportBadFormat(context, "Input field width is zero", start);
589 }
590 }
591 if (PeekNext() == '.') {
592 ++offset_;
593 edit.digits = GetIntField(context);
594 if (CharType ch{PeekNext()};
595 ch == 'e' || ch == 'E' || ch == 'd' || ch == 'D') {
596 ++offset_;
597 edit.expoDigits = GetIntField(context);
598 }
599 }
600 }
601 }
602 return edit;
603}
604
605template <typename CONTEXT>
606RT_API_ATTRS void FormatControl<CONTEXT>::Finish(Context &context) {
607 CueUpNextDataEdit(context, true /* stop at colon or end of FORMAT */);
608 if (freeFormat_) {
609 FreeMemory(const_cast<CharType *>(format_));
610 }
611}
612} // namespace Fortran::runtime::io
613#endif // FLANG_RT_RUNTIME_FORMAT_IMPLEMENTATION_H_
614

Warning: This file is not a C or C++ file. It does not have highlighting.

source code of flang-rt/include/flang-rt/runtime/format-implementation.h