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
DescribeIEEESignaledExceptions()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
CloseAllExternalUnits(const char * why)48 static void CloseAllExternalUnits(const char *why) {
49 Fortran::runtime::io::IoErrorHandler handler{why};
50 Fortran::runtime::io::ExternalFileUnit::CloseAll(handler);
51 }
52
RTNAME(StopStatement)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
RTNAME(StopStatementText)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
StartPause()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
EndPause()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
RTNAME(PauseStatement)106 void RTNAME(PauseStatement)() {
107 if (StartPause()) {
108 std::fputs("Fortran PAUSE: hit RETURN to continue:", stderr);
109 EndPause();
110 }
111 }
112
RTNAME(PauseStatementInt)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
RTNAME(PauseStatementText)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
RTNAME(FailImageStatement)129 [[noreturn]] void RTNAME(FailImageStatement)() {
130 Fortran::runtime::NotifyOtherImagesOfFailImageStatement();
131 CloseAllExternalUnits("FAIL IMAGE statement");
132 std::exit(EXIT_FAILURE);
133 }
134
RTNAME(ProgramEndStatement)135 [[noreturn]] void RTNAME(ProgramEndStatement)() {
136 CloseAllExternalUnits("END statement");
137 std::exit(EXIT_SUCCESS);
138 }
139
RTNAME(Exit)140 [[noreturn]] void RTNAME(Exit)(int status) {
141 CloseAllExternalUnits("CALL EXIT()");
142 std::exit(status);
143 }
144
RTNAME(Abort)145 [[noreturn]] void RTNAME(Abort)() { std::abort(); }
146
RTNAME(ReportFatalUserError)147 [[noreturn]] void RTNAME(ReportFatalUserError)(
148 const char *message, const char *source, int line) {
149 Fortran::runtime::Terminator{source, line}.Crash(message);
150 }
151 }
152