1 //===-- runtime/stop.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 "flang/Runtime/stop.h" 10 #include "environment.h" 11 #include "file.h" 12 #include "io-error.h" 13 #include "terminator.h" 14 #include "unit.h" 15 #include <cfenv> 16 #include <cstdio> 17 #include <cstdlib> 18 19 extern "C" { 20 21 static void DescribeIEEESignaledExceptions() { 22 #ifdef fetestexcept // a macro in some environments; omit std:: 23 auto excepts{fetestexcept(FE_ALL_EXCEPT)}; 24 #else 25 auto excepts{std::fetestexcept(FE_ALL_EXCEPT)}; 26 #endif 27 if (excepts) { 28 std::fputs("IEEE arithmetic exceptions signaled:", stderr); 29 if (excepts & FE_DIVBYZERO) { 30 std::fputs(" DIVBYZERO", stderr); 31 } 32 if (excepts & FE_INEXACT) { 33 std::fputs(" INEXACT", stderr); 34 } 35 if (excepts & FE_INVALID) { 36 std::fputs(" INVALID", stderr); 37 } 38 if (excepts & FE_OVERFLOW) { 39 std::fputs(" OVERFLOW", stderr); 40 } 41 if (excepts & FE_UNDERFLOW) { 42 std::fputs(" UNDERFLOW", stderr); 43 } 44 std::fputc('\n', stderr); 45 } 46 } 47 48 static void CloseAllExternalUnits(const char *why) { 49 Fortran::runtime::io::IoErrorHandler handler{why}; 50 Fortran::runtime::io::ExternalFileUnit::CloseAll(handler); 51 } 52 53 [[noreturn]] void RTNAME(StopStatement)( 54 int code, bool isErrorStop, bool quiet) { 55 CloseAllExternalUnits("STOP statement"); 56 if (Fortran::runtime::executionEnvironment.noStopMessage && code == 0) { 57 quiet = true; 58 } 59 if (!quiet) { 60 std::fprintf(stderr, "Fortran %s", isErrorStop ? "ERROR STOP" : "STOP"); 61 if (code != EXIT_SUCCESS) { 62 std::fprintf(stderr, ": code %d\n", code); 63 } 64 std::fputc('\n', stderr); 65 DescribeIEEESignaledExceptions(); 66 } 67 std::exit(code); 68 } 69 70 [[noreturn]] void RTNAME(StopStatementText)( 71 const char *code, std::size_t length, bool isErrorStop, bool quiet) { 72 CloseAllExternalUnits("STOP statement"); 73 if (!quiet) { 74 if (Fortran::runtime::executionEnvironment.noStopMessage && !isErrorStop) { 75 std::fprintf(stderr, "%.*s\n", static_cast<int>(length), code); 76 } else { 77 std::fprintf(stderr, "Fortran %s: %.*s\n", 78 isErrorStop ? "ERROR STOP" : "STOP", static_cast<int>(length), code); 79 } 80 DescribeIEEESignaledExceptions(); 81 } 82 if (isErrorStop) { 83 std::exit(EXIT_FAILURE); 84 } else { 85 std::exit(EXIT_SUCCESS); 86 } 87 } 88 89 static bool StartPause() { 90 if (Fortran::runtime::io::IsATerminal(0)) { 91 Fortran::runtime::io::IoErrorHandler handler{"PAUSE statement"}; 92 Fortran::runtime::io::ExternalFileUnit::FlushAll(handler); 93 return true; 94 } 95 return false; 96 } 97 98 static void EndPause() { 99 std::fflush(nullptr); 100 if (std::fgetc(stdin) == EOF) { 101 CloseAllExternalUnits("PAUSE statement"); 102 std::exit(EXIT_SUCCESS); 103 } 104 } 105 106 void RTNAME(PauseStatement)() { 107 if (StartPause()) { 108 std::fputs("Fortran PAUSE: hit RETURN to continue:", stderr); 109 EndPause(); 110 } 111 } 112 113 void RTNAME(PauseStatementInt)(int code) { 114 if (StartPause()) { 115 std::fprintf(stderr, "Fortran PAUSE %d: hit RETURN to continue:", code); 116 EndPause(); 117 } 118 } 119 120 void RTNAME(PauseStatementText)(const char *code, std::size_t length) { 121 if (StartPause()) { 122 std::fprintf(stderr, 123 "Fortran PAUSE %.*s: hit RETURN to continue:", static_cast<int>(length), 124 code); 125 EndPause(); 126 } 127 } 128 129 [[noreturn]] void RTNAME(FailImageStatement)() { 130 Fortran::runtime::NotifyOtherImagesOfFailImageStatement(); 131 CloseAllExternalUnits("FAIL IMAGE statement"); 132 std::exit(EXIT_FAILURE); 133 } 134 135 [[noreturn]] void RTNAME(ProgramEndStatement)() { 136 CloseAllExternalUnits("END statement"); 137 std::exit(EXIT_SUCCESS); 138 } 139 140 [[noreturn]] void RTNAME(Exit)(int status) { 141 CloseAllExternalUnits("CALL EXIT()"); 142 std::exit(status); 143 } 144 145 [[noreturn]] void RTNAME(Abort)() { std::abort(); } 146 } 147