[flang] Lower basic STOP statement

[clementval]

Summary

This patch lowers STOP statement without arguments
and ERROR STOP. STOP statement with arguments lowering will
come in later patches ince it requires some expression lowering
to be added.
STOP statement is lowered to a runtime call.

Also makes sure we are creating a constant in the MLIR arith constant.

This patch is part of the upstreaming effort from fir-dev branch.

Co-authored-by: Eric Schweitz <[e-mail]>

[clementval]

Rebase

[kiranchandramohan]

LGTM.

flang/lib/Lower/Runtime.cpp

10–23

Nit: It might be possible to trim this, I guess time-intrinsic, random etc are probably not needed now.

flang/lib/Lower/Bridge.cpp

 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Lower/Bridge.h"
 #include "flang/Evaluate/tools.h"
 #include "flang/Lower/CallInterface.h"
 #include "flang/Lower/Mangler.h"
 #include "flang/Lower/PFTBuilder.h"
+#include "flang/Lower/Runtime.h"
 #include "flang/Lower/SymbolMap.h"
 #include "flang/Lower/Todo.h"
 #include "flang/Optimizer/Support/FIRContext.h"
 #include "mlir/IR/PatternMatch.h"
 #include "mlir/Transforms/RegionUtils.h"
 #include "llvm/Support/CommandLine.h"
 #include "llvm/Support/Debug.h"
 
private:
   void genFIR(const Fortran::parser::PauseStmt &stmt) {
     TODO(toLocation(), "PauseStmt lowering");
   }
 
   void genFIR(const Fortran::parser::FailImageStmt &stmt) {
     TODO(toLocation(), "FailImageStmt lowering");
   }
 
+  // call STOP, ERROR STOP in runtime
   void genFIR(const Fortran::parser::StopStmt &stmt) {
-    TODO(toLocation(), "StopStmt lowering");
+    genStopStatement(*this, stmt);
   }
 
   void genFIR(const Fortran::parser::ReturnStmt &stmt) {
     TODO(toLocation(), "ReturnStmt lowering");
   }
 
   void genFIR(const Fortran::parser::CycleStmt &) {
     TODO(toLocation(), "CycleStmt lowering");

flang/lib/Lower/CMakeLists.txt

 get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS)
 
 add_flang_library(FortranLower
   Bridge.cpp
   CallInterface.cpp
   Coarray.cpp
   ConvertType.cpp
   Mangler.cpp
   OpenACC.cpp
   OpenMP.cpp
   PFTBuilder.cpp
+  Runtime.cpp
   SymbolMap.cpp
 
   DEPENDS
   FIRDialect
   FIRBuilder
   FIRSupport
   FIRTransforms
   ${dialect_libs}

flang/lib/Lower/Runtime.cpp

+//===-- Runtime.cpp -------------------------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Lower/Runtime.h"
+#include "flang/Lower/Bridge.h"
+#include "flang/Lower/Todo.h"
+#include "flang/Optimizer/Builder/BoxValue.h"
+#include "flang/Optimizer/Builder/FIRBuilder.h"
+#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
+#include "flang/Parser/parse-tree.h"
+#include "flang/Runtime/misc-intrinsic.h"
+#include "flang/Runtime/pointer.h"
+#include "flang/Runtime/random.h"
+#include "flang/Runtime/stop.h"
+#include "flang/Runtime/time-intrinsic.h"
+#include "flang/Semantics/tools.h"
+#include "llvm/Support/Debug.h"
+
+#define DEBUG_TYPE "flang-lower-runtime"
+
+using namespace Fortran::runtime;
+
+/// Runtime calls that do not return to the caller indicate this condition by
+/// terminating the current basic block with an unreachable op.
+static void genUnreachable(fir::FirOpBuilder &builder, mlir::Location loc) {
+  builder.create<fir::UnreachableOp>(loc);
+  mlir::Block *newBlock =
+      builder.getBlock()->splitBlock(builder.getInsertionPoint());
+  builder.setInsertionPointToStart(newBlock);
+}
+
+//===----------------------------------------------------------------------===//
+// Misc. Fortran statements that lower to runtime calls
+//===----------------------------------------------------------------------===//
+
+void Fortran::lower::genStopStatement(
+    Fortran::lower::AbstractConverter &converter,
+    const Fortran::parser::StopStmt &stmt) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  mlir::Location loc = converter.getCurrentLocation();
+  llvm::SmallVector<mlir::Value> operands;
+  mlir::FuncOp callee;
+  mlir::FunctionType calleeType;
+  // First operand is stop code (zero if absent)
+  if (std::get<std::optional<Fortran::parser::StopCode>>(stmt.t)) {
+    TODO(loc, "STOP first operand not lowered yet");
+  } else {
+    callee = fir::runtime::getRuntimeFunc<mkRTKey(StopStatement)>(loc, builder);
+    calleeType = callee.getType();
+    operands.push_back(
+        builder.createIntegerConstant(loc, calleeType.getInput(0), 0));
+  }
+
+  // Second operand indicates ERROR STOP
+  bool isError = std::get<Fortran::parser::StopStmt::Kind>(stmt.t) ==
+                 Fortran::parser::StopStmt::Kind::ErrorStop;
+  operands.push_back(builder.createIntegerConstant(
+      loc, calleeType.getInput(operands.size()), isError));
+
+  // Third operand indicates QUIET (default to false).
+  if (std::get<std::optional<Fortran::parser::ScalarLogicalExpr>>(stmt.t)) {
+    TODO(loc, "STOP third operand not lowered yet");
+  } else {
+    operands.push_back(builder.createIntegerConstant(
+        loc, calleeType.getInput(operands.size()), 0));
+  }
+
+  builder.create<fir::CallOp>(loc, callee, operands);
+  genUnreachable(builder, loc);
+}

flang/lib/Optimizer/Builder/FIRBuilder.cpp

mlir::Value fir::FirOpBuilder::createNullConstant(mlir::Location loc,
                                                   mlir::Type ptrType) {
   auto ty = ptrType ? ptrType : getRefType(getNoneType());
   return create<fir::ZeroOp>(loc, ty);
 }
 
 mlir::Value fir::FirOpBuilder::createIntegerConstant(mlir::Location loc,
                                                      mlir::Type ty,
                                                      std::int64_t cst) {
-  return create<mlir::ConstantOp>(loc, ty, getIntegerAttr(ty, cst));
+  return create<mlir::arith::ConstantOp>(loc, ty, getIntegerAttr(ty, cst));
 }
 
 mlir::Value
 fir::FirOpBuilder::createRealConstant(mlir::Location loc, mlir::Type fltTy,
                                       llvm::APFloat::integerPart val) {
   auto apf = [&]() -> llvm::APFloat {
     if (auto ty = fltTy.dyn_cast<fir::RealType>())
       return llvm::APFloat(kindMap.getFloatSemantics(ty.getFKind()), val);

flang/test/Lower/stop-statement.f90

+! RUN: bbc %s -emit-fir --canonicalize -o - | FileCheck %s
+
+! CHECK-LABEL stop_test
+subroutine stop_test()
+ ! CHECK-DAG: %[[c0:.*]] = arith.constant 0 : i32
+ ! CHECK-DAG: %[[false:.*]] = arith.constant false
+ ! CHECK: fir.call @_Fortran{{.*}}StopStatement(%[[c0]], %[[false]], %[[false]])
+ ! CHECK-NEXT: fir.unreachable
+ stop
+end subroutine 
+
+
+! CHECK-LABEL stop_error
+subroutine stop_error()
+ error stop
+ ! CHECK-DAG: %[[c0:.*]] = arith.constant 0 : i32
+ ! CHECK-DAG: %[[true:.*]] = arith.constant true
+ ! CHECK-DAG: %[[false:.*]] = arith.constant false
+ ! CHECK: fir.call @_Fortran{{.*}}StopStatement(%[[c0]], %[[true]], %[[false]])
+ ! CHECK-NEXT: fir.unreachable
+end subroutine

flang/unittests/Optimizer/Builder/DoLoopHelperTest.cpp

public:
   fir::FirOpBuilder &getBuilder() { return *firBuilder; }
 
   mlir::MLIRContext context;
   std::unique_ptr<fir::KindMapping> kindMap;
   fir::FirOpBuilder *firBuilder;
 };
 
 void checkConstantValue(const mlir::Value &value, int64_t v) {
-  EXPECT_TRUE(mlir::isa<ConstantOp>(value.getDefiningOp()));
-  auto cstOp = dyn_cast<ConstantOp>(value.getDefiningOp());
+  EXPECT_TRUE(mlir::isa<mlir::arith::ConstantOp>(value.getDefiningOp()));
+  auto cstOp = dyn_cast<mlir::arith::ConstantOp>(value.getDefiningOp());
   auto valueAttr = cstOp.getValue().dyn_cast_or_null<IntegerAttr>();
   EXPECT_EQ(v, valueAttr.getInt());
 }
 
 TEST_F(DoLoopHelperTest, createLoopWithCountTest) {
   auto firBuilder = getBuilder();
   fir::factory::DoLoopHelper helper(firBuilder, firBuilder.getUnknownLoc());
 

flang/unittests/Optimizer/Builder/FIRBuilderTest.cpp

static arith::CmpIOp createCondition(fir::FirOpBuilder &builder) {
   auto loc = builder.getUnknownLoc();
   auto zero1 = builder.createIntegerConstant(loc, builder.getIndexType(), 0);
   auto zero2 = builder.createIntegerConstant(loc, builder.getIndexType(), 0);
   return builder.create<arith::CmpIOp>(
       loc, arith::CmpIPredicate::eq, zero1, zero2);
 }
 
 static void checkIntegerConstant(mlir::Value value, mlir::Type ty, int64_t v) {
-  EXPECT_TRUE(mlir::isa<ConstantOp>(value.getDefiningOp()));
-  auto cstOp = dyn_cast<ConstantOp>(value.getDefiningOp());
+  EXPECT_TRUE(mlir::isa<mlir::arith::ConstantOp>(value.getDefiningOp()));
+  auto cstOp = dyn_cast<mlir::arith::ConstantOp>(value.getDefiningOp());
   EXPECT_EQ(ty, cstOp.getType());
   auto valueAttr = cstOp.getValue().dyn_cast_or_null<IntegerAttr>();
   EXPECT_EQ(v, valueAttr.getInt());
 }
 
 //===----------------------------------------------------------------------===//
 // IfBuilder tests
 //===----------------------------------------------------------------------===//