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 "io-error.h"
11 #include "terminator.h"
12 #include "unit.h"
13 #include <cfenv>
14 #include <cstdio>
15 #include <cstdlib>
16 
17 extern "C" {
18 
19 static void DescribeIEEESignaledExceptions() {
20 #ifdef fetestexcept // a macro in some environments; omit std::
21   auto excepts{fetestexcept(FE_ALL_EXCEPT)};
22 #else
23   auto excepts{std::fetestexcept(FE_ALL_EXCEPT)};
24 #endif
25   if (excepts) {
26     std::fputs("IEEE arithmetic exceptions signaled:", stderr);
27     if (excepts & FE_DIVBYZERO) {
28       std::fputs(" DIVBYZERO", stderr);
29     }
30     if (excepts & FE_INEXACT) {
31       std::fputs(" INEXACT", stderr);
32     }
33     if (excepts & FE_INVALID) {
34       std::fputs(" INVALID", stderr);
35     }
36     if (excepts & FE_OVERFLOW) {
37       std::fputs(" OVERFLOW", stderr);
38     }
39     if (excepts & FE_UNDERFLOW) {
40       std::fputs(" UNDERFLOW", stderr);
41     }
42   }
43 }
44 
45 static void CloseAllExternalUnits(const char *why) {
46   Fortran::runtime::io::IoErrorHandler handler{why};
47   Fortran::runtime::io::ExternalFileUnit::CloseAll(handler);
48 }
49 
50 [[noreturn]] void RTNAME(StopStatement)(
51     int code, bool isErrorStop, bool quiet) {
52   CloseAllExternalUnits("STOP statement");
53   if (!quiet) {
54     if (code != EXIT_SUCCESS) {
55       std::fprintf(stderr, "Fortran %s: code %d\n",
56           isErrorStop ? "ERROR STOP" : "STOP", code);
57     }
58     DescribeIEEESignaledExceptions();
59   }
60   std::exit(code);
61 }
62 
63 [[noreturn]] void RTNAME(StopStatementText)(
64     const char *code, bool isErrorStop, bool quiet) {
65   CloseAllExternalUnits("STOP statement");
66   if (!quiet) {
67     std::fprintf(
68         stderr, "Fortran %s: %s\n", isErrorStop ? "ERROR STOP" : "STOP", code);
69     DescribeIEEESignaledExceptions();
70   }
71   std::exit(EXIT_FAILURE);
72 }
73 
74 [[noreturn]] void RTNAME(FailImageStatement)() {
75   Fortran::runtime::NotifyOtherImagesOfFailImageStatement();
76   CloseAllExternalUnits("FAIL IMAGE statement");
77   std::exit(EXIT_FAILURE);
78 }
79 
80 [[noreturn]] void RTNAME(ProgramEndStatement)() {
81   CloseAllExternalUnits("END statement");
82   std::exit(EXIT_SUCCESS);
83 }
84 }
85