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