diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp --- a/flang/lib/Lower/IntrinsicCall.cpp +++ b/flang/lib/Lower/IntrinsicCall.cpp @@ -29,6 +29,7 @@ #include "flang/Optimizer/Builder/Runtime/Numeric.h" #include "flang/Optimizer/Builder/Runtime/RTBuilder.h" #include "flang/Optimizer/Builder/Runtime/Reduction.h" +#include "flang/Optimizer/Builder/Runtime/Stop.h" #include "flang/Optimizer/Builder/Runtime/Transformational.h" #include "flang/Optimizer/Dialect/FIROpsSupport.h" #include "flang/Optimizer/Support/FatalError.h" @@ -453,6 +454,7 @@ fir::ExtendedValue genDotProduct(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genEoshift(mlir::Type, llvm::ArrayRef); + void genExit(llvm::ArrayRef); mlir::Value genExponent(mlir::Type, llvm::ArrayRef); template mlir::Value genExtremum(mlir::Type, llvm::ArrayRef); @@ -652,6 +654,10 @@ {"boundary", asBox, handleDynamicOptional}, {"dim", asValue}}}, /*isElemental=*/false}, + {"exit", + &I::genExit, + {{{"status", asValue}}}, + /*isElemental=*/false}, {"exponent", &I::genExponent}, {"floor", &I::genFloor}, {"fraction", &I::genFraction}, @@ -1981,6 +1987,22 @@ "unexpected result for EOSHIFT"); } +// EXIT +void IntrinsicLibrary::genExit(llvm::ArrayRef args) { + assert(args.size() == 1); + + mlir::Value status = + isAbsent(args[0]) + ? builder.createIntegerConstant(loc, builder.getDefaultIntegerType(), + EXIT_SUCCESS) + : fir::getBase(args[0]); + + assert(status.getType() == builder.getDefaultIntegerType() && + "STATUS parameter must be an INTEGER of default kind"); + + fir::runtime::genExit(builder, loc, status); +} + // EXPONENT mlir::Value IntrinsicLibrary::genExponent(mlir::Type resultType, llvm::ArrayRef args) { diff --git a/flang/test/Lower/Intrinsics/exit.f90 b/flang/test/Lower/Intrinsics/exit.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/Intrinsics/exit.f90 @@ -0,0 +1,23 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck --check-prefixes=CHECK,CHECK-32 -DDEFAULT_INTEGER_SIZE=32 %s +! bbc doesn't have a way to set the default kinds so we use flang-new driver +! RUN: flang-new -fc1 -fdefault-integer-8 -emit-fir %s -o - | FileCheck --check-prefixes=CHECK,CHECK-64 -DDEFAULT_INTEGER_SIZE=64 %s + +! CHECK-LABEL: func @_QPexit_test1() { +subroutine exit_test1 + call exit() + ! CHECK: %[[status:.*]] = arith.constant 0 : i[[DEFAULT_INTEGER_SIZE]] + ! CHECK-64: %[[statusConvert:.*]] = fir.convert %[[status]] : (i64) -> i32 + ! CHECK-32: %{{[0-9]+}} = fir.call @_FortranAExit(%[[status]]) : (i32) -> none + ! CHECK-64: %{{[0-9]+}} = fir.call @_FortranAExit(%[[statusConvert]]) : (i32) -> none + end subroutine exit_test1 + + ! CHECK-LABEL: func @_QPexit_test2( + ! CHECK-SAME: %[[statusArg:.*]]: !fir.ref{{.*}}) { + subroutine exit_test2(status) + integer :: status + call exit(status) + ! CHECK: %[[status:.*]] = fir.load %[[statusArg]] : !fir.ref + ! CHECK-64: %[[statusConv:.*]] = fir.convert %[[status]] : (i64) -> i32 + ! CHECK-32: %{{[0-9]+}} = fir.call @_FortranAExit(%[[status]]) : (i32) -> none + ! CHECK-64: %{{[0-9]+}} = fir.call @_FortranAExit(%[[statusConv]]) : (i32) -> none + end subroutine exit_test2