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     std::fprintf(stderr, "Fortran %s: %.*s\n",
75         isErrorStop ? "ERROR STOP" : "STOP", static_cast<int>(length), code);
76     DescribeIEEESignaledExceptions();
77   }
78   std::exit(EXIT_FAILURE);
79 }
80 
81 static bool StartPause() {
82   if (Fortran::runtime::io::IsATerminal(0)) {
83     Fortran::runtime::io::IoErrorHandler handler{"PAUSE statement"};
84     Fortran::runtime::io::ExternalFileUnit::FlushAll(handler);
85     return true;
86   }
87   return false;
88 }
89 
90 static void EndPause() {
91   std::fflush(nullptr);
92   if (std::fgetc(stdin) == EOF) {
93     CloseAllExternalUnits("PAUSE statement");
94     std::exit(EXIT_SUCCESS);
95   }
96 }
97 
98 void RTNAME(PauseStatement)() {
99   if (StartPause()) {
100     std::fputs("Fortran PAUSE: hit RETURN to continue:", stderr);
101     EndPause();
102   }
103 }
104 
105 void RTNAME(PauseStatementInt)(int code) {
106   if (StartPause()) {
107     std::fprintf(stderr, "Fortran PAUSE %d: hit RETURN to continue:", code);
108     EndPause();
109   }
110 }
111 
112 void RTNAME(PauseStatementText)(const char *code, std::size_t length) {
113   if (StartPause()) {
114     std::fprintf(stderr,
115         "Fortran PAUSE %.*s: hit RETURN to continue:", static_cast<int>(length),
116         code);
117     EndPause();
118   }
119 }
120 
121 [[noreturn]] void RTNAME(FailImageStatement)() {
122   Fortran::runtime::NotifyOtherImagesOfFailImageStatement();
123   CloseAllExternalUnits("FAIL IMAGE statement");
124   std::exit(EXIT_FAILURE);
125 }
126 
127 [[noreturn]] void RTNAME(ProgramEndStatement)() {
128   CloseAllExternalUnits("END statement");
129   std::exit(EXIT_SUCCESS);
130 }
131 
132 [[noreturn]] void RTNAME(Exit)(int status) {
133   CloseAllExternalUnits("CALL EXIT()");
134   std::exit(status);
135 }
136 
137 [[noreturn]] void RTNAME(Abort)() { std::abort(); }
138 }
139