[flang][MIF] Adding Stop and ErrorStop operations #166787
Open
Conversation
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
llvmbot
added
flang
Member
|
@llvm/pr-subscribers-flang-fir-hlfir Author: Jean-Didier PAILLEUX (JDPailleux) ChangesThis PR proposes to add Similarly, as specified by the PRIF specification, the program termination must call the PRIF Patch is 34.74 KiB, truncated to 20.00 KiB below, full version: https://github.com/llvm/llvm-project/pull/166787.diff 11 Files Affected:
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 52471d3702b76..eeaec1c7530a5 100644
--- a/flang/include/flang/Optimizer/Dialect/MIF/MIFOps.td
+++ b/flang/include/flang/Optimizer/Dialect/MIF/MIFOps.td
@@ -33,6 +33,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 cb555249125f6..94f1c22060c92 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"
@@ -84,10 +85,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)) {
@@ -105,8 +111,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();
@@ -131,11 +141,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 {
@@ -143,7 +154,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 c6cc2e855ff35..6feaf8c5eabde 100644
--- a/flang/lib/Optimizer/Dialect/MIF/MIFOps.cpp
+++ b/flang/lib/Optimizer/Dialect/MIF/MIFOps.cpp
@@ -18,6 +18,32 @@
#define GET_OP_CLASSES
#include "flang/Optimizer/Dialect/MIF/MIFOps.cpp.inc"
+//===----------------------------------------------------------------------===//
+// 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 206cb9be0574f..491c32a9576f0 100644
--- a/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp
+++ b/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp
@@ -93,6 +93,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> {
@@ -455,7 +551,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,
MIFCoBroadcastOpConversion, MIFCoMaxOpConversion,
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 @_QPerro...
[truncated]
|
jeanPerier
requested changes
Nov 12, 2025
Contributor
jeanPerier
left a comment
jeanPerier
left a comment
There was a problem hiding this comment.
Thanks @JDPailleux for working on this topic.
I think a different approach is needed here because:
- program termination may occur in more contexts that STOP/STOP ERROR (e.g. triggered inside the Fortran runtime after invalid IO without IOSTAT/ERRMSG).
- ad-hoc handling of STOP/STOP ERROR in lowering when
-fcoarrayis provided is adding the divergence in the compiler flow earlier than needed, and assumes that all libraries linked to a program using mutli image statements were compiled with-fcoarray(I think we should aim to avoid this requirement, although I have done a good job at assessing how much that is possible).
Instead, the Fortran runtime already has three APIs meant for mutli image Fortran that are called when a program hits terminations:
RT_API_ATTRS void NotifyOtherImagesOfNormalEnd();
RT_API_ATTRS void NotifyOtherImagesOfFailImageStatement();
RT_API_ATTRS void NotifyOtherImagesOfErrorTermination();
They currently are no-ops.
What I think should happen is that when lowering mif.init:
- PRIF termination APIs that must be called when the current image terminate should be registered to the Fortran runtime so that they can be called in the three APIs above.
- Fortran runtime termination should also likely be registered to the PRIF runtime so that when another image fails, the PRIF runtime can initiate the terminations of other images (to make sure that any Fortran runtime data structure/state that needs to be cleaned-up before termination is cleaned-up).
So I think you need to add an new API to the Fortran runtime so that you can register the PRIF callbacks as needed. Maybe using std::atexit is also an option.
That way, there will be a termination interface between PRIF and the Fortran Runtime without having to catch and special case all termination situations inside compiler code. This should also allow aborts in library compiled without -focarray to still properly signal the termination to other images.
Contributor
Hi @jeanPerier - Thanks for pointing out these callbacks. I agree in principle that this might be a reasonable approach, and I certainly agree it would be best to funnel error terminations initiated inside flang-rt into multi-image error termination. However IIUC adopting this approach will require some non-trivial changes to how these three APIs are registered and invoked inside flang-rt. Skimming the code, the most egregious problem that pops out is that currently Fortran normal error termination implies a synchronization (barrier) across all the images, so it's only safe to call when you're really really sure that the program has reached a specified normal termination point. Most importantly, I see several places in the exit code in flang-rt that invoke |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
4 participants
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
This PR proposes to add
StopandErrorStopoperations to the MIF dialect in order to lower to the corresponding PRIF procedures.If the
-fcoarrayflag is passed, then all calls toSTOPandERROR STOPwill be replaced by those of PRIF/MIF.Similarly, as specified by the PRIF specification, the program termination must call the PRIF
STOPprocedure to clean up the parallel environment.