llvm-project

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
    if (Fortran::runtime::executionEnvironment.noStopMessage && !isErrorStop) {
75
      std::fprintf(stderr, "%.*s\n", static_cast<int>(length), code);
76
    } else {
77
      std::fprintf(stderr, "Fortran %s: %.*s\n",
78
          isErrorStop ? "ERROR STOP" : "STOP", static_cast<int>(length), code);
79
    }
80
    DescribeIEEESignaledExceptions();
81
  }
82
  if (isErrorStop) {
83
    std::exit(EXIT_FAILURE);
84
  } else {
85
    std::exit(EXIT_SUCCESS);
86
  }
87
}
88

89
static bool StartPause() {
90
  if (Fortran::runtime::io::IsATerminal(0)) {
91
    Fortran::runtime::io::IoErrorHandler handler{"PAUSE statement"};
92
    Fortran::runtime::io::ExternalFileUnit::FlushAll(handler);
93
    return true;
94
  }
95
  return false;
96
}
97

98
static void EndPause() {
99
  std::fflush(nullptr);
100
  if (std::fgetc(stdin) == EOF) {
101
    CloseAllExternalUnits("PAUSE statement");
102
    std::exit(EXIT_SUCCESS);
103
  }
104
}
105

106
void RTNAME(PauseStatement)() {
107
  if (StartPause()) {
108
    std::fputs("Fortran PAUSE: hit RETURN to continue:", stderr);
109
    EndPause();
110
  }
111
}
112

113
void RTNAME(PauseStatementInt)(int code) {
114
  if (StartPause()) {
115
    std::fprintf(stderr, "Fortran PAUSE %d: hit RETURN to continue:", code);
116
    EndPause();
117
  }
118
}
119

120
void RTNAME(PauseStatementText)(const char *code, std::size_t length) {
121
  if (StartPause()) {
122
    std::fprintf(stderr,
123
        "Fortran PAUSE %.*s: hit RETURN to continue:", static_cast<int>(length),
124
        code);
125
    EndPause();
126
  }
127
}
128

129
[[noreturn]] void RTNAME(FailImageStatement)() {
130
  Fortran::runtime::NotifyOtherImagesOfFailImageStatement();
131
  CloseAllExternalUnits("FAIL IMAGE statement");
132
  std::exit(EXIT_FAILURE);
133
}
134

135
[[noreturn]] void RTNAME(ProgramEndStatement)() {
136
  CloseAllExternalUnits("END statement");
137
  std::exit(EXIT_SUCCESS);
138
}
139

140
[[noreturn]] void RTNAME(Exit)(int status) {
141
  CloseAllExternalUnits("CALL EXIT()");
142
  std::exit(status);
143
}
144

145
[[noreturn]] void RTNAME(Abort)() {
146
  // TODO: Add backtrace call, unless with `-fno-backtrace`.
147
  std::abort();
148
}
149

150
[[noreturn]] void RTNAME(ReportFatalUserError)(
151
    const char *message, const char *source, int line) {
152
  Fortran::runtime::Terminator{source, line}.Crash(message);
153
}
154
}
155