[flang-commits] [flang] [llvm] [flang-rt] Split large unformatted sequential records into subrecords (PR #213003)

[Eugene Epshteyn via flang-commits]

================
@@ -607,67 +711,130 @@ void ExternalFileUnit::EndIoStatement() {
 void ExternalFileUnit::BeginSequentialVariableUnformattedInputRecord(
     IoErrorHandler &handler) {
   RUNTIME_CHECK(handler, access == Access::Sequential);
-  std::uint32_t header{0}, footer{0};
-  std::size_t need{recordOffsetInFrame_ + sizeof header};
-  std::size_t got{ReadFrame(frameOffsetInFile_, need, handler)};
-  // Try to emit informative errors to help debug corrupted files.
+  unformattedDiskExtent_ = 0;
+  streamRead_ = false;
+  FileOffset recordStart{
+      frameOffsetInFile_ + static_cast<FileOffset>(recordOffsetInFrame_)};
   const char *error{nullptr};
-  if (got < need) {
-    if (got == recordOffsetInFrame_) {
-      HitEndOnRead(handler);
+  std::int32_t header{0}, footer{0}, firstHeader{0};
+  std::size_t totalPayload{0};
+  FileOffset filePos{recordStart};
+
+  enum class MarkerRead { Ok, Eof, Short };
+  enum class ScanOutcome { Ok, Eof, Fail };
+  const char *scanError{nullptr};
+
+  auto readMarkerAt = [&](FileOffset &pos, std::int32_t &marker, bool swap) {
+    char buf[kRecMarkSize];
+    auto got{Read(pos, buf, kRecMarkSize, kRecMarkSize, handler)};
+    if (got < kRecMarkSize) {
+      return got == 0 ? MarkerRead::Eof : MarkerRead::Short;
+    }
+    pos += kRecMarkSize;
+    marker = LoadRecordMarker(buf, swap);
+    return MarkerRead::Ok;
+  };
+
+  auto scanRecord = [&](bool swap, std::int32_t &outHeader,
+                        std::int32_t &outFooter, std::int32_t &outFirstHeader,
+                        std::size_t &outTotalPayload,
+                        FileOffset &outFilePos) -> ScanOutcome {
+    scanError = nullptr;
+    outFilePos = recordStart;
+    outTotalPayload = 0;
+    switch (readMarkerAt(outFilePos, outHeader, swap)) {
+    case MarkerRead::Ok:
+      break;
+    case MarkerRead::Eof:
+      return ScanOutcome::Eof;
+    case MarkerRead::Short:
+      scanError = "Unformatted variable-length sequential file input failed at "
+                  "record #%jd (file offset %jd): truncated record header";
+      return ScanOutcome::Fail;
+    }
+    outFirstHeader = outHeader;
+    do {
+      outTotalPayload += SubrecordPayloadBytes(outHeader);
+      outFilePos += static_cast<FileOffset>(SubrecordPayloadBytes(outHeader));
+      if (readMarkerAt(outFilePos, outFooter, swap) != MarkerRead::Ok) {
+        scanError =
+            "Unformatted variable-length sequential file input failed at "
+            "record #%jd (file offset %jd): truncated record footer";
+        return ScanOutcome::Fail;
+      }
+      if (SubrecordPayloadBytes(outFooter) !=
+          SubrecordPayloadBytes(outHeader)) {
+        scanError =
+            "Unformatted variable-length sequential file input failed at "
+            "record #%jd (file offset %jd): record header has length %jd "
+            "that does not match record footer (%jd)";
+        return ScanOutcome::Fail;
+      }
+      if (outHeader >= 0) {
+        return ScanOutcome::Ok;
+      }
+      if (readMarkerAt(outFilePos, outHeader, swap) != MarkerRead::Ok) {
+        scanError =
+            "Unformatted variable-length sequential file input failed at "
+            "record #%jd (file offset %jd): truncated record header";
+        return ScanOutcome::Fail;
+      }
+    } while (true);
+  };
+
+  auto outcome{scanRecord(
+      swapEndianness_, header, footer, firstHeader, totalPayload, filePos)};
+  if (outcome == ScanOutcome::Eof) {
+    HitEndOnRead(handler);
+    return;
+  }
+  if (outcome == ScanOutcome::Fail) {
----------------
eugeneepshteyn wrote:

(This comment was generated with the help of AI)

Forward reads of the old 2 GiB+ layout work now, but two cases still go wrong, both because the chain walk checks marker magnitudes and not their signs:

- A record of exactly 2 GiB had the marker 0x80000000. Read as signed, its footer has the same magnitude as its header, so the walk takes the old footer as a valid first-subrecord footer and the next record's header as a continuation. The two records are merged: record 2 then hits end of file, and a READ that asks for more than record 1 holds returns record 2's data with `iostat=0`.
- BACKSPACE has no unsigned fallback. For any old 2–4 GiB record, its negative footer is taken as a continuation marker, so the second BACKSPACE below fails with `iostat=1027` and leaves the unit at a wrong position. `POSITION='APPEND'` followed by two BACKSPACEs fails the same way.

In the layout this PR (and gfortran) writes, the first subrecord's footer is non-negative and every later footer is negative. Checking that in the forward walk, and the matching header signs while BACKSPACE walks back (falling back to the unsigned reading when they don't hold), would separate the two formats in both directions. A 4-byte read of the unsigned footer before the `ReadFrame` of the whole record would also avoid asking for a ~4 GiB frame when a header is just corrupt.

```fortran
! mklegacy: write the old layout of a large record, then a small one.
! ./mklegacy 2147483648   (exactly 2 GiB)   or   ./mklegacy 2147483664
program mklegacy
  use iso_fortran_env, only: int8, int32, int64
  implicit none
  integer(int64) :: n
  integer(int8), allocatable :: a(:)
  integer :: u
  character(len=32) :: arg
  call get_command_argument(1, arg)
  read (arg, *) n
  allocate (a(n)); a = 1
  open (newunit=u, file='legacy.dat', access='stream', form='unformatted', &
        status='replace')
  write (u) int(n - 2_int64**32, int32), a, int(n - 2_int64**32, int32)
  write (u) 8_int32, 777_int64, 8_int32
  close (u)
end program
```

```fortran
program rdlegacy
  use iso_fortran_env, only: int8, int64
  implicit none
  integer(int8) :: head(8)
  integer(int64) :: v
  integer :: u, ios
  open (newunit=u, file='legacy.dat', form='unformatted', status='old')
  read (u, iostat=ios) head
  print *, 'record 1 iostat =', ios
  v = -1
  read (u, iostat=ios) v
  print *, 'record 2 iostat =', ios, ' value =', v
  rewind (u)
  read (u) head
  read (u, iostat=ios) v
  backspace (u, iostat=ios)
  backspace (u, iostat=ios)
  print *, 'second backspace iostat =', ios
  close (u)
end program
```

| payload | before this PR | this revision |
|---|---|---|
| 2147483648 | record 2 = 777, BACKSPACE OK | record 2: `iostat=-1` (end of file) |
| 2147483664 | record 2 = 777, BACKSPACE OK | record 2 = 777; second BACKSPACE `iostat=1027` |


https://github.com/llvm/llvm-project/pull/213003