diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 19c623cc1ec00..71955632e48cd 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/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,
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Stop.h b/flang/include/flang/Optimizer/Builder/Runtime/Stop.h
index 6f764badf6f3a..be73cffff021e 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Stop.h
+++ b/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,
diff --git a/flang/include/flang/Runtime/stop.h b/flang/include/flang/Runtime/stop.h
index f7c4ffe7403e8..d442f72bfe1fa 100644
--- a/flang/include/flang/Runtime/stop.h
+++ b/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.
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index cdea572c14757..87ce6ed339667 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/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::pureSubroutine},
{"co_broadcast",
{{"a", AnyData, Rank::anyOrAssumedRank, Optionality::required,
common::Intent::InOut},
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 5dfa53e047f42..acb77694d6ebf 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/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,
diff --git a/flang/lib/Optimizer/Builder/Runtime/Stop.cpp b/flang/lib/Optimizer/Builder/Runtime/Stop.cpp
index 411181cc6dd1c..541e5f3b5d11a 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Stop.cpp
+++ b/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) {
diff --git a/flang/runtime/stop.cpp b/flang/runtime/stop.cpp
index cfb36b4084020..17d0ca661d9e8 100644
--- a/flang/runtime/stop.cpp
+++ b/flang/runtime/stop.cpp
@@ -16,6 +16,11 @@
#include <cstdio>
#include <cstdlib>
+#include "llvm/Config/config.h"
+#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");
+
+#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);
diff --git a/flang/test/Lower/Intrinsics/backtrace.f90 b/flang/test/Lower/Intrinsics/backtrace.f90
new file mode 100644
index 0000000000000..9d5e7b4965baf
--- /dev/null
+++ b/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