1*aab4263aSValentin Clement //===-- Runtime.cpp -------------------------------------------------------===// 2*aab4263aSValentin Clement // 3*aab4263aSValentin Clement // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. 4*aab4263aSValentin Clement // See https://llvm.org/LICENSE.txt for license information. 5*aab4263aSValentin Clement // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception 6*aab4263aSValentin Clement // 7*aab4263aSValentin Clement //===----------------------------------------------------------------------===// 8*aab4263aSValentin Clement 9*aab4263aSValentin Clement #include "flang/Lower/Runtime.h" 10*aab4263aSValentin Clement #include "flang/Lower/Bridge.h" 11*aab4263aSValentin Clement #include "flang/Lower/Todo.h" 12*aab4263aSValentin Clement #include "flang/Optimizer/Builder/FIRBuilder.h" 13*aab4263aSValentin Clement #include "flang/Optimizer/Builder/Runtime/RTBuilder.h" 14*aab4263aSValentin Clement #include "flang/Parser/parse-tree.h" 15*aab4263aSValentin Clement #include "flang/Runtime/stop.h" 16*aab4263aSValentin Clement #include "flang/Semantics/tools.h" 17*aab4263aSValentin Clement #include "llvm/Support/Debug.h" 18*aab4263aSValentin Clement 19*aab4263aSValentin Clement #define DEBUG_TYPE "flang-lower-runtime" 20*aab4263aSValentin Clement 21*aab4263aSValentin Clement using namespace Fortran::runtime; 22*aab4263aSValentin Clement 23*aab4263aSValentin Clement /// Runtime calls that do not return to the caller indicate this condition by 24*aab4263aSValentin Clement /// terminating the current basic block with an unreachable op. 25*aab4263aSValentin Clement static void genUnreachable(fir::FirOpBuilder &builder, mlir::Location loc) { 26*aab4263aSValentin Clement builder.create<fir::UnreachableOp>(loc); 27*aab4263aSValentin Clement mlir::Block *newBlock = 28*aab4263aSValentin Clement builder.getBlock()->splitBlock(builder.getInsertionPoint()); 29*aab4263aSValentin Clement builder.setInsertionPointToStart(newBlock); 30*aab4263aSValentin Clement } 31*aab4263aSValentin Clement 32*aab4263aSValentin Clement //===----------------------------------------------------------------------===// 33*aab4263aSValentin Clement // Misc. Fortran statements that lower to runtime calls 34*aab4263aSValentin Clement //===----------------------------------------------------------------------===// 35*aab4263aSValentin Clement 36*aab4263aSValentin Clement void Fortran::lower::genStopStatement( 37*aab4263aSValentin Clement Fortran::lower::AbstractConverter &converter, 38*aab4263aSValentin Clement const Fortran::parser::StopStmt &stmt) { 39*aab4263aSValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 40*aab4263aSValentin Clement mlir::Location loc = converter.getCurrentLocation(); 41*aab4263aSValentin Clement llvm::SmallVector<mlir::Value> operands; 42*aab4263aSValentin Clement mlir::FuncOp callee; 43*aab4263aSValentin Clement mlir::FunctionType calleeType; 44*aab4263aSValentin Clement // First operand is stop code (zero if absent) 45*aab4263aSValentin Clement if (std::get<std::optional<Fortran::parser::StopCode>>(stmt.t)) { 46*aab4263aSValentin Clement TODO(loc, "STOP first operand not lowered yet"); 47*aab4263aSValentin Clement } else { 48*aab4263aSValentin Clement callee = fir::runtime::getRuntimeFunc<mkRTKey(StopStatement)>(loc, builder); 49*aab4263aSValentin Clement calleeType = callee.getType(); 50*aab4263aSValentin Clement operands.push_back( 51*aab4263aSValentin Clement builder.createIntegerConstant(loc, calleeType.getInput(0), 0)); 52*aab4263aSValentin Clement } 53*aab4263aSValentin Clement 54*aab4263aSValentin Clement // Second operand indicates ERROR STOP 55*aab4263aSValentin Clement bool isError = std::get<Fortran::parser::StopStmt::Kind>(stmt.t) == 56*aab4263aSValentin Clement Fortran::parser::StopStmt::Kind::ErrorStop; 57*aab4263aSValentin Clement operands.push_back(builder.createIntegerConstant( 58*aab4263aSValentin Clement loc, calleeType.getInput(operands.size()), isError)); 59*aab4263aSValentin Clement 60*aab4263aSValentin Clement // Third operand indicates QUIET (default to false). 61*aab4263aSValentin Clement if (std::get<std::optional<Fortran::parser::ScalarLogicalExpr>>(stmt.t)) { 62*aab4263aSValentin Clement TODO(loc, "STOP third operand not lowered yet"); 63*aab4263aSValentin Clement } else { 64*aab4263aSValentin Clement operands.push_back(builder.createIntegerConstant( 65*aab4263aSValentin Clement loc, calleeType.getInput(operands.size()), 0)); 66*aab4263aSValentin Clement } 67*aab4263aSValentin Clement 68*aab4263aSValentin Clement builder.create<fir::CallOp>(loc, callee, operands); 69*aab4263aSValentin Clement genUnreachable(builder, loc); 70*aab4263aSValentin Clement } 71