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); mlir::Value genAtand(mlir::Type, llvm::ArrayRef); + void genBacktrace(llvm::ArrayRef); fir::ExtendedValue genBesselJn(mlir::Type, llvm::ArrayRef); 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 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(loc, abortFunc, std::nullopt); } +void fir::runtime::genBacktrace(fir::FirOpBuilder &builder, + mlir::Location loc) { + mlir::func::FuncOp backtraceFunc = + fir::runtime::getRuntimeFunc(loc, builder); + builder.create(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 #include +#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