265 lines · cpp
1//===-- Runtime.cpp -------------------------------------------------------===//2//3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.4// See https://llvm.org/LICENSE.txt for license information.5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception6//7//===----------------------------------------------------------------------===//8 9#include "flang/Lower/Runtime.h"10#include "flang/Lower/Bridge.h"11#include "flang/Lower/OpenACC.h"12#include "flang/Lower/OpenMP.h"13#include "flang/Lower/StatementContext.h"14#include "flang/Optimizer/Builder/FIRBuilder.h"15#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"16#include "flang/Optimizer/Builder/Todo.h"17#include "flang/Optimizer/Dialect/FIROpsSupport.h"18#include "flang/Optimizer/Dialect/MIF/MIFOps.h"19#include "flang/Parser/parse-tree.h"20#include "flang/Runtime/misc-intrinsic.h"21#include "flang/Runtime/pointer.h"22#include "flang/Runtime/random.h"23#include "flang/Runtime/stop.h"24#include "flang/Runtime/time-intrinsic.h"25#include "flang/Semantics/tools.h"26#include "mlir/Dialect/OpenACC/OpenACC.h"27#include "mlir/Dialect/OpenMP/OpenMPDialect.h"28#include "llvm/Support/Debug.h"29#include <optional>30 31#define DEBUG_TYPE "flang-lower-runtime"32 33using namespace Fortran::runtime;34 35/// Runtime calls that do not return to the caller indicate this condition by36/// terminating the current basic block with an unreachable op.37static void genUnreachable(fir::FirOpBuilder &builder, mlir::Location loc) {38 mlir::Block *curBlock = builder.getBlock();39 mlir::Operation *parentOp = curBlock->getParentOp();40 if (parentOp->getDialect()->getNamespace() ==41 mlir::omp::OpenMPDialect::getDialectNamespace())42 Fortran::lower::genOpenMPTerminator(builder, parentOp, loc);43 else if (Fortran::lower::isInsideOpenACCComputeConstruct(builder))44 Fortran::lower::genOpenACCTerminator(builder, parentOp, loc);45 else46 fir::UnreachableOp::create(builder, loc);47 mlir::Block *newBlock = curBlock->splitBlock(builder.getInsertionPoint());48 builder.setInsertionPointToStart(newBlock);49}50 51//===----------------------------------------------------------------------===//52// Misc. Fortran statements that lower to runtime calls53//===----------------------------------------------------------------------===//54 55void Fortran::lower::genStopStatement(56 Fortran::lower::AbstractConverter &converter,57 const Fortran::parser::StopStmt &stmt) {58 const bool isError = std::get<Fortran::parser::StopStmt::Kind>(stmt.t) ==59 Fortran::parser::StopStmt::Kind::ErrorStop;60 fir::FirOpBuilder &builder = converter.getFirOpBuilder();61 mlir::Location loc = converter.getCurrentLocation();62 Fortran::lower::StatementContext stmtCtx;63 llvm::SmallVector<mlir::Value> operands;64 mlir::func::FuncOp callee;65 mlir::FunctionType calleeType;66 // First operand is stop code (zero if absent)67 if (const auto &code =68 std::get<std::optional<Fortran::parser::StopCode>>(stmt.t)) {69 auto expr =70 converter.genExprValue(*Fortran::semantics::GetExpr(*code), stmtCtx);71 LLVM_DEBUG(llvm::dbgs() << "stop expression: "; expr.dump();72 llvm::dbgs() << '\n');73 expr.match(74 [&](const fir::CharBoxValue &x) {75 callee = fir::runtime::getRuntimeFunc<mkRTKey(StopStatementText)>(76 loc, builder);77 calleeType = callee.getFunctionType();78 // Creates a pair of operands for the CHARACTER and its LEN.79 operands.push_back(80 builder.createConvert(loc, calleeType.getInput(0), x.getAddr()));81 operands.push_back(82 builder.createConvert(loc, calleeType.getInput(1), x.getLen()));83 },84 [&](fir::UnboxedValue x) {85 callee = fir::runtime::getRuntimeFunc<mkRTKey(StopStatement)>(86 loc, builder);87 calleeType = callee.getFunctionType();88 mlir::Value cast =89 builder.createConvert(loc, calleeType.getInput(0), x);90 operands.push_back(cast);91 },92 [&](auto) {93 fir::emitFatalError(loc, "unhandled expression in STOP");94 });95 } else {96 callee = fir::runtime::getRuntimeFunc<mkRTKey(StopStatement)>(loc, builder);97 calleeType = callee.getFunctionType();98 // Default to values are advised in F'2023 11.4 p2.99 operands.push_back(builder.createIntegerConstant(100 loc, calleeType.getInput(0), isError ? 1 : 0));101 }102 103 // Second operand indicates ERROR STOP104 operands.push_back(builder.createIntegerConstant(105 loc, calleeType.getInput(operands.size()), isError));106 107 // Third operand indicates QUIET (default to false).108 if (const auto &quiet =109 std::get<std::optional<Fortran::parser::ScalarLogicalExpr>>(stmt.t)) {110 const SomeExpr *expr = Fortran::semantics::GetExpr(*quiet);111 assert(expr && "failed getting typed expression");112 mlir::Value q = fir::getBase(converter.genExprValue(*expr, stmtCtx));113 operands.push_back(114 builder.createConvert(loc, calleeType.getInput(operands.size()), q));115 } else {116 operands.push_back(builder.createIntegerConstant(117 loc, calleeType.getInput(operands.size()), 0));118 }119 120 fir::CallOp::create(builder, loc, callee, operands);121 auto blockIsUnterminated = [&builder]() {122 mlir::Block *currentBlock = builder.getBlock();123 return currentBlock->empty() ||124 !currentBlock->back().hasTrait<mlir::OpTrait::IsTerminator>();125 };126 if (blockIsUnterminated())127 genUnreachable(builder, loc);128}129 130void Fortran::lower::genFailImageStatement(131 Fortran::lower::AbstractConverter &converter) {132 fir::FirOpBuilder &builder = converter.getFirOpBuilder();133 mlir::Location loc = converter.getCurrentLocation();134 mlir::func::FuncOp callee =135 fir::runtime::getRuntimeFunc<mkRTKey(FailImageStatement)>(loc, builder);136 fir::CallOp::create(builder, loc, callee, mlir::ValueRange{});137 genUnreachable(builder, loc);138}139 140void Fortran::lower::genNotifyWaitStatement(141 Fortran::lower::AbstractConverter &converter,142 const Fortran::parser::NotifyWaitStmt &) {143 TODO(converter.getCurrentLocation(), "coarray: NOTIFY WAIT runtime");144}145 146void Fortran::lower::genEventPostStatement(147 Fortran::lower::AbstractConverter &converter,148 const Fortran::parser::EventPostStmt &) {149 TODO(converter.getCurrentLocation(), "coarray: EVENT POST runtime");150}151 152void Fortran::lower::genEventWaitStatement(153 Fortran::lower::AbstractConverter &converter,154 const Fortran::parser::EventWaitStmt &) {155 TODO(converter.getCurrentLocation(), "coarray: EVENT WAIT runtime");156}157 158void Fortran::lower::genLockStatement(159 Fortran::lower::AbstractConverter &converter,160 const Fortran::parser::LockStmt &) {161 TODO(converter.getCurrentLocation(), "coarray: LOCK runtime");162}163 164void Fortran::lower::genUnlockStatement(165 Fortran::lower::AbstractConverter &converter,166 const Fortran::parser::UnlockStmt &) {167 TODO(converter.getCurrentLocation(), "coarray: UNLOCK runtime");168}169 170void Fortran::lower::genPauseStatement(171 Fortran::lower::AbstractConverter &converter,172 const Fortran::parser::PauseStmt &stmt) {173 174 fir::FirOpBuilder &builder = converter.getFirOpBuilder();175 mlir::Location loc = converter.getCurrentLocation();176 Fortran::lower::StatementContext stmtCtx;177 178 llvm::SmallVector<mlir::Value> operands;179 mlir::func::FuncOp callee;180 mlir::FunctionType calleeType;181 182 if (stmt.v.has_value()) {183 const auto &code = stmt.v.value();184 auto expr =185 converter.genExprValue(*Fortran::semantics::GetExpr(code), stmtCtx);186 expr.match(187 // Character-valued expression -> call PauseStatementText (CHAR, LEN)188 [&](const fir::CharBoxValue &x) {189 callee = fir::runtime::getRuntimeFunc<mkRTKey(PauseStatementText)>(190 loc, builder);191 calleeType = callee.getFunctionType();192 193 operands.push_back(194 builder.createConvert(loc, calleeType.getInput(0), x.getAddr()));195 operands.push_back(196 builder.createConvert(loc, calleeType.getInput(1), x.getLen()));197 },198 // Unboxed value -> call PauseStatementInt which accepts an integer.199 [&](fir::UnboxedValue x) {200 callee = fir::runtime::getRuntimeFunc<mkRTKey(PauseStatementInt)>(201 loc, builder);202 calleeType = callee.getFunctionType();203 assert(calleeType.getNumInputs() >= 1);204 mlir::Value cast =205 builder.createConvert(loc, calleeType.getInput(0), x);206 operands.push_back(cast);207 },208 [&](auto) {209 fir::emitFatalError(loc, "unhandled expression in PAUSE");210 });211 } else {212 callee =213 fir::runtime::getRuntimeFunc<mkRTKey(PauseStatement)>(loc, builder);214 calleeType = callee.getFunctionType();215 }216 217 fir::CallOp::create(builder, loc, callee, operands);218 219 // NOTE: PAUSE does not terminate the current block. The program may resume220 // and continue normal execution, so we do not emit control-flow terminators.221}222 223void Fortran::lower::genPointerAssociate(fir::FirOpBuilder &builder,224 mlir::Location loc,225 mlir::Value pointer,226 mlir::Value target) {227 mlir::func::FuncOp func =228 fir::runtime::getRuntimeFunc<mkRTKey(PointerAssociate)>(loc, builder);229 llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(230 builder, loc, func.getFunctionType(), pointer, target);231 fir::CallOp::create(builder, loc, func, args);232}233 234void Fortran::lower::genPointerAssociateRemapping(235 fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value pointer,236 mlir::Value target, mlir::Value bounds, bool isMonomorphic) {237 mlir::func::FuncOp func =238 isMonomorphic239 ? fir::runtime::getRuntimeFunc<mkRTKey(240 PointerAssociateRemappingMonomorphic)>(loc, builder)241 : fir::runtime::getRuntimeFunc<mkRTKey(PointerAssociateRemapping)>(242 loc, builder);243 auto fTy = func.getFunctionType();244 auto sourceFile = fir::factory::locationToFilename(builder, loc);245 auto sourceLine =246 fir::factory::locationToLineNo(builder, loc, fTy.getInput(4));247 llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(248 builder, loc, func.getFunctionType(), pointer, target, bounds, sourceFile,249 sourceLine);250 fir::CallOp::create(builder, loc, func, args);251}252 253void Fortran::lower::genPointerAssociateLowerBounds(fir::FirOpBuilder &builder,254 mlir::Location loc,255 mlir::Value pointer,256 mlir::Value target,257 mlir::Value lbounds) {258 mlir::func::FuncOp func =259 fir::runtime::getRuntimeFunc<mkRTKey(PointerAssociateLowerBounds)>(260 loc, builder);261 llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(262 builder, loc, func.getFunctionType(), pointer, target, lbounds);263 fir::CallOp::create(builder, loc, func, args);264}265