230 lines · cpp
1//===-- lib/runtime/stop.cpp ------------------------------------*- 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-exception6//7//===----------------------------------------------------------------------===//8 9#include "flang/Runtime/stop.h"10#include "config.h"11#include "unit.h"12#include "flang-rt/runtime/environment.h"13#include "flang-rt/runtime/file.h"14#include "flang-rt/runtime/io-error.h"15#include "flang-rt/runtime/terminator.h"16#include <cfenv>17#include <cstdio>18#include <cstdlib>19 20#ifdef HAVE_BACKTRACE21#include BACKTRACE_HEADER22#endif23 24extern "C" {25 26[[maybe_unused]] static void DescribeIEEESignaledExceptions() {27#ifdef fetestexcept // a macro in some environments; omit std::28 auto excepts{fetestexcept(FE_ALL_EXCEPT)};29#else30 auto excepts{std::fetestexcept(FE_ALL_EXCEPT)};31#endif32 if (excepts) {33 std::fputs("IEEE arithmetic exceptions signaled:", stderr);34#ifdef FE_DIVBYZERO35 if (excepts & FE_DIVBYZERO) {36 std::fputs(" DIVBYZERO", stderr);37 }38#endif39#ifdef FE_INEXACT40 if (excepts & FE_INEXACT) {41 std::fputs(" INEXACT", stderr);42 }43#endif44#ifdef FE_INVALID45 if (excepts & FE_INVALID) {46 std::fputs(" INVALID", stderr);47 }48#endif49#ifdef FE_OVERFLOW50 if (excepts & FE_OVERFLOW) {51 std::fputs(" OVERFLOW", stderr);52 }53#endif54#ifdef FE_UNDERFLOW55 if (excepts & FE_UNDERFLOW) {56 std::fputs(" UNDERFLOW", stderr);57 }58#endif59 std::fputc('\n', stderr);60 }61}62 63static void CloseAllExternalUnits(const char *why) {64 Fortran::runtime::io::IoErrorHandler handler{why};65 Fortran::runtime::io::ExternalFileUnit::CloseAll(handler);66}67 68[[noreturn]] RT_API_ATTRS void RTNAME(StopStatement)(69 int code, bool isErrorStop, bool quiet) {70#if defined(RT_DEVICE_COMPILATION)71 if (Fortran::runtime::executionEnvironment.noStopMessage && code == 0) {72 quiet = true;73 }74 if (!quiet) {75 if (isErrorStop) {76 std::printf("Fortran ERROR STOP");77 } else {78 std::printf("Fortran STOP");79 }80 if (code != EXIT_SUCCESS) {81 std::printf(": code %d\n", code);82 }83 std::printf("\n");84 }85 Fortran::runtime::DeviceTrap();86#else87 CloseAllExternalUnits("STOP statement");88 if (Fortran::runtime::executionEnvironment.noStopMessage && code == 0) {89 quiet = true;90 }91 if (!quiet) {92 std::fprintf(stderr, "Fortran %s", isErrorStop ? "ERROR STOP" : "STOP");93 if (code != EXIT_SUCCESS) {94 std::fprintf(stderr, ": code %d\n", code);95 }96 std::fputc('\n', stderr);97 DescribeIEEESignaledExceptions();98 }99 std::exit(code);100#endif101}102 103[[noreturn]] RT_API_ATTRS void RTNAME(StopStatementText)(104 const char *code, std::size_t length, bool isErrorStop, bool quiet) {105#if defined(RT_DEVICE_COMPILATION)106 if (!quiet) {107 if (Fortran::runtime::executionEnvironment.noStopMessage && !isErrorStop) {108 std::printf("%s\n", code);109 } else {110 std::printf(111 "Fortran %s: %s\n", isErrorStop ? "ERROR STOP" : "STOP", code);112 }113 }114 Fortran::runtime::DeviceTrap();115#else116 CloseAllExternalUnits("STOP statement");117 if (!quiet) {118 if (Fortran::runtime::executionEnvironment.noStopMessage && !isErrorStop) {119 std::fprintf(stderr, "%.*s\n", static_cast<int>(length), code);120 } else {121 std::fprintf(stderr, "Fortran %s: %.*s\n",122 isErrorStop ? "ERROR STOP" : "STOP", static_cast<int>(length), code);123 }124 DescribeIEEESignaledExceptions();125 }126 if (isErrorStop) {127 std::exit(EXIT_FAILURE);128 } else {129 std::exit(EXIT_SUCCESS);130 }131#endif132}133 134static bool StartPause() {135 if (Fortran::runtime::io::IsATerminal(0)) {136 Fortran::runtime::io::IoErrorHandler handler{"PAUSE statement"};137 Fortran::runtime::io::ExternalFileUnit::FlushAll(handler);138 return true;139 }140 return false;141}142 143static void EndPause() {144 std::fflush(nullptr);145 if (std::fgetc(stdin) == EOF) {146 CloseAllExternalUnits("PAUSE statement");147 std::exit(EXIT_SUCCESS);148 }149}150 151void RTNAME(PauseStatement)() {152 if (StartPause()) {153 std::fputs("Fortran PAUSE: hit RETURN to continue:", stderr);154 EndPause();155 }156}157 158void RTNAME(PauseStatementInt)(int code) {159 if (StartPause()) {160 std::fprintf(stderr, "Fortran PAUSE %d: hit RETURN to continue:", code);161 EndPause();162 }163}164 165void RTNAME(PauseStatementText)(const char *code, std::size_t length) {166 if (StartPause()) {167 std::fprintf(stderr,168 "Fortran PAUSE %.*s: hit RETURN to continue:", static_cast<int>(length),169 code);170 EndPause();171 }172}173 174[[noreturn]] void RTNAME(FailImageStatement)() {175 Fortran::runtime::NotifyOtherImagesOfFailImageStatement();176 CloseAllExternalUnits("FAIL IMAGE statement");177 std::exit(EXIT_FAILURE);178}179 180[[noreturn]] void RTNAME(ProgramEndStatement)() {181 CloseAllExternalUnits("END statement");182 std::exit(EXIT_SUCCESS);183}184 185[[noreturn]] void RTNAME(Exit)(int status) {186 CloseAllExternalUnits("CALL EXIT()");187 std::exit(status);188}189 190static RT_NOINLINE_ATTR void PrintBacktrace() {191#ifdef HAVE_BACKTRACE192 // TODO: Need to parse DWARF information to print function line numbers193 constexpr int MAX_CALL_STACK{999};194 void *buffer[MAX_CALL_STACK];195 int nptrs{(int)backtrace(buffer, MAX_CALL_STACK)};196 197 if (char **symbols{backtrace_symbols(buffer, nptrs)}) {198 // Skip the PrintBacktrace() frame, as it is just a utility.199 // It makes sense to start printing the backtrace200 // from Abort() or backtrace().201 for (int i = 1; i < nptrs; i++) {202 Fortran::runtime::Terminator{}.PrintCrashArgs(203 "#%d %s\n", i - 1, symbols[i]);204 }205 free(symbols);206 }207 208#else209 210 // TODO: Need to implement the version for other platforms.211 Fortran::runtime::Terminator{}.PrintCrashArgs("backtrace is not supported.");212 213#endif214}215 216[[noreturn]] RT_OPTNONE_ATTR void RTNAME(Abort)() {217#ifdef HAVE_BACKTRACE218 PrintBacktrace();219#endif220 std::abort();221}222 223RT_OPTNONE_ATTR void FORTRAN_PROCEDURE_NAME(backtrace)() { PrintBacktrace(); }224 225[[noreturn]] RT_API_ATTRS void RTNAME(ReportFatalUserError)(226 const char *message, const char *source, int line) {227 Fortran::runtime::Terminator{source, line}.Crash(message);228}229}230