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     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 }