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-exception
6//
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_BACKTRACE
21#include BACKTRACE_HEADER
22#endif
23
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#else
30 auto excepts{std::fetestexcept(FE_ALL_EXCEPT)};
31#endif
32 if (excepts) {
33 std::fputs(s: "IEEE arithmetic exceptions signaled:", stderr);
34#ifdef FE_DIVBYZERO
35 if (excepts & FE_DIVBYZERO) {
36 std::fputs(s: " DIVBYZERO", stderr);
37 }
38#endif
39#ifdef FE_INEXACT
40 if (excepts & FE_INEXACT) {
41 std::fputs(s: " INEXACT", stderr);
42 }
43#endif
44#ifdef FE_INVALID
45 if (excepts & FE_INVALID) {
46 std::fputs(s: " INVALID", stderr);
47 }
48#endif
49#ifdef FE_OVERFLOW
50 if (excepts & FE_OVERFLOW) {
51 std::fputs(s: " OVERFLOW", stderr);
52 }
53#endif
54#ifdef FE_UNDERFLOW
55 if (excepts & FE_UNDERFLOW) {
56 std::fputs(s: " UNDERFLOW", stderr);
57 }
58#endif
59 std::fputc(c: '\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#else
87 CloseAllExternalUnits(why: "STOP statement");
88 if (Fortran::runtime::executionEnvironment.noStopMessage && code == 0) {
89 quiet = true;
90 }
91 if (!quiet) {
92 std::fprintf(stderr, format: "Fortran %s", isErrorStop ? "ERROR STOP" : "STOP");
93 if (code != EXIT_SUCCESS) {
94 std::fprintf(stderr, format: ": code %d\n", code);
95 }
96 std::fputc(c: '\n', stderr);
97 DescribeIEEESignaledExceptions();
98 }
99 std::exit(status: code);
100#endif
101}
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#else
116 CloseAllExternalUnits(why: "STOP statement");
117 if (!quiet) {
118 if (Fortran::runtime::executionEnvironment.noStopMessage && !isErrorStop) {
119 std::fprintf(stderr, format: "%.*s\n", static_cast<int>(length), code);
120 } else {
121 std::fprintf(stderr, format: "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#endif
132}
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(stream: nullptr);
145 if (std::fgetc(stdin) == EOF) {
146 CloseAllExternalUnits(why: "PAUSE statement");
147 std::exit(EXIT_SUCCESS);
148 }
149}
150
151void RTNAME(PauseStatement)() {
152 if (StartPause()) {
153 std::fputs(s: "Fortran PAUSE: hit RETURN to continue:", stderr);
154 EndPause();
155 }
156}
157
158void RTNAME(PauseStatementInt)(int code) {
159 if (StartPause()) {
160 std::fprintf(stderr, format: "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 format: "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(why: "FAIL IMAGE statement");
177 std::exit(EXIT_FAILURE);
178}
179
180[[noreturn]] void RTNAME(ProgramEndStatement)() {
181 CloseAllExternalUnits(why: "END statement");
182 std::exit(EXIT_SUCCESS);
183}
184
185[[noreturn]] void RTNAME(Exit)(int status) {
186 CloseAllExternalUnits(why: "CALL EXIT()");
187 std::exit(status: status);
188}
189
190static RT_NOINLINE_ATTR void PrintBacktrace() {
191#ifdef HAVE_BACKTRACE
192 // TODO: Need to parse DWARF information to print function line numbers
193 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 backtrace
200 // 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#else
209
210 // TODO: Need to implement the version for other platforms.
211 Fortran::runtime::Terminator{}.PrintCrashArgs("backtrace is not supported.");
212
213#endif
214}
215
216[[noreturn]] RT_OPTNONE_ATTR void RTNAME(Abort)() {
217#ifdef HAVE_BACKTRACE
218 PrintBacktrace();
219#endif
220 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

source code of flang-rt/lib/runtime/stop.cpp