flang/runtime/internal-unit.cpp

   1 //===-- runtime/internal-unit.cpp -----------------------------------------===//
   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 #include "internal-unit.h"
  10 #include "io-error.h"
  11 #include "flang/Runtime/descriptor.h"
  12 #include "flang/Runtime/freestanding-tools.h"
  13 #include <algorithm>
  14 #include <type_traits>
  15
  16 namespace Fortran::runtime::io {
  17 RT_OFFLOAD_API_GROUP_BEGIN
  18
  19 template <Direction DIR>
  20 RT_API_ATTRS InternalDescriptorUnit<DIR>::InternalDescriptorUnit(
  21     Scalar scalar, std::size_t length, int kind) {
  22   internalIoCharKind = kind;
  23   recordLength = length;
  24   endfileRecordNumber = 2;
  25   void *pointer{reinterpret_cast<void *>(const_cast<char *>(scalar))};
  26   descriptor().Establish(TypeCode{TypeCategory::Character, kind}, length * kind,
  27       pointer, 0, nullptr, CFI_attribute_pointer);
  28 }
  29
  30 template <Direction DIR>
  31 RT_API_ATTRS InternalDescriptorUnit<DIR>::InternalDescriptorUnit(
  32     const Descriptor &that, const Terminator &terminator) {
  33   auto thatType{that.type().GetCategoryAndKind()};
  34   RUNTIME_CHECK(terminator, thatType.has_value());
  35   RUNTIME_CHECK(terminator, thatType->first == TypeCategory::Character);
  36   Descriptor &d{descriptor()};
  37   RUNTIME_CHECK(
  38       terminator, that.SizeInBytes() <= d.SizeInBytes(maxRank, true, 0));
  39   new (&d) Descriptor{that};
  40   d.Check();
  41   internalIoCharKind = thatType->second;
  42   recordLength = d.ElementBytes();
  43   endfileRecordNumber = d.Elements() + 1;
  44 }
  45
  46 template <Direction DIR>
  47 RT_API_ATTRS bool InternalDescriptorUnit<DIR>::Emit(
  48     const char *data, std::size_t bytes, IoErrorHandler &handler) {
  49   if constexpr (DIR == Direction::Input) {
  50     handler.Crash("InternalDescriptorUnit<Direction::Input>::Emit() called");
  51     return false && data[bytes] != 0; // bogus compare silences GCC warning
  52   } else {
  53     if (bytes <= 0) {
  54       return true;
  55     }
  56     char *record{CurrentRecord()};
  57     if (!record) {
  58       handler.SignalError(IostatInternalWriteOverrun);
  59       return false;
  60     }
  61     auto furthestAfter{std::max(furthestPositionInRecord,
  62         positionInRecord + static_cast<std::int64_t>(bytes))};
  63     bool ok{true};
  64     if (furthestAfter > static_cast<std::int64_t>(recordLength.value_or(0))) {
  65       handler.SignalError(IostatRecordWriteOverrun);
  66       furthestAfter = recordLength.value_or(0);
  67       bytes = std::max(std::int64_t{0}, furthestAfter - positionInRecord);
  68       ok = false;
  69     } else if (positionInRecord > furthestPositionInRecord) {
  70       BlankFill(record + furthestPositionInRecord,
  71           positionInRecord - furthestPositionInRecord);
  72     }
  73     std::memcpy(record + positionInRecord, data, bytes);
  74     positionInRecord += bytes;
  75     furthestPositionInRecord = furthestAfter;
  76     return ok;
  77   }
  78 }
  79
  80 template <Direction DIR>
  81 RT_API_ATTRS std::size_t InternalDescriptorUnit<DIR>::GetNextInputBytes(
  82     const char *&p, IoErrorHandler &handler) {
  83   if constexpr (DIR == Direction::Output) {
  84     handler.Crash("InternalDescriptorUnit<Direction::Output>::"
  85                   "GetNextInputBytes() called");
  86     return 0;
  87   } else {
  88     const char *record{CurrentRecord()};
  89     if (!record) {
  90       handler.SignalEnd();
  91       return 0;
  92     } else if (positionInRecord >= recordLength.value_or(positionInRecord)) {
  93       return 0;
  94     } else {
  95       p = &record[positionInRecord];
  96       return *recordLength - positionInRecord;
  97     }
  98   }
  99 }
 100
 101 template <Direction DIR>
 102 RT_API_ATTRS bool InternalDescriptorUnit<DIR>::AdvanceRecord(
 103     IoErrorHandler &handler) {
 104   if (currentRecordNumber >= endfileRecordNumber.value_or(0)) {
 105     if constexpr (DIR == Direction::Input) {
 106       handler.SignalEnd();
 107     } else {
 108       handler.SignalError(IostatInternalWriteOverrun);
 109     }
 110     return false;
 111   }
 112   if constexpr (DIR == Direction::Output) {
 113     BlankFillOutputRecord();
 114   }
 115   ++currentRecordNumber;
 116   BeginRecord();
 117   return true;
 118 }
 119
 120 template <Direction DIR>
 121 RT_API_ATTRS void InternalDescriptorUnit<DIR>::BlankFill(
 122     char *at, std::size_t bytes) {
 123   switch (internalIoCharKind) {
 124   case 2:
 125     Fortran::runtime::fill_n(reinterpret_cast<char16_t *>(at), bytes / 2,
 126         static_cast<char16_t>(' '));
 127     break;
 128   case 4:
 129     Fortran::runtime::fill_n(reinterpret_cast<char32_t *>(at), bytes / 4,
 130         static_cast<char32_t>(' '));
 131     break;
 132   default:
 133     Fortran::runtime::fill_n(at, bytes, ' ');
 134     break;
 135   }
 136 }
 137
 138 template <Direction DIR>
 139 RT_API_ATTRS void InternalDescriptorUnit<DIR>::BlankFillOutputRecord() {
 140   if constexpr (DIR == Direction::Output) {
 141     if (furthestPositionInRecord <
 142         recordLength.value_or(furthestPositionInRecord)) {
 143       BlankFill(CurrentRecord() + furthestPositionInRecord,
 144           *recordLength - furthestPositionInRecord);
 145     }
 146   }
 147 }
 148
 149 template <Direction DIR>
 150 RT_API_ATTRS void InternalDescriptorUnit<DIR>::BackspaceRecord(
 151     IoErrorHandler &handler) {
 152   RUNTIME_CHECK(handler, currentRecordNumber > 1);
 153   --currentRecordNumber;
 154   BeginRecord();
 155 }
 156
 157 template <Direction DIR>
 158 RT_API_ATTRS std::int64_t InternalDescriptorUnit<DIR>::InquirePos() {
 159   return (currentRecordNumber - 1) * recordLength.value_or(0) +
 160       positionInRecord + 1;
 161 }
 162
 163 template class InternalDescriptorUnit<Direction::Output>;
 164 template class InternalDescriptorUnit<Direction::Input>;
 165
 166 RT_OFFLOAD_API_GROUP_END
 167 } // namespace Fortran::runtime::io