flang/runtime/stop.cpp

   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 #ifdef FE_DIVBYZERO
  30     if (excepts & FE_DIVBYZERO) {
  31       std::fputs(" DIVBYZERO", stderr);
  32     }
  33 #endif
  34 #ifdef FE_INEXACT
  35     if (excepts & FE_INEXACT) {
  36       std::fputs(" INEXACT", stderr);
  37     }
  38 #endif
  39 #ifdef FE_INVALID
  40     if (excepts & FE_INVALID) {
  41       std::fputs(" INVALID", stderr);
  42     }
  43 #endif
  44 #ifdef FE_OVERFLOW
  45     if (excepts & FE_OVERFLOW) {
  46       std::fputs(" OVERFLOW", stderr);
  47     }
  48 #endif
  49 #ifdef FE_UNDERFLOW
  50     if (excepts & FE_UNDERFLOW) {
  51       std::fputs(" UNDERFLOW", stderr);
  52     }
  53 #endif
  54     std::fputc('\n', stderr);
  55   }
  56 }
  57
  58 static void CloseAllExternalUnits(const char *why) {
  59   Fortran::runtime::io::IoErrorHandler handler{why};
  60   Fortran::runtime::io::ExternalFileUnit::CloseAll(handler);
  61 }
  62
  63 [[noreturn]] void RTNAME(StopStatement)(
  64     int code, bool isErrorStop, bool quiet) {
  65   CloseAllExternalUnits("STOP statement");
  66   if (Fortran::runtime::executionEnvironment.noStopMessage && code == 0) {
  67     quiet = true;
  68   }
  69   if (!quiet) {
  70     std::fprintf(stderr, "Fortran %s", isErrorStop ? "ERROR STOP" : "STOP");
  71     if (code != EXIT_SUCCESS) {
  72       std::fprintf(stderr, ": code %d\n", code);
  73     }
  74     std::fputc('\n', stderr);
  75     DescribeIEEESignaledExceptions();
  76   }
  77   std::exit(code);
  78 }
  79
  80 [[noreturn]] void RTNAME(StopStatementText)(
  81     const char *code, std::size_t length, bool isErrorStop, bool quiet) {
  82   CloseAllExternalUnits("STOP statement");
  83   if (!quiet) {
  84     if (Fortran::runtime::executionEnvironment.noStopMessage && !isErrorStop) {
  85       std::fprintf(stderr, "%.*s\n", static_cast<int>(length), code);
  86     } else {
  87       std::fprintf(stderr, "Fortran %s: %.*s\n",
  88           isErrorStop ? "ERROR STOP" : "STOP", static_cast<int>(length), code);
  89     }
  90     DescribeIEEESignaledExceptions();
  91   }
  92   if (isErrorStop) {
  93     std::exit(EXIT_FAILURE);
  94   } else {
  95     std::exit(EXIT_SUCCESS);
  96   }
  97 }
  98
  99 static bool StartPause() {
 100   if (Fortran::runtime::io::IsATerminal(0)) {
 101     Fortran::runtime::io::IoErrorHandler handler{"PAUSE statement"};
 102     Fortran::runtime::io::ExternalFileUnit::FlushAll(handler);
 103     return true;
 104   }
 105   return false;
 106 }
 107
 108 static void EndPause() {
 109   std::fflush(nullptr);
 110   if (std::fgetc(stdin) == EOF) {
 111     CloseAllExternalUnits("PAUSE statement");
 112     std::exit(EXIT_SUCCESS);
 113   }
 114 }
 115
 116 void RTNAME(PauseStatement)() {
 117   if (StartPause()) {
 118     std::fputs("Fortran PAUSE: hit RETURN to continue:", stderr);
 119     EndPause();
 120   }
 121 }
 122
 123 void RTNAME(PauseStatementInt)(int code) {
 124   if (StartPause()) {
 125     std::fprintf(stderr, "Fortran PAUSE %d: hit RETURN to continue:", code);
 126     EndPause();
 127   }
 128 }
 129
 130 void RTNAME(PauseStatementText)(const char *code, std::size_t length) {
 131   if (StartPause()) {
 132     std::fprintf(stderr,
 133         "Fortran PAUSE %.*s: hit RETURN to continue:", static_cast<int>(length),
 134         code);
 135     EndPause();
 136   }
 137 }
 138
 139 [[noreturn]] void RTNAME(FailImageStatement)() {
 140   Fortran::runtime::NotifyOtherImagesOfFailImageStatement();
 141   CloseAllExternalUnits("FAIL IMAGE statement");
 142   std::exit(EXIT_FAILURE);
 143 }
 144
 145 [[noreturn]] void RTNAME(ProgramEndStatement)() {
 146   CloseAllExternalUnits("END statement");
 147   std::exit(EXIT_SUCCESS);
 148 }
 149
 150 [[noreturn]] void RTNAME(Exit)(int status) {
 151   CloseAllExternalUnits("CALL EXIT()");
 152   std::exit(status);
 153 }
 154
 155 [[noreturn]] void RTNAME(Abort)() {
 156   // TODO: Add backtrace call, unless with `-fno-backtrace`.
 157   std::abort();
 158 }
 159
 160 [[noreturn]] void RTNAME(ReportFatalUserError)(
 161     const char *message, const char *source, int line) {
 162   Fortran::runtime::Terminator{source, line}.Crash(message);
 163 }
 164 }