6f8cea3f90
This PR proposes to add `Stop` and `ErrorStop` PRIF call procedures to the MIF dialect. If the `-fcoarray` flag is passed, then all calls to `STOP` and `ERROR STOP` will use those of PRIF in flang-rt. Thes procedure has been registered during the initialization (mif::InitOp). --------- Co-authored-by: Dan Bonachea <dobonachea@lbl.gov>
141 lines
3.6 KiB
C++
141 lines
3.6 KiB
C++
//===-- lib/runtime/terminator.cpp ------------------------------*- 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 "flang-rt/runtime/terminator.h"
|
|
#include <cstdio>
|
|
#include <cstdlib>
|
|
|
|
namespace Fortran::runtime {
|
|
|
|
#if !defined(RT_DEVICE_COMPILATION)
|
|
[[maybe_unused]] static void (*crashHandler)(
|
|
const char *, int, const char *, va_list &){nullptr};
|
|
|
|
void Terminator::RegisterCrashHandler(
|
|
void (*handler)(const char *, int, const char *, va_list &)) {
|
|
crashHandler = handler;
|
|
}
|
|
|
|
void Terminator::InvokeCrashHandler(const char *message, ...) const {
|
|
if (crashHandler) {
|
|
va_list ap;
|
|
va_start(ap, message);
|
|
crashHandler(sourceFileName_, sourceLine_, message, ap);
|
|
va_end(ap);
|
|
}
|
|
}
|
|
|
|
[[noreturn]] void Terminator::CrashArgs(
|
|
const char *message, va_list &ap) const {
|
|
CrashHeader();
|
|
std::vfprintf(stderr, message, ap);
|
|
va_end(ap);
|
|
CrashFooter();
|
|
}
|
|
#endif
|
|
|
|
RT_OFFLOAD_API_GROUP_BEGIN
|
|
|
|
RT_API_ATTRS void Terminator::CrashHeader() const {
|
|
#if defined(RT_DEVICE_COMPILATION)
|
|
std::printf("\nfatal Fortran runtime error");
|
|
if (sourceFileName_) {
|
|
std::printf("(%s", sourceFileName_);
|
|
if (sourceLine_) {
|
|
std::printf(":%d", sourceLine_);
|
|
}
|
|
std::printf(")");
|
|
}
|
|
std::printf(": ");
|
|
#else
|
|
std::fputs("\nfatal Fortran runtime error", stderr);
|
|
if (sourceFileName_) {
|
|
std::fprintf(stderr, "(%s", sourceFileName_);
|
|
if (sourceLine_) {
|
|
std::fprintf(stderr, ":%d", sourceLine_);
|
|
}
|
|
fputc(')', stderr);
|
|
}
|
|
std::fputs(": ", stderr);
|
|
#endif
|
|
}
|
|
|
|
[[noreturn]] RT_API_ATTRS void Terminator::CrashFooter() const {
|
|
#if defined(RT_DEVICE_COMPILATION)
|
|
std::printf("\n");
|
|
#else
|
|
fputc('\n', stderr);
|
|
// FIXME: re-enable the flush along with the IO enabling.
|
|
io::FlushOutputOnCrash(*this);
|
|
#endif
|
|
NotifyOtherImagesOfErrorTermination(EXIT_FAILURE);
|
|
#if defined(RT_DEVICE_COMPILATION)
|
|
DeviceTrap();
|
|
#else
|
|
std::abort();
|
|
#endif
|
|
}
|
|
|
|
[[noreturn]] RT_API_ATTRS void Terminator::CheckFailed(
|
|
const char *predicate, const char *file, int line) const {
|
|
Crash("Internal error: RUNTIME_CHECK(%s) failed at %s(%d)", predicate, file,
|
|
line);
|
|
}
|
|
|
|
[[noreturn]] RT_API_ATTRS void Terminator::CheckFailed(
|
|
const char *predicate) const {
|
|
Crash("Internal error: RUNTIME_CHECK(%s) failed at %s(%d)", predicate,
|
|
sourceFileName_, sourceLine_);
|
|
}
|
|
|
|
static RT_VAR_ATTRS void (*normalEndCallback)(int) = nullptr;
|
|
static RT_VAR_ATTRS void (*failImageCallback)(void) = nullptr;
|
|
static RT_VAR_ATTRS void (*errorCallback)(int) = nullptr;
|
|
|
|
void SetNormalEndCallback(void (*callback)(int)) {
|
|
normalEndCallback = callback;
|
|
}
|
|
|
|
void SetFailImageCallback(void (*callback)(void)) {
|
|
failImageCallback = callback;
|
|
}
|
|
|
|
void SetErrorCallback(void (*callback)(int)) { errorCallback = callback; }
|
|
|
|
[[noreturn]]
|
|
void NormalExit(int exitCode) {
|
|
SynchronizeImagesOfNormalEnd(exitCode); // might never return
|
|
|
|
std::exit(exitCode);
|
|
}
|
|
|
|
[[noreturn]]
|
|
void ErrorExit(int exitCode) {
|
|
NotifyOtherImagesOfErrorTermination(exitCode); // might never return
|
|
|
|
std::exit(exitCode);
|
|
}
|
|
|
|
RT_API_ATTRS void SynchronizeImagesOfNormalEnd(int code) {
|
|
if (normalEndCallback)
|
|
(*normalEndCallback)(code);
|
|
}
|
|
|
|
RT_API_ATTRS void NotifyOtherImagesOfFailImageStatement() {
|
|
if (failImageCallback)
|
|
(*failImageCallback)();
|
|
}
|
|
|
|
RT_API_ATTRS void NotifyOtherImagesOfErrorTermination(int code) {
|
|
if (errorCallback)
|
|
(*errorCallback)(code);
|
|
}
|
|
RT_OFFLOAD_API_GROUP_END
|
|
|
|
} // namespace Fortran::runtime
|