[flang][MIF] Adding Stop and ErrorStop operations

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">;

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
 //===----------------------------------------------------------------------===//

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,19 +141,27 @@ 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 {
     operands.push_back(builder.createIntegerConstant(
         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() ||

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);
 }

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
 //===----------------------------------------------------------------------===//

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,