[flang-commits] [flang] [llvm] [flang][MIF] Adding Stop and ErrorStop operations (PR #166787)
Jean-Didier PAILLEUX via flang-commits
flang-commits at lists.llvm.org
Mon Dec 15 06:00:08 PST 2025
https://github.com/JDPailleux updated https://github.com/llvm/llvm-project/pull/166787
>From 1bbd25ff5f8451e4511687018631b86359646f11 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 1/2] [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 9b5bfa7daa23dccf3ef538c7ae1e7001e3d986c2 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 2/2] 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 98d7de81c7f08..f2ef8c71d2af5 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
@@ -252,6 +252,14 @@ constexpr TypeBuilderFunc getModel<void (*)(int)>() {
};
}
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
+
More information about the flang-commits
mailing list