1 //===-- 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 "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   }
44 }
45 
46 static void CloseAllExternalUnits(const char *why) {
47   Fortran::runtime::io::IoErrorHandler handler{why};
48   Fortran::runtime::io::ExternalFileUnit::CloseAll(handler);
49 }
50 
51 [[noreturn]] void RTNAME(StopStatement)(
52     int code, bool isErrorStop, bool quiet) {
53   CloseAllExternalUnits("STOP statement");
54   if (!quiet) {
55     if (code != EXIT_SUCCESS) {
56       std::fprintf(stderr, "Fortran %s: code %d\n",
57           isErrorStop ? "ERROR STOP" : "STOP", code);
58     }
59     DescribeIEEESignaledExceptions();
60   }
61   std::exit(code);
62 }
63 
64 [[noreturn]] void RTNAME(StopStatementText)(
65     const char *code, bool isErrorStop, bool quiet) {
66   CloseAllExternalUnits("STOP statement");
67   if (!quiet) {
68     std::fprintf(
69         stderr, "Fortran %s: %s\n", isErrorStop ? "ERROR STOP" : "STOP", code);
70     DescribeIEEESignaledExceptions();
71   }
72   std::exit(EXIT_FAILURE);
73 }
74 
75 void RTNAME(PauseStatement)() {
76   if (Fortran::runtime::io::IsATerminal(0)) {
77     Fortran::runtime::io::IoErrorHandler handler{"PAUSE statement"};
78     Fortran::runtime::io::ExternalFileUnit::FlushAll(handler);
79     std::fputs("Fortran PAUSE: hit RETURN to continue:", stderr);
80     std::fflush(nullptr);
81     if (std::fgetc(stdin) == EOF) {
82       CloseAllExternalUnits("PAUSE statement");
83       std::exit(EXIT_SUCCESS);
84     }
85   }
86 }
87 
88 [[noreturn]] void RTNAME(FailImageStatement)() {
89   Fortran::runtime::NotifyOtherImagesOfFailImageStatement();
90   CloseAllExternalUnits("FAIL IMAGE statement");
91   std::exit(EXIT_FAILURE);
92 }
93 
94 [[noreturn]] void RTNAME(ProgramEndStatement)() {
95   CloseAllExternalUnits("END statement");
96   std::exit(EXIT_SUCCESS);
97 }
98 }
99