Backtrace support for flang

flang/CMakeLists.txt

@@ -90,6 +90,11 @@ if (FLANG_STANDALONE_BUILD)
   # We need a pre-built/installed version of LLVM.
   find_package(LLVM REQUIRED HINTS "${LLVM_DIR_ABSOLUTE}")
 
+  # function checks
+  find_package(Backtrace)
+  set(HAVE_BACKTRACE ${Backtrace_FOUND})
+  set(BACKTRACE_HEADER ${Backtrace_HEADER})
+
   # Users might specify a path to CLANG_DIR that's:
   #   * a full path, or
   #   * a path relative to the path of this script.

flang/include/flang/Optimizer/Builder/IntrinsicCall.h

@@ -196,6 +196,7 @@ struct IntrinsicLibrary {
   fir::ExtendedValue genAssociated(mlir::Type,
                                    llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genAtand(mlir::Type, llvm::ArrayRef<mlir::Value>);
+  void genBacktrace(llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genBesselJn(mlir::Type,
                                  llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genBesselYn(mlir::Type,

flang/include/flang/Optimizer/Builder/Runtime/Stop.h

@@ -30,6 +30,9 @@ void genExit(fir::FirOpBuilder &, mlir::Location, mlir::Value status);
 /// Generate call to ABORT intrinsic runtime routine.
 void genAbort(fir::FirOpBuilder &, mlir::Location);
 
+/// Generate call to BACKTRACE intrinsic runtime routine.
+void genBacktrace(fir::FirOpBuilder &builder, mlir::Location loc);
+
 /// Generate call to crash the program with an error message when detecting
 /// an invalid situation at runtime.
 void genReportFatalUserError(fir::FirOpBuilder &, mlir::Location,

flang/include/flang/Runtime/stop.h

@@ -29,6 +29,7 @@ NORETURN void RTNAME(ProgramEndStatement)(NO_ARGUMENTS);
 // Extensions
 NORETURN void RTNAME(Exit)(int status DEFAULT_VALUE(EXIT_SUCCESS));
 NORETURN void RTNAME(Abort)(NO_ARGUMENTS);
+void RTNAME(Backtrace)(NO_ARGUMENTS);
 
 // Crash with an error message when the program dynamically violates a Fortran
 // constraint.

flang/lib/Evaluate/intrinsics.cpp

@@ -1336,6 +1336,7 @@ static const IntrinsicInterface intrinsicSubroutine[]{
             {"stat", AnyInt, Rank::scalar, Optionality::optional,
                 common::Intent::Out}},
         {}, Rank::elemental, IntrinsicClass::atomicSubroutine},
+    {"backtrace", {}, {}, Rank::elemental, IntrinsicClass::impureSubroutine},
     {"co_broadcast",
         {{"a", AnyData, Rank::anyOrAssumedRank, Optionality::required,
              common::Intent::InOut},

flang/lib/Optimizer/Builder/IntrinsicCall.cpp

@@ -150,6 +150,7 @@ static constexpr IntrinsicHandler handlers[]{
     {"atan2pi", &I::genAtanpi},
     {"atand", &I::genAtand},
     {"atanpi", &I::genAtanpi},
+    {"backtrace", &I::genBacktrace},
     {"bessel_jn",
      &I::genBesselJn,
      {{{"n1", asValue}, {"n2", asValue}, {"x", asValue}}},
@@ -2682,6 +2683,12 @@ IntrinsicLibrary::genBesselJn(mlir::Type resultType,
   }
 }
 
+// Backtrace
+void IntrinsicLibrary::genBacktrace(llvm::ArrayRef<fir::ExtendedValue> args) {
+  assert(args.size() == 0);
+  fir::runtime::genBacktrace(builder, loc);
+}
+
 // BESSEL_YN
 fir::ExtendedValue
 IntrinsicLibrary::genBesselYn(mlir::Type resultType,

flang/lib/Optimizer/Builder/Runtime/Stop.cpp

@@ -28,6 +28,13 @@ void fir::runtime::genAbort(fir::FirOpBuilder &builder, mlir::Location loc) {
   builder.create<fir::CallOp>(loc, abortFunc, std::nullopt);
 }
 
+void fir::runtime::genBacktrace(fir::FirOpBuilder &builder,
+                                mlir::Location loc) {
+  mlir::func::FuncOp backtraceFunc =
+      fir::runtime::getRuntimeFunc<mkRTKey(Backtrace)>(loc, builder);
+  builder.create<fir::CallOp>(loc, backtraceFunc, std::nullopt);
+}
+
 void fir::runtime::genReportFatalUserError(fir::FirOpBuilder &builder,
                                            mlir::Location loc,
                                            llvm::StringRef message) {

flang/runtime/config.h.cmake

@@ -8,4 +8,9 @@
    don't. */
 #cmakedefine01 HAVE_DECL_STRERROR_S
 
+/* Define to 1 if you have the `backtrace' function. */
+#cmakedefine HAVE_BACKTRACE ${HAVE_BACKTRACE}
+
+#define BACKTRACE_HEADER <${BACKTRACE_HEADER}>
+
 #endif

flang/runtime/stop.cpp

@@ -7,6 +7,7 @@
 //===----------------------------------------------------------------------===//
 
 #include "flang/Runtime/stop.h"
+#include "config.h"
 #include "environment.h"
 #include "file.h"
 #include "io-error.h"
@@ -16,6 +17,10 @@
 #include <cstdio>
 #include <cstdlib>
 
+#ifdef HAVE_BACKTRACE
+#include BACKTRACE_HEADER
+#endif
+
 extern "C" {
 
 static void DescribeIEEESignaledExceptions() {
@@ -152,11 +157,36 @@ void RTNAME(PauseStatementText)(const char *code, std::size_t length) {
   std::exit(status);
 }
 
+static void PrintBacktrace() {
+#ifdef HAVE_BACKTRACE
+  // TODO: Need to parse DWARF information to print function line numbers
+  constexpr int MAX_CALL_STACK{999};
+  void *buffer[MAX_CALL_STACK];
+  int nptrs{backtrace(buffer, MAX_CALL_STACK)};
+
+  if (char **symbols{backtrace_symbols(buffer, nptrs)}) {
+    for (int i = 0; i < nptrs; i++) {
+      Fortran::runtime::Terminator{}.PrintCrashArgs("#%d %s\n", i, symbols[i]);
+    }
+    free(symbols);
+  }
+
+#else
+
+  // TODO: Need to implement the version for other platforms.
+  Fortran::runtime::Terminator{}.PrintCrashArgs(
+      "Handle the case when a backtrace is not available\n");
+
+#endif
+}
+
 [[noreturn]] void RTNAME(Abort)() {
-  // TODO: Add backtrace call, unless with `-fno-backtrace`.
+  PrintBacktrace();
   std::abort();
 }
 
+void RTNAME(Backtrace)() { PrintBacktrace(); }
+
 [[noreturn]] void RTNAME(ReportFatalUserError)(
     const char *message, const char *source, int line) {
   Fortran::runtime::Terminator{source, line}.Crash(message);

flang/test/Lower/Intrinsics/backtrace.f90

@@ -0,0 +1,10 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func.func @_QPbacktrace_test() {
+! CHECK:         %[[VAL_0:.*]] = fir.call @_FortranABacktrace() {{.*}}: () -> none
+! CHECK:         return
+! CHECK:       }
+
+subroutine backtrace_test()
+  call backtrace
+end subroutine