flang/lib/Lower/Runtime.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-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   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  59   mlir::Location loc = converter.getCurrentLocation();
  60   Fortran::lower::StatementContext stmtCtx;
  61   llvm::SmallVector<mlir::Value> operands;
  62   mlir::func::FuncOp callee;
  63   mlir::FunctionType calleeType;
  64   // First operand is stop code (zero if absent)
  65   if (const auto &code =
  66           std::get<std::optional<Fortran::parser::StopCode>>(stmt.t)) {
  67     auto expr =
  68         converter.genExprValue(*Fortran::semantics::GetExpr(*code), stmtCtx);
  69     LLVM_DEBUG(llvm::dbgs() << "stop expression: "; expr.dump();
  70                llvm::dbgs() << '\n');
  71     expr.match(
  72         [&](const fir::CharBoxValue &x) {
  73           callee = fir::runtime::getRuntimeFunc<mkRTKey(StopStatementText)>(
  74               loc, builder);
  75           calleeType = callee.getFunctionType();
  76           // Creates a pair of operands for the CHARACTER and its LEN.
  77           operands.push_back(
  78               builder.createConvert(loc, calleeType.getInput(0), x.getAddr()));
  79           operands.push_back(
  80               builder.createConvert(loc, calleeType.getInput(1), x.getLen()));
  81         },
  82         [&](fir::UnboxedValue x) {
  83           callee = fir::runtime::getRuntimeFunc<mkRTKey(StopStatement)>(
  84               loc, builder);
  85           calleeType = callee.getFunctionType();
  86           mlir::Value cast =
  87               builder.createConvert(loc, calleeType.getInput(0), x);
  88           operands.push_back(cast);
  89         },
  90         [&](auto) {
  91           mlir::emitError(loc, "unhandled expression in STOP");
  92           std::exit(1);
  93         });
  94   } else {
  95     callee = fir::runtime::getRuntimeFunc<mkRTKey(StopStatement)>(loc, builder);
  96     calleeType = callee.getFunctionType();
  97     operands.push_back(
  98         builder.createIntegerConstant(loc, calleeType.getInput(0), 0));
  99   }
 100
 101   // Second operand indicates ERROR STOP
 102   bool isError = std::get<Fortran::parser::StopStmt::Kind>(stmt.t) ==
 103                  Fortran::parser::StopStmt::Kind::ErrorStop;
 104   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   builder.create<fir::CallOp>(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
 130 void 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   builder.create<fir::CallOp>(loc, callee, std::nullopt);
 137   genUnreachable(builder, loc);
 138 }
 139
 140 void Fortran::lower::genNotifyWaitStatement(
 141     Fortran::lower::AbstractConverter &converter,
 142     const Fortran::parser::NotifyWaitStmt &) {
 143   TODO(converter.getCurrentLocation(), "coarray: NOTIFY WAIT runtime");
 144 }
 145
 146 void Fortran::lower::genEventPostStatement(
 147     Fortran::lower::AbstractConverter &converter,
 148     const Fortran::parser::EventPostStmt &) {
 149   TODO(converter.getCurrentLocation(), "coarray: EVENT POST runtime");
 150 }
 151
 152 void Fortran::lower::genEventWaitStatement(
 153     Fortran::lower::AbstractConverter &converter,
 154     const Fortran::parser::EventWaitStmt &) {
 155   TODO(converter.getCurrentLocation(), "coarray: EVENT WAIT runtime");
 156 }
 157
 158 void Fortran::lower::genLockStatement(
 159     Fortran::lower::AbstractConverter &converter,
 160     const Fortran::parser::LockStmt &) {
 161   TODO(converter.getCurrentLocation(), "coarray: LOCK runtime");
 162 }
 163
 164 void Fortran::lower::genUnlockStatement(
 165     Fortran::lower::AbstractConverter &converter,
 166     const Fortran::parser::UnlockStmt &) {
 167   TODO(converter.getCurrentLocation(), "coarray: UNLOCK runtime");
 168 }
 169
 170 void Fortran::lower::genSyncAllStatement(
 171     Fortran::lower::AbstractConverter &converter,
 172     const Fortran::parser::SyncAllStmt &) {
 173   TODO(converter.getCurrentLocation(), "coarray: SYNC ALL runtime");
 174 }
 175
 176 void Fortran::lower::genSyncImagesStatement(
 177     Fortran::lower::AbstractConverter &converter,
 178     const Fortran::parser::SyncImagesStmt &) {
 179   TODO(converter.getCurrentLocation(), "coarray: SYNC IMAGES runtime");
 180 }
 181
 182 void Fortran::lower::genSyncMemoryStatement(
 183     Fortran::lower::AbstractConverter &converter,
 184     const Fortran::parser::SyncMemoryStmt &) {
 185   TODO(converter.getCurrentLocation(), "coarray: SYNC MEMORY runtime");
 186 }
 187
 188 void Fortran::lower::genSyncTeamStatement(
 189     Fortran::lower::AbstractConverter &converter,
 190     const Fortran::parser::SyncTeamStmt &) {
 191   TODO(converter.getCurrentLocation(), "coarray: SYNC TEAM runtime");
 192 }
 193
 194 void Fortran::lower::genPauseStatement(
 195     Fortran::lower::AbstractConverter &converter,
 196     const Fortran::parser::PauseStmt &) {
 197   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
 198   mlir::Location loc = converter.getCurrentLocation();
 199   mlir::func::FuncOp callee =
 200       fir::runtime::getRuntimeFunc<mkRTKey(PauseStatement)>(loc, builder);
 201   builder.create<fir::CallOp>(loc, callee, std::nullopt);
 202 }
 203
 204 void Fortran::lower::genPointerAssociate(fir::FirOpBuilder &builder,
 205                                          mlir::Location loc,
 206                                          mlir::Value pointer,
 207                                          mlir::Value target) {
 208   mlir::func::FuncOp func =
 209       fir::runtime::getRuntimeFunc<mkRTKey(PointerAssociate)>(loc, builder);
 210   llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
 211       builder, loc, func.getFunctionType(), pointer, target);
 212   builder.create<fir::CallOp>(loc, func, args).getResult(0);
 213 }
 214
 215 void Fortran::lower::genPointerAssociateRemapping(fir::FirOpBuilder &builder,
 216                                                   mlir::Location loc,
 217                                                   mlir::Value pointer,
 218                                                   mlir::Value target,
 219                                                   mlir::Value bounds) {
 220   mlir::func::FuncOp func =
 221       fir::runtime::getRuntimeFunc<mkRTKey(PointerAssociateRemapping)>(loc,
 222                                                                        builder);
 223   auto fTy = func.getFunctionType();
 224   auto sourceFile = fir::factory::locationToFilename(builder, loc);
 225   auto sourceLine =
 226       fir::factory::locationToLineNo(builder, loc, fTy.getInput(4));
 227   llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
 228       builder, loc, func.getFunctionType(), pointer, target, bounds, sourceFile,
 229       sourceLine);
 230   builder.create<fir::CallOp>(loc, func, args).getResult(0);
 231 }
 232
 233 void Fortran::lower::genPointerAssociateLowerBounds(fir::FirOpBuilder &builder,
 234                                                     mlir::Location loc,
 235                                                     mlir::Value pointer,
 236                                                     mlir::Value target,
 237                                                     mlir::Value lbounds) {
 238   mlir::func::FuncOp func =
 239       fir::runtime::getRuntimeFunc<mkRTKey(PointerAssociateLowerBounds)>(
 240           loc, builder);
 241   llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
 242       builder, loc, func.getFunctionType(), pointer, target, lbounds);
 243   builder.create<fir::CallOp>(loc, func, args).getResult(0);
 244 }