ISO_Fortran_binding.cc
derived-type.cc
descriptor.cc
+ file.cc
format.cc
io-api.cc
io-error.cc
memory.cc
stop.cc
terminator.cc
+ tools.cc
transformational.cc
type-code.cc
)
--- /dev/null
+//===-- runtime/file.cc -----------------------------------------*- 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 "file.h"
+#include "magic-numbers.h"
+#include "memory.h"
+#include "tools.h"
+#include <cerrno>
+#include <cstring>
+#include <fcntl.h>
+#include <stdlib.h>
+#include <unistd.h>
+
+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);
+ int flags{0};
+ static const char *actions[]{"READ", "WRITE", "READWRITE", nullptr};
+ switch (IdentifyValue(action, actionLength, actions)) {
+ case 0: flags = O_RDONLY; break;
+ case 1: flags = O_WRONLY; break;
+ case 2: 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?
+ return;
+ }
+ break;
+ case 1: // STATUS='NEW'
+ flags |= O_CREAT | O_EXCL;
+ break;
+ case 2: // STATUS='SCRATCH'
+ if (path_.get()) {
+ handler.Crash("FILE= must not appear with STATUS='SCRATCH'");
+ path_.reset();
+ }
+ {
+ char path[]{"/tmp/Fortran-Scratch-XXXXXX"};
+ fd_ = ::mkstemp(path);
+ if (fd_ < 0) {
+ handler.SignalErrno();
+ }
+ ::unlink(path);
+ }
+ return;
+ case 3: // STATUS='REPLACE'
+ flags |= O_CREAT | O_TRUNC;
+ break;
+ case 4: // STATUS='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) {
+ handler.SignalErrno();
+ }
+ }
+ path_ = SaveDefaultCharacter(path, pathLength, handler);
+ if (!path_.get()) {
+ handler.Crash(
+ "FILE= is required unless STATUS='OLD' and unit is connected");
+ }
+ fd_ = ::open(path_.get(), flags, 0600);
+ if (fd_ < 0) {
+ handler.SignalErrno();
+ }
+ pending_.reset();
+ knownSize_.reset();
+}
+
+void OpenFile::Close(
+ const char *status, std::size_t statusLength, 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:
+ 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) {
+ if (::close(fd_) != 0) {
+ handler.SignalErrno();
+ }
+ fd_ = -1;
+ }
+}
+
+std::size_t OpenFile::Read(Offset at, char *buffer, std::size_t minBytes,
+ std::size_t maxBytes, IoErrorHandler &handler) {
+ if (maxBytes == 0) {
+ return 0;
+ }
+ CriticalSection criticalSection{lock_};
+ CheckOpen(handler);
+ if (!Seek(at, handler)) {
+ return 0;
+ }
+ if (maxBytes < minBytes) {
+ minBytes = maxBytes;
+ }
+ std::size_t got{0};
+ while (got < minBytes) {
+ auto chunk{::read(fd_, buffer + got, maxBytes - got)};
+ if (chunk == 0) {
+ handler.SignalEnd();
+ break;
+ }
+ if (chunk < 0) {
+ auto err{errno};
+ if (err != EAGAIN && err != EWOULDBLOCK && err != EINTR) {
+ handler.SignalError(err);
+ break;
+ }
+ } else {
+ position_ += chunk;
+ got += chunk;
+ }
+ }
+ return got;
+}
+
+std::size_t OpenFile::Write(
+ Offset at, const char *buffer, std::size_t bytes, IoErrorHandler &handler) {
+ if (bytes == 0) {
+ return 0;
+ }
+ CriticalSection criticalSection{lock_};
+ CheckOpen(handler);
+ if (!Seek(at, handler)) {
+ return 0;
+ }
+ std::size_t put{0};
+ while (put < bytes) {
+ auto chunk{::write(fd_, buffer + put, bytes - put)};
+ if (chunk >= 0) {
+ position_ += chunk;
+ put += chunk;
+ } else {
+ auto err{errno};
+ if (err != EAGAIN && err != EWOULDBLOCK && err != EINTR) {
+ handler.SignalError(err);
+ break;
+ }
+ }
+ }
+ if (knownSize_ && position_ > *knownSize_) {
+ knownSize_ = position_;
+ }
+ return put;
+}
+
+void OpenFile::Truncate(Offset at, IoErrorHandler &handler) {
+ CriticalSection criticalSection{lock_};
+ CheckOpen(handler);
+ if (!knownSize_ || *knownSize_ != at) {
+ if (::ftruncate(fd_, at) != 0) {
+ handler.SignalErrno();
+ }
+ knownSize_ = at;
+ }
+}
+
+// The operation is performed immediately; the results are saved
+// to be claimed by a later WAIT statement.
+// TODO: True asynchronicity
+int OpenFile::ReadAsynchronously(
+ Offset at, char *buffer, std::size_t bytes, IoErrorHandler &handler) {
+ CriticalSection criticalSection{lock_};
+ CheckOpen(handler);
+ int iostat{0};
+ for (std::size_t got{0}; got < bytes;) {
+#if _XOPEN_SOURCE >= 500 || _POSIX_C_SOURCE >= 200809L
+ auto chunk{::pread(fd_, buffer + got, bytes - got, at)};
+#else
+ auto chunk{RawSeek(at) ? ::read(fd_, buffer + got, bytes - got) : -1};
+#endif
+ if (chunk == 0) {
+ iostat = FORTRAN_RUNTIME_IOSTAT_END;
+ break;
+ }
+ if (chunk < 0) {
+ auto err{errno};
+ if (err != EAGAIN && err != EWOULDBLOCK && err != EINTR) {
+ iostat = err;
+ break;
+ }
+ } else {
+ at += chunk;
+ got += chunk;
+ }
+ }
+ return PendingResult(handler, iostat);
+}
+
+// TODO: True asynchronicity
+int OpenFile::WriteAsynchronously(
+ Offset at, const char *buffer, std::size_t bytes, IoErrorHandler &handler) {
+ CriticalSection criticalSection{lock_};
+ CheckOpen(handler);
+ int iostat{0};
+ for (std::size_t put{0}; put < bytes;) {
+#if _XOPEN_SOURCE >= 500 || _POSIX_C_SOURCE >= 200809L
+ auto chunk{::pwrite(fd_, buffer + put, bytes - put, at)};
+#else
+ auto chunk{RawSeek(at) ? ::write(fd_, buffer + put, bytes - put) : -1};
+#endif
+ if (chunk >= 0) {
+ at += chunk;
+ put += chunk;
+ } else {
+ auto err{errno};
+ if (err != EAGAIN && err != EWOULDBLOCK && err != EINTR) {
+ iostat = err;
+ break;
+ }
+ }
+ }
+ return PendingResult(handler, iostat);
+}
+
+void OpenFile::Wait(int id, IoErrorHandler &handler) {
+ std::optional<int> ioStat;
+ {
+ CriticalSection criticalSection{lock_};
+ Pending *prev{nullptr};
+ for (Pending *p{pending_.get()}; p; p = (prev = p)->next.get()) {
+ if (p->id == id) {
+ ioStat = p->ioStat;
+ if (prev) {
+ prev->next.reset(p->next.release());
+ } else {
+ pending_.reset(p->next.release());
+ }
+ break;
+ }
+ }
+ }
+ if (ioStat) {
+ handler.SignalError(*ioStat);
+ }
+}
+
+void OpenFile::WaitAll(IoErrorHandler &handler) {
+ while (true) {
+ int ioStat;
+ {
+ CriticalSection criticalSection{lock_};
+ if (pending_) {
+ ioStat = pending_->ioStat;
+ pending_.reset(pending_->next.release());
+ } else {
+ return;
+ }
+ }
+ handler.SignalError(ioStat);
+ }
+}
+
+void OpenFile::CheckOpen(Terminator &terminator) {
+ RUNTIME_CHECK(terminator, fd_ >= 0);
+}
+
+bool OpenFile::Seek(Offset at, IoErrorHandler &handler) {
+ if (at == position_) {
+ return true;
+ } else if (RawSeek(at)) {
+ position_ = at;
+ return true;
+ } else {
+ handler.SignalErrno();
+ return false;
+ }
+}
+
+bool OpenFile::RawSeek(Offset at) {
+#ifdef _LARGEFILE64_SOURCE
+ return ::lseek64(fd_, at, SEEK_SET) == 0;
+#else
+ return ::lseek(fd_, at, SEEK_SET) == 0;
+#endif
+}
+
+int OpenFile::PendingResult(Terminator &terminator, int iostat) {
+ int id{nextId_++};
+ pending_.reset(&New<Pending>{}(terminator, id, iostat, std::move(pending_)));
+ return id;
+}
+}
--- /dev/null
+//===-- runtime/file.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
+//
+//===----------------------------------------------------------------------===//
+
+// Raw system I/O wrappers
+
+#ifndef FORTRAN_RUNTIME_FILE_H_
+#define FORTRAN_RUNTIME_FILE_H_
+
+#include "io-error.h"
+#include "lock.h"
+#include "memory.h"
+#include "terminator.h"
+#include <cinttypes>
+#include <optional>
+
+namespace Fortran::runtime::io {
+
+class OpenFile {
+public:
+ using Offset = std::uint64_t;
+
+ Offset 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 Close(const char *action, std::size_t actionLength, IoErrorHandler &);
+
+ // Reads data into memory; returns amount acquired. Synchronous.
+ // Partial reads (less than minBytes) signify end-of-file. If the
+ // buffer is larger than minBytes, and extra returned data will be
+ // preserved for future consumption, set maxBytes larger than minBytes
+ // to reduce system calls This routine handles EAGAIN/EWOULDBLOCK and EINTR.
+ std::size_t Read(Offset, char *, std::size_t minBytes, std::size_t maxBytes,
+ IoErrorHandler &);
+
+ // Writes data. Synchronous. Partial writes indicate program-handled
+ // error conditions.
+ std::size_t Write(Offset, const char *, std::size_t, IoErrorHandler &);
+
+ // Truncates the file
+ void Truncate(Offset, IoErrorHandler &);
+
+ // Asynchronous transfers
+ int ReadAsynchronously(Offset, char *, std::size_t, IoErrorHandler &);
+ int WriteAsynchronously(Offset, const char *, std::size_t, IoErrorHandler &);
+ void Wait(int id, IoErrorHandler &);
+ void WaitAll(IoErrorHandler &);
+
+private:
+ struct Pending {
+ int id;
+ int ioStat{0};
+ OwningPtr<Pending> next;
+ };
+
+ // lock_ must be held for these
+ void CheckOpen(Terminator &);
+ bool Seek(Offset, IoErrorHandler &);
+ bool RawSeek(Offset);
+ int PendingResult(Terminator &, int);
+
+ Lock lock_;
+ int fd_{-1};
+ OwningPtr<char> path_;
+ Offset position_{0};
+ std::optional<Offset> knownSize_;
+ int nextId_;
+ OwningPtr<Pending> pending_;
+};
+}
+#endif // FORTRAN_RUNTIME_FILE_H_
AsynchronousId IONAME(BeginAsynchronousInput)(ExternalUnit, std::int64_t REC,
char *, std::size_t, const char *sourceFile = nullptr, int sourceLine = 0);
Cookie IONAME(BeginWait)(ExternalUnit, AsynchronousId);
+Cookie IONAME(BeginWaitAll)(ExternalUnit);
// Other I/O statements
Cookie IONAME(BeginClose)(
void IoErrorHandler::Begin(const char *sourceFileName, int sourceLine) {
flags_ = 0;
ioStat_ = 0;
- hitEnd_ = false;
- hitEor_ = false;
SetLocation(sourceFileName, sourceLine);
}
void IoErrorHandler::SignalError(int iostatOrErrno) {
- if (iostatOrErrno != 0) {
+ if (iostatOrErrno == FORTRAN_RUNTIME_IOSTAT_END) {
+ SignalEnd();
+ } else if (iostatOrErrno == FORTRAN_RUNTIME_IOSTAT_EOR) {
+ SignalEor();
+ } else if (iostatOrErrno != 0) {
if (flags_ & hasIoStat) {
- if (!ioStat_) {
- ioStat_ = iostatOrErrno;
+ if (ioStat_ <= 0) {
+ ioStat_ = iostatOrErrno; // priority over END=/EOR=
}
} else if (iostatOrErrno == FORTRAN_RUNTIME_IOSTAT_INQUIRE_INTERNAL_UNIT) {
Crash("INQUIRE on internal unit");
}
}
+void IoErrorHandler::SignalErrno() { SignalError(errno); }
+
void IoErrorHandler::SignalEnd() {
if (flags_ & hasEnd) {
- hitEnd_ = true;
+ if (!ioStat_ || ioStat_ < FORTRAN_RUNTIME_IOSTAT_END) {
+ ioStat_ = FORTRAN_RUNTIME_IOSTAT_END;
+ }
} else {
Crash("End of file");
}
void IoErrorHandler::SignalEor() {
if (flags_ & hasEor) {
- hitEor_ = true;
+ if (!ioStat_ || ioStat_ < FORTRAN_RUNTIME_IOSTAT_EOR) {
+ ioStat_ = FORTRAN_RUNTIME_IOSTAT_EOR; // least priority
+ }
} else {
Crash("End of record");
}
}
-
-int IoErrorHandler::GetIoStat() const {
- if (ioStat_) {
- return ioStat_;
- } else if (hitEnd_) {
- return FORTRAN_RUNTIME_IOSTAT_END;
- } else if (hitEor_) {
- return FORTRAN_RUNTIME_IOSTAT_EOR;
- } else {
- return 0;
- }
-}
-
}
void HasEorLabel() { flags_ |= hasEor; }
void SignalError(int iostatOrErrno);
+ void SignalErrno();
void SignalEnd();
void SignalEor();
- int GetIoStat() const;
+ int GetIoStat() const { return ioStat_; }
private:
enum Flag : std::uint8_t {
hasEor = 8, // EOR=
};
std::uint8_t flags_{0};
- bool hitEnd_{false};
- bool hitEor_{false};
int ioStat_{0};
};
--- /dev/null
+//===-- runtime/lock.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
+//
+//===----------------------------------------------------------------------===//
+
+// Wraps pthread_mutex_t (or whatever)
+
+#ifndef FORTRAN_RUNTIME_LOCK_H_
+#define FORTRAN_RUNTIME_LOCK_H_
+
+#include <pthread.h>
+
+namespace Fortran::runtime {
+
+class Lock {
+public:
+ Lock() { pthread_mutex_init(&mutex_, nullptr); }
+ ~Lock() { pthread_mutex_destroy(&mutex_); }
+ void Take() { pthread_mutex_lock(&mutex_); }
+ bool Try() { return pthread_mutex_trylock(&mutex_) != 0; }
+ void Drop() { pthread_mutex_unlock(&mutex_); }
+
+ void CheckLocked(Terminator &terminator) {
+ if (Try()) {
+ Drop();
+ terminator.Crash("Lock::CheckLocked() failed");
+ }
+ }
+
+private:
+ pthread_mutex_t mutex_;
+};
+
+class CriticalSection {
+public:
+ explicit CriticalSection(Lock &lock) : lock_{lock} { lock_.Take(); }
+ ~CriticalSection() { lock_.Drop(); }
+
+private:
+ Lock &lock_;
+};
+}
+
+#endif // FORTRAN_RUNTIME_LOCK_H_
void FreeMemoryAndNullify(void *&);
template<typename A> struct New {
- template<typename... X> A &operator()(Terminator &terminator, X&&... x) {
- return *new (AllocateMemoryOrCrash(terminator, sizeof(A))) A{std::forward<X>(x)...};
+ template<typename... X> A &operator()(Terminator &terminator, X &&... x) {
+ return *new (AllocateMemoryOrCrash(terminator, sizeof(A)))
+ A{std::forward<X>(x)...};
}
};
-namespace {
-template<typename A> class OwningPtrDeleter {
+template<typename A> struct OwningPtrDeleter {
void operator()(A *p) { FreeMemory(p); }
};
-}
template<typename A> using OwningPtr = std::unique_ptr<A, OwningPtrDeleter<A>>;
}
--- /dev/null
+//===-- runtime/tools.cc ----------------------------------------*- 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 "tools.h"
+#include <cstring>
+
+namespace Fortran::runtime {
+
+OwningPtr<char> SaveDefaultCharacter(
+ const char *s, std::size_t length, Terminator &terminator) {
+ if (s) {
+ auto *p{static_cast<char *>(AllocateMemoryOrCrash(terminator, length + 1))};
+ std::memcpy(p, s, length);
+ p[length] = '\0';
+ return OwningPtr<char>{p};
+ } else {
+ return OwningPtr<char>{};
+ }
+}
+
+static bool CaseInsensitiveMatch(
+ const char *value, std::size_t length, const char *possibility) {
+ for (; length-- > 0; ++value, ++possibility) {
+ char ch{*value};
+ if (ch >= 'a' && ch <= 'z') {
+ ch += 'A' - 'a';
+ }
+ if (*possibility == '\0' || ch != *possibility) {
+ return false;
+ }
+ }
+ return *possibility == '\0';
+}
+
+int IdentifyValue(
+ const char *value, std::size_t length, const char *possibilities[]) {
+ if (value) {
+ for (int j{0}; possibilities[j]; ++j) {
+ if (CaseInsensitiveMatch(value, length, possibilities[j])) {
+ return j;
+ }
+ }
+ }
+ return -1;
+}
+}
--- /dev/null
+//===-- runtime/tools.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_RUNTIME_TOOLS_H_
+#define FORTRAN_RUNTIME_TOOLS_H_
+#include "memory.h"
+namespace Fortran::runtime {
+
+class Terminator;
+
+OwningPtr<char> SaveDefaultCharacter(const char *, std::size_t, Terminator &);
+
+// For validating and recognizing default CHARACTER values in a
+// case-insensitive manner. Returns the zero-based index into the
+// null-terminated array of upper-case possibilities when the value is valid,
+// or -1 when it has no match.
+int IdentifyValue(
+ const char *value, std::size_t length, const char *possibilities[]);
+}
+#endif // FORTRAN_RUNTIME_TOOLS_H_
projects / platform / upstream / llvm.git / commitdiff