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