[flang] Support extention intrinsic ABORT

[peixin]

Summary

The semantic checks and runtime have been supported. This supports the
lowering of intrinsic ABORT.

gfortran prints a backtrace before abort, unless -fno-backtrace is
given. This is good to use. The intrinsic BACKTRACE is not supported
yet, so add TODO in the runtime.

This extention is needed in SPEC2017 521.wrf_r in
https://github.com/llvm/llvm-project/issues/55955.

[peixin]

flang/runtime/stop.cpp

146

@klausler Can I add this TODO here?

[klausler]

flang/runtime/stop.cpp

146

Compilers that have ABORT as an extension intrinsic or as a standard library utility do so as a means to access the standard C library function abort (std::abort), which simply sends SIGABRT to the current process. Does any Fortran compiler emit a backtrace before doing so? If not, f18 should not either.

[peixin]

flang/runtime/stop.cpp

146

Yes, gfortran emit a braktrace as I mentioned in the summary. Here is the details in gfortran, and here is the testing.

[peixin]

flang/runtime/stop.cpp

146

ping @klausler

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

 class FirOpBuilder;
 }
 
 namespace fir::runtime {
 
 /// Generate call to EXIT intrinsic runtime routine.
 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 crash the program with an error message when detecting
 /// an invalid situation at runtime.
 void genReportFatalUserError(fir::FirOpBuilder &, mlir::Location,
                              llvm::StringRef message);
 
 } // namespace fir::runtime
 #endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_STOP_H

flang/lib/Lower/IntrinsicCall.cpp

mlir::Value genRuntimeCall(llvm::StringRef name, mlir::Type,
                              llvm::ArrayRef<mlir::Value>);
 
   using RuntimeCallGenerator = std::function<mlir::Value(
       fir::FirOpBuilder &, mlir::Location, llvm::ArrayRef<mlir::Value>)>;
   RuntimeCallGenerator
   getRuntimeCallGenerator(llvm::StringRef name,
                           mlir::FunctionType soughtFuncType);
 
+  void genAbort(llvm::ArrayRef<fir::ExtendedValue>);
+
   /// Lowering for the ABS intrinsic. The ABS intrinsic expects one argument in
   /// the llvm::ArrayRef. The ABS intrinsic is lowered into MLIR/FIR operation
   /// if the argument is an integer, into llvm intrinsics if the argument is
   /// real and to the `hypot` math routine if the argument is of complex type.
   mlir::Value genAbs(mlir::Type, llvm::ArrayRef<mlir::Value>);
   template <void (*CallRuntime)(fir::FirOpBuilder &, mlir::Location loc,
                                 mlir::Value, mlir::Value)>
   fir::ExtendedValue genAdjustRtCall(mlir::Type,

 /// Table that drives the fir generation depending on the intrinsic.
 /// one to one mapping with Fortran arguments. If no mapping is
 /// defined here for a generic intrinsic, genRuntimeCall will be called
 /// to look for a match in the runtime a emit a call. Note that the argument
 /// lowering rules for an intrinsic need to be provided only if at least one
 /// argument must not be lowered by value. In which case, the lowering rules
 /// should be provided for all the intrinsic arguments for completeness.
 static constexpr IntrinsicHandler handlers[]{
+    {"abort", &I::genAbort},
     {"abs", &I::genAbs},
     {"achar", &I::genChar},
     {"adjustl",
      &I::genAdjustRtCall<fir::runtime::genAdjustL>,
      {{{"string", asAddr}}},
      /*isElemental=*/true},
     {"adjustr",
      &I::genAdjustRtCall<fir::runtime::genAdjustR>,

 
 mlir::Value IntrinsicLibrary::genConversion(mlir::Type resultType,
                                             llvm::ArrayRef<mlir::Value> args) {
   // There can be an optional kind in second argument.
   assert(args.size() >= 1);
   return builder.convertWithSemantics(loc, resultType, args[0]);
 }
 
+// ABORT
+void IntrinsicLibrary::genAbort(llvm::ArrayRef<fir::ExtendedValue> args) {
+  assert(args.size() == 0);
+  fir::runtime::genAbort(builder, loc);
+}
+
 // ABS
 mlir::Value IntrinsicLibrary::genAbs(mlir::Type resultType,
                                      llvm::ArrayRef<mlir::Value> args) {
   assert(args.size() == 1);
   mlir::Value arg = args[0];
   mlir::Type type = arg.getType();
   if (fir::isa_real(type)) {
     // Runtime call to fp abs. An alternative would be to use mlir

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

 void fir::runtime::genExit(fir::FirOpBuilder &builder, mlir::Location loc,
                            mlir::Value status) {
   auto exitFunc = fir::runtime::getRuntimeFunc<mkRTKey(Exit)>(loc, builder);
   llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
       builder, loc, exitFunc.getFunctionType(), status);
   builder.create<fir::CallOp>(loc, exitFunc, args);
 }
 
+void fir::runtime::genAbort(fir::FirOpBuilder &builder, mlir::Location loc) {
+  mlir::func::FuncOp abortFunc =
+      fir::runtime::getRuntimeFunc<mkRTKey(Abort)>(loc, builder);
+  builder.create<fir::CallOp>(loc, abortFunc, llvm::None);
+}
+
 void fir::runtime::genReportFatalUserError(fir::FirOpBuilder &builder,
                                            mlir::Location loc,
                                            llvm::StringRef message) {
   mlir::func::FuncOp crashFunc =
       fir::runtime::getRuntimeFunc<mkRTKey(ReportFatalUserError)>(loc, builder);
   mlir::FunctionType funcTy = crashFunc.getFunctionType();
   mlir::Value msgVal = fir::getBase(
       fir::factory::createStringLiteral(builder, loc, message.str() + '\0'));
   mlir::Value sourceLine =
       fir::factory::locationToLineNo(builder, loc, funcTy.getInput(2));
   mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
   llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
       builder, loc, funcTy, msgVal, sourceFile, sourceLine);
   builder.create<fir::CallOp>(loc, crashFunc, args);
 }

flang/runtime/stop.cpp

[[noreturn]] void RTNAME(ProgramEndStatement)() {
   std::exit(EXIT_SUCCESS);
 }
 
 [[noreturn]] void RTNAME(Exit)(int status) {
   CloseAllExternalUnits("CALL EXIT()");
   std::exit(status);
 }
 
-[[noreturn]] void RTNAME(Abort)() { std::abort(); }
+[[noreturn]] void RTNAME(Abort)() {
+  // TODO: Add backtrace call, unless with `-fno-backtrace`.
+  std::abort();
+}
 
 [[noreturn]] void RTNAME(ReportFatalUserError)(
     const char *message, const char *source, int line) {
   Fortran::runtime::Terminator{source, line}.Crash(message);
 }
 }

flang/test/Lower/Intrinsics/abort.f90

+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func.func @_QPabort_test() {
+! CHECK:         %[[VAL_0:.*]] = fir.call @_FortranAAbort() : () -> none
+! CHECK:         return
+! CHECK:       }
+
+subroutine abort_test()
+  call abort
+end subroutine