[flang] [llvm] [flang][MIF] Adding Stop and ErrorStop operations (PR #166787)
Jean-Didier PAILLEUX via llvm-commits
llvm-commits at lists.llvm.org
Tue Jan 27 05:29:16 PST 2026
https://github.com/JDPailleux updated https://github.com/llvm/llvm-project/pull/166787
>From 6fa04b031fe7d4691e6c468fc903431cbf33f7c9 Mon Sep 17 00:00:00 2001
From: Jean-Didier Pailleux <jean-didier.pailleux at sipearl.com>
Date: Fri, 31 Oct 2025 10:36:47 +0100
Subject: [PATCH 01/12] [flang][MIF] Adding Stop and ErrorStop operations
---
.../flang/Optimizer/Dialect/FIRTypes.td | 1 +
.../flang/Optimizer/Dialect/MIF/MIFOps.td | 42 +++++
flang/lib/Lower/Runtime.cpp | 22 ++-
flang/lib/Optimizer/Builder/Runtime/Main.cpp | 7 +-
flang/lib/Optimizer/Dialect/MIF/MIFOps.cpp | 26 +++
.../Optimizer/Transforms/MIFOpConversion.cpp | 99 +++++++++++-
flang/test/Fir/MIF/error_stop.mlir | 152 ++++++++++++++++++
flang/test/Fir/MIF/stop.mlir | 152 ++++++++++++++++++
flang/test/Lower/MIF/coarray-init.f90 | 5 +
flang/test/Lower/MIF/error_stop.f90 | 58 +++++++
flang/test/Lower/MIF/stop.f90 | 58 +++++++
11 files changed, 618 insertions(+), 4 deletions(-)
create mode 100644 flang/test/Fir/MIF/error_stop.mlir
create mode 100644 flang/test/Fir/MIF/stop.mlir
create mode 100644 flang/test/Lower/MIF/error_stop.f90
create mode 100644 flang/test/Lower/MIF/stop.f90
diff --git a/flang/include/flang/Optimizer/Dialect/FIRTypes.td b/flang/include/flang/Optimizer/Dialect/FIRTypes.td
index c953d9ecb67cf..f2bb6f34313ed 100644
--- a/flang/include/flang/Optimizer/Dialect/FIRTypes.td
+++ b/flang/include/flang/Optimizer/Dialect/FIRTypes.td
@@ -597,6 +597,7 @@ def AnyLogicalLike : TypeConstraint<Or<[BoolLike.predicate,
fir_LogicalType.predicate]>, "any logical">;
def AnyRealLike : TypeConstraint<FloatLike.predicate, "any real">;
def AnyIntegerType : Type<AnyIntegerLike.predicate, "any integer">;
+def AnyLogicalType : Type<AnyLogicalLike.predicate, "any logical">;
def AnyFirComplexLike : TypeConstraint<CPred<"::fir::isa_complex($_self)">,
"any floating point complex type">;
diff --git a/flang/include/flang/Optimizer/Dialect/MIF/MIFOps.td b/flang/include/flang/Optimizer/Dialect/MIF/MIFOps.td
index a6c7d0a07b019..0d4478cdd4453 100644
--- a/flang/include/flang/Optimizer/Dialect/MIF/MIFOps.td
+++ b/flang/include/flang/Optimizer/Dialect/MIF/MIFOps.td
@@ -37,6 +37,48 @@ def mif_InitOp : mif_Op<"init", []> {
let assemblyFormat = "`->` type($stat) attr-dict";
}
+def mif_StopOp : mif_Op<"stop", [AttrSizedOperandSegments]> {
+ let summary = "Initiates normal or error termination of the prorgram";
+ let description = [{
+ This operation initiates normal termination for the calling image.
+ It synchronizes all executing images, cleans up the parallel runtime environment,
+ and then terminates the program.
+ Calls to this operation do not return.
+ This operation supports both normal termination at the end of a
+ program, as well as any STOP statements from the user source code.
+ }];
+
+ let arguments = (ins Optional<AnyType>:$stop_code,
+ Optional<AnyLogicalType>:$quiet);
+
+ let hasVerifier = 1;
+ let assemblyFormat = [{
+ ( `code` $stop_code^ )? ( `quiet` $quiet^ )?
+ attr-dict `:` functional-type(operands, results)
+ }];
+}
+
+def mif_ErrorStopOp : mif_Op<"error_stop", [AttrSizedOperandSegments]> {
+ let summary = "Initiates normal or error termination of the prorgram";
+ let description = [{
+ This operation initiates error termination for all images.
+ This operation immediately terminates the program.
+ Calls to this operation do not return.
+ This operation supports error termination, such as from any
+ ERROR STOP statements in the user program.
+ }];
+
+ let arguments = (ins Optional<AnyType>:$stop_code,
+ Optional<AnyLogicalType>:$quiet);
+
+ let hasVerifier = 1;
+ let assemblyFormat = [{
+ ( `code` $stop_code^ )? ( `quiet` $quiet^ )?
+ attr-dict `:` functional-type(operands, results)
+ }];
+}
+
+
//===----------------------------------------------------------------------===//
// Image Queries
//===----------------------------------------------------------------------===//
diff --git a/flang/lib/Lower/Runtime.cpp b/flang/lib/Lower/Runtime.cpp
index 5f8586b9c8a88..3c515c3a2580a 100644
--- a/flang/lib/Lower/Runtime.cpp
+++ b/flang/lib/Lower/Runtime.cpp
@@ -11,6 +11,7 @@
#include "flang/Lower/OpenACC.h"
#include "flang/Lower/OpenMP.h"
#include "flang/Lower/StatementContext.h"
+#include "flang/Optimizer/Builder/Character.h"
#include "flang/Optimizer/Builder/FIRBuilder.h"
#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
#include "flang/Optimizer/Builder/Todo.h"
@@ -59,10 +60,15 @@ void Fortran::lower::genStopStatement(
Fortran::parser::StopStmt::Kind::ErrorStop;
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
mlir::Location loc = converter.getCurrentLocation();
+ bool coarrayIsEnabled =
+ converter.getFoldingContext().languageFeatures().IsEnabled(
+ Fortran::common::LanguageFeature::Coarray);
+
Fortran::lower::StatementContext stmtCtx;
llvm::SmallVector<mlir::Value> operands;
mlir::func::FuncOp callee;
mlir::FunctionType calleeType;
+ mlir::Value stopCode;
// First operand is stop code (zero if absent)
if (const auto &code =
std::get<std::optional<Fortran::parser::StopCode>>(stmt.t)) {
@@ -80,8 +86,12 @@ void Fortran::lower::genStopStatement(
builder.createConvert(loc, calleeType.getInput(0), x.getAddr()));
operands.push_back(
builder.createConvert(loc, calleeType.getInput(1), x.getLen()));
+ if (coarrayIsEnabled)
+ stopCode =
+ fir::factory::CharacterExprHelper{builder, loc}.createEmbox(x);
},
[&](fir::UnboxedValue x) {
+ stopCode = x;
callee = fir::runtime::getRuntimeFunc<mkRTKey(StopStatement)>(
loc, builder);
calleeType = callee.getFunctionType();
@@ -105,11 +115,12 @@ void Fortran::lower::genStopStatement(
loc, calleeType.getInput(operands.size()), isError));
// Third operand indicates QUIET (default to false).
+ mlir::Value q;
if (const auto &quiet =
std::get<std::optional<Fortran::parser::ScalarLogicalExpr>>(stmt.t)) {
const SomeExpr *expr = Fortran::semantics::GetExpr(*quiet);
assert(expr && "failed getting typed expression");
- mlir::Value q = fir::getBase(converter.genExprValue(*expr, stmtCtx));
+ q = fir::getBase(converter.genExprValue(*expr, stmtCtx));
operands.push_back(
builder.createConvert(loc, calleeType.getInput(operands.size()), q));
} else {
@@ -117,7 +128,14 @@ void Fortran::lower::genStopStatement(
loc, calleeType.getInput(operands.size()), 0));
}
- fir::CallOp::create(builder, loc, callee, operands);
+ if (coarrayIsEnabled) {
+ if (isError)
+ mif::ErrorStopOp::create(builder, loc, stopCode, q);
+ else
+ mif::StopOp::create(builder, loc, stopCode, q);
+ } else
+ fir::CallOp::create(builder, loc, callee, operands);
+
auto blockIsUnterminated = [&builder]() {
mlir::Block *currentBlock = builder.getBlock();
return currentBlock->empty() ||
diff --git a/flang/lib/Optimizer/Builder/Runtime/Main.cpp b/flang/lib/Optimizer/Builder/Runtime/Main.cpp
index 9ce5e172f3cd3..099d985a1e07f 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Main.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Main.cpp
@@ -74,8 +74,13 @@ void fir::runtime::genMain(
mif::InitOp::create(builder, loc);
fir::CallOp::create(builder, loc, qqMainFn);
- fir::CallOp::create(builder, loc, stopFn);
mlir::Value ret = builder.createIntegerConstant(loc, argcTy, 0);
+ if (initCoarrayEnv) {
+ mlir::Value quiet = builder.createBool(loc, true);
+ mif::StopOp::create(builder, loc, ret, quiet);
+ } else
+ fir::CallOp::create(builder, loc, stopFn);
+
mlir::func::ReturnOp::create(builder, loc, ret);
}
diff --git a/flang/lib/Optimizer/Dialect/MIF/MIFOps.cpp b/flang/lib/Optimizer/Dialect/MIF/MIFOps.cpp
index 5f68f3dda54a7..4c04be2deb306 100644
--- a/flang/lib/Optimizer/Dialect/MIF/MIFOps.cpp
+++ b/flang/lib/Optimizer/Dialect/MIF/MIFOps.cpp
@@ -15,6 +15,32 @@
#include "mlir/IR/PatternMatch.h"
#include "llvm/ADT/SmallVector.h"
+//===----------------------------------------------------------------------===//
+// StopOp && ErrorStop
+//===----------------------------------------------------------------------===//
+
+template <typename OP>
+llvm::LogicalResult StopErrorStopVerify(OP &op) {
+ if (op.getStopCode()) {
+ mlir::Type codeType = op.getStopCode().getType();
+ if (!fir::isa_integer(codeType) &&
+ !fir::isa_char(fir::unwrapPassByRefType(codeType)))
+ return op.emitOpError(
+ "`stop_code` shall be of type integer or character.");
+ if (fir::isa_char(fir::unwrapPassByRefType(codeType)) &&
+ !mlir::isa<fir::BoxCharType>(codeType))
+ return op.emitOpError(
+ "`stop_code` base type is character and shall be a !fir.boxchar.");
+ }
+ return mlir::success();
+}
+
+llvm::LogicalResult mif::StopOp::verify() { return StopErrorStopVerify(*this); }
+
+llvm::LogicalResult mif::ErrorStopOp::verify() {
+ return StopErrorStopVerify(*this);
+}
+
//===----------------------------------------------------------------------===//
// NumImagesOp
//===----------------------------------------------------------------------===//
diff --git a/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp b/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp
index 0d3d2f6c144ff..48985e8d07b0c 100644
--- a/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp
+++ b/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp
@@ -100,6 +100,102 @@ struct MIFInitOpConversion : public mlir::OpRewritePattern<mif::InitOp> {
}
};
+static fir::CallOp genPRIFStopErrorStop(fir::FirOpBuilder &builder,
+ mlir::Location loc, mlir::Value quiet,
+ mlir::Value stopCode,
+ bool isError = false) {
+ mlir::Type stopCharTy = fir::BoxCharType::get(builder.getContext(), 1);
+ mlir::Type i1Ty = builder.getI1Type();
+ mlir::Type i32Ty = builder.getI32Type();
+
+ mlir::FunctionType ftype = mlir::FunctionType::get(
+ builder.getContext(),
+ /*inputs*/
+ {builder.getRefType(i1Ty), builder.getRefType(i32Ty), stopCharTy},
+ /*results*/ {});
+ mlir::func::FuncOp funcOp =
+ isError
+ ? builder.createFunction(loc, getPRIFProcName("error_stop"), ftype)
+ : builder.createFunction(loc, getPRIFProcName("stop"), ftype);
+
+ // Default value of QUIET to false
+ mlir::Value q;
+ if (!quiet) {
+ q = builder.createBool(loc, false);
+ quiet = builder.createTemporary(loc, i1Ty);
+ } else {
+ q = quiet;
+ if (q.getType() != i1Ty)
+ q = fir::ConvertOp::create(builder, loc, i1Ty, q);
+ quiet = builder.createTemporary(loc, i1Ty);
+ }
+ fir::StoreOp::create(builder, loc, q, quiet);
+
+ mlir::Value stopCodeInt, stopCodeChar;
+ if (!stopCode) {
+ stopCodeChar = fir::AbsentOp::create(builder, loc, stopCharTy);
+ stopCodeInt =
+ fir::AbsentOp::create(builder, loc, builder.getRefType(i32Ty));
+ } else if (fir::isa_integer(stopCode.getType())) {
+ stopCodeChar = fir::AbsentOp::create(builder, loc, stopCharTy);
+ stopCodeInt = builder.createTemporary(loc, i32Ty);
+ if (stopCode.getType() != i32Ty)
+ stopCode = fir::ConvertOp::create(builder, loc, i32Ty, stopCode);
+ fir::StoreOp::create(builder, loc, stopCode, stopCodeInt);
+ } else {
+ stopCodeChar = stopCode;
+ if (!mlir::isa<fir::BoxCharType>(stopCodeChar.getType())) {
+ auto len =
+ fir::UndefOp::create(builder, loc, builder.getCharacterLengthType());
+ stopCodeChar =
+ fir::EmboxCharOp::create(builder, loc, stopCharTy, stopCodeChar, len);
+ }
+ stopCodeInt =
+ fir::AbsentOp::create(builder, loc, builder.getRefType(i32Ty));
+ }
+
+ llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
+ builder, loc, ftype, quiet, stopCodeInt, stopCodeChar);
+ return fir::CallOp::create(builder, loc, funcOp, args);
+}
+
+/// Convert mif.stop operation to runtime call of 'prif_stop'
+struct MIFStopOpConversion : public mlir::OpRewritePattern<mif::StopOp> {
+ using OpRewritePattern::OpRewritePattern;
+
+ mlir::LogicalResult
+ matchAndRewrite(mif::StopOp op,
+ mlir::PatternRewriter &rewriter) const override {
+ auto mod = op->template getParentOfType<mlir::ModuleOp>();
+ fir::FirOpBuilder builder(rewriter, mod);
+ mlir::Location loc = op.getLoc();
+
+ fir::CallOp callOp =
+ genPRIFStopErrorStop(builder, loc, op.getQuiet(), op.getStopCode());
+ rewriter.replaceOp(op, callOp);
+ return mlir::success();
+ }
+};
+
+/// Convert mif.error_stop operation to runtime call of 'prif_error_stop'
+struct MIFErrorStopOpConversion
+ : public mlir::OpRewritePattern<mif::ErrorStopOp> {
+ using OpRewritePattern::OpRewritePattern;
+
+ mlir::LogicalResult
+ matchAndRewrite(mif::ErrorStopOp op,
+ mlir::PatternRewriter &rewriter) const override {
+ auto mod = op->template getParentOfType<mlir::ModuleOp>();
+ fir::FirOpBuilder builder(rewriter, mod);
+ mlir::Location loc = op.getLoc();
+
+ fir::CallOp callOp = genPRIFStopErrorStop(
+ builder, loc, op.getQuiet(), op.getStopCode(), /*isError*/ true);
+ rewriter.replaceOp(op, callOp);
+ return mlir::success();
+ }
+};
+
/// Convert mif.this_image operation to PRIF runtime call
struct MIFThisImageOpConversion
: public mlir::OpRewritePattern<mif::ThisImageOp> {
@@ -689,7 +785,8 @@ class MIFOpConversion : public fir::impl::MIFOpConversionBase<MIFOpConversion> {
} // namespace
void mif::populateMIFOpConversionPatterns(mlir::RewritePatternSet &patterns) {
- patterns.insert<MIFInitOpConversion, MIFThisImageOpConversion,
+ patterns.insert<MIFInitOpConversion, MIFStopOpConversion,
+ MIFErrorStopOpConversion, MIFThisImageOpConversion,
MIFNumImagesOpConversion, MIFSyncAllOpConversion,
MIFSyncImagesOpConversion, MIFSyncMemoryOpConversion,
MIFSyncTeamOpConversion, MIFCoBroadcastOpConversion,
diff --git a/flang/test/Fir/MIF/error_stop.mlir b/flang/test/Fir/MIF/error_stop.mlir
new file mode 100644
index 0000000000000..d9fab07e71183
--- /dev/null
+++ b/flang/test/Fir/MIF/error_stop.mlir
@@ -0,0 +1,152 @@
+// RUN: fir-opt --mif-convert %s | FileCheck %s
+
+func.func @_QPerror_stop_test() {
+ %0 = fir.dummy_scope : !fir.dscope
+ mif.error_stop : () -> ()
+ fir.unreachable
+}
+func.func @_QPerror_stop_code1() {
+ %0 = fir.dummy_scope : !fir.dscope
+ %1 = fir.alloca i32 {bindc_name = "int_code", uniq_name = "_QFerror_stop_code1Eint_code"}
+ %2:2 = hlfir.declare %1 {uniq_name = "_QFerror_stop_code1Eint_code"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+ %3 = fir.load %2#0 : !fir.ref<i32>
+ mif.error_stop code %3 : (i32) -> ()
+ fir.unreachable
+}
+func.func @_QPerror_stop_code2() {
+ %0 = fir.dummy_scope : !fir.dscope
+ %c26_i32 = arith.constant 26 : i32
+ %1 = hlfir.no_reassoc %c26_i32 : i32
+ mif.error_stop code %1 : (i32) -> ()
+ fir.unreachable
+}
+func.func @_QPerror_stop_code_char1() {
+ %0 = fir.dummy_scope : !fir.dscope
+ %c128 = arith.constant 128 : index
+ %1 = fir.alloca !fir.char<1,128> {bindc_name = "char_code", uniq_name = "_QFerror_stop_code_char1Echar_code"}
+ %2:2 = hlfir.declare %1 typeparams %c128 {uniq_name = "_QFerror_stop_code_char1Echar_code"} : (!fir.ref<!fir.char<1,128>>, index) -> (!fir.ref<!fir.char<1,128>>, !fir.ref<!fir.char<1,128>>)
+ %3 = fir.emboxchar %2#0, %c128 : (!fir.ref<!fir.char<1,128>>, index) -> !fir.boxchar<1>
+ mif.error_stop code %3 : (!fir.boxchar<1>) -> ()
+ fir.unreachable
+}
+func.func @_QPerror_stop_code_char2() {
+ %0 = fir.dummy_scope : !fir.dscope
+ %1 = fir.address_of(@_QQclX63) : !fir.ref<!fir.char<1>>
+ %c1 = arith.constant 1 : index
+ %2:2 = hlfir.declare %1 typeparams %c1 {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQclX63"} : (!fir.ref<!fir.char<1>>, index) -> (!fir.ref<!fir.char<1>>, !fir.ref<!fir.char<1>>)
+ %3 = fir.emboxchar %2#0, %c1 : (!fir.ref<!fir.char<1>>, index) -> !fir.boxchar<1>
+ mif.error_stop code %3 : (!fir.boxchar<1>) -> ()
+ fir.unreachable
+}
+func.func @_QPerror_stop_code_char3() {
+ %0 = fir.dummy_scope : !fir.dscope
+ %1 = fir.address_of(@_QQclX70726F6772616D206661696C6564) : !fir.ref<!fir.char<1,14>>
+ %c14 = arith.constant 14 : index
+ %2:2 = hlfir.declare %1 typeparams %c14 {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQclX70726F6772616D206661696C6564"} : (!fir.ref<!fir.char<1,14>>, index) -> (!fir.ref<!fir.char<1,14>>, !fir.ref<!fir.char<1,14>>)
+ %3 = hlfir.as_expr %2#0 : (!fir.ref<!fir.char<1,14>>) -> !hlfir.expr<!fir.char<1,14>>
+ %4:3 = hlfir.associate %3 typeparams %c14 {adapt.valuebyref} : (!hlfir.expr<!fir.char<1,14>>, index) -> (!fir.ref<!fir.char<1,14>>, !fir.ref<!fir.char<1,14>>, i1)
+ %5 = fir.emboxchar %4#0, %c14 : (!fir.ref<!fir.char<1,14>>, index) -> !fir.boxchar<1>
+ mif.error_stop code %5 : (!fir.boxchar<1>) -> ()
+ fir.unreachable
+}
+func.func @_QPerror_stop_code_quiet1() {
+ %0 = fir.dummy_scope : !fir.dscope
+ %1 = fir.alloca !fir.logical<4> {bindc_name = "bool", uniq_name = "_QFerror_stop_code_quiet1Ebool"}
+ %2:2 = hlfir.declare %1 {uniq_name = "_QFerror_stop_code_quiet1Ebool"} : (!fir.ref<!fir.logical<4>>) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>)
+ %3 = fir.alloca i32 {bindc_name = "int_code", uniq_name = "_QFerror_stop_code_quiet1Eint_code"}
+ %4:2 = hlfir.declare %3 {uniq_name = "_QFerror_stop_code_quiet1Eint_code"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+ %5 = fir.load %4#0 : !fir.ref<i32>
+ %6 = fir.load %2#0 : !fir.ref<!fir.logical<4>>
+ mif.error_stop code %5 quiet %6 : (i32, !fir.logical<4>) -> ()
+ fir.unreachable
+}
+func.func @_QPerror_stop_code_quiet2() {
+ %0 = fir.dummy_scope : !fir.dscope
+ %1 = fir.alloca i32 {bindc_name = "int_code", uniq_name = "_QFerror_stop_code_quiet2Eint_code"}
+ %2:2 = hlfir.declare %1 {uniq_name = "_QFerror_stop_code_quiet2Eint_code"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+ %3 = fir.load %2#0 : !fir.ref<i32>
+ %true = arith.constant true
+ mif.error_stop code %3 quiet %true : (i32, i1) -> ()
+ fir.unreachable
+}
+func.func @_QPerror_stop_code_quiet3() {
+ %0 = fir.dummy_scope : !fir.dscope
+ %1 = fir.alloca i32 {bindc_name = "int_code", uniq_name = "_QFerror_stop_code_quiet3Eint_code"}
+ %2:2 = hlfir.declare %1 {uniq_name = "_QFerror_stop_code_quiet3Eint_code"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+ %3 = fir.load %2#0 : !fir.ref<i32>
+ %4 = hlfir.no_reassoc %3 : i32
+ %false = arith.constant false
+ mif.error_stop code %4 quiet %false : (i32, i1) -> ()
+ fir.unreachable
+}
+func.func private @_FortranAStopStatement(i32, i1, i1) attributes {fir.runtime}
+func.func private @_FortranAStopStatementText(!fir.ref<i8>, i64, i1, i1) attributes {fir.runtime}
+fir.global linkonce @_QQclX63 constant : !fir.char<1> {
+ %0 = fir.string_lit "c"(1) : !fir.char<1>
+ fir.has_value %0 : !fir.char<1>
+}
+fir.global linkonce @_QQclX70726F6772616D206661696C6564 constant : !fir.char<1,14> {
+ %0 = fir.string_lit "program failed"(14) : !fir.char<1,14>
+ fir.has_value %0 : !fir.char<1,14>
+}
+
+
+// CHECK-label : func.func @_QPerror_stop_test
+// CHECK: %[[FALSE:.*]] = arith.constant false
+// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
+// CHECK2: %[[CODE_CHAR:.*]] = fir.absent !fir.boxchar<1>
+// CHECK2: %[[CODE_INT:.*]] = fir.absent !fir.ref<i32>
+// CHECK2: fir.call @_QMprifPprif_error_stop(%[[QUIET]], %[[CODE_INT]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
+
+// CHECK-label : func.func @_QPerror_stop_code1
+// CHECK: %[[FALSE:.*]] = arith.constant false
+// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
+// CHECK: %[[CODE_CHAR:.*]] = fir.absent !fir.boxchar<1>
+// CHECK: fir.call @_QMprifPprif_error_stop(%[[QUIET]], %[[CODE_INT:.*]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
+
+// CHECK-label : func.func @_QPerror_stop_code2
+// CHECK: %[[FALSE:.*]] = arith.constant false
+// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
+// CHECK: %[[CODE_CHAR:.*]] = fir.absent !fir.boxchar<1>
+// CHECK: fir.call @_QMprifPprif_error_stop(%[[QUIET]], %[[CODE_INT:.*]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
+
+// CHECK-label : func.func @_QPerror_stop_code_char1
+// CHECK: %[[CODE_CHAR:.*]] = fir.emboxchar %[[VAL_X:.*]]#0, %[[C128:.*]] : (!fir.ref<!fir.char<1,128>>, index) -> !fir.boxchar<1>
+// CHECK: %[[FALSE:.*]] = arith.constant false
+// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
+// CHECK: %[[CODE_INT:.*]] = fir.absent !fir.ref<i32>
+// CHECK: fir.call @_QMprifPprif_error_stop(%[[QUIET]], %[[CODE_INT]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
+
+// CHECK-label : func.func @_QPerror_stop_code_char2
+// CHECK: %[[CODE_CHAR:.*]] = fir.emboxchar %[[VAL_X:.*]]#0, %[[C1:.*]] : (!fir.ref<!fir.char<1>>, index) -> !fir.boxchar<1>
+// CHECK: %[[FALSE:.*]] = arith.constant false
+// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
+// CHECK: %[[CODE_INT:.*]] = fir.absent !fir.ref<i32>
+// CHECK: fir.call @_QMprifPprif_error_stop(%[[QUIET]], %[[CODE_INT]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
+
+// CHECK-label : func.func @_QPerror_stop_code_char3
+// CHECK: %[[CODE_CHAR:.*]] = fir.emboxchar %[[VAL_X:.*]]#0, %[[C14:.*]] : (!fir.ref<!fir.char<1,14>>, index) -> !fir.boxchar<1>
+// CHECK: %[[FALSE:.*]] = arith.constant false
+// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
+// CHECK: %[[CODE_INT:.*]] = fir.absent !fir.ref<i32>
+// CHECK: fir.call @_QMprifPprif_error_stop(%[[QUIET]], %[[CODE_INT]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
+
+// CHECK-label : func.func @_QPerror_stop_code_quiet1
+// CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_Q:.*]]#0 : !fir.ref<!fir.logical<4>>
+// CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.logical<4>) -> i1
+// CHECK: fir.store %[[VAL_2]] to %[[QUIET:.*]] : !fir.ref<i1>
+// CHECK: %[[CODE_CHAR:.*]] = fir.absent !fir.boxchar<1>
+// CHECK: fir.call @_QMprifPprif_error_stop(%[[QUIET]], %[[CODE_INT:.*]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
+
+// CHECK-label : func.func @_QPerror_stop_code_quiet2
+// CHECK: %[[TRUE:.*]] = arith.constant true
+// CHECK: fir.store %[[TRUE]] to %[[QUIET:.*]] : !fir.ref<i1>
+// CHECK: %[[CODE_CHAR:.*]] = fir.absent !fir.boxchar<1>
+// CHECK: fir.call @_QMprifPprif_error_stop(%[[QUIET]], %[[CODE_INT:.*]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
+
+// CHECK-label : func.func @_QPerror_stop_code_quiet3
+// CHECK: %[[FALSE:.*]] = arith.constant false
+// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
+// CHECK: %[[CODE_CHAR:.*]] = fir.absent !fir.boxchar<1>
+// CHECK: fir.call @_QMprifPprif_error_stop(%[[QUIET]], %[[CODE_INT:.*]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
+
diff --git a/flang/test/Fir/MIF/stop.mlir b/flang/test/Fir/MIF/stop.mlir
new file mode 100644
index 0000000000000..43bd92ef52242
--- /dev/null
+++ b/flang/test/Fir/MIF/stop.mlir
@@ -0,0 +1,152 @@
+// RUN: fir-opt --mif-convert %s | FileCheck %s
+
+func.func @_QPstop_test() {
+ %0 = fir.dummy_scope : !fir.dscope
+ mif.stop : () -> ()
+ fir.unreachable
+}
+func.func @_QPstop_code1() {
+ %0 = fir.dummy_scope : !fir.dscope
+ %1 = fir.alloca i32 {bindc_name = "int_code", uniq_name = "_QFstop_code1Eint_code"}
+ %2:2 = hlfir.declare %1 {uniq_name = "_QFstop_code1Eint_code"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+ %3 = fir.load %2#0 : !fir.ref<i32>
+ mif.stop code %3 : (i32) -> ()
+ fir.unreachable
+}
+func.func @_QPstop_code2() {
+ %0 = fir.dummy_scope : !fir.dscope
+ %c26_i32 = arith.constant 26 : i32
+ %1 = hlfir.no_reassoc %c26_i32 : i32
+ mif.stop code %1 : (i32) -> ()
+ fir.unreachable
+}
+func.func @_QPstop_code_char1() {
+ %0 = fir.dummy_scope : !fir.dscope
+ %c128 = arith.constant 128 : index
+ %1 = fir.alloca !fir.char<1,128> {bindc_name = "char_code", uniq_name = "_QFstop_code_char1Echar_code"}
+ %2:2 = hlfir.declare %1 typeparams %c128 {uniq_name = "_QFstop_code_char1Echar_code"} : (!fir.ref<!fir.char<1,128>>, index) -> (!fir.ref<!fir.char<1,128>>, !fir.ref<!fir.char<1,128>>)
+ %3 = fir.emboxchar %2#0, %c128 : (!fir.ref<!fir.char<1,128>>, index) -> !fir.boxchar<1>
+ mif.stop code %3 : (!fir.boxchar<1>) -> ()
+ fir.unreachable
+}
+func.func @_QPstop_code_char2() {
+ %0 = fir.dummy_scope : !fir.dscope
+ %1 = fir.address_of(@_QQclX63) : !fir.ref<!fir.char<1>>
+ %c1 = arith.constant 1 : index
+ %2:2 = hlfir.declare %1 typeparams %c1 {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQclX63"} : (!fir.ref<!fir.char<1>>, index) -> (!fir.ref<!fir.char<1>>, !fir.ref<!fir.char<1>>)
+ %3 = fir.emboxchar %2#0, %c1 : (!fir.ref<!fir.char<1>>, index) -> !fir.boxchar<1>
+ mif.stop code %3 : (!fir.boxchar<1>) -> ()
+ fir.unreachable
+}
+func.func @_QPstop_code_char3() {
+ %0 = fir.dummy_scope : !fir.dscope
+ %1 = fir.address_of(@_QQclX70726F6772616D206661696C6564) : !fir.ref<!fir.char<1,14>>
+ %c14 = arith.constant 14 : index
+ %2:2 = hlfir.declare %1 typeparams %c14 {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQclX70726F6772616D206661696C6564"} : (!fir.ref<!fir.char<1,14>>, index) -> (!fir.ref<!fir.char<1,14>>, !fir.ref<!fir.char<1,14>>)
+ %3 = hlfir.as_expr %2#0 : (!fir.ref<!fir.char<1,14>>) -> !hlfir.expr<!fir.char<1,14>>
+ %4:3 = hlfir.associate %3 typeparams %c14 {adapt.valuebyref} : (!hlfir.expr<!fir.char<1,14>>, index) -> (!fir.ref<!fir.char<1,14>>, !fir.ref<!fir.char<1,14>>, i1)
+ %5 = fir.emboxchar %4#0, %c14 : (!fir.ref<!fir.char<1,14>>, index) -> !fir.boxchar<1>
+ mif.stop code %5 : (!fir.boxchar<1>) -> ()
+ fir.unreachable
+}
+func.func @_QPstop_code_quiet1() {
+ %0 = fir.dummy_scope : !fir.dscope
+ %1 = fir.alloca !fir.logical<4> {bindc_name = "bool", uniq_name = "_QFstop_code_quiet1Ebool"}
+ %2:2 = hlfir.declare %1 {uniq_name = "_QFstop_code_quiet1Ebool"} : (!fir.ref<!fir.logical<4>>) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>)
+ %3 = fir.alloca i32 {bindc_name = "int_code", uniq_name = "_QFstop_code_quiet1Eint_code"}
+ %4:2 = hlfir.declare %3 {uniq_name = "_QFstop_code_quiet1Eint_code"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+ %5 = fir.load %4#0 : !fir.ref<i32>
+ %6 = fir.load %2#0 : !fir.ref<!fir.logical<4>>
+ mif.stop code %5 quiet %6 : (i32, !fir.logical<4>) -> ()
+ fir.unreachable
+}
+func.func @_QPstop_code_quiet2() {
+ %0 = fir.dummy_scope : !fir.dscope
+ %1 = fir.alloca i32 {bindc_name = "int_code", uniq_name = "_QFstop_code_quiet2Eint_code"}
+ %2:2 = hlfir.declare %1 {uniq_name = "_QFstop_code_quiet2Eint_code"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+ %3 = fir.load %2#0 : !fir.ref<i32>
+ %true = arith.constant true
+ mif.stop code %3 quiet %true : (i32, i1) -> ()
+ fir.unreachable
+}
+func.func @_QPstop_code_quiet3() {
+ %0 = fir.dummy_scope : !fir.dscope
+ %1 = fir.alloca i32 {bindc_name = "int_code", uniq_name = "_QFstop_code_quiet3Eint_code"}
+ %2:2 = hlfir.declare %1 {uniq_name = "_QFstop_code_quiet3Eint_code"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+ %3 = fir.load %2#0 : !fir.ref<i32>
+ %4 = hlfir.no_reassoc %3 : i32
+ %false = arith.constant false
+ mif.stop code %4 quiet %false : (i32, i1) -> ()
+ fir.unreachable
+}
+func.func private @_FortranAStopStatement(i32, i1, i1) attributes {fir.runtime}
+func.func private @_FortranAStopStatementText(!fir.ref<i8>, i64, i1, i1) attributes {fir.runtime}
+fir.global linkonce @_QQclX63 constant : !fir.char<1> {
+ %0 = fir.string_lit "c"(1) : !fir.char<1>
+ fir.has_value %0 : !fir.char<1>
+}
+fir.global linkonce @_QQclX70726F6772616D206661696C6564 constant : !fir.char<1,14> {
+ %0 = fir.string_lit "program failed"(14) : !fir.char<1,14>
+ fir.has_value %0 : !fir.char<1,14>
+}
+
+
+// CHECK-label : func.func @_QPstop_test
+// CHECK: %[[FALSE:.*]] = arith.constant false
+// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
+// CHECK2: %[[CODE_CHAR:.*]] = fir.absent !fir.boxchar<1>
+// CHECK2: %[[CODE_INT:.*]] = fir.absent !fir.ref<i32>
+// CHECK2: fir.call @_QMprifPprif_stop(%[[QUIET]], %[[CODE_INT]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
+
+// CHECK-label : func.func @_QPstop_code1
+// CHECK: %[[FALSE:.*]] = arith.constant false
+// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
+// CHECK: %[[CODE_CHAR:.*]] = fir.absent !fir.boxchar<1>
+// CHECK: fir.call @_QMprifPprif_stop(%[[QUIET]], %[[CODE_INT:.*]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
+
+// CHECK-label : func.func @_QPstop_code2
+// CHECK: %[[FALSE:.*]] = arith.constant false
+// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
+// CHECK: %[[CODE_CHAR:.*]] = fir.absent !fir.boxchar<1>
+// CHECK: fir.call @_QMprifPprif_stop(%[[QUIET]], %[[CODE_INT:.*]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
+
+// CHECK-label : func.func @_QPstop_code_char1
+// CHECK: %[[CODE_CHAR:.*]] = fir.emboxchar %[[VAL_X:.*]]#0, %[[C128:.*]] : (!fir.ref<!fir.char<1,128>>, index) -> !fir.boxchar<1>
+// CHECK: %[[FALSE:.*]] = arith.constant false
+// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
+// CHECK: %[[CODE_INT:.*]] = fir.absent !fir.ref<i32>
+// CHECK: fir.call @_QMprifPprif_stop(%[[QUIET]], %[[CODE_INT]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
+
+// CHECK-label : func.func @_QPstop_code_char2
+// CHECK: %[[CODE_CHAR:.*]] = fir.emboxchar %[[VAL_X:.*]]#0, %[[C1:.*]] : (!fir.ref<!fir.char<1>>, index) -> !fir.boxchar<1>
+// CHECK: %[[FALSE:.*]] = arith.constant false
+// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
+// CHECK: %[[CODE_INT:.*]] = fir.absent !fir.ref<i32>
+// CHECK: fir.call @_QMprifPprif_stop(%[[QUIET]], %[[CODE_INT]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
+
+// CHECK-label : func.func @_QPstop_code_char3
+// CHECK: %[[CODE_CHAR:.*]] = fir.emboxchar %[[VAL_X:.*]]#0, %[[C14:.*]] : (!fir.ref<!fir.char<1,14>>, index) -> !fir.boxchar<1>
+// CHECK: %[[FALSE:.*]] = arith.constant false
+// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
+// CHECK: %[[CODE_INT:.*]] = fir.absent !fir.ref<i32>
+// CHECK: fir.call @_QMprifPprif_stop(%[[QUIET]], %[[CODE_INT]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
+
+// CHECK-label : func.func @_QPstop_code_quiet1
+// CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_Q:.*]]#0 : !fir.ref<!fir.logical<4>>
+// CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.logical<4>) -> i1
+// CHECK: fir.store %[[VAL_2]] to %[[QUIET:.*]] : !fir.ref<i1>
+// CHECK: %[[CODE_CHAR:.*]] = fir.absent !fir.boxchar<1>
+// CHECK: fir.call @_QMprifPprif_stop(%[[QUIET]], %[[CODE_INT:.*]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
+
+// CHECK-label : func.func @_QPstop_code_quiet2
+// CHECK: %[[TRUE:.*]] = arith.constant true
+// CHECK: fir.store %[[TRUE]] to %[[QUIET:.*]] : !fir.ref<i1>
+// CHECK: %[[CODE_CHAR:.*]] = fir.absent !fir.boxchar<1>
+// CHECK: fir.call @_QMprifPprif_stop(%[[QUIET]], %[[CODE_INT:.*]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
+
+// CHECK-label : func.func @_QPstop_code_quiet3
+// CHECK: %[[FALSE:.*]] = arith.constant false
+// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
+// CHECK: %[[CODE_CHAR:.*]] = fir.absent !fir.boxchar<1>
+// CHECK: fir.call @_QMprifPprif_stop(%[[QUIET]], %[[CODE_INT:.*]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
+
diff --git a/flang/test/Lower/MIF/coarray-init.f90 b/flang/test/Lower/MIF/coarray-init.f90
index e3526f6e09993..d0dd08f69d152 100644
--- a/flang/test/Lower/MIF/coarray-init.f90
+++ b/flang/test/Lower/MIF/coarray-init.f90
@@ -9,3 +9,8 @@ program test_init
! ALL: fir.call @_FortranAProgramStart
! COARRAY: mif.init -> i32
! NOCOARRAY-NOT: mif.init
+
+! COARRAY: %[[TRUE:.*]] = arith.constant true
+! COARRAY: mif.stop code %[[C0_I32:.*]] quiet %[[TRUE]] : (i32, i1)
+! NOCOARRAY-NOT: mif.stop
+! NOCOARRAY: fir.call @_FortranAProgramEndStatement
diff --git a/flang/test/Lower/MIF/error_stop.f90 b/flang/test/Lower/MIF/error_stop.f90
new file mode 100644
index 0000000000000..8159b92104d82
--- /dev/null
+++ b/flang/test/Lower/MIF/error_stop.f90
@@ -0,0 +1,58 @@
+! RUN: %flang_fc1 -emit-hlfir -fcoarray %s -o - | FileCheck %s --check-prefixes=COARRAY
+! RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s --check-prefixes=NOCOARRAY
+
+! NOCOARRAY-NOT: mif.error_stop
+
+subroutine error_stop_test()
+ ! COARRAY: mif.error_stop : ()
+ error stop
+end subroutine
+
+subroutine error_stop_code1()
+ integer int_code
+ ! COARRAY: mif.error_stop code %[[CODE:.*]] : (i32)
+ error stop int_code
+end subroutine
+
+subroutine error_stop_code2()
+ ! COARRAY: mif.error_stop code %[[CODE:.*]] : (i32)
+ error stop ((5 + 8) * 2)
+end subroutine
+
+subroutine error_stop_code_char1()
+ character(len=128) char_code
+ ! COARRAY: %[[CODE:.*]] = fir.emboxchar %[[VAL:.*]]#0, %[[C128:.*]] : (!fir.ref<!fir.char<1,128>>, index) -> !fir.boxchar<1>
+ ! COARRAY: mif.error_stop code %[[CODE]] : (!fir.boxchar<1>)
+ error stop char_code
+end subroutine
+
+subroutine error_stop_code_char2()
+ ! COARRAY: %[[CODE:.*]] = fir.emboxchar %[[VAL:.*]]#0, %[[C1:.*]] : (!fir.ref<!fir.char<1>>, index) -> !fir.boxchar<1>
+ ! COARRAY: mif.error_stop code %[[CODE]] : (!fir.boxchar<1>)
+ error stop 'c'
+end subroutine
+
+subroutine error_stop_code_char3()
+ ! COARRAY: %[[CODE:.*]] = fir.emboxchar %[[VAL:.*]]#0, %[[C14:.*]] : (!fir.ref<!fir.char<1,14>>, index) -> !fir.boxchar<1>
+ ! COARRAY: mif.error_stop code %[[CODE]] : (!fir.boxchar<1>)
+ error stop ('program failed')
+end subroutine
+
+subroutine error_stop_code_quiet1()
+ integer int_code
+ logical bool
+ ! COARRAY mif.error_stop
+ error stop int_code, quiet=bool
+end subroutine
+
+subroutine error_stop_code_quiet2()
+ integer int_code
+ ! COARRAY mif.error_stop code %[[CODE:.*]] quiet %true : (i32, i1)
+ error stop int_code, quiet=.true.
+end subroutine
+
+subroutine error_stop_code_quiet3()
+ integer int_code
+ ! COARRAY mif.error_stop code %[[CODE:.*]] quiet %false : (i32, i1)
+ error stop (int_code), quiet=.false.
+end subroutine
diff --git a/flang/test/Lower/MIF/stop.f90 b/flang/test/Lower/MIF/stop.f90
new file mode 100644
index 0000000000000..af0268d237a55
--- /dev/null
+++ b/flang/test/Lower/MIF/stop.f90
@@ -0,0 +1,58 @@
+! RUN: %flang_fc1 -emit-hlfir -fcoarray %s -o - | FileCheck %s --check-prefixes=COARRAY
+! RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s --check-prefixes=NOCOARRAY
+
+! NOCOARRAY-NOT: mif.stop
+
+subroutine stop_test()
+ ! COARRAY: mif.stop : ()
+ stop
+end subroutine
+
+subroutine stop_code1()
+ integer int_code
+ ! COARRAY: mif.stop code %[[CODE:.*]] : (i32)
+ stop int_code
+end subroutine
+
+subroutine stop_code2()
+ ! COARRAY: mif.stop code %[[CODE:.*]] : (i32)
+ stop ((5 + 8) * 2)
+end subroutine
+
+subroutine stop_code_char1()
+ character(len=128) char_code
+ ! COARRAY: %[[CODE:.*]] = fir.emboxchar %[[VAL:.*]]#0, %[[C128:.*]] : (!fir.ref<!fir.char<1,128>>, index) -> !fir.boxchar<1>
+ ! COARRAY: mif.stop code %[[CODE]] : (!fir.boxchar<1>)
+ stop char_code
+end subroutine
+
+subroutine stop_code_char2()
+ ! COARRAY: %[[CODE:.*]] = fir.emboxchar %[[VAL:.*]]#0, %[[C1:.*]] : (!fir.ref<!fir.char<1>>, index) -> !fir.boxchar<1>
+ ! COARRAY: mif.stop code %[[CODE]] : (!fir.boxchar<1>)
+ stop 'c'
+end subroutine
+
+subroutine stop_code_char3()
+ ! COARRAY: %[[CODE:.*]] = fir.emboxchar %[[VAL:.*]]#0, %[[C14:.*]] : (!fir.ref<!fir.char<1,14>>, index) -> !fir.boxchar<1>
+ ! COARRAY: mif.stop code %[[CODE]] : (!fir.boxchar<1>)
+ stop ('program failed')
+end subroutine
+
+subroutine stop_code_quiet1()
+ integer int_code
+ logical bool
+ ! COARRAY mif.stop
+ stop int_code, quiet=bool
+end subroutine
+
+subroutine stop_code_quiet2()
+ integer int_code
+ ! COARRAY mif.stop code %[[CODE:.*]] quiet %true : (i32, i1)
+ stop int_code, quiet=.true.
+end subroutine
+
+subroutine stop_code_quiet3()
+ integer int_code
+ ! COARRAY mif.stop code %[[CODE:.*]] quiet %false : (i32, i1)
+ stop (int_code), quiet=.false.
+end subroutine
>From 335b52f45cdae464dd456b1c7c0fc5700be3a2ee Mon Sep 17 00:00:00 2001
From: Jean-Didier Pailleux <jean-didier.pailleux at sipearl.com>
Date: Mon, 15 Dec 2025 14:05:49 +0100
Subject: [PATCH 02/12] Registering termination functions of PRIF runtime into
the Flang runtime
---
.../include/flang-rt/runtime/terminator.h | 4 +
flang-rt/lib/runtime/stop.cpp | 12 ++
flang-rt/lib/runtime/terminator.cpp | 18 ++-
.../Optimizer/Builder/Runtime/RTBuilder.h | 8 +
flang/include/flang/Runtime/stop.h | 4 +
.../Optimizer/Transforms/MIFOpConversion.cpp | 138 ++++++++++++++----
flang/test/Fir/MIF/init.mlir | 36 ++++-
7 files changed, 187 insertions(+), 33 deletions(-)
diff --git a/flang-rt/include/flang-rt/runtime/terminator.h b/flang-rt/include/flang-rt/runtime/terminator.h
index 047b576be4bc1..4086ec853173f 100644
--- a/flang-rt/include/flang-rt/runtime/terminator.h
+++ b/flang-rt/include/flang-rt/runtime/terminator.h
@@ -12,6 +12,7 @@
#define FLANG_RT_RUNTIME_TERMINATOR_H_
#include "flang/Common/api-attrs.h"
+#include "flang/Runtime/stop.h"
#include <cstdarg>
#include <cstdio>
#include <cstdlib>
@@ -112,6 +113,9 @@ class Terminator {
else \
Terminator{__FILE__, __LINE__}.CheckFailed(#pred)
+static void (*normalEndCallback)(void) = nullptr;
+static void (*failImageCallback)(void) = nullptr;
+static void (*errorCallback)(void) = nullptr;
RT_API_ATTRS void NotifyOtherImagesOfNormalEnd();
RT_API_ATTRS void NotifyOtherImagesOfFailImageStatement();
RT_API_ATTRS void NotifyOtherImagesOfErrorTermination();
diff --git a/flang-rt/lib/runtime/stop.cpp b/flang-rt/lib/runtime/stop.cpp
index 66b3c1d2a9b4e..6ed1c10a9a599 100644
--- a/flang-rt/lib/runtime/stop.cpp
+++ b/flang-rt/lib/runtime/stop.cpp
@@ -182,6 +182,18 @@ void RTNAME(PauseStatementText)(const char *code, std::size_t length) {
std::exit(EXIT_SUCCESS);
}
+void RTNAME(RegisterImagesNormalEndCallback)(void (*callback)(void)) {
+ Fortran::runtime::normalEndCallback = callback;
+}
+
+void RTNAME(RegisterImagesErrorCallback)(void (*callback)(void)) {
+ Fortran::runtime::errorCallback = callback;
+}
+
+void RTNAME(RegisterFailImageCallback)(void (*callback)(void)) {
+ Fortran::runtime::failImageCallback = callback;
+}
+
[[noreturn]] void RTNAME(Exit)(int status) {
CloseAllExternalUnits("CALL EXIT()");
std::exit(status);
diff --git a/flang-rt/lib/runtime/terminator.cpp b/flang-rt/lib/runtime/terminator.cpp
index 97ca824342b15..25b8961ea594c 100644
--- a/flang-rt/lib/runtime/terminator.cpp
+++ b/flang-rt/lib/runtime/terminator.cpp
@@ -93,10 +93,20 @@ RT_API_ATTRS void Terminator::CrashHeader() const {
sourceFileName_, sourceLine_);
}
-// TODO: These will be defined in the coarray runtime library
-RT_API_ATTRS void NotifyOtherImagesOfNormalEnd() {}
-RT_API_ATTRS void NotifyOtherImagesOfFailImageStatement() {}
-RT_API_ATTRS void NotifyOtherImagesOfErrorTermination() {}
+RT_API_ATTRS void NotifyOtherImagesOfNormalEnd() {
+ if (normalEndCallback)
+ (*normalEndCallback)();
+}
+
+RT_API_ATTRS void NotifyOtherImagesOfFailImageStatement() {
+ if (failImageCallback)
+ (*failImageCallback)();
+}
+
+RT_API_ATTRS void NotifyOtherImagesOfErrorTermination() {
+ if (errorCallback)
+ (*errorCallback)();
+}
RT_OFFLOAD_API_GROUP_END
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h b/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
index 960405ee0006f..2c74ab29f75e8 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
@@ -279,6 +279,14 @@ getModel<void *(*)(void *, const void *, unsigned __int64)>() {
}
#endif
template <>
+constexpr TypeBuilderFunc getModel<void (*)(void)>() {
+ return [](mlir::MLIRContext *context) -> mlir::Type {
+ return fir::LLVMPointerType::get(
+ context,
+ mlir::FunctionType::get(context, /*inputs=*/{}, /*results*/ {}));
+ };
+}
+template <>
constexpr TypeBuilderFunc getModel<void **>() {
return [](mlir::MLIRContext *context) -> mlir::Type {
return fir::ReferenceType::get(
diff --git a/flang/include/flang/Runtime/stop.h b/flang/include/flang/Runtime/stop.h
index 81c28904efcbe..2b82e7dfd6143 100644
--- a/flang/include/flang/Runtime/stop.h
+++ b/flang/include/flang/Runtime/stop.h
@@ -28,6 +28,10 @@ void RTNAME(PauseStatementText)(const char *, size_t);
NORETURN void RTNAME(FailImageStatement)(NO_ARGUMENTS);
NORETURN void RTNAME(ProgramEndStatement)(NO_ARGUMENTS);
+void RTNAME(RegisterImagesNormalEndCallback)(void (*)(void));
+void RTNAME(RegisterImagesErrorCallback)(void (*)(void));
+void RTNAME(RegisterFailImageCallback)(void (*)(void));
+
// Extensions
NORETURN void RTNAME(Exit)(int status DEFAULT_VALUE(EXIT_SUCCESS));
RT_OFFLOAD_API_GROUP_BEGIN
diff --git a/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp b/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp
index 48985e8d07b0c..e5b6f4991a7fb 100644
--- a/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp
+++ b/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp
@@ -16,6 +16,7 @@
#include "flang/Optimizer/HLFIR/HLFIROps.h"
#include "flang/Optimizer/Support/DataLayout.h"
#include "flang/Optimizer/Support/InternalNames.h"
+#include "flang/Runtime/stop.h"
#include "mlir/IR/Matchers.h"
#include "mlir/Transforms/DialectConversion.h"
#include "mlir/Transforms/GreedyPatternRewriteDriver.h"
@@ -74,32 +75,6 @@ static mlir::Value genStatPRIF(fir::FirOpBuilder &builder, mlir::Location loc,
return stat;
}
-/// Convert mif.init operation to runtime call of 'prif_init'
-struct MIFInitOpConversion : public mlir::OpRewritePattern<mif::InitOp> {
- using OpRewritePattern::OpRewritePattern;
-
- mlir::LogicalResult
- matchAndRewrite(mif::InitOp op,
- mlir::PatternRewriter &rewriter) const override {
- auto mod = op->template getParentOfType<mlir::ModuleOp>();
- fir::FirOpBuilder builder(rewriter, mod);
- mlir::Location loc = op.getLoc();
-
- mlir::Type i32Ty = builder.getI32Type();
- mlir::Value result = builder.createTemporary(loc, i32Ty);
- mlir::FunctionType ftype = mlir::FunctionType::get(
- builder.getContext(),
- /*inputs*/ {builder.getRefType(i32Ty)}, /*results*/ {});
- mlir::func::FuncOp funcOp =
- builder.createFunction(loc, getPRIFProcName("init"), ftype);
- llvm::SmallVector<mlir::Value> args =
- fir::runtime::createArguments(builder, loc, ftype, result);
- fir::CallOp::create(builder, loc, funcOp, args);
- rewriter.replaceOpWithNewOp<fir::LoadOp>(op, result);
- return mlir::success();
- }
-};
-
static fir::CallOp genPRIFStopErrorStop(fir::FirOpBuilder &builder,
mlir::Location loc, mlir::Value quiet,
mlir::Value stopCode,
@@ -159,6 +134,117 @@ static fir::CallOp genPRIFStopErrorStop(fir::FirOpBuilder &builder,
return fir::CallOp::create(builder, loc, funcOp, args);
}
+enum class TerminationKind { Normal = 0, Error = 1, FailImage = 2 };
+// Generates a wrapper function for the different kind of termination in PRIF.
+// This function will be used to register wrappers on PRIF runtime termination
+// functions into the Fortran runtime.
+mlir::Value genTerminationOperationWrapper(fir::FirOpBuilder &builder,
+ mlir::Location loc,
+ mlir::ModuleOp module,
+ TerminationKind termKind) {
+ mlir::FunctionType funcType = mlir::FunctionType::get(
+ builder.getContext(), /*inputs*/ {}, /*result*/ {});
+ std::string funcName;
+ if (termKind == TerminationKind::Normal)
+ funcName = getPRIFProcName("stop");
+ else if (termKind == TerminationKind::Error)
+ funcName = getPRIFProcName("error_stop");
+ else
+ funcName = getPRIFProcName("fail_image");
+ funcName += "_termination_wrapper";
+ mlir::func::FuncOp funcWrapperOp =
+ module.lookupSymbol<mlir::func::FuncOp>(funcName);
+
+ if (!funcWrapperOp) {
+ funcWrapperOp = builder.createFunction(loc, funcName, funcType);
+
+ // generating the body of the function.
+ mlir::OpBuilder::InsertPoint saveInsertPoint = builder.saveInsertionPoint();
+ builder.setInsertionPointToStart(funcWrapperOp.addEntryBlock());
+
+ mlir::Type i32Ty = builder.getI32Type();
+ if (termKind == TerminationKind::Normal) {
+ mlir::Value quiet = builder.createBool(loc, true);
+ genPRIFStopErrorStop(builder, loc, quiet, mlir::Value{},
+ /*isError*/ false);
+ } else if (termKind == TerminationKind::Error) {
+ mlir::Value one = builder.createIntegerConstant(loc, i32Ty, 1);
+ genPRIFStopErrorStop(builder, loc, mlir::Value{}, one, /*isError*/ true);
+ } else {
+ mlir::func::FuncOp fOp = builder.createFunction(
+ loc, getPRIFProcName("fail_image"),
+ mlir::FunctionType::get(builder.getContext(), {}, {}));
+ fir::CallOp::create(builder, loc, fOp);
+ }
+
+ mlir::func::ReturnOp::create(builder, loc);
+ builder.restoreInsertionPoint(saveInsertPoint);
+ }
+
+ mlir::SymbolRefAttr symbolRef = mlir::SymbolRefAttr::get(
+ builder.getContext(), funcWrapperOp.getSymNameAttr());
+ return fir::AddrOfOp::create(builder, loc, funcType, symbolRef);
+}
+
+/// Convert mif.init operation to runtime call of 'prif_init'
+struct MIFInitOpConversion : public mlir::OpRewritePattern<mif::InitOp> {
+ using OpRewritePattern::OpRewritePattern;
+
+ mlir::LogicalResult
+ matchAndRewrite(mif::InitOp op,
+ mlir::PatternRewriter &rewriter) const override {
+ auto mod = op->template getParentOfType<mlir::ModuleOp>();
+ fir::FirOpBuilder builder(rewriter, mod);
+ mlir::Location loc = op.getLoc();
+
+ mlir::Type i32Ty = builder.getI32Type();
+ mlir::Value result = builder.createTemporary(loc, i32Ty);
+
+ // Registering PRIF runtime termination to the Fortran runtime
+ // STOP
+ mlir::Value funcStopOp = genTerminationOperationWrapper(
+ builder, loc, mod, TerminationKind::Normal);
+ mlir::func::FuncOp normalEndFunc =
+ fir::runtime::getRuntimeFunc<mkRTKey(RegisterImagesNormalEndCallback)>(
+ loc, builder);
+ llvm::SmallVector<mlir::Value> args1 = fir::runtime::createArguments(
+ builder, loc, normalEndFunc.getFunctionType(), funcStopOp);
+ fir::CallOp::create(builder, loc, normalEndFunc, args1);
+
+ // ERROR STOP
+ mlir::Value funcErrorStopOp = genTerminationOperationWrapper(
+ builder, loc, mod, TerminationKind::Error);
+ mlir::func::FuncOp errorFunc =
+ fir::runtime::getRuntimeFunc<mkRTKey(RegisterImagesErrorCallback)>(
+ loc, builder);
+ llvm::SmallVector<mlir::Value> args2 = fir::runtime::createArguments(
+ builder, loc, errorFunc.getFunctionType(), funcErrorStopOp);
+ fir::CallOp::create(builder, loc, errorFunc, args2);
+
+ // FAIL IMAGE
+ mlir::Value failImageOp = genTerminationOperationWrapper(
+ builder, loc, mod, TerminationKind::FailImage);
+ mlir::func::FuncOp failImageFunc =
+ fir::runtime::getRuntimeFunc<mkRTKey(RegisterFailImageCallback)>(
+ loc, builder);
+ llvm::SmallVector<mlir::Value> args3 = fir::runtime::createArguments(
+ builder, loc, errorFunc.getFunctionType(), failImageOp);
+ fir::CallOp::create(builder, loc, failImageFunc, args3);
+
+ // Intialize the multi-image parallel environment
+ mlir::FunctionType ftype = mlir::FunctionType::get(
+ builder.getContext(),
+ /*inputs*/ {builder.getRefType(i32Ty)}, /*results*/ {});
+ mlir::func::FuncOp funcOp =
+ builder.createFunction(loc, getPRIFProcName("init"), ftype);
+ llvm::SmallVector<mlir::Value> args =
+ fir::runtime::createArguments(builder, loc, ftype, result);
+ fir::CallOp::create(builder, loc, funcOp, args);
+ rewriter.replaceOpWithNewOp<fir::LoadOp>(op, result);
+ return mlir::success();
+ }
+};
+
/// Convert mif.stop operation to runtime call of 'prif_stop'
struct MIFStopOpConversion : public mlir::OpRewritePattern<mif::StopOp> {
using OpRewritePattern::OpRewritePattern;
diff --git a/flang/test/Fir/MIF/init.mlir b/flang/test/Fir/MIF/init.mlir
index 0f1177f92427e..6dc801af9da79 100644
--- a/flang/test/Fir/MIF/init.mlir
+++ b/flang/test/Fir/MIF/init.mlir
@@ -18,7 +18,37 @@ module attributes {dlti.dl_spec = #dlti.dl_spec<!llvm.ptr<270> = dense<32> : vec
}
}
-
// CHECK-LABEL: func.func @main
-// CHECK: %[[VAL_0:.*]] = fir.alloca i32
-// CHECK: fir.call @_QMprifPprif_init(%[[VAL_0]]) : (!fir.ref<i32>) -> ()
+// CHECK: %[[VAL_0:.*]] = fir.alloca i32
+// CHECK: %[[VAL_1:.*]] = fir.address_of(@_QMprifPprif_stop_termination_wrapper) : () -> ()
+// CHECK: fir.call @_FortranARegisterImagesNormalEndCallback({{.*}}) : (!fir.llvm_ptr<() -> ()>) -> ()
+// CHECK: %[[VAL_2:.*]] = fir.address_of(@_QMprifPprif_error_stop_termination_wrapper) : () -> ()
+// CHECK: fir.call @_FortranARegisterImagesErrorCallback({{.*}}) : (!fir.llvm_ptr<() -> ()>) -> ()
+// CHECK: %[[VAL_3:.*]] = fir.address_of(@_QMprifPprif_fail_image_termination_wrapper) : () -> ()
+// CHECK: fir.call @_FortranARegisterFailImageCallback({{.*}}) : (!fir.llvm_ptr<() -> ()>) -> ()
+// CHECK: fir.call @_QMprifPprif_init(%[[VAL_0]]) : (!fir.ref<i32>) -> ()
+
+// CHECK-LABEL: func.func private @_QMprifPprif_stop_termination_wrapper
+// CHECK: %[[VAL_0:.*]] = fir.alloca i1
+// CHECK: %[[TRUE:.*]] = arith.constant true
+// CHECK: fir.store %[[TRUE]] to %[[VAL_0]] : !fir.ref<i1>
+// CHECK: %[[VAL_1:.*]] = fir.absent !fir.boxchar<1>
+// CHECK: %[[VAL_2:.*]] = fir.absent !fir.ref<i32>
+// CHECK: fir.call @_QMprifPprif_stop(%[[VAL_0]], %[[VAL_2]], %[[VAL_1]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
+// CHECK: return
+
+// CHECK-LABEL: func.func private @_QMprifPprif_error_stop_termination_wrapper
+// CHECK: %[[VAL_0:.*]] = fir.alloca i32
+// CHECK: %[[VAL_1:.*]] = fir.alloca i1
+// CHECK: %[[C1_I32:.*]] = arith.constant 1 : i32
+// CHECK: %[[FALSE:.*]] = arith.constant false
+// CHECK: fir.store %[[FALSE]] to %[[VAL_1]] : !fir.ref<i1>
+// CHECK: %[[VAL_2:.*]] = fir.absent !fir.boxchar<1>
+// CHECK: fir.store %[[C1_I32]] to %[[VAL_0]] : !fir.ref<i32>
+// CHECK: fir.call @_QMprifPprif_error_stop(%[[VAL_1]], %[[VAL_0]], %[[VAL_2]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
+// CHECK: return
+
+// CHECK-LABEL: func.func private @_QMprifPprif_fail_image_termination_wrapper
+// CHECK: fir.call @_QMprifPprif_fail_image() : () -> ()
+// CHECK: return
+
>From 7a6818808f0cdc70ac080f4ba183c19473ea597b Mon Sep 17 00:00:00 2001
From: Jean-Didier Pailleux <jean-didier.pailleux at sipearl.com>
Date: Tue, 6 Jan 2026 07:58:09 +0100
Subject: [PATCH 03/12] Add a structure to manage Exits (ExitHandler) and
update the Flang terminaison API
- Configure of the exitHandle base on -fcoarray
- If this option is present, then we use the Flang terminaison API that
wraps calls to PRIF (prif_stop, prif_error_stop)
- Otherwise, we use the classic std::exit
---
.../include/flang-rt/runtime/terminator.h | 20 +++++--
flang-rt/lib/runtime/main.cpp | 5 +-
flang-rt/lib/runtime/stop.cpp | 18 +++---
flang-rt/lib/runtime/terminator.cpp | 31 ++++++++--
flang/include/flang/Runtime/main.h | 4 +-
flang/include/flang/Runtime/stop.h | 4 +-
flang/lib/Lower/Runtime.cpp | 16 +----
flang/lib/Optimizer/Builder/Runtime/Main.cpp | 13 +++--
.../Optimizer/Transforms/MIFOpConversion.cpp | 21 ++++---
flang/test/Driver/emit-mlir.f90 | 5 +-
flang/test/Fir/MIF/init.mlir | 26 ++++-----
flang/test/Lower/MIF/coarray-init.f90 | 12 ++--
flang/test/Lower/MIF/error_stop.f90 | 58 -------------------
flang/test/Lower/MIF/stop.f90 | 58 -------------------
flang/test/Lower/convert.f90 | 3 +-
flang/test/Lower/environment-defaults.f90 | 3 +-
16 files changed, 105 insertions(+), 192 deletions(-)
delete mode 100644 flang/test/Lower/MIF/error_stop.f90
delete mode 100644 flang/test/Lower/MIF/stop.f90
diff --git a/flang-rt/include/flang-rt/runtime/terminator.h b/flang-rt/include/flang-rt/runtime/terminator.h
index 4086ec853173f..0a86e3b671901 100644
--- a/flang-rt/include/flang-rt/runtime/terminator.h
+++ b/flang-rt/include/flang-rt/runtime/terminator.h
@@ -113,12 +113,22 @@ class Terminator {
else \
Terminator{__FILE__, __LINE__}.CheckFailed(#pred)
-static void (*normalEndCallback)(void) = nullptr;
-static void (*failImageCallback)(void) = nullptr;
-static void (*errorCallback)(void) = nullptr;
-RT_API_ATTRS void NotifyOtherImagesOfNormalEnd();
+struct ExitHandler {
+ ExitHandler() {};
+
+ void Configure(bool multiImageFeatureEnabled);
+ void Exit(int exitCode);
+
+ bool multiImageFeatureEnabled{false};
+};
+extern RT_VAR_ATTRS ExitHandler exitHandler;
+
+extern RT_VAR_ATTRS void (*normalEndCallback)(int);
+extern RT_VAR_ATTRS void (*failImageCallback)(void);
+extern RT_VAR_ATTRS void (*errorCallback)(int);
+RT_API_ATTRS void SynchronizeImagesOfNormalEnd(int);
RT_API_ATTRS void NotifyOtherImagesOfFailImageStatement();
-RT_API_ATTRS void NotifyOtherImagesOfErrorTermination();
+RT_API_ATTRS void NotifyOtherImagesOfErrorTermination(int);
#if defined(RT_DEVICE_COMPILATION)
/// Trap the execution on the device.
diff --git a/flang-rt/lib/runtime/main.cpp b/flang-rt/lib/runtime/main.cpp
index b3f066cda3732..96e59ab238744 100644
--- a/flang-rt/lib/runtime/main.cpp
+++ b/flang-rt/lib/runtime/main.cpp
@@ -28,8 +28,9 @@ static void ConfigureFloatingPoint() {
extern "C" {
void RTNAME(ProgramStart)(int argc, const char *argv[], const char *envp[],
- const EnvironmentDefaultList *envDefaults) {
- std::atexit(Fortran::runtime::NotifyOtherImagesOfNormalEnd);
+ const EnvironmentDefaultList *envDefaults,
+ const bool multiImageInitialized) {
+ Fortran::runtime::exitHandler.Configure(multiImageInitialized);
Fortran::runtime::executionEnvironment.Configure(
argc, argv, envp, envDefaults);
ConfigureFloatingPoint();
diff --git a/flang-rt/lib/runtime/stop.cpp b/flang-rt/lib/runtime/stop.cpp
index 6ed1c10a9a599..f9a3a8bb99236 100644
--- a/flang-rt/lib/runtime/stop.cpp
+++ b/flang-rt/lib/runtime/stop.cpp
@@ -96,7 +96,7 @@ static void CloseAllExternalUnits(const char *why) {
std::fputc('\n', stderr);
DescribeIEEESignaledExceptions();
}
- std::exit(code);
+ Fortran::runtime::exitHandler.Exit(code);
#endif
}
@@ -124,9 +124,9 @@ static void CloseAllExternalUnits(const char *why) {
DescribeIEEESignaledExceptions();
}
if (isErrorStop) {
- std::exit(EXIT_FAILURE);
+ Fortran::runtime::exitHandler.Exit(EXIT_FAILURE);
} else {
- std::exit(EXIT_SUCCESS);
+ Fortran::runtime::exitHandler.Exit(EXIT_SUCCESS);
}
#endif
}
@@ -144,7 +144,7 @@ static void EndPause() {
std::fflush(nullptr);
if (std::fgetc(stdin) == EOF) {
CloseAllExternalUnits("PAUSE statement");
- std::exit(EXIT_SUCCESS);
+ Fortran::runtime::exitHandler.Exit(EXIT_SUCCESS);
}
}
@@ -174,19 +174,19 @@ void RTNAME(PauseStatementText)(const char *code, std::size_t length) {
[[noreturn]] void RTNAME(FailImageStatement)() {
Fortran::runtime::NotifyOtherImagesOfFailImageStatement();
CloseAllExternalUnits("FAIL IMAGE statement");
- std::exit(EXIT_FAILURE);
+ Fortran::runtime::exitHandler.Exit(EXIT_FAILURE);
}
[[noreturn]] void RTNAME(ProgramEndStatement)() {
CloseAllExternalUnits("END statement");
- std::exit(EXIT_SUCCESS);
+ Fortran::runtime::exitHandler.Exit(EXIT_SUCCESS);
}
-void RTNAME(RegisterImagesNormalEndCallback)(void (*callback)(void)) {
+void RTNAME(RegisterImagesNormalEndCallback)(void (*callback)(int)) {
Fortran::runtime::normalEndCallback = callback;
}
-void RTNAME(RegisterImagesErrorCallback)(void (*callback)(void)) {
+void RTNAME(RegisterImagesErrorCallback)(void (*callback)(int)) {
Fortran::runtime::errorCallback = callback;
}
@@ -196,7 +196,7 @@ void RTNAME(RegisterFailImageCallback)(void (*callback)(void)) {
[[noreturn]] void RTNAME(Exit)(int status) {
CloseAllExternalUnits("CALL EXIT()");
- std::exit(status);
+ Fortran::runtime::exitHandler.Exit(status);
}
static RT_NOINLINE_ATTR void PrintBacktrace() {
diff --git a/flang-rt/lib/runtime/terminator.cpp b/flang-rt/lib/runtime/terminator.cpp
index 25b8961ea594c..5525e428e84f8 100644
--- a/flang-rt/lib/runtime/terminator.cpp
+++ b/flang-rt/lib/runtime/terminator.cpp
@@ -41,6 +41,13 @@ void Terminator::InvokeCrashHandler(const char *message, ...) const {
RT_OFFLOAD_API_GROUP_BEGIN
+#ifndef FLANG_RUNTIME_NO_GLOBAL_VAR_DEFS
+RT_VAR_ATTRS ExitHandler exitHandler;
+RT_VAR_ATTRS void (*normalEndCallback)(int);
+RT_VAR_ATTRS void (*failImageCallback)(void);
+RT_VAR_ATTRS void (*errorCallback)(int);
+#endif // FLANG_RUNTIME_NO_GLOBAL_VAR_DEFS
+
RT_API_ATTRS void Terminator::CrashHeader() const {
#if defined(RT_DEVICE_COMPILATION)
std::printf("\nfatal Fortran runtime error");
@@ -73,7 +80,7 @@ RT_API_ATTRS void Terminator::CrashHeader() const {
// FIXME: re-enable the flush along with the IO enabling.
io::FlushOutputOnCrash(*this);
#endif
- NotifyOtherImagesOfErrorTermination();
+ NotifyOtherImagesOfErrorTermination(EXIT_FAILURE);
#if defined(RT_DEVICE_COMPILATION)
DeviceTrap();
#else
@@ -93,9 +100,23 @@ RT_API_ATTRS void Terminator::CrashHeader() const {
sourceFileName_, sourceLine_);
}
-RT_API_ATTRS void NotifyOtherImagesOfNormalEnd() {
+void ExitHandler::Configure(bool mifEnabled) {
+ multiImageFeatureEnabled = mifEnabled;
+}
+
+void ExitHandler::Exit(int exitCode) {
+ if (multiImageFeatureEnabled)
+ if (exitCode == EXIT_SUCCESS)
+ SynchronizeImagesOfNormalEnd(exitCode);
+ else
+ NotifyOtherImagesOfErrorTermination(exitCode);
+ else
+ std::exit(exitCode);
+}
+
+RT_API_ATTRS void SynchronizeImagesOfNormalEnd(int code) {
if (normalEndCallback)
- (*normalEndCallback)();
+ (*normalEndCallback)(code);
}
RT_API_ATTRS void NotifyOtherImagesOfFailImageStatement() {
@@ -103,9 +124,9 @@ RT_API_ATTRS void NotifyOtherImagesOfFailImageStatement() {
(*failImageCallback)();
}
-RT_API_ATTRS void NotifyOtherImagesOfErrorTermination() {
+RT_API_ATTRS void NotifyOtherImagesOfErrorTermination(int code) {
if (errorCallback)
- (*errorCallback)();
+ (*errorCallback)(code);
}
RT_OFFLOAD_API_GROUP_END
diff --git a/flang/include/flang/Runtime/main.h b/flang/include/flang/Runtime/main.h
index 88232ea64fa6a..5da3d9b903cb8 100644
--- a/flang/include/flang/Runtime/main.h
+++ b/flang/include/flang/Runtime/main.h
@@ -15,8 +15,8 @@
struct EnvironmentDefaultList;
FORTRAN_EXTERN_C_BEGIN
-void RTNAME(ProgramStart)(
- int, const char *[], const char *[], const struct EnvironmentDefaultList *);
+void RTNAME(ProgramStart)(int, const char *[], const char *[],
+ const struct EnvironmentDefaultList *, const bool multiImageInitialized);
void RTNAME(ByteswapOption)(void); // -byteswapio
FORTRAN_EXTERN_C_END
diff --git a/flang/include/flang/Runtime/stop.h b/flang/include/flang/Runtime/stop.h
index 2b82e7dfd6143..710d75494c875 100644
--- a/flang/include/flang/Runtime/stop.h
+++ b/flang/include/flang/Runtime/stop.h
@@ -28,8 +28,8 @@ void RTNAME(PauseStatementText)(const char *, size_t);
NORETURN void RTNAME(FailImageStatement)(NO_ARGUMENTS);
NORETURN void RTNAME(ProgramEndStatement)(NO_ARGUMENTS);
-void RTNAME(RegisterImagesNormalEndCallback)(void (*)(void));
-void RTNAME(RegisterImagesErrorCallback)(void (*)(void));
+void RTNAME(RegisterImagesNormalEndCallback)(void (*)(int));
+void RTNAME(RegisterImagesErrorCallback)(void (*)(int));
void RTNAME(RegisterFailImageCallback)(void (*)(void));
// Extensions
diff --git a/flang/lib/Lower/Runtime.cpp b/flang/lib/Lower/Runtime.cpp
index 3c515c3a2580a..27e907e255332 100644
--- a/flang/lib/Lower/Runtime.cpp
+++ b/flang/lib/Lower/Runtime.cpp
@@ -68,7 +68,6 @@ void Fortran::lower::genStopStatement(
llvm::SmallVector<mlir::Value> operands;
mlir::func::FuncOp callee;
mlir::FunctionType calleeType;
- mlir::Value stopCode;
// First operand is stop code (zero if absent)
if (const auto &code =
std::get<std::optional<Fortran::parser::StopCode>>(stmt.t)) {
@@ -86,12 +85,8 @@ void Fortran::lower::genStopStatement(
builder.createConvert(loc, calleeType.getInput(0), x.getAddr()));
operands.push_back(
builder.createConvert(loc, calleeType.getInput(1), x.getLen()));
- if (coarrayIsEnabled)
- stopCode =
- fir::factory::CharacterExprHelper{builder, loc}.createEmbox(x);
},
[&](fir::UnboxedValue x) {
- stopCode = x;
callee = fir::runtime::getRuntimeFunc<mkRTKey(StopStatement)>(
loc, builder);
calleeType = callee.getFunctionType();
@@ -115,12 +110,11 @@ void Fortran::lower::genStopStatement(
loc, calleeType.getInput(operands.size()), isError));
// Third operand indicates QUIET (default to false).
- mlir::Value q;
if (const auto &quiet =
std::get<std::optional<Fortran::parser::ScalarLogicalExpr>>(stmt.t)) {
const SomeExpr *expr = Fortran::semantics::GetExpr(*quiet);
assert(expr && "failed getting typed expression");
- q = fir::getBase(converter.genExprValue(*expr, stmtCtx));
+ mlir::Value q = fir::getBase(converter.genExprValue(*expr, stmtCtx));
operands.push_back(
builder.createConvert(loc, calleeType.getInput(operands.size()), q));
} else {
@@ -128,13 +122,7 @@ void Fortran::lower::genStopStatement(
loc, calleeType.getInput(operands.size()), 0));
}
- if (coarrayIsEnabled) {
- if (isError)
- mif::ErrorStopOp::create(builder, loc, stopCode, q);
- else
- mif::StopOp::create(builder, loc, stopCode, q);
- } else
- fir::CallOp::create(builder, loc, callee, operands);
+ fir::CallOp::create(builder, loc, callee, operands);
auto blockIsUnterminated = [&builder]() {
mlir::Block *currentBlock = builder.getBlock();
diff --git a/flang/lib/Optimizer/Builder/Runtime/Main.cpp b/flang/lib/Optimizer/Builder/Runtime/Main.cpp
index 099d985a1e07f..be79afbcc5467 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Main.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Main.cpp
@@ -29,12 +29,14 @@ void fir::runtime::genMain(
auto *context = builder.getContext();
auto argcTy = builder.getDefaultIntegerType();
auto ptrTy = mlir::LLVM::LLVMPointerType::get(context);
+ auto logTy = builder.getIntegerType(1);
// void ProgramStart(int argc, char** argv, char** envp,
// _QQEnvironmentDefaults* env)
auto startFn = builder.createFunction(
loc, RTNAME_STRING(ProgramStart),
- mlir::FunctionType::get(context, {argcTy, ptrTy, ptrTy, ptrTy}, {}));
+ mlir::FunctionType::get(context, {argcTy, ptrTy, ptrTy, ptrTy, logTy},
+ {}));
// void ProgramStop()
auto stopFn =
builder.createFunction(loc, RTNAME_STRING(ProgramEndStatement),
@@ -59,9 +61,12 @@ void fir::runtime::genMain(
// it only happens once and to provide consistent results if multiple files
// are compiled separately.
auto env = fir::runtime::genEnvironmentDefaults(builder, loc, defs);
+ mlir::Value multiImageFeatureEnabled =
+ builder.createBool(loc, initCoarrayEnv);
llvm::SmallVector<mlir::Value, 4> args(block->getArguments());
args.push_back(env);
+ args.push_back(multiImageFeatureEnabled);
fir::CallOp::create(builder, loc, startFn, args);
@@ -76,11 +81,7 @@ void fir::runtime::genMain(
fir::CallOp::create(builder, loc, qqMainFn);
mlir::Value ret = builder.createIntegerConstant(loc, argcTy, 0);
- if (initCoarrayEnv) {
- mlir::Value quiet = builder.createBool(loc, true);
- mif::StopOp::create(builder, loc, ret, quiet);
- } else
- fir::CallOp::create(builder, loc, stopFn);
+ fir::CallOp::create(builder, loc, stopFn);
mlir::func::ReturnOp::create(builder, loc, ret);
}
diff --git a/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp b/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp
index e5b6f4991a7fb..8b6c3c930179d 100644
--- a/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp
+++ b/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp
@@ -142,15 +142,19 @@ mlir::Value genTerminationOperationWrapper(fir::FirOpBuilder &builder,
mlir::Location loc,
mlir::ModuleOp module,
TerminationKind termKind) {
- mlir::FunctionType funcType = mlir::FunctionType::get(
- builder.getContext(), /*inputs*/ {}, /*result*/ {});
std::string funcName;
- if (termKind == TerminationKind::Normal)
+ mlir::FunctionType funcType =
+ mlir::FunctionType::get(builder.getContext(), {}, {});
+ mlir::Type i32Ty = builder.getI32Type();
+ if (termKind == TerminationKind::Normal) {
funcName = getPRIFProcName("stop");
- else if (termKind == TerminationKind::Error)
+ funcType = mlir::FunctionType::get(builder.getContext(), {i32Ty}, {});
+ } else if (termKind == TerminationKind::Error) {
funcName = getPRIFProcName("error_stop");
- else
+ funcType = mlir::FunctionType::get(builder.getContext(), {i32Ty}, {});
+ } else {
funcName = getPRIFProcName("fail_image");
+ }
funcName += "_termination_wrapper";
mlir::func::FuncOp funcWrapperOp =
module.lookupSymbol<mlir::func::FuncOp>(funcName);
@@ -165,11 +169,12 @@ mlir::Value genTerminationOperationWrapper(fir::FirOpBuilder &builder,
mlir::Type i32Ty = builder.getI32Type();
if (termKind == TerminationKind::Normal) {
mlir::Value quiet = builder.createBool(loc, true);
- genPRIFStopErrorStop(builder, loc, quiet, mlir::Value{},
+ genPRIFStopErrorStop(builder, loc, quiet, funcWrapperOp.getArgument(0),
/*isError*/ false);
} else if (termKind == TerminationKind::Error) {
- mlir::Value one = builder.createIntegerConstant(loc, i32Ty, 1);
- genPRIFStopErrorStop(builder, loc, mlir::Value{}, one, /*isError*/ true);
+ mlir::Value quiet = builder.createBool(loc, true);
+ genPRIFStopErrorStop(builder, loc, quiet, funcWrapperOp.getArgument(0),
+ /*isError*/ true);
} else {
mlir::func::FuncOp fOp = builder.createFunction(
loc, getPRIFProcName("fail_image"),
diff --git a/flang/test/Driver/emit-mlir.f90 b/flang/test/Driver/emit-mlir.f90
index f2a4b6cf7670b..6b6a1df32fe02 100644
--- a/flang/test/Driver/emit-mlir.f90
+++ b/flang/test/Driver/emit-mlir.f90
@@ -16,12 +16,13 @@
! CHECK-NEXT: fir.dummy_scope
! CHECK-NEXT: return
! CHECK-NEXT: }
-! CHECK-NEXT: func.func private @_FortranAProgramStart(i32, !llvm.ptr, !llvm.ptr, !llvm.ptr)
+! CHECK-NEXT: func.func private @_FortranAProgramStart(i32, !llvm.ptr, !llvm.ptr, !llvm.ptr, i1)
! CHECK-NEXT: func.func private @_FortranAProgramEndStatement()
! CHECK-NEXT: func.func @main(%arg0: i32, %arg1: !llvm.ptr, %arg2: !llvm.ptr) -> i32 {
! CHECK-NEXT: %c0_i32 = arith.constant 0 : i32
+! CHECK-NEXT: %false = arith.constant false
! CHECK-NEXT: %0 = fir.zero_bits !fir.ref<tuple<i32, !fir.ref<!fir.array<0xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>>
-! CHECK-NEXT: fir.call @_FortranAProgramStart(%arg0, %arg1, %arg2, %0) {{.*}} : (i32, !llvm.ptr, !llvm.ptr, !fir.ref<tuple<i32, !fir.ref<!fir.array<0xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>>)
+! CHECK-NEXT: fir.call @_FortranAProgramStart(%arg0, %arg1, %arg2, %0, %false) {{.*}} : (i32, !llvm.ptr, !llvm.ptr, !fir.ref<tuple<i32, !fir.ref<!fir.array<0xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>>, i1)
! CHECK-NEXT: fir.call @_QQmain() fastmath<contract> : () -> ()
! CHECK-NEXT: fir.call @_FortranAProgramEndStatement() {{.*}} : () -> ()
! CHECK-NEXT: return %c0_i32 : i32
diff --git a/flang/test/Fir/MIF/init.mlir b/flang/test/Fir/MIF/init.mlir
index 6dc801af9da79..355e5d651666d 100644
--- a/flang/test/Fir/MIF/init.mlir
+++ b/flang/test/Fir/MIF/init.mlir
@@ -20,31 +20,31 @@ module attributes {dlti.dl_spec = #dlti.dl_spec<!llvm.ptr<270> = dense<32> : vec
// CHECK-LABEL: func.func @main
// CHECK: %[[VAL_0:.*]] = fir.alloca i32
-// CHECK: %[[VAL_1:.*]] = fir.address_of(@_QMprifPprif_stop_termination_wrapper) : () -> ()
+// CHECK: %[[VAL_1:.*]] = fir.address_of(@_QMprifPprif_stop_termination_wrapper) : (i32) -> ()
// CHECK: fir.call @_FortranARegisterImagesNormalEndCallback({{.*}}) : (!fir.llvm_ptr<() -> ()>) -> ()
-// CHECK: %[[VAL_2:.*]] = fir.address_of(@_QMprifPprif_error_stop_termination_wrapper) : () -> ()
+// CHECK: %[[VAL_2:.*]] = fir.address_of(@_QMprifPprif_error_stop_termination_wrapper) : (i32) -> ()
// CHECK: fir.call @_FortranARegisterImagesErrorCallback({{.*}}) : (!fir.llvm_ptr<() -> ()>) -> ()
// CHECK: %[[VAL_3:.*]] = fir.address_of(@_QMprifPprif_fail_image_termination_wrapper) : () -> ()
// CHECK: fir.call @_FortranARegisterFailImageCallback({{.*}}) : (!fir.llvm_ptr<() -> ()>) -> ()
// CHECK: fir.call @_QMprifPprif_init(%[[VAL_0]]) : (!fir.ref<i32>) -> ()
-// CHECK-LABEL: func.func private @_QMprifPprif_stop_termination_wrapper
-// CHECK: %[[VAL_0:.*]] = fir.alloca i1
+// CHECK: func.func private @_QMprifPprif_stop_termination_wrapper(%[[ARG0:.*]]: i32)
+// CHECK: %[[VAL_0:.*]] = fir.alloca i32
+// CHECK: %[[VAL_1:.*]] = fir.alloca i1
// CHECK: %[[TRUE:.*]] = arith.constant true
-// CHECK: fir.store %[[TRUE]] to %[[VAL_0]] : !fir.ref<i1>
-// CHECK: %[[VAL_1:.*]] = fir.absent !fir.boxchar<1>
-// CHECK: %[[VAL_2:.*]] = fir.absent !fir.ref<i32>
-// CHECK: fir.call @_QMprifPprif_stop(%[[VAL_0]], %[[VAL_2]], %[[VAL_1]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
+// CHECK: fir.store %[[TRUE]] to %[[VAL_1]] : !fir.ref<i1>
+// CHECK: %[[VAL_2:.*]] = fir.absent !fir.boxchar<1>
+// CHECK: fir.store %[[ARG0]] to %[[VAL_0]] : !fir.ref<i32>
+// CHECK: fir.call @_QMprifPprif_stop(%[[VAL_1]], %[[VAL_0]], %[[VAL_2]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
// CHECK: return
-// CHECK-LABEL: func.func private @_QMprifPprif_error_stop_termination_wrapper
+// CHECK: func.func private @_QMprifPprif_error_stop_termination_wrapper(%[[ARG0:.*]]: i32)
// CHECK: %[[VAL_0:.*]] = fir.alloca i32
// CHECK: %[[VAL_1:.*]] = fir.alloca i1
-// CHECK: %[[C1_I32:.*]] = arith.constant 1 : i32
-// CHECK: %[[FALSE:.*]] = arith.constant false
-// CHECK: fir.store %[[FALSE]] to %[[VAL_1]] : !fir.ref<i1>
+// CHECK: %[[TRUE:.*]] = arith.constant true
+// CHECK: fir.store %[[TRUE]] to %[[VAL_1]] : !fir.ref<i1>
// CHECK: %[[VAL_2:.*]] = fir.absent !fir.boxchar<1>
-// CHECK: fir.store %[[C1_I32]] to %[[VAL_0]] : !fir.ref<i32>
+// CHECK: fir.store %[[ARG0]] to %[[VAL_0]] : !fir.ref<i32>
// CHECK: fir.call @_QMprifPprif_error_stop(%[[VAL_1]], %[[VAL_0]], %[[VAL_2]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
// CHECK: return
diff --git a/flang/test/Lower/MIF/coarray-init.f90 b/flang/test/Lower/MIF/coarray-init.f90
index d0dd08f69d152..09d58636872ea 100644
--- a/flang/test/Lower/MIF/coarray-init.f90
+++ b/flang/test/Lower/MIF/coarray-init.f90
@@ -6,11 +6,11 @@ program test_init
end
! ALL-LABEL: func.func @main
-! ALL: fir.call @_FortranAProgramStart
+! COARRAY: %true = arith.constant true
+! COARRAY: fir.call @_FortranAProgramStart(%arg0, %arg1, %arg2, %0, %true) {{.*}} : (i32, !llvm.ptr, !llvm.ptr, !fir.ref<tuple<i32, !fir.ref<!fir.array<0xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>>, i1) -> ()
+
+! NOCOARRAY: %false = arith.constant false
+! NOCARRAY: fir.call @_FortranAProgramStart(%arg0, %arg1, %arg2, %0, %false) {{.*}} : (i32, !llvm.ptr, !llvm.ptr, !fir.ref<tuple<i32, !fir.ref<!fir.array<0xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>>, i1) -> ()
+
! COARRAY: mif.init -> i32
! NOCOARRAY-NOT: mif.init
-
-! COARRAY: %[[TRUE:.*]] = arith.constant true
-! COARRAY: mif.stop code %[[C0_I32:.*]] quiet %[[TRUE]] : (i32, i1)
-! NOCOARRAY-NOT: mif.stop
-! NOCOARRAY: fir.call @_FortranAProgramEndStatement
diff --git a/flang/test/Lower/MIF/error_stop.f90 b/flang/test/Lower/MIF/error_stop.f90
deleted file mode 100644
index 8159b92104d82..0000000000000
--- a/flang/test/Lower/MIF/error_stop.f90
+++ /dev/null
@@ -1,58 +0,0 @@
-! RUN: %flang_fc1 -emit-hlfir -fcoarray %s -o - | FileCheck %s --check-prefixes=COARRAY
-! RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s --check-prefixes=NOCOARRAY
-
-! NOCOARRAY-NOT: mif.error_stop
-
-subroutine error_stop_test()
- ! COARRAY: mif.error_stop : ()
- error stop
-end subroutine
-
-subroutine error_stop_code1()
- integer int_code
- ! COARRAY: mif.error_stop code %[[CODE:.*]] : (i32)
- error stop int_code
-end subroutine
-
-subroutine error_stop_code2()
- ! COARRAY: mif.error_stop code %[[CODE:.*]] : (i32)
- error stop ((5 + 8) * 2)
-end subroutine
-
-subroutine error_stop_code_char1()
- character(len=128) char_code
- ! COARRAY: %[[CODE:.*]] = fir.emboxchar %[[VAL:.*]]#0, %[[C128:.*]] : (!fir.ref<!fir.char<1,128>>, index) -> !fir.boxchar<1>
- ! COARRAY: mif.error_stop code %[[CODE]] : (!fir.boxchar<1>)
- error stop char_code
-end subroutine
-
-subroutine error_stop_code_char2()
- ! COARRAY: %[[CODE:.*]] = fir.emboxchar %[[VAL:.*]]#0, %[[C1:.*]] : (!fir.ref<!fir.char<1>>, index) -> !fir.boxchar<1>
- ! COARRAY: mif.error_stop code %[[CODE]] : (!fir.boxchar<1>)
- error stop 'c'
-end subroutine
-
-subroutine error_stop_code_char3()
- ! COARRAY: %[[CODE:.*]] = fir.emboxchar %[[VAL:.*]]#0, %[[C14:.*]] : (!fir.ref<!fir.char<1,14>>, index) -> !fir.boxchar<1>
- ! COARRAY: mif.error_stop code %[[CODE]] : (!fir.boxchar<1>)
- error stop ('program failed')
-end subroutine
-
-subroutine error_stop_code_quiet1()
- integer int_code
- logical bool
- ! COARRAY mif.error_stop
- error stop int_code, quiet=bool
-end subroutine
-
-subroutine error_stop_code_quiet2()
- integer int_code
- ! COARRAY mif.error_stop code %[[CODE:.*]] quiet %true : (i32, i1)
- error stop int_code, quiet=.true.
-end subroutine
-
-subroutine error_stop_code_quiet3()
- integer int_code
- ! COARRAY mif.error_stop code %[[CODE:.*]] quiet %false : (i32, i1)
- error stop (int_code), quiet=.false.
-end subroutine
diff --git a/flang/test/Lower/MIF/stop.f90 b/flang/test/Lower/MIF/stop.f90
deleted file mode 100644
index af0268d237a55..0000000000000
--- a/flang/test/Lower/MIF/stop.f90
+++ /dev/null
@@ -1,58 +0,0 @@
-! RUN: %flang_fc1 -emit-hlfir -fcoarray %s -o - | FileCheck %s --check-prefixes=COARRAY
-! RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s --check-prefixes=NOCOARRAY
-
-! NOCOARRAY-NOT: mif.stop
-
-subroutine stop_test()
- ! COARRAY: mif.stop : ()
- stop
-end subroutine
-
-subroutine stop_code1()
- integer int_code
- ! COARRAY: mif.stop code %[[CODE:.*]] : (i32)
- stop int_code
-end subroutine
-
-subroutine stop_code2()
- ! COARRAY: mif.stop code %[[CODE:.*]] : (i32)
- stop ((5 + 8) * 2)
-end subroutine
-
-subroutine stop_code_char1()
- character(len=128) char_code
- ! COARRAY: %[[CODE:.*]] = fir.emboxchar %[[VAL:.*]]#0, %[[C128:.*]] : (!fir.ref<!fir.char<1,128>>, index) -> !fir.boxchar<1>
- ! COARRAY: mif.stop code %[[CODE]] : (!fir.boxchar<1>)
- stop char_code
-end subroutine
-
-subroutine stop_code_char2()
- ! COARRAY: %[[CODE:.*]] = fir.emboxchar %[[VAL:.*]]#0, %[[C1:.*]] : (!fir.ref<!fir.char<1>>, index) -> !fir.boxchar<1>
- ! COARRAY: mif.stop code %[[CODE]] : (!fir.boxchar<1>)
- stop 'c'
-end subroutine
-
-subroutine stop_code_char3()
- ! COARRAY: %[[CODE:.*]] = fir.emboxchar %[[VAL:.*]]#0, %[[C14:.*]] : (!fir.ref<!fir.char<1,14>>, index) -> !fir.boxchar<1>
- ! COARRAY: mif.stop code %[[CODE]] : (!fir.boxchar<1>)
- stop ('program failed')
-end subroutine
-
-subroutine stop_code_quiet1()
- integer int_code
- logical bool
- ! COARRAY mif.stop
- stop int_code, quiet=bool
-end subroutine
-
-subroutine stop_code_quiet2()
- integer int_code
- ! COARRAY mif.stop code %[[CODE:.*]] quiet %true : (i32, i1)
- stop int_code, quiet=.true.
-end subroutine
-
-subroutine stop_code_quiet3()
- integer int_code
- ! COARRAY mif.stop code %[[CODE:.*]] quiet %false : (i32, i1)
- stop (int_code), quiet=.false.
-end subroutine
diff --git a/flang/test/Lower/convert.f90 b/flang/test/Lower/convert.f90
index 75d0f844149ce..ef6e732ce35db 100755
--- a/flang/test/Lower/convert.f90
+++ b/flang/test/Lower/convert.f90
@@ -11,8 +11,9 @@ program test
! Try to test that -fconvert=<value> flag results in a environment default list
! with the FORT_CONVERT option correctly specified.
+! ALL: %false = arith.constant false
! ALL: %0 = fir.address_of(@_QQEnvironmentDefaults.list) : !fir.ref<tuple<i32, !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>>
-! ALL: fir.call @_FortranAProgramStart(%arg0, %arg1, %arg2, %0)
+! ALL: fir.call @_FortranAProgramStart(%arg0, %arg1, %arg2, %0, %false)
! ALL: fir.global linkonce @_QQEnvironmentDefaults.items constant : !fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>> {
! ALL: %[[VAL_0:.*]] = fir.undefined !fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>
diff --git a/flang/test/Lower/environment-defaults.f90 b/flang/test/Lower/environment-defaults.f90
index f5f41dabecc1d..d71bf12aa54e9 100755
--- a/flang/test/Lower/environment-defaults.f90
+++ b/flang/test/Lower/environment-defaults.f90
@@ -9,5 +9,6 @@ program test
! CHECK-NOT: @_QQEnvironmentDefaults
+! CHECK: %false = arith.constant false
! CHECK: %0 = fir.zero_bits !fir.ref<tuple<i32, !fir.ref<!fir.array<0xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>>
-! CHECK-NEXT: @_FortranAProgramStart(%arg0, %arg1, %arg2, %0)
+! CHECK-NEXT: @_FortranAProgramStart(%arg0, %arg1, %arg2, %0, %false)
>From f87445396558e1ad96882bdc1a235750a8cf55ad Mon Sep 17 00:00:00 2001
From: Jean-Didier Pailleux <jean-didier.pailleux at sipearl.com>
Date: Tue, 13 Jan 2026 15:50:50 +0100
Subject: [PATCH 04/12] Remove useless mif::StopOp and mif::ErrorStopOp +
Adding the choose between normal and error exit
---
.../include/flang-rt/runtime/terminator.h | 3 +-
flang-rt/lib/runtime/stop.cpp | 17 +-
flang-rt/lib/runtime/terminator.cpp | 14 +-
.../flang/Optimizer/Dialect/MIF/MIFOps.td | 42 -----
flang/lib/Lower/Runtime.cpp | 3 -
flang/lib/Optimizer/Dialect/MIF/MIFOps.cpp | 26 ---
.../Optimizer/Transforms/MIFOpConversion.cpp | 41 +----
flang/test/Fir/MIF/error_stop.mlir | 152 ------------------
flang/test/Fir/MIF/stop.mlir | 152 ------------------
9 files changed, 22 insertions(+), 428 deletions(-)
delete mode 100644 flang/test/Fir/MIF/error_stop.mlir
delete mode 100644 flang/test/Fir/MIF/stop.mlir
diff --git a/flang-rt/include/flang-rt/runtime/terminator.h b/flang-rt/include/flang-rt/runtime/terminator.h
index 0a86e3b671901..4afe90bc8ce2f 100644
--- a/flang-rt/include/flang-rt/runtime/terminator.h
+++ b/flang-rt/include/flang-rt/runtime/terminator.h
@@ -117,7 +117,8 @@ struct ExitHandler {
ExitHandler() {};
void Configure(bool multiImageFeatureEnabled);
- void Exit(int exitCode);
+ void NormalExit(int exitCode);
+ void ErrorExit(int exitCode);
bool multiImageFeatureEnabled{false};
};
diff --git a/flang-rt/lib/runtime/stop.cpp b/flang-rt/lib/runtime/stop.cpp
index f9a3a8bb99236..4ad93dd41c827 100644
--- a/flang-rt/lib/runtime/stop.cpp
+++ b/flang-rt/lib/runtime/stop.cpp
@@ -96,7 +96,10 @@ static void CloseAllExternalUnits(const char *why) {
std::fputc('\n', stderr);
DescribeIEEESignaledExceptions();
}
- Fortran::runtime::exitHandler.Exit(code);
+ if (isErrorStop)
+ Fortran::runtime::exitHandler.ErrorExit(code);
+ else
+ Fortran::runtime::exitHandler.NormalExit(code);
#endif
}
@@ -124,9 +127,9 @@ static void CloseAllExternalUnits(const char *why) {
DescribeIEEESignaledExceptions();
}
if (isErrorStop) {
- Fortran::runtime::exitHandler.Exit(EXIT_FAILURE);
+ Fortran::runtime::exitHandler.ErrorExit(EXIT_FAILURE);
} else {
- Fortran::runtime::exitHandler.Exit(EXIT_SUCCESS);
+ Fortran::runtime::exitHandler.NormalExit(EXIT_SUCCESS);
}
#endif
}
@@ -144,7 +147,7 @@ static void EndPause() {
std::fflush(nullptr);
if (std::fgetc(stdin) == EOF) {
CloseAllExternalUnits("PAUSE statement");
- Fortran::runtime::exitHandler.Exit(EXIT_SUCCESS);
+ Fortran::runtime::exitHandler.NormalExit(EXIT_SUCCESS);
}
}
@@ -174,12 +177,12 @@ void RTNAME(PauseStatementText)(const char *code, std::size_t length) {
[[noreturn]] void RTNAME(FailImageStatement)() {
Fortran::runtime::NotifyOtherImagesOfFailImageStatement();
CloseAllExternalUnits("FAIL IMAGE statement");
- Fortran::runtime::exitHandler.Exit(EXIT_FAILURE);
+ Fortran::runtime::exitHandler.NormalExit(EXIT_FAILURE);
}
[[noreturn]] void RTNAME(ProgramEndStatement)() {
CloseAllExternalUnits("END statement");
- Fortran::runtime::exitHandler.Exit(EXIT_SUCCESS);
+ Fortran::runtime::exitHandler.NormalExit(EXIT_SUCCESS);
}
void RTNAME(RegisterImagesNormalEndCallback)(void (*callback)(int)) {
@@ -196,7 +199,7 @@ void RTNAME(RegisterFailImageCallback)(void (*callback)(void)) {
[[noreturn]] void RTNAME(Exit)(int status) {
CloseAllExternalUnits("CALL EXIT()");
- Fortran::runtime::exitHandler.Exit(status);
+ Fortran::runtime::exitHandler.NormalExit(status);
}
static RT_NOINLINE_ATTR void PrintBacktrace() {
diff --git a/flang-rt/lib/runtime/terminator.cpp b/flang-rt/lib/runtime/terminator.cpp
index 5525e428e84f8..b240660a5642d 100644
--- a/flang-rt/lib/runtime/terminator.cpp
+++ b/flang-rt/lib/runtime/terminator.cpp
@@ -104,12 +104,16 @@ void ExitHandler::Configure(bool mifEnabled) {
multiImageFeatureEnabled = mifEnabled;
}
-void ExitHandler::Exit(int exitCode) {
+void ExitHandler::NormalExit(int exitCode) {
if (multiImageFeatureEnabled)
- if (exitCode == EXIT_SUCCESS)
- SynchronizeImagesOfNormalEnd(exitCode);
- else
- NotifyOtherImagesOfErrorTermination(exitCode);
+ NotifyOtherImagesOfErrorTermination(exitCode);
+ else
+ std::exit(exitCode);
+}
+
+void ExitHandler::ErrorExit(int exitCode) {
+ if (multiImageFeatureEnabled)
+ SynchronizeImagesOfNormalEnd(exitCode);
else
std::exit(exitCode);
}
diff --git a/flang/include/flang/Optimizer/Dialect/MIF/MIFOps.td b/flang/include/flang/Optimizer/Dialect/MIF/MIFOps.td
index 0d4478cdd4453..a6c7d0a07b019 100644
--- a/flang/include/flang/Optimizer/Dialect/MIF/MIFOps.td
+++ b/flang/include/flang/Optimizer/Dialect/MIF/MIFOps.td
@@ -37,48 +37,6 @@ def mif_InitOp : mif_Op<"init", []> {
let assemblyFormat = "`->` type($stat) attr-dict";
}
-def mif_StopOp : mif_Op<"stop", [AttrSizedOperandSegments]> {
- let summary = "Initiates normal or error termination of the prorgram";
- let description = [{
- This operation initiates normal termination for the calling image.
- It synchronizes all executing images, cleans up the parallel runtime environment,
- and then terminates the program.
- Calls to this operation do not return.
- This operation supports both normal termination at the end of a
- program, as well as any STOP statements from the user source code.
- }];
-
- let arguments = (ins Optional<AnyType>:$stop_code,
- Optional<AnyLogicalType>:$quiet);
-
- let hasVerifier = 1;
- let assemblyFormat = [{
- ( `code` $stop_code^ )? ( `quiet` $quiet^ )?
- attr-dict `:` functional-type(operands, results)
- }];
-}
-
-def mif_ErrorStopOp : mif_Op<"error_stop", [AttrSizedOperandSegments]> {
- let summary = "Initiates normal or error termination of the prorgram";
- let description = [{
- This operation initiates error termination for all images.
- This operation immediately terminates the program.
- Calls to this operation do not return.
- This operation supports error termination, such as from any
- ERROR STOP statements in the user program.
- }];
-
- let arguments = (ins Optional<AnyType>:$stop_code,
- Optional<AnyLogicalType>:$quiet);
-
- let hasVerifier = 1;
- let assemblyFormat = [{
- ( `code` $stop_code^ )? ( `quiet` $quiet^ )?
- attr-dict `:` functional-type(operands, results)
- }];
-}
-
-
//===----------------------------------------------------------------------===//
// Image Queries
//===----------------------------------------------------------------------===//
diff --git a/flang/lib/Lower/Runtime.cpp b/flang/lib/Lower/Runtime.cpp
index 27e907e255332..915e4aa9ca09b 100644
--- a/flang/lib/Lower/Runtime.cpp
+++ b/flang/lib/Lower/Runtime.cpp
@@ -60,9 +60,6 @@ void Fortran::lower::genStopStatement(
Fortran::parser::StopStmt::Kind::ErrorStop;
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
mlir::Location loc = converter.getCurrentLocation();
- bool coarrayIsEnabled =
- converter.getFoldingContext().languageFeatures().IsEnabled(
- Fortran::common::LanguageFeature::Coarray);
Fortran::lower::StatementContext stmtCtx;
llvm::SmallVector<mlir::Value> operands;
diff --git a/flang/lib/Optimizer/Dialect/MIF/MIFOps.cpp b/flang/lib/Optimizer/Dialect/MIF/MIFOps.cpp
index 4c04be2deb306..5f68f3dda54a7 100644
--- a/flang/lib/Optimizer/Dialect/MIF/MIFOps.cpp
+++ b/flang/lib/Optimizer/Dialect/MIF/MIFOps.cpp
@@ -15,32 +15,6 @@
#include "mlir/IR/PatternMatch.h"
#include "llvm/ADT/SmallVector.h"
-//===----------------------------------------------------------------------===//
-// StopOp && ErrorStop
-//===----------------------------------------------------------------------===//
-
-template <typename OP>
-llvm::LogicalResult StopErrorStopVerify(OP &op) {
- if (op.getStopCode()) {
- mlir::Type codeType = op.getStopCode().getType();
- if (!fir::isa_integer(codeType) &&
- !fir::isa_char(fir::unwrapPassByRefType(codeType)))
- return op.emitOpError(
- "`stop_code` shall be of type integer or character.");
- if (fir::isa_char(fir::unwrapPassByRefType(codeType)) &&
- !mlir::isa<fir::BoxCharType>(codeType))
- return op.emitOpError(
- "`stop_code` base type is character and shall be a !fir.boxchar.");
- }
- return mlir::success();
-}
-
-llvm::LogicalResult mif::StopOp::verify() { return StopErrorStopVerify(*this); }
-
-llvm::LogicalResult mif::ErrorStopOp::verify() {
- return StopErrorStopVerify(*this);
-}
-
//===----------------------------------------------------------------------===//
// NumImagesOp
//===----------------------------------------------------------------------===//
diff --git a/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp b/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp
index 8b6c3c930179d..81a914a96a4af 100644
--- a/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp
+++ b/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp
@@ -166,7 +166,6 @@ mlir::Value genTerminationOperationWrapper(fir::FirOpBuilder &builder,
mlir::OpBuilder::InsertPoint saveInsertPoint = builder.saveInsertionPoint();
builder.setInsertionPointToStart(funcWrapperOp.addEntryBlock());
- mlir::Type i32Ty = builder.getI32Type();
if (termKind == TerminationKind::Normal) {
mlir::Value quiet = builder.createBool(loc, true);
genPRIFStopErrorStop(builder, loc, quiet, funcWrapperOp.getArgument(0),
@@ -250,43 +249,6 @@ struct MIFInitOpConversion : public mlir::OpRewritePattern<mif::InitOp> {
}
};
-/// Convert mif.stop operation to runtime call of 'prif_stop'
-struct MIFStopOpConversion : public mlir::OpRewritePattern<mif::StopOp> {
- using OpRewritePattern::OpRewritePattern;
-
- mlir::LogicalResult
- matchAndRewrite(mif::StopOp op,
- mlir::PatternRewriter &rewriter) const override {
- auto mod = op->template getParentOfType<mlir::ModuleOp>();
- fir::FirOpBuilder builder(rewriter, mod);
- mlir::Location loc = op.getLoc();
-
- fir::CallOp callOp =
- genPRIFStopErrorStop(builder, loc, op.getQuiet(), op.getStopCode());
- rewriter.replaceOp(op, callOp);
- return mlir::success();
- }
-};
-
-/// Convert mif.error_stop operation to runtime call of 'prif_error_stop'
-struct MIFErrorStopOpConversion
- : public mlir::OpRewritePattern<mif::ErrorStopOp> {
- using OpRewritePattern::OpRewritePattern;
-
- mlir::LogicalResult
- matchAndRewrite(mif::ErrorStopOp op,
- mlir::PatternRewriter &rewriter) const override {
- auto mod = op->template getParentOfType<mlir::ModuleOp>();
- fir::FirOpBuilder builder(rewriter, mod);
- mlir::Location loc = op.getLoc();
-
- fir::CallOp callOp = genPRIFStopErrorStop(
- builder, loc, op.getQuiet(), op.getStopCode(), /*isError*/ true);
- rewriter.replaceOp(op, callOp);
- return mlir::success();
- }
-};
-
/// Convert mif.this_image operation to PRIF runtime call
struct MIFThisImageOpConversion
: public mlir::OpRewritePattern<mif::ThisImageOp> {
@@ -876,8 +838,7 @@ class MIFOpConversion : public fir::impl::MIFOpConversionBase<MIFOpConversion> {
} // namespace
void mif::populateMIFOpConversionPatterns(mlir::RewritePatternSet &patterns) {
- patterns.insert<MIFInitOpConversion, MIFStopOpConversion,
- MIFErrorStopOpConversion, MIFThisImageOpConversion,
+ patterns.insert<MIFInitOpConversion, MIFThisImageOpConversion,
MIFNumImagesOpConversion, MIFSyncAllOpConversion,
MIFSyncImagesOpConversion, MIFSyncMemoryOpConversion,
MIFSyncTeamOpConversion, MIFCoBroadcastOpConversion,
diff --git a/flang/test/Fir/MIF/error_stop.mlir b/flang/test/Fir/MIF/error_stop.mlir
deleted file mode 100644
index d9fab07e71183..0000000000000
--- a/flang/test/Fir/MIF/error_stop.mlir
+++ /dev/null
@@ -1,152 +0,0 @@
-// RUN: fir-opt --mif-convert %s | FileCheck %s
-
-func.func @_QPerror_stop_test() {
- %0 = fir.dummy_scope : !fir.dscope
- mif.error_stop : () -> ()
- fir.unreachable
-}
-func.func @_QPerror_stop_code1() {
- %0 = fir.dummy_scope : !fir.dscope
- %1 = fir.alloca i32 {bindc_name = "int_code", uniq_name = "_QFerror_stop_code1Eint_code"}
- %2:2 = hlfir.declare %1 {uniq_name = "_QFerror_stop_code1Eint_code"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
- %3 = fir.load %2#0 : !fir.ref<i32>
- mif.error_stop code %3 : (i32) -> ()
- fir.unreachable
-}
-func.func @_QPerror_stop_code2() {
- %0 = fir.dummy_scope : !fir.dscope
- %c26_i32 = arith.constant 26 : i32
- %1 = hlfir.no_reassoc %c26_i32 : i32
- mif.error_stop code %1 : (i32) -> ()
- fir.unreachable
-}
-func.func @_QPerror_stop_code_char1() {
- %0 = fir.dummy_scope : !fir.dscope
- %c128 = arith.constant 128 : index
- %1 = fir.alloca !fir.char<1,128> {bindc_name = "char_code", uniq_name = "_QFerror_stop_code_char1Echar_code"}
- %2:2 = hlfir.declare %1 typeparams %c128 {uniq_name = "_QFerror_stop_code_char1Echar_code"} : (!fir.ref<!fir.char<1,128>>, index) -> (!fir.ref<!fir.char<1,128>>, !fir.ref<!fir.char<1,128>>)
- %3 = fir.emboxchar %2#0, %c128 : (!fir.ref<!fir.char<1,128>>, index) -> !fir.boxchar<1>
- mif.error_stop code %3 : (!fir.boxchar<1>) -> ()
- fir.unreachable
-}
-func.func @_QPerror_stop_code_char2() {
- %0 = fir.dummy_scope : !fir.dscope
- %1 = fir.address_of(@_QQclX63) : !fir.ref<!fir.char<1>>
- %c1 = arith.constant 1 : index
- %2:2 = hlfir.declare %1 typeparams %c1 {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQclX63"} : (!fir.ref<!fir.char<1>>, index) -> (!fir.ref<!fir.char<1>>, !fir.ref<!fir.char<1>>)
- %3 = fir.emboxchar %2#0, %c1 : (!fir.ref<!fir.char<1>>, index) -> !fir.boxchar<1>
- mif.error_stop code %3 : (!fir.boxchar<1>) -> ()
- fir.unreachable
-}
-func.func @_QPerror_stop_code_char3() {
- %0 = fir.dummy_scope : !fir.dscope
- %1 = fir.address_of(@_QQclX70726F6772616D206661696C6564) : !fir.ref<!fir.char<1,14>>
- %c14 = arith.constant 14 : index
- %2:2 = hlfir.declare %1 typeparams %c14 {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQclX70726F6772616D206661696C6564"} : (!fir.ref<!fir.char<1,14>>, index) -> (!fir.ref<!fir.char<1,14>>, !fir.ref<!fir.char<1,14>>)
- %3 = hlfir.as_expr %2#0 : (!fir.ref<!fir.char<1,14>>) -> !hlfir.expr<!fir.char<1,14>>
- %4:3 = hlfir.associate %3 typeparams %c14 {adapt.valuebyref} : (!hlfir.expr<!fir.char<1,14>>, index) -> (!fir.ref<!fir.char<1,14>>, !fir.ref<!fir.char<1,14>>, i1)
- %5 = fir.emboxchar %4#0, %c14 : (!fir.ref<!fir.char<1,14>>, index) -> !fir.boxchar<1>
- mif.error_stop code %5 : (!fir.boxchar<1>) -> ()
- fir.unreachable
-}
-func.func @_QPerror_stop_code_quiet1() {
- %0 = fir.dummy_scope : !fir.dscope
- %1 = fir.alloca !fir.logical<4> {bindc_name = "bool", uniq_name = "_QFerror_stop_code_quiet1Ebool"}
- %2:2 = hlfir.declare %1 {uniq_name = "_QFerror_stop_code_quiet1Ebool"} : (!fir.ref<!fir.logical<4>>) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>)
- %3 = fir.alloca i32 {bindc_name = "int_code", uniq_name = "_QFerror_stop_code_quiet1Eint_code"}
- %4:2 = hlfir.declare %3 {uniq_name = "_QFerror_stop_code_quiet1Eint_code"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
- %5 = fir.load %4#0 : !fir.ref<i32>
- %6 = fir.load %2#0 : !fir.ref<!fir.logical<4>>
- mif.error_stop code %5 quiet %6 : (i32, !fir.logical<4>) -> ()
- fir.unreachable
-}
-func.func @_QPerror_stop_code_quiet2() {
- %0 = fir.dummy_scope : !fir.dscope
- %1 = fir.alloca i32 {bindc_name = "int_code", uniq_name = "_QFerror_stop_code_quiet2Eint_code"}
- %2:2 = hlfir.declare %1 {uniq_name = "_QFerror_stop_code_quiet2Eint_code"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
- %3 = fir.load %2#0 : !fir.ref<i32>
- %true = arith.constant true
- mif.error_stop code %3 quiet %true : (i32, i1) -> ()
- fir.unreachable
-}
-func.func @_QPerror_stop_code_quiet3() {
- %0 = fir.dummy_scope : !fir.dscope
- %1 = fir.alloca i32 {bindc_name = "int_code", uniq_name = "_QFerror_stop_code_quiet3Eint_code"}
- %2:2 = hlfir.declare %1 {uniq_name = "_QFerror_stop_code_quiet3Eint_code"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
- %3 = fir.load %2#0 : !fir.ref<i32>
- %4 = hlfir.no_reassoc %3 : i32
- %false = arith.constant false
- mif.error_stop code %4 quiet %false : (i32, i1) -> ()
- fir.unreachable
-}
-func.func private @_FortranAStopStatement(i32, i1, i1) attributes {fir.runtime}
-func.func private @_FortranAStopStatementText(!fir.ref<i8>, i64, i1, i1) attributes {fir.runtime}
-fir.global linkonce @_QQclX63 constant : !fir.char<1> {
- %0 = fir.string_lit "c"(1) : !fir.char<1>
- fir.has_value %0 : !fir.char<1>
-}
-fir.global linkonce @_QQclX70726F6772616D206661696C6564 constant : !fir.char<1,14> {
- %0 = fir.string_lit "program failed"(14) : !fir.char<1,14>
- fir.has_value %0 : !fir.char<1,14>
-}
-
-
-// CHECK-label : func.func @_QPerror_stop_test
-// CHECK: %[[FALSE:.*]] = arith.constant false
-// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
-// CHECK2: %[[CODE_CHAR:.*]] = fir.absent !fir.boxchar<1>
-// CHECK2: %[[CODE_INT:.*]] = fir.absent !fir.ref<i32>
-// CHECK2: fir.call @_QMprifPprif_error_stop(%[[QUIET]], %[[CODE_INT]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
-
-// CHECK-label : func.func @_QPerror_stop_code1
-// CHECK: %[[FALSE:.*]] = arith.constant false
-// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
-// CHECK: %[[CODE_CHAR:.*]] = fir.absent !fir.boxchar<1>
-// CHECK: fir.call @_QMprifPprif_error_stop(%[[QUIET]], %[[CODE_INT:.*]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
-
-// CHECK-label : func.func @_QPerror_stop_code2
-// CHECK: %[[FALSE:.*]] = arith.constant false
-// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
-// CHECK: %[[CODE_CHAR:.*]] = fir.absent !fir.boxchar<1>
-// CHECK: fir.call @_QMprifPprif_error_stop(%[[QUIET]], %[[CODE_INT:.*]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
-
-// CHECK-label : func.func @_QPerror_stop_code_char1
-// CHECK: %[[CODE_CHAR:.*]] = fir.emboxchar %[[VAL_X:.*]]#0, %[[C128:.*]] : (!fir.ref<!fir.char<1,128>>, index) -> !fir.boxchar<1>
-// CHECK: %[[FALSE:.*]] = arith.constant false
-// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
-// CHECK: %[[CODE_INT:.*]] = fir.absent !fir.ref<i32>
-// CHECK: fir.call @_QMprifPprif_error_stop(%[[QUIET]], %[[CODE_INT]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
-
-// CHECK-label : func.func @_QPerror_stop_code_char2
-// CHECK: %[[CODE_CHAR:.*]] = fir.emboxchar %[[VAL_X:.*]]#0, %[[C1:.*]] : (!fir.ref<!fir.char<1>>, index) -> !fir.boxchar<1>
-// CHECK: %[[FALSE:.*]] = arith.constant false
-// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
-// CHECK: %[[CODE_INT:.*]] = fir.absent !fir.ref<i32>
-// CHECK: fir.call @_QMprifPprif_error_stop(%[[QUIET]], %[[CODE_INT]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
-
-// CHECK-label : func.func @_QPerror_stop_code_char3
-// CHECK: %[[CODE_CHAR:.*]] = fir.emboxchar %[[VAL_X:.*]]#0, %[[C14:.*]] : (!fir.ref<!fir.char<1,14>>, index) -> !fir.boxchar<1>
-// CHECK: %[[FALSE:.*]] = arith.constant false
-// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
-// CHECK: %[[CODE_INT:.*]] = fir.absent !fir.ref<i32>
-// CHECK: fir.call @_QMprifPprif_error_stop(%[[QUIET]], %[[CODE_INT]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
-
-// CHECK-label : func.func @_QPerror_stop_code_quiet1
-// CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_Q:.*]]#0 : !fir.ref<!fir.logical<4>>
-// CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.logical<4>) -> i1
-// CHECK: fir.store %[[VAL_2]] to %[[QUIET:.*]] : !fir.ref<i1>
-// CHECK: %[[CODE_CHAR:.*]] = fir.absent !fir.boxchar<1>
-// CHECK: fir.call @_QMprifPprif_error_stop(%[[QUIET]], %[[CODE_INT:.*]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
-
-// CHECK-label : func.func @_QPerror_stop_code_quiet2
-// CHECK: %[[TRUE:.*]] = arith.constant true
-// CHECK: fir.store %[[TRUE]] to %[[QUIET:.*]] : !fir.ref<i1>
-// CHECK: %[[CODE_CHAR:.*]] = fir.absent !fir.boxchar<1>
-// CHECK: fir.call @_QMprifPprif_error_stop(%[[QUIET]], %[[CODE_INT:.*]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
-
-// CHECK-label : func.func @_QPerror_stop_code_quiet3
-// CHECK: %[[FALSE:.*]] = arith.constant false
-// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
-// CHECK: %[[CODE_CHAR:.*]] = fir.absent !fir.boxchar<1>
-// CHECK: fir.call @_QMprifPprif_error_stop(%[[QUIET]], %[[CODE_INT:.*]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
-
diff --git a/flang/test/Fir/MIF/stop.mlir b/flang/test/Fir/MIF/stop.mlir
deleted file mode 100644
index 43bd92ef52242..0000000000000
--- a/flang/test/Fir/MIF/stop.mlir
+++ /dev/null
@@ -1,152 +0,0 @@
-// RUN: fir-opt --mif-convert %s | FileCheck %s
-
-func.func @_QPstop_test() {
- %0 = fir.dummy_scope : !fir.dscope
- mif.stop : () -> ()
- fir.unreachable
-}
-func.func @_QPstop_code1() {
- %0 = fir.dummy_scope : !fir.dscope
- %1 = fir.alloca i32 {bindc_name = "int_code", uniq_name = "_QFstop_code1Eint_code"}
- %2:2 = hlfir.declare %1 {uniq_name = "_QFstop_code1Eint_code"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
- %3 = fir.load %2#0 : !fir.ref<i32>
- mif.stop code %3 : (i32) -> ()
- fir.unreachable
-}
-func.func @_QPstop_code2() {
- %0 = fir.dummy_scope : !fir.dscope
- %c26_i32 = arith.constant 26 : i32
- %1 = hlfir.no_reassoc %c26_i32 : i32
- mif.stop code %1 : (i32) -> ()
- fir.unreachable
-}
-func.func @_QPstop_code_char1() {
- %0 = fir.dummy_scope : !fir.dscope
- %c128 = arith.constant 128 : index
- %1 = fir.alloca !fir.char<1,128> {bindc_name = "char_code", uniq_name = "_QFstop_code_char1Echar_code"}
- %2:2 = hlfir.declare %1 typeparams %c128 {uniq_name = "_QFstop_code_char1Echar_code"} : (!fir.ref<!fir.char<1,128>>, index) -> (!fir.ref<!fir.char<1,128>>, !fir.ref<!fir.char<1,128>>)
- %3 = fir.emboxchar %2#0, %c128 : (!fir.ref<!fir.char<1,128>>, index) -> !fir.boxchar<1>
- mif.stop code %3 : (!fir.boxchar<1>) -> ()
- fir.unreachable
-}
-func.func @_QPstop_code_char2() {
- %0 = fir.dummy_scope : !fir.dscope
- %1 = fir.address_of(@_QQclX63) : !fir.ref<!fir.char<1>>
- %c1 = arith.constant 1 : index
- %2:2 = hlfir.declare %1 typeparams %c1 {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQclX63"} : (!fir.ref<!fir.char<1>>, index) -> (!fir.ref<!fir.char<1>>, !fir.ref<!fir.char<1>>)
- %3 = fir.emboxchar %2#0, %c1 : (!fir.ref<!fir.char<1>>, index) -> !fir.boxchar<1>
- mif.stop code %3 : (!fir.boxchar<1>) -> ()
- fir.unreachable
-}
-func.func @_QPstop_code_char3() {
- %0 = fir.dummy_scope : !fir.dscope
- %1 = fir.address_of(@_QQclX70726F6772616D206661696C6564) : !fir.ref<!fir.char<1,14>>
- %c14 = arith.constant 14 : index
- %2:2 = hlfir.declare %1 typeparams %c14 {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQclX70726F6772616D206661696C6564"} : (!fir.ref<!fir.char<1,14>>, index) -> (!fir.ref<!fir.char<1,14>>, !fir.ref<!fir.char<1,14>>)
- %3 = hlfir.as_expr %2#0 : (!fir.ref<!fir.char<1,14>>) -> !hlfir.expr<!fir.char<1,14>>
- %4:3 = hlfir.associate %3 typeparams %c14 {adapt.valuebyref} : (!hlfir.expr<!fir.char<1,14>>, index) -> (!fir.ref<!fir.char<1,14>>, !fir.ref<!fir.char<1,14>>, i1)
- %5 = fir.emboxchar %4#0, %c14 : (!fir.ref<!fir.char<1,14>>, index) -> !fir.boxchar<1>
- mif.stop code %5 : (!fir.boxchar<1>) -> ()
- fir.unreachable
-}
-func.func @_QPstop_code_quiet1() {
- %0 = fir.dummy_scope : !fir.dscope
- %1 = fir.alloca !fir.logical<4> {bindc_name = "bool", uniq_name = "_QFstop_code_quiet1Ebool"}
- %2:2 = hlfir.declare %1 {uniq_name = "_QFstop_code_quiet1Ebool"} : (!fir.ref<!fir.logical<4>>) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>)
- %3 = fir.alloca i32 {bindc_name = "int_code", uniq_name = "_QFstop_code_quiet1Eint_code"}
- %4:2 = hlfir.declare %3 {uniq_name = "_QFstop_code_quiet1Eint_code"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
- %5 = fir.load %4#0 : !fir.ref<i32>
- %6 = fir.load %2#0 : !fir.ref<!fir.logical<4>>
- mif.stop code %5 quiet %6 : (i32, !fir.logical<4>) -> ()
- fir.unreachable
-}
-func.func @_QPstop_code_quiet2() {
- %0 = fir.dummy_scope : !fir.dscope
- %1 = fir.alloca i32 {bindc_name = "int_code", uniq_name = "_QFstop_code_quiet2Eint_code"}
- %2:2 = hlfir.declare %1 {uniq_name = "_QFstop_code_quiet2Eint_code"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
- %3 = fir.load %2#0 : !fir.ref<i32>
- %true = arith.constant true
- mif.stop code %3 quiet %true : (i32, i1) -> ()
- fir.unreachable
-}
-func.func @_QPstop_code_quiet3() {
- %0 = fir.dummy_scope : !fir.dscope
- %1 = fir.alloca i32 {bindc_name = "int_code", uniq_name = "_QFstop_code_quiet3Eint_code"}
- %2:2 = hlfir.declare %1 {uniq_name = "_QFstop_code_quiet3Eint_code"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
- %3 = fir.load %2#0 : !fir.ref<i32>
- %4 = hlfir.no_reassoc %3 : i32
- %false = arith.constant false
- mif.stop code %4 quiet %false : (i32, i1) -> ()
- fir.unreachable
-}
-func.func private @_FortranAStopStatement(i32, i1, i1) attributes {fir.runtime}
-func.func private @_FortranAStopStatementText(!fir.ref<i8>, i64, i1, i1) attributes {fir.runtime}
-fir.global linkonce @_QQclX63 constant : !fir.char<1> {
- %0 = fir.string_lit "c"(1) : !fir.char<1>
- fir.has_value %0 : !fir.char<1>
-}
-fir.global linkonce @_QQclX70726F6772616D206661696C6564 constant : !fir.char<1,14> {
- %0 = fir.string_lit "program failed"(14) : !fir.char<1,14>
- fir.has_value %0 : !fir.char<1,14>
-}
-
-
-// CHECK-label : func.func @_QPstop_test
-// CHECK: %[[FALSE:.*]] = arith.constant false
-// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
-// CHECK2: %[[CODE_CHAR:.*]] = fir.absent !fir.boxchar<1>
-// CHECK2: %[[CODE_INT:.*]] = fir.absent !fir.ref<i32>
-// CHECK2: fir.call @_QMprifPprif_stop(%[[QUIET]], %[[CODE_INT]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
-
-// CHECK-label : func.func @_QPstop_code1
-// CHECK: %[[FALSE:.*]] = arith.constant false
-// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
-// CHECK: %[[CODE_CHAR:.*]] = fir.absent !fir.boxchar<1>
-// CHECK: fir.call @_QMprifPprif_stop(%[[QUIET]], %[[CODE_INT:.*]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
-
-// CHECK-label : func.func @_QPstop_code2
-// CHECK: %[[FALSE:.*]] = arith.constant false
-// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
-// CHECK: %[[CODE_CHAR:.*]] = fir.absent !fir.boxchar<1>
-// CHECK: fir.call @_QMprifPprif_stop(%[[QUIET]], %[[CODE_INT:.*]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
-
-// CHECK-label : func.func @_QPstop_code_char1
-// CHECK: %[[CODE_CHAR:.*]] = fir.emboxchar %[[VAL_X:.*]]#0, %[[C128:.*]] : (!fir.ref<!fir.char<1,128>>, index) -> !fir.boxchar<1>
-// CHECK: %[[FALSE:.*]] = arith.constant false
-// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
-// CHECK: %[[CODE_INT:.*]] = fir.absent !fir.ref<i32>
-// CHECK: fir.call @_QMprifPprif_stop(%[[QUIET]], %[[CODE_INT]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
-
-// CHECK-label : func.func @_QPstop_code_char2
-// CHECK: %[[CODE_CHAR:.*]] = fir.emboxchar %[[VAL_X:.*]]#0, %[[C1:.*]] : (!fir.ref<!fir.char<1>>, index) -> !fir.boxchar<1>
-// CHECK: %[[FALSE:.*]] = arith.constant false
-// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
-// CHECK: %[[CODE_INT:.*]] = fir.absent !fir.ref<i32>
-// CHECK: fir.call @_QMprifPprif_stop(%[[QUIET]], %[[CODE_INT]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
-
-// CHECK-label : func.func @_QPstop_code_char3
-// CHECK: %[[CODE_CHAR:.*]] = fir.emboxchar %[[VAL_X:.*]]#0, %[[C14:.*]] : (!fir.ref<!fir.char<1,14>>, index) -> !fir.boxchar<1>
-// CHECK: %[[FALSE:.*]] = arith.constant false
-// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
-// CHECK: %[[CODE_INT:.*]] = fir.absent !fir.ref<i32>
-// CHECK: fir.call @_QMprifPprif_stop(%[[QUIET]], %[[CODE_INT]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
-
-// CHECK-label : func.func @_QPstop_code_quiet1
-// CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_Q:.*]]#0 : !fir.ref<!fir.logical<4>>
-// CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.logical<4>) -> i1
-// CHECK: fir.store %[[VAL_2]] to %[[QUIET:.*]] : !fir.ref<i1>
-// CHECK: %[[CODE_CHAR:.*]] = fir.absent !fir.boxchar<1>
-// CHECK: fir.call @_QMprifPprif_stop(%[[QUIET]], %[[CODE_INT:.*]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
-
-// CHECK-label : func.func @_QPstop_code_quiet2
-// CHECK: %[[TRUE:.*]] = arith.constant true
-// CHECK: fir.store %[[TRUE]] to %[[QUIET:.*]] : !fir.ref<i1>
-// CHECK: %[[CODE_CHAR:.*]] = fir.absent !fir.boxchar<1>
-// CHECK: fir.call @_QMprifPprif_stop(%[[QUIET]], %[[CODE_INT:.*]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
-
-// CHECK-label : func.func @_QPstop_code_quiet3
-// CHECK: %[[FALSE:.*]] = arith.constant false
-// CHECK: fir.store %[[FALSE]] to %[[QUIET:.*]] : !fir.ref<i1>
-// CHECK: %[[CODE_CHAR:.*]] = fir.absent !fir.boxchar<1>
-// CHECK: fir.call @_QMprifPprif_stop(%[[QUIET]], %[[CODE_INT:.*]], %[[CODE_CHAR]]) : (!fir.ref<i1>, !fir.ref<i32>, !fir.boxchar<1>) -> ()
-
>From 449d5cf5f999e2fa91efb5c2608128fbb5f89d23 Mon Sep 17 00:00:00 2001
From: Jean-Didier PAILLEUX <jean-di.pailleux at outlook.com>
Date: Wed, 14 Jan 2026 15:53:09 +0100
Subject: [PATCH 05/12] Update flang-rt/lib/runtime/stop.cpp
Co-authored-by: Dan Bonachea <dobonachea at lbl.gov>
---
flang-rt/lib/runtime/stop.cpp | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/flang-rt/lib/runtime/stop.cpp b/flang-rt/lib/runtime/stop.cpp
index 4ad93dd41c827..b8c4ba8531647 100644
--- a/flang-rt/lib/runtime/stop.cpp
+++ b/flang-rt/lib/runtime/stop.cpp
@@ -147,7 +147,7 @@ static void EndPause() {
std::fflush(nullptr);
if (std::fgetc(stdin) == EOF) {
CloseAllExternalUnits("PAUSE statement");
- Fortran::runtime::exitHandler.NormalExit(EXIT_SUCCESS);
+ Fortran::runtime::exitHandler.ErrorExit(EXIT_SUCCESS);
}
}
>From fff2b9fd5808d3f1f4421003eb29aba673909f44 Mon Sep 17 00:00:00 2001
From: Jean-Didier PAILLEUX <jean-di.pailleux at outlook.com>
Date: Wed, 14 Jan 2026 15:59:17 +0100
Subject: [PATCH 06/12] Update flang-rt/include/flang-rt/runtime/terminator.h
Co-authored-by: Dan Bonachea <dobonachea at lbl.gov>
---
flang-rt/include/flang-rt/runtime/terminator.h | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/flang-rt/include/flang-rt/runtime/terminator.h b/flang-rt/include/flang-rt/runtime/terminator.h
index 4afe90bc8ce2f..7e49b80b36ce8 100644
--- a/flang-rt/include/flang-rt/runtime/terminator.h
+++ b/flang-rt/include/flang-rt/runtime/terminator.h
@@ -117,8 +117,8 @@ struct ExitHandler {
ExitHandler() {};
void Configure(bool multiImageFeatureEnabled);
- void NormalExit(int exitCode);
- void ErrorExit(int exitCode);
+ [[noreturn]] void NormalExit(int exitCode);
+ [[noreturn]] void ErrorExit(int exitCode);
bool multiImageFeatureEnabled{false};
};
>From b4387a22ed6ea79c45e242c3240036c510e215f3 Mon Sep 17 00:00:00 2001
From: Jean-Didier PAILLEUX <jean-di.pailleux at outlook.com>
Date: Wed, 14 Jan 2026 16:00:56 +0100
Subject: [PATCH 07/12] Update flang-rt/lib/runtime/terminator.cpp
Co-authored-by: Dan Bonachea <dobonachea at lbl.gov>
---
flang-rt/lib/runtime/terminator.cpp | 14 ++++++++------
1 file changed, 8 insertions(+), 6 deletions(-)
diff --git a/flang-rt/lib/runtime/terminator.cpp b/flang-rt/lib/runtime/terminator.cpp
index b240660a5642d..d2b25dde549c6 100644
--- a/flang-rt/lib/runtime/terminator.cpp
+++ b/flang-rt/lib/runtime/terminator.cpp
@@ -104,18 +104,20 @@ void ExitHandler::Configure(bool mifEnabled) {
multiImageFeatureEnabled = mifEnabled;
}
+[[noreturn]]
void ExitHandler::NormalExit(int exitCode) {
if (multiImageFeatureEnabled)
- NotifyOtherImagesOfErrorTermination(exitCode);
- else
- std::exit(exitCode);
+ SynchronizeImagesOfNormalEnd(exitCode); // might never return
+
+ std::exit(exitCode);
}
+[[noreturn]]
void ExitHandler::ErrorExit(int exitCode) {
if (multiImageFeatureEnabled)
- SynchronizeImagesOfNormalEnd(exitCode);
- else
- std::exit(exitCode);
+ NotifyOtherImagesOfErrorTermination(exitCode); // might never return
+
+ std::exit(exitCode);
}
RT_API_ATTRS void SynchronizeImagesOfNormalEnd(int code) {
>From 4caac843a87a6d2eee6794084e91073ab7d37cb2 Mon Sep 17 00:00:00 2001
From: Jean-Didier Pailleux <jean-didier.pailleux at sipearl.com>
Date: Wed, 14 Jan 2026 16:27:10 +0100
Subject: [PATCH 08/12] Remove useless header + update ProgramStart call in
CommandTest
---
flang-rt/unittests/Runtime/CommandTest.cpp | 2 +-
flang/lib/Lower/Runtime.cpp | 1 -
2 files changed, 1 insertion(+), 2 deletions(-)
diff --git a/flang-rt/unittests/Runtime/CommandTest.cpp b/flang-rt/unittests/Runtime/CommandTest.cpp
index 6919a98105b8a..b5f4409b58a72 100644
--- a/flang-rt/unittests/Runtime/CommandTest.cpp
+++ b/flang-rt/unittests/Runtime/CommandTest.cpp
@@ -67,7 +67,7 @@ static OwningPtr<Descriptor> IntDescriptor(const int &value) {
class CommandFixture : public ::testing::Test {
protected:
CommandFixture(int argc, const char *argv[]) {
- RTNAME(ProgramStart)(argc, argv, {}, {});
+ RTNAME(ProgramStart)(argc, argv, {}, {}, false);
}
std::string GetPaddedStr(const char *text, std::size_t len) const {
diff --git a/flang/lib/Lower/Runtime.cpp b/flang/lib/Lower/Runtime.cpp
index 915e4aa9ca09b..2a135e52d761c 100644
--- a/flang/lib/Lower/Runtime.cpp
+++ b/flang/lib/Lower/Runtime.cpp
@@ -11,7 +11,6 @@
#include "flang/Lower/OpenACC.h"
#include "flang/Lower/OpenMP.h"
#include "flang/Lower/StatementContext.h"
-#include "flang/Optimizer/Builder/Character.h"
#include "flang/Optimizer/Builder/FIRBuilder.h"
#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
#include "flang/Optimizer/Builder/Todo.h"
>From 2caa4636c8b84d79fcc4f4cae53386a8f37551e9 Mon Sep 17 00:00:00 2001
From: Jean-Didier Pailleux <jean-didier.pailleux at sipearl.com>
Date: Thu, 15 Jan 2026 08:41:46 +0100
Subject: [PATCH 09/12] Remove QUIET argument in genPRIFStopErrorStop an set
quiet to true by default
---
.../Optimizer/Transforms/MIFOpConversion.cpp | 22 +++++--------------
1 file changed, 6 insertions(+), 16 deletions(-)
diff --git a/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp b/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp
index 81a914a96a4af..fed941c0afbe6 100644
--- a/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp
+++ b/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp
@@ -76,7 +76,7 @@ static mlir::Value genStatPRIF(fir::FirOpBuilder &builder, mlir::Location loc,
}
static fir::CallOp genPRIFStopErrorStop(fir::FirOpBuilder &builder,
- mlir::Location loc, mlir::Value quiet,
+ mlir::Location loc,
mlir::Value stopCode,
bool isError = false) {
mlir::Type stopCharTy = fir::BoxCharType::get(builder.getContext(), 1);
@@ -93,17 +93,9 @@ static fir::CallOp genPRIFStopErrorStop(fir::FirOpBuilder &builder,
? builder.createFunction(loc, getPRIFProcName("error_stop"), ftype)
: builder.createFunction(loc, getPRIFProcName("stop"), ftype);
- // Default value of QUIET to false
- mlir::Value q;
- if (!quiet) {
- q = builder.createBool(loc, false);
- quiet = builder.createTemporary(loc, i1Ty);
- } else {
- q = quiet;
- if (q.getType() != i1Ty)
- q = fir::ConvertOp::create(builder, loc, i1Ty, q);
- quiet = builder.createTemporary(loc, i1Ty);
- }
+ // QUIET is managed in flang-rt, so its value is set to TRUE here.
+ mlir::Value q = builder.createBool(loc, true);
+ mlir::Value quiet = builder.createTemporary(loc, i1Ty);
fir::StoreOp::create(builder, loc, q, quiet);
mlir::Value stopCodeInt, stopCodeChar;
@@ -167,12 +159,10 @@ mlir::Value genTerminationOperationWrapper(fir::FirOpBuilder &builder,
builder.setInsertionPointToStart(funcWrapperOp.addEntryBlock());
if (termKind == TerminationKind::Normal) {
- mlir::Value quiet = builder.createBool(loc, true);
- genPRIFStopErrorStop(builder, loc, quiet, funcWrapperOp.getArgument(0),
+ genPRIFStopErrorStop(builder, loc, funcWrapperOp.getArgument(0),
/*isError*/ false);
} else if (termKind == TerminationKind::Error) {
- mlir::Value quiet = builder.createBool(loc, true);
- genPRIFStopErrorStop(builder, loc, quiet, funcWrapperOp.getArgument(0),
+ genPRIFStopErrorStop(builder, loc, funcWrapperOp.getArgument(0),
/*isError*/ true);
} else {
mlir::func::FuncOp fOp = builder.createFunction(
>From 709193e4ffa4499d231a9a07b660e11ae7c68181 Mon Sep 17 00:00:00 2001
From: Jean-Didier PAILLEUX <jean-di.pailleux at outlook.com>
Date: Wed, 21 Jan 2026 09:00:41 +0100
Subject: [PATCH 10/12] Update flang-rt/lib/runtime/stop.cpp
Co-authored-by: Dan Bonachea <dobonachea at lbl.gov>
---
flang-rt/lib/runtime/stop.cpp | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/flang-rt/lib/runtime/stop.cpp b/flang-rt/lib/runtime/stop.cpp
index b8c4ba8531647..7c6b80f1549ec 100644
--- a/flang-rt/lib/runtime/stop.cpp
+++ b/flang-rt/lib/runtime/stop.cpp
@@ -175,8 +175,8 @@ void RTNAME(PauseStatementText)(const char *code, std::size_t length) {
}
[[noreturn]] void RTNAME(FailImageStatement)() {
- Fortran::runtime::NotifyOtherImagesOfFailImageStatement();
CloseAllExternalUnits("FAIL IMAGE statement");
+ Fortran::runtime::NotifyOtherImagesOfFailImageStatement();
Fortran::runtime::exitHandler.NormalExit(EXIT_FAILURE);
}
>From 829dbc464c843235ce3363b6382800710ffb46c0 Mon Sep 17 00:00:00 2001
From: Jean-Didier Pailleux <jean-didier.pailleux at sipearl.com>
Date: Tue, 27 Jan 2026 11:53:51 +0100
Subject: [PATCH 11/12] Remove non necessary boolean in ExitHandler and hide
global variables
---
flang-rt/include/flang-rt/runtime/terminator.h | 7 -------
flang-rt/lib/runtime/main.cpp | 4 +---
flang-rt/lib/runtime/terminator.cpp | 14 ++++++--------
flang-rt/unittests/Runtime/CommandTest.cpp | 2 +-
flang/include/flang/Runtime/main.h | 4 ++--
flang/lib/Lower/Runtime.cpp | 1 -
flang/lib/Optimizer/Builder/Runtime/Main.cpp | 7 +------
flang/test/Driver/emit-mlir.f90 | 5 ++---
flang/test/Lower/MIF/coarray-init.f90 | 6 ------
flang/test/Lower/convert.f90 | 3 +--
flang/test/Lower/environment-defaults.f90 | 3 +--
11 files changed, 15 insertions(+), 41 deletions(-)
diff --git a/flang-rt/include/flang-rt/runtime/terminator.h b/flang-rt/include/flang-rt/runtime/terminator.h
index 7e49b80b36ce8..85a5aeacf8fae 100644
--- a/flang-rt/include/flang-rt/runtime/terminator.h
+++ b/flang-rt/include/flang-rt/runtime/terminator.h
@@ -116,17 +116,10 @@ class Terminator {
struct ExitHandler {
ExitHandler() {};
- void Configure(bool multiImageFeatureEnabled);
[[noreturn]] void NormalExit(int exitCode);
[[noreturn]] void ErrorExit(int exitCode);
-
- bool multiImageFeatureEnabled{false};
};
-extern RT_VAR_ATTRS ExitHandler exitHandler;
-extern RT_VAR_ATTRS void (*normalEndCallback)(int);
-extern RT_VAR_ATTRS void (*failImageCallback)(void);
-extern RT_VAR_ATTRS void (*errorCallback)(int);
RT_API_ATTRS void SynchronizeImagesOfNormalEnd(int);
RT_API_ATTRS void NotifyOtherImagesOfFailImageStatement();
RT_API_ATTRS void NotifyOtherImagesOfErrorTermination(int);
diff --git a/flang-rt/lib/runtime/main.cpp b/flang-rt/lib/runtime/main.cpp
index 96e59ab238744..f9fceec561f8a 100644
--- a/flang-rt/lib/runtime/main.cpp
+++ b/flang-rt/lib/runtime/main.cpp
@@ -28,9 +28,7 @@ static void ConfigureFloatingPoint() {
extern "C" {
void RTNAME(ProgramStart)(int argc, const char *argv[], const char *envp[],
- const EnvironmentDefaultList *envDefaults,
- const bool multiImageInitialized) {
- Fortran::runtime::exitHandler.Configure(multiImageInitialized);
+ const EnvironmentDefaultList *envDefaults) {
Fortran::runtime::executionEnvironment.Configure(
argc, argv, envp, envDefaults);
ConfigureFloatingPoint();
diff --git a/flang-rt/lib/runtime/terminator.cpp b/flang-rt/lib/runtime/terminator.cpp
index d2b25dde549c6..1591708589311 100644
--- a/flang-rt/lib/runtime/terminator.cpp
+++ b/flang-rt/lib/runtime/terminator.cpp
@@ -100,22 +100,21 @@ RT_API_ATTRS void Terminator::CrashHeader() const {
sourceFileName_, sourceLine_);
}
-void ExitHandler::Configure(bool mifEnabled) {
- multiImageFeatureEnabled = mifEnabled;
-}
+static RT_VAR_ATTRS ExitHandler exitHandler;
+static RT_VAR_ATTRS void (*normalEndCallback)(int) = nullptr;
+static RT_VAR_ATTRS void (*failImageCallback)(void) = nullptr;
+static RT_VAR_ATTRS void (*errorCallback)(int) = nullptr;
[[noreturn]]
void ExitHandler::NormalExit(int exitCode) {
- if (multiImageFeatureEnabled)
- SynchronizeImagesOfNormalEnd(exitCode); // might never return
+ SynchronizeImagesOfNormalEnd(exitCode); // might never return
std::exit(exitCode);
}
[[noreturn]]
void ExitHandler::ErrorExit(int exitCode) {
- if (multiImageFeatureEnabled)
- NotifyOtherImagesOfErrorTermination(exitCode); // might never return
+ NotifyOtherImagesOfErrorTermination(exitCode); // might never return
std::exit(exitCode);
}
@@ -134,7 +133,6 @@ RT_API_ATTRS void NotifyOtherImagesOfErrorTermination(int code) {
if (errorCallback)
(*errorCallback)(code);
}
-
RT_OFFLOAD_API_GROUP_END
} // namespace Fortran::runtime
diff --git a/flang-rt/unittests/Runtime/CommandTest.cpp b/flang-rt/unittests/Runtime/CommandTest.cpp
index b5f4409b58a72..6919a98105b8a 100644
--- a/flang-rt/unittests/Runtime/CommandTest.cpp
+++ b/flang-rt/unittests/Runtime/CommandTest.cpp
@@ -67,7 +67,7 @@ static OwningPtr<Descriptor> IntDescriptor(const int &value) {
class CommandFixture : public ::testing::Test {
protected:
CommandFixture(int argc, const char *argv[]) {
- RTNAME(ProgramStart)(argc, argv, {}, {}, false);
+ RTNAME(ProgramStart)(argc, argv, {}, {});
}
std::string GetPaddedStr(const char *text, std::size_t len) const {
diff --git a/flang/include/flang/Runtime/main.h b/flang/include/flang/Runtime/main.h
index 5da3d9b903cb8..88232ea64fa6a 100644
--- a/flang/include/flang/Runtime/main.h
+++ b/flang/include/flang/Runtime/main.h
@@ -15,8 +15,8 @@
struct EnvironmentDefaultList;
FORTRAN_EXTERN_C_BEGIN
-void RTNAME(ProgramStart)(int, const char *[], const char *[],
- const struct EnvironmentDefaultList *, const bool multiImageInitialized);
+void RTNAME(ProgramStart)(
+ int, const char *[], const char *[], const struct EnvironmentDefaultList *);
void RTNAME(ByteswapOption)(void); // -byteswapio
FORTRAN_EXTERN_C_END
diff --git a/flang/lib/Lower/Runtime.cpp b/flang/lib/Lower/Runtime.cpp
index 2a135e52d761c..a8b241b07de5e 100644
--- a/flang/lib/Lower/Runtime.cpp
+++ b/flang/lib/Lower/Runtime.cpp
@@ -59,7 +59,6 @@ void Fortran::lower::genStopStatement(
Fortran::parser::StopStmt::Kind::ErrorStop;
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
mlir::Location loc = converter.getCurrentLocation();
-
Fortran::lower::StatementContext stmtCtx;
llvm::SmallVector<mlir::Value> operands;
mlir::func::FuncOp callee;
diff --git a/flang/lib/Optimizer/Builder/Runtime/Main.cpp b/flang/lib/Optimizer/Builder/Runtime/Main.cpp
index be79afbcc5467..f1ac0dac7d3b7 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Main.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Main.cpp
@@ -29,14 +29,12 @@ void fir::runtime::genMain(
auto *context = builder.getContext();
auto argcTy = builder.getDefaultIntegerType();
auto ptrTy = mlir::LLVM::LLVMPointerType::get(context);
- auto logTy = builder.getIntegerType(1);
// void ProgramStart(int argc, char** argv, char** envp,
// _QQEnvironmentDefaults* env)
auto startFn = builder.createFunction(
loc, RTNAME_STRING(ProgramStart),
- mlir::FunctionType::get(context, {argcTy, ptrTy, ptrTy, ptrTy, logTy},
- {}));
+ mlir::FunctionType::get(context, {argcTy, ptrTy, ptrTy, ptrTy}, {}));
// void ProgramStop()
auto stopFn =
builder.createFunction(loc, RTNAME_STRING(ProgramEndStatement),
@@ -61,12 +59,9 @@ void fir::runtime::genMain(
// it only happens once and to provide consistent results if multiple files
// are compiled separately.
auto env = fir::runtime::genEnvironmentDefaults(builder, loc, defs);
- mlir::Value multiImageFeatureEnabled =
- builder.createBool(loc, initCoarrayEnv);
llvm::SmallVector<mlir::Value, 4> args(block->getArguments());
args.push_back(env);
- args.push_back(multiImageFeatureEnabled);
fir::CallOp::create(builder, loc, startFn, args);
diff --git a/flang/test/Driver/emit-mlir.f90 b/flang/test/Driver/emit-mlir.f90
index 6b6a1df32fe02..f2a4b6cf7670b 100644
--- a/flang/test/Driver/emit-mlir.f90
+++ b/flang/test/Driver/emit-mlir.f90
@@ -16,13 +16,12 @@
! CHECK-NEXT: fir.dummy_scope
! CHECK-NEXT: return
! CHECK-NEXT: }
-! CHECK-NEXT: func.func private @_FortranAProgramStart(i32, !llvm.ptr, !llvm.ptr, !llvm.ptr, i1)
+! CHECK-NEXT: func.func private @_FortranAProgramStart(i32, !llvm.ptr, !llvm.ptr, !llvm.ptr)
! CHECK-NEXT: func.func private @_FortranAProgramEndStatement()
! CHECK-NEXT: func.func @main(%arg0: i32, %arg1: !llvm.ptr, %arg2: !llvm.ptr) -> i32 {
! CHECK-NEXT: %c0_i32 = arith.constant 0 : i32
-! CHECK-NEXT: %false = arith.constant false
! CHECK-NEXT: %0 = fir.zero_bits !fir.ref<tuple<i32, !fir.ref<!fir.array<0xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>>
-! CHECK-NEXT: fir.call @_FortranAProgramStart(%arg0, %arg1, %arg2, %0, %false) {{.*}} : (i32, !llvm.ptr, !llvm.ptr, !fir.ref<tuple<i32, !fir.ref<!fir.array<0xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>>, i1)
+! CHECK-NEXT: fir.call @_FortranAProgramStart(%arg0, %arg1, %arg2, %0) {{.*}} : (i32, !llvm.ptr, !llvm.ptr, !fir.ref<tuple<i32, !fir.ref<!fir.array<0xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>>)
! CHECK-NEXT: fir.call @_QQmain() fastmath<contract> : () -> ()
! CHECK-NEXT: fir.call @_FortranAProgramEndStatement() {{.*}} : () -> ()
! CHECK-NEXT: return %c0_i32 : i32
diff --git a/flang/test/Lower/MIF/coarray-init.f90 b/flang/test/Lower/MIF/coarray-init.f90
index 09d58636872ea..3e360452c244e 100644
--- a/flang/test/Lower/MIF/coarray-init.f90
+++ b/flang/test/Lower/MIF/coarray-init.f90
@@ -6,11 +6,5 @@ program test_init
end
! ALL-LABEL: func.func @main
-! COARRAY: %true = arith.constant true
-! COARRAY: fir.call @_FortranAProgramStart(%arg0, %arg1, %arg2, %0, %true) {{.*}} : (i32, !llvm.ptr, !llvm.ptr, !fir.ref<tuple<i32, !fir.ref<!fir.array<0xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>>, i1) -> ()
-
-! NOCOARRAY: %false = arith.constant false
-! NOCARRAY: fir.call @_FortranAProgramStart(%arg0, %arg1, %arg2, %0, %false) {{.*}} : (i32, !llvm.ptr, !llvm.ptr, !fir.ref<tuple<i32, !fir.ref<!fir.array<0xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>>, i1) -> ()
-
! COARRAY: mif.init -> i32
! NOCOARRAY-NOT: mif.init
diff --git a/flang/test/Lower/convert.f90 b/flang/test/Lower/convert.f90
index ef6e732ce35db..75d0f844149ce 100755
--- a/flang/test/Lower/convert.f90
+++ b/flang/test/Lower/convert.f90
@@ -11,9 +11,8 @@ program test
! Try to test that -fconvert=<value> flag results in a environment default list
! with the FORT_CONVERT option correctly specified.
-! ALL: %false = arith.constant false
! ALL: %0 = fir.address_of(@_QQEnvironmentDefaults.list) : !fir.ref<tuple<i32, !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>>
-! ALL: fir.call @_FortranAProgramStart(%arg0, %arg1, %arg2, %0, %false)
+! ALL: fir.call @_FortranAProgramStart(%arg0, %arg1, %arg2, %0)
! ALL: fir.global linkonce @_QQEnvironmentDefaults.items constant : !fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>> {
! ALL: %[[VAL_0:.*]] = fir.undefined !fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>
diff --git a/flang/test/Lower/environment-defaults.f90 b/flang/test/Lower/environment-defaults.f90
index d71bf12aa54e9..f5f41dabecc1d 100755
--- a/flang/test/Lower/environment-defaults.f90
+++ b/flang/test/Lower/environment-defaults.f90
@@ -9,6 +9,5 @@ program test
! CHECK-NOT: @_QQEnvironmentDefaults
-! CHECK: %false = arith.constant false
! CHECK: %0 = fir.zero_bits !fir.ref<tuple<i32, !fir.ref<!fir.array<0xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>>
-! CHECK-NEXT: @_FortranAProgramStart(%arg0, %arg1, %arg2, %0, %false)
+! CHECK-NEXT: @_FortranAProgramStart(%arg0, %arg1, %arg2, %0)
>From ab1c8e00136af25effc7992922eb4033c7961bfc Mon Sep 17 00:00:00 2001
From: Jean-Didier Pailleux <jean-didier.pailleux at sipearl.com>
Date: Tue, 27 Jan 2026 14:28:49 +0100
Subject: [PATCH 12/12] Remove exitHandler
---
.../include/flang-rt/runtime/terminator.h | 10 ++++-----
flang-rt/lib/runtime/stop.cpp | 22 +++++++++----------
flang-rt/lib/runtime/terminator.cpp | 22 ++++++++++---------
flang/lib/Optimizer/Builder/Runtime/Main.cpp | 1 -
flang/test/Lower/MIF/coarray-init.f90 | 1 +
5 files changed, 29 insertions(+), 27 deletions(-)
diff --git a/flang-rt/include/flang-rt/runtime/terminator.h b/flang-rt/include/flang-rt/runtime/terminator.h
index 85a5aeacf8fae..a856c4eb76188 100644
--- a/flang-rt/include/flang-rt/runtime/terminator.h
+++ b/flang-rt/include/flang-rt/runtime/terminator.h
@@ -113,12 +113,12 @@ class Terminator {
else \
Terminator{__FILE__, __LINE__}.CheckFailed(#pred)
-struct ExitHandler {
- ExitHandler() {};
+void SetNormalEndCallback(void (*callback)(int));
+void SetFailImageCallback(void (*callback)(void));
+void SetErrorCallback(void (*callback)(int));
- [[noreturn]] void NormalExit(int exitCode);
- [[noreturn]] void ErrorExit(int exitCode);
-};
+[[noreturn]] void NormalExit(int exitCode);
+[[noreturn]] void ErrorExit(int exitCode);
RT_API_ATTRS void SynchronizeImagesOfNormalEnd(int);
RT_API_ATTRS void NotifyOtherImagesOfFailImageStatement();
diff --git a/flang-rt/lib/runtime/stop.cpp b/flang-rt/lib/runtime/stop.cpp
index 7c6b80f1549ec..75fa64c4c0039 100644
--- a/flang-rt/lib/runtime/stop.cpp
+++ b/flang-rt/lib/runtime/stop.cpp
@@ -97,9 +97,9 @@ static void CloseAllExternalUnits(const char *why) {
DescribeIEEESignaledExceptions();
}
if (isErrorStop)
- Fortran::runtime::exitHandler.ErrorExit(code);
+ Fortran::runtime::ErrorExit(code);
else
- Fortran::runtime::exitHandler.NormalExit(code);
+ Fortran::runtime::NormalExit(code);
#endif
}
@@ -127,9 +127,9 @@ static void CloseAllExternalUnits(const char *why) {
DescribeIEEESignaledExceptions();
}
if (isErrorStop) {
- Fortran::runtime::exitHandler.ErrorExit(EXIT_FAILURE);
+ Fortran::runtime::ErrorExit(EXIT_FAILURE);
} else {
- Fortran::runtime::exitHandler.NormalExit(EXIT_SUCCESS);
+ Fortran::runtime::NormalExit(EXIT_SUCCESS);
}
#endif
}
@@ -147,7 +147,7 @@ static void EndPause() {
std::fflush(nullptr);
if (std::fgetc(stdin) == EOF) {
CloseAllExternalUnits("PAUSE statement");
- Fortran::runtime::exitHandler.ErrorExit(EXIT_SUCCESS);
+ Fortran::runtime::ErrorExit(EXIT_SUCCESS);
}
}
@@ -177,29 +177,29 @@ void RTNAME(PauseStatementText)(const char *code, std::size_t length) {
[[noreturn]] void RTNAME(FailImageStatement)() {
CloseAllExternalUnits("FAIL IMAGE statement");
Fortran::runtime::NotifyOtherImagesOfFailImageStatement();
- Fortran::runtime::exitHandler.NormalExit(EXIT_FAILURE);
+ Fortran::runtime::NormalExit(EXIT_FAILURE);
}
[[noreturn]] void RTNAME(ProgramEndStatement)() {
CloseAllExternalUnits("END statement");
- Fortran::runtime::exitHandler.NormalExit(EXIT_SUCCESS);
+ Fortran::runtime::NormalExit(EXIT_SUCCESS);
}
void RTNAME(RegisterImagesNormalEndCallback)(void (*callback)(int)) {
- Fortran::runtime::normalEndCallback = callback;
+ Fortran::runtime::SetNormalEndCallback(callback);
}
void RTNAME(RegisterImagesErrorCallback)(void (*callback)(int)) {
- Fortran::runtime::errorCallback = callback;
+ Fortran::runtime::SetErrorCallback(callback);
}
void RTNAME(RegisterFailImageCallback)(void (*callback)(void)) {
- Fortran::runtime::failImageCallback = callback;
+ Fortran::runtime::SetFailImageCallback(callback);
}
[[noreturn]] void RTNAME(Exit)(int status) {
CloseAllExternalUnits("CALL EXIT()");
- Fortran::runtime::exitHandler.NormalExit(status);
+ Fortran::runtime::NormalExit(status);
}
static RT_NOINLINE_ATTR void PrintBacktrace() {
diff --git a/flang-rt/lib/runtime/terminator.cpp b/flang-rt/lib/runtime/terminator.cpp
index 1591708589311..e8d64223919e4 100644
--- a/flang-rt/lib/runtime/terminator.cpp
+++ b/flang-rt/lib/runtime/terminator.cpp
@@ -41,13 +41,6 @@ void Terminator::InvokeCrashHandler(const char *message, ...) const {
RT_OFFLOAD_API_GROUP_BEGIN
-#ifndef FLANG_RUNTIME_NO_GLOBAL_VAR_DEFS
-RT_VAR_ATTRS ExitHandler exitHandler;
-RT_VAR_ATTRS void (*normalEndCallback)(int);
-RT_VAR_ATTRS void (*failImageCallback)(void);
-RT_VAR_ATTRS void (*errorCallback)(int);
-#endif // FLANG_RUNTIME_NO_GLOBAL_VAR_DEFS
-
RT_API_ATTRS void Terminator::CrashHeader() const {
#if defined(RT_DEVICE_COMPILATION)
std::printf("\nfatal Fortran runtime error");
@@ -100,20 +93,29 @@ RT_API_ATTRS void Terminator::CrashHeader() const {
sourceFileName_, sourceLine_);
}
-static RT_VAR_ATTRS ExitHandler exitHandler;
static RT_VAR_ATTRS void (*normalEndCallback)(int) = nullptr;
static RT_VAR_ATTRS void (*failImageCallback)(void) = nullptr;
static RT_VAR_ATTRS void (*errorCallback)(int) = nullptr;
+void SetNormalEndCallback(void (*callback)(int)) {
+ normalEndCallback = callback;
+}
+
+void SetFailImageCallback(void (*callback)(void)) {
+ failImageCallback = callback;
+}
+
+void SetErrorCallback(void (*callback)(int)) { errorCallback = callback; }
+
[[noreturn]]
-void ExitHandler::NormalExit(int exitCode) {
+void NormalExit(int exitCode) {
SynchronizeImagesOfNormalEnd(exitCode); // might never return
std::exit(exitCode);
}
[[noreturn]]
-void ExitHandler::ErrorExit(int exitCode) {
+void ErrorExit(int exitCode) {
NotifyOtherImagesOfErrorTermination(exitCode); // might never return
std::exit(exitCode);
diff --git a/flang/lib/Optimizer/Builder/Runtime/Main.cpp b/flang/lib/Optimizer/Builder/Runtime/Main.cpp
index f1ac0dac7d3b7..2b748ded039fd 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Main.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Main.cpp
@@ -77,6 +77,5 @@ void fir::runtime::genMain(
mlir::Value ret = builder.createIntegerConstant(loc, argcTy, 0);
fir::CallOp::create(builder, loc, stopFn);
-
mlir::func::ReturnOp::create(builder, loc, ret);
}
diff --git a/flang/test/Lower/MIF/coarray-init.f90 b/flang/test/Lower/MIF/coarray-init.f90
index 3e360452c244e..e3526f6e09993 100644
--- a/flang/test/Lower/MIF/coarray-init.f90
+++ b/flang/test/Lower/MIF/coarray-init.f90
@@ -6,5 +6,6 @@ program test_init
end
! ALL-LABEL: func.func @main
+! ALL: fir.call @_FortranAProgramStart
! COARRAY: mif.init -> i32
! NOCOARRAY-NOT: mif.init
More information about the llvm-commits
mailing list