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
32using 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.
36static 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
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 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
131void 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
141void Fortran::lower::genNotifyWaitStatement(
142 Fortran::lower::AbstractConverter &converter,
143 const Fortran::parser::NotifyWaitStmt &) {
144 TODO(converter.getCurrentLocation(), "coarray: NOTIFY WAIT runtime");
145}
146
147void Fortran::lower::genEventPostStatement(
148 Fortran::lower::AbstractConverter &converter,
149 const Fortran::parser::EventPostStmt &) {
150 TODO(converter.getCurrentLocation(), "coarray: EVENT POST runtime");
151}
152
153void Fortran::lower::genEventWaitStatement(
154 Fortran::lower::AbstractConverter &converter,
155 const Fortran::parser::EventWaitStmt &) {
156 TODO(converter.getCurrentLocation(), "coarray: EVENT WAIT runtime");
157}
158
159void Fortran::lower::genLockStatement(
160 Fortran::lower::AbstractConverter &converter,
161 const Fortran::parser::LockStmt &) {
162 TODO(converter.getCurrentLocation(), "coarray: LOCK runtime");
163}
164
165void Fortran::lower::genUnlockStatement(
166 Fortran::lower::AbstractConverter &converter,
167 const Fortran::parser::UnlockStmt &) {
168 TODO(converter.getCurrentLocation(), "coarray: UNLOCK runtime");
169}
170
171void Fortran::lower::genSyncAllStatement(
172 Fortran::lower::AbstractConverter &converter,
173 const Fortran::parser::SyncAllStmt &) {
174 TODO(converter.getCurrentLocation(), "coarray: SYNC ALL runtime");
175}
176
177void Fortran::lower::genSyncImagesStatement(
178 Fortran::lower::AbstractConverter &converter,
179 const Fortran::parser::SyncImagesStmt &) {
180 TODO(converter.getCurrentLocation(), "coarray: SYNC IMAGES runtime");
181}
182
183void Fortran::lower::genSyncMemoryStatement(
184 Fortran::lower::AbstractConverter &converter,
185 const Fortran::parser::SyncMemoryStmt &) {
186 TODO(converter.getCurrentLocation(), "coarray: SYNC MEMORY runtime");
187}
188
189void Fortran::lower::genSyncTeamStatement(
190 Fortran::lower::AbstractConverter &converter,
191 const Fortran::parser::SyncTeamStmt &) {
192 TODO(converter.getCurrentLocation(), "coarray: SYNC TEAM runtime");
193}
194
195void 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
205void 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).getResult(0);
214}
215
216void 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).getResult(0);
232}
233
234void 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).getResult(0);
245}
246

source code of flang/lib/Lower/Runtime.cpp