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
19extern "C" {
20
21static 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(s: "IEEE arithmetic exceptions signaled:", stderr);
29 if (excepts & FE_DIVBYZERO) {
30 std::fputs(s: " DIVBYZERO", stderr);
31 }
32 if (excepts & FE_INEXACT) {
33 std::fputs(s: " INEXACT", stderr);
34 }
35 if (excepts & FE_INVALID) {
36 std::fputs(s: " INVALID", stderr);
37 }
38 if (excepts & FE_OVERFLOW) {
39 std::fputs(s: " OVERFLOW", stderr);
40 }
41 if (excepts & FE_UNDERFLOW) {
42 std::fputs(s: " UNDERFLOW", stderr);
43 }
44 std::fputc(c: '\n', stderr);
45 }
46}
47
48static 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(why: "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(c: '\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(why: "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
89static 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
98static void EndPause() {
99 std::fflush(stream: nullptr);
100 if (std::fgetc(stdin) == EOF) {
101 CloseAllExternalUnits(why: "PAUSE statement");
102 std::exit(EXIT_SUCCESS);
103 }
104}
105
106void RTNAME(PauseStatement)() {
107 if (StartPause()) {
108 std::fputs(s: "Fortran PAUSE: hit RETURN to continue:", stderr);
109 EndPause();
110 }
111}
112
113void RTNAME(PauseStatementInt)(int code) {
114 if (StartPause()) {
115 std::fprintf(stderr, "Fortran PAUSE %d: hit RETURN to continue:", code);
116 EndPause();
117 }
118}
119
120void 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(why: "FAIL IMAGE statement");
132 std::exit(EXIT_FAILURE);
133}
134
135[[noreturn]] void RTNAME(ProgramEndStatement)() {
136 CloseAllExternalUnits(why: "END statement");
137 std::exit(EXIT_SUCCESS);
138}
139
140[[noreturn]] void RTNAME(Exit)(int status) {
141 CloseAllExternalUnits(why: "CALL EXIT()");
142 std::exit(status);
143}
144
145[[noreturn]] void RTNAME(Abort)() {
146 // TODO: Add backtrace call, unless with `-fno-backtrace`.
147 std::abort();
148}
149
150[[noreturn]] void RTNAME(ReportFatalUserError)(
151 const char *message, const char *source, int line) {
152 Fortran::runtime::Terminator{source, line}.Crash(message);
153}
154}
155

source code of flang/runtime/stop.cpp