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-exception 6 // 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/Parser/parse-tree.h" 19 #include "flang/Runtime/misc-intrinsic.h" 20 #include "flang/Runtime/pointer.h" 21 #include "flang/Runtime/random.h" 22 #include "flang/Runtime/stop.h" 23 #include "flang/Runtime/time-intrinsic.h" 24 #include "flang/Semantics/tools.h" 25 #include "mlir/Dialect/OpenACC/OpenACC.h" 26 #include "mlir/Dialect/OpenMP/OpenMPDialect.h" 27 #include "llvm/Support/Debug.h" 28 #include <optional> 29 30 #define DEBUG_TYPE "flang-lower-runtime" 31 32 using namespace Fortran::runtime; 33 34 /// Runtime calls that do not return to the caller indicate this condition by 35 /// terminating the current basic block with an unreachable op. 36 static void genUnreachable(fir::FirOpBuilder &builder, mlir::Location loc) { 37 mlir::Block *curBlock = builder.getBlock(); 38 mlir::Operation *parentOp = curBlock->getParentOp(); 39 if (parentOp->getDialect()->getNamespace() == 40 mlir::omp::OpenMPDialect::getDialectNamespace()) 41 Fortran::lower::genOpenMPTerminator(builder, parentOp, loc); 42 else if (parentOp->getDialect()->getNamespace() == 43 mlir::acc::OpenACCDialect::getDialectNamespace()) 44 Fortran::lower::genOpenACCTerminator(builder, parentOp, loc); 45 else 46 builder.create<fir::UnreachableOp>(loc); 47 mlir::Block *newBlock = curBlock->splitBlock(builder.getInsertionPoint()); 48 builder.setInsertionPointToStart(newBlock); 49 } 50 51 //===----------------------------------------------------------------------===// 52 // Misc. Fortran statements that lower to runtime calls 53 //===----------------------------------------------------------------------===// 54 55 void 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 mlir::emitError(loc, "unhandled expression in STOP"); 94 std::exit(1); 95 }); 96 } else { 97 callee = fir::runtime::getRuntimeFunc<mkRTKey(StopStatement)>(loc, builder); 98 calleeType = callee.getFunctionType(); 99 // Default to values are advised in F'2023 11.4 p2. 100 operands.push_back(builder.createIntegerConstant( 101 loc, calleeType.getInput(0), isError ? 1 : 0)); 102 } 103 104 // Second operand indicates ERROR STOP 105 operands.push_back(builder.createIntegerConstant( 106 loc, calleeType.getInput(operands.size()), isError)); 107 108 // Third operand indicates QUIET (default to false). 109 if (const auto &quiet = 110 std::get<std::optional<Fortran::parser::ScalarLogicalExpr>>(stmt.t)) { 111 const SomeExpr *expr = Fortran::semantics::GetExpr(*quiet); 112 assert(expr && "failed getting typed expression"); 113 mlir::Value q = fir::getBase(converter.genExprValue(*expr, stmtCtx)); 114 operands.push_back( 115 builder.createConvert(loc, calleeType.getInput(operands.size()), q)); 116 } else { 117 operands.push_back(builder.createIntegerConstant( 118 loc, calleeType.getInput(operands.size()), 0)); 119 } 120 121 builder.create<fir::CallOp>(loc, callee, operands); 122 auto blockIsUnterminated = [&builder]() { 123 mlir::Block *currentBlock = builder.getBlock(); 124 return currentBlock->empty() || 125 !currentBlock->back().hasTrait<mlir::OpTrait::IsTerminator>(); 126 }; 127 if (blockIsUnterminated()) 128 genUnreachable(builder, loc); 129 } 130 131 void Fortran::lower::genFailImageStatement( 132 Fortran::lower::AbstractConverter &converter) { 133 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 134 mlir::Location loc = converter.getCurrentLocation(); 135 mlir::func::FuncOp callee = 136 fir::runtime::getRuntimeFunc<mkRTKey(FailImageStatement)>(loc, builder); 137 builder.create<fir::CallOp>(loc, callee, std::nullopt); 138 genUnreachable(builder, loc); 139 } 140 141 void Fortran::lower::genNotifyWaitStatement( 142 Fortran::lower::AbstractConverter &converter, 143 const Fortran::parser::NotifyWaitStmt &) { 144 TODO(converter.getCurrentLocation(), "coarray: NOTIFY WAIT runtime"); 145 } 146 147 void Fortran::lower::genEventPostStatement( 148 Fortran::lower::AbstractConverter &converter, 149 const Fortran::parser::EventPostStmt &) { 150 TODO(converter.getCurrentLocation(), "coarray: EVENT POST runtime"); 151 } 152 153 void Fortran::lower::genEventWaitStatement( 154 Fortran::lower::AbstractConverter &converter, 155 const Fortran::parser::EventWaitStmt &) { 156 TODO(converter.getCurrentLocation(), "coarray: EVENT WAIT runtime"); 157 } 158 159 void Fortran::lower::genLockStatement( 160 Fortran::lower::AbstractConverter &converter, 161 const Fortran::parser::LockStmt &) { 162 TODO(converter.getCurrentLocation(), "coarray: LOCK runtime"); 163 } 164 165 void Fortran::lower::genUnlockStatement( 166 Fortran::lower::AbstractConverter &converter, 167 const Fortran::parser::UnlockStmt &) { 168 TODO(converter.getCurrentLocation(), "coarray: UNLOCK runtime"); 169 } 170 171 void Fortran::lower::genSyncAllStatement( 172 Fortran::lower::AbstractConverter &converter, 173 const Fortran::parser::SyncAllStmt &) { 174 TODO(converter.getCurrentLocation(), "coarray: SYNC ALL runtime"); 175 } 176 177 void Fortran::lower::genSyncImagesStatement( 178 Fortran::lower::AbstractConverter &converter, 179 const Fortran::parser::SyncImagesStmt &) { 180 TODO(converter.getCurrentLocation(), "coarray: SYNC IMAGES runtime"); 181 } 182 183 void Fortran::lower::genSyncMemoryStatement( 184 Fortran::lower::AbstractConverter &converter, 185 const Fortran::parser::SyncMemoryStmt &) { 186 TODO(converter.getCurrentLocation(), "coarray: SYNC MEMORY runtime"); 187 } 188 189 void Fortran::lower::genSyncTeamStatement( 190 Fortran::lower::AbstractConverter &converter, 191 const Fortran::parser::SyncTeamStmt &) { 192 TODO(converter.getCurrentLocation(), "coarray: SYNC TEAM runtime"); 193 } 194 195 void Fortran::lower::genPauseStatement( 196 Fortran::lower::AbstractConverter &converter, 197 const Fortran::parser::PauseStmt &) { 198 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 199 mlir::Location loc = converter.getCurrentLocation(); 200 mlir::func::FuncOp callee = 201 fir::runtime::getRuntimeFunc<mkRTKey(PauseStatement)>(loc, builder); 202 builder.create<fir::CallOp>(loc, callee, std::nullopt); 203 } 204 205 void Fortran::lower::genPointerAssociate(fir::FirOpBuilder &builder, 206 mlir::Location loc, 207 mlir::Value pointer, 208 mlir::Value target) { 209 mlir::func::FuncOp func = 210 fir::runtime::getRuntimeFunc<mkRTKey(PointerAssociate)>(loc, builder); 211 llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments( 212 builder, loc, func.getFunctionType(), pointer, target); 213 builder.create<fir::CallOp>(loc, func, args); 214 } 215 216 void Fortran::lower::genPointerAssociateRemapping(fir::FirOpBuilder &builder, 217 mlir::Location loc, 218 mlir::Value pointer, 219 mlir::Value target, 220 mlir::Value bounds) { 221 mlir::func::FuncOp func = 222 fir::runtime::getRuntimeFunc<mkRTKey(PointerAssociateRemapping)>(loc, 223 builder); 224 auto fTy = func.getFunctionType(); 225 auto sourceFile = fir::factory::locationToFilename(builder, loc); 226 auto sourceLine = 227 fir::factory::locationToLineNo(builder, loc, fTy.getInput(4)); 228 llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments( 229 builder, loc, func.getFunctionType(), pointer, target, bounds, sourceFile, 230 sourceLine); 231 builder.create<fir::CallOp>(loc, func, args); 232 } 233 234 void Fortran::lower::genPointerAssociateLowerBounds(fir::FirOpBuilder &builder, 235 mlir::Location loc, 236 mlir::Value pointer, 237 mlir::Value target, 238 mlir::Value lbounds) { 239 mlir::func::FuncOp func = 240 fir::runtime::getRuntimeFunc<mkRTKey(PointerAssociateLowerBounds)>( 241 loc, builder); 242 llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments( 243 builder, loc, func.getFunctionType(), pointer, target, lbounds); 244 builder.create<fir::CallOp>(loc, func, args); 245 } 246