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/StatementContext.h"
12 #include "flang/Lower/Todo.h"
13 #include "flang/Optimizer/Builder/FIRBuilder.h"
14 #include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
15 #include "flang/Parser/parse-tree.h"
16 #include "flang/Runtime/pointer.h"
17 #include "flang/Runtime/random.h"
18 #include "flang/Runtime/stop.h"
19 #include "flang/Runtime/time-intrinsic.h"
20 #include "flang/Semantics/tools.h"
21 #include "llvm/Support/Debug.h"
22 
23 #define DEBUG_TYPE "flang-lower-runtime"
24 
25 using namespace Fortran::runtime;
26 
27 /// Runtime calls that do not return to the caller indicate this condition by
28 /// terminating the current basic block with an unreachable op.
29 static void genUnreachable(fir::FirOpBuilder &builder, mlir::Location loc) {
30   builder.create<fir::UnreachableOp>(loc);
31   mlir::Block *newBlock =
32       builder.getBlock()->splitBlock(builder.getInsertionPoint());
33   builder.setInsertionPointToStart(newBlock);
34 }
35 
36 //===----------------------------------------------------------------------===//
37 // Misc. Fortran statements that lower to runtime calls
38 //===----------------------------------------------------------------------===//
39 
40 void Fortran::lower::genStopStatement(
41     Fortran::lower::AbstractConverter &converter,
42     const Fortran::parser::StopStmt &stmt) {
43   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
44   mlir::Location loc = converter.getCurrentLocation();
45   Fortran::lower::StatementContext stmtCtx;
46   llvm::SmallVector<mlir::Value> operands;
47   mlir::FuncOp callee;
48   mlir::FunctionType calleeType;
49   // First operand is stop code (zero if absent)
50   if (const auto &code =
51           std::get<std::optional<Fortran::parser::StopCode>>(stmt.t)) {
52     auto expr =
53         converter.genExprValue(*Fortran::semantics::GetExpr(*code), stmtCtx);
54     LLVM_DEBUG(llvm::dbgs() << "stop expression: "; expr.dump();
55                llvm::dbgs() << '\n');
56     expr.match(
57         [&](const fir::CharBoxValue &x) {
58           callee = fir::runtime::getRuntimeFunc<mkRTKey(StopStatementText)>(
59               loc, builder);
60           calleeType = callee.getType();
61           // Creates a pair of operands for the CHARACTER and its LEN.
62           operands.push_back(
63               builder.createConvert(loc, calleeType.getInput(0), x.getAddr()));
64           operands.push_back(
65               builder.createConvert(loc, calleeType.getInput(1), x.getLen()));
66         },
67         [&](fir::UnboxedValue x) {
68           callee = fir::runtime::getRuntimeFunc<mkRTKey(StopStatement)>(
69               loc, builder);
70           calleeType = callee.getType();
71           mlir::Value cast =
72               builder.createConvert(loc, calleeType.getInput(0), x);
73           operands.push_back(cast);
74         },
75         [&](auto) {
76           mlir::emitError(loc, "unhandled expression in STOP");
77           std::exit(1);
78         });
79   } else {
80     callee = fir::runtime::getRuntimeFunc<mkRTKey(StopStatement)>(loc, builder);
81     calleeType = callee.getType();
82     operands.push_back(
83         builder.createIntegerConstant(loc, calleeType.getInput(0), 0));
84   }
85 
86   // Second operand indicates ERROR STOP
87   bool isError = std::get<Fortran::parser::StopStmt::Kind>(stmt.t) ==
88                  Fortran::parser::StopStmt::Kind::ErrorStop;
89   operands.push_back(builder.createIntegerConstant(
90       loc, calleeType.getInput(operands.size()), isError));
91 
92   // Third operand indicates QUIET (default to false).
93   if (const auto &quiet =
94           std::get<std::optional<Fortran::parser::ScalarLogicalExpr>>(stmt.t)) {
95     const SomeExpr *expr = Fortran::semantics::GetExpr(*quiet);
96     assert(expr && "failed getting typed expression");
97     mlir::Value q = fir::getBase(converter.genExprValue(*expr, stmtCtx));
98     operands.push_back(
99         builder.createConvert(loc, calleeType.getInput(operands.size()), q));
100   } else {
101     operands.push_back(builder.createIntegerConstant(
102         loc, calleeType.getInput(operands.size()), 0));
103   }
104 
105   builder.create<fir::CallOp>(loc, callee, operands);
106   genUnreachable(builder, loc);
107 }
108 
109 void Fortran::lower::genPauseStatement(
110     Fortran::lower::AbstractConverter &converter,
111     const Fortran::parser::PauseStmt &) {
112   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
113   mlir::Location loc = converter.getCurrentLocation();
114   mlir::FuncOp callee =
115       fir::runtime::getRuntimeFunc<mkRTKey(PauseStatement)>(loc, builder);
116   builder.create<fir::CallOp>(loc, callee, llvm::None);
117 }
118 
119 mlir::Value Fortran::lower::genAssociated(fir::FirOpBuilder &builder,
120                                           mlir::Location loc,
121                                           mlir::Value pointer,
122                                           mlir::Value target) {
123   mlir::FuncOp func =
124       fir::runtime::getRuntimeFunc<mkRTKey(PointerIsAssociatedWith)>(loc,
125                                                                      builder);
126   llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
127       builder, loc, func.getType(), pointer, target);
128   return builder.create<fir::CallOp>(loc, func, args).getResult(0);
129 }
130 
131 mlir::Value Fortran::lower::genCpuTime(fir::FirOpBuilder &builder,
132                                        mlir::Location loc) {
133   mlir::FuncOp func =
134       fir::runtime::getRuntimeFunc<mkRTKey(CpuTime)>(loc, builder);
135   return builder.create<fir::CallOp>(loc, func, llvm::None).getResult(0);
136 }
137 
138 void Fortran::lower::genDateAndTime(fir::FirOpBuilder &builder,
139                                     mlir::Location loc,
140                                     llvm::Optional<fir::CharBoxValue> date,
141                                     llvm::Optional<fir::CharBoxValue> time,
142                                     llvm::Optional<fir::CharBoxValue> zone,
143                                     mlir::Value values) {
144   mlir::FuncOp callee =
145       fir::runtime::getRuntimeFunc<mkRTKey(DateAndTime)>(loc, builder);
146   mlir::FunctionType funcTy = callee.getType();
147   mlir::Type idxTy = builder.getIndexType();
148   mlir::Value zero;
149   auto splitArg = [&](llvm::Optional<fir::CharBoxValue> arg,
150                       mlir::Value &buffer, mlir::Value &len) {
151     if (arg) {
152       buffer = arg->getBuffer();
153       len = arg->getLen();
154     } else {
155       if (!zero)
156         zero = builder.createIntegerConstant(loc, idxTy, 0);
157       buffer = zero;
158       len = zero;
159     }
160   };
161   mlir::Value dateBuffer;
162   mlir::Value dateLen;
163   splitArg(date, dateBuffer, dateLen);
164   mlir::Value timeBuffer;
165   mlir::Value timeLen;
166   splitArg(time, timeBuffer, timeLen);
167   mlir::Value zoneBuffer;
168   mlir::Value zoneLen;
169   splitArg(zone, zoneBuffer, zoneLen);
170 
171   mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
172   mlir::Value sourceLine =
173       fir::factory::locationToLineNo(builder, loc, funcTy.getInput(7));
174 
175   llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
176       builder, loc, funcTy, dateBuffer, dateLen, timeBuffer, timeLen,
177       zoneBuffer, zoneLen, sourceFile, sourceLine, values);
178   builder.create<fir::CallOp>(loc, callee, args);
179 }
180 
181 void Fortran::lower::genRandomInit(fir::FirOpBuilder &builder,
182                                    mlir::Location loc, mlir::Value repeatable,
183                                    mlir::Value imageDistinct) {
184   mlir::FuncOp func =
185       fir::runtime::getRuntimeFunc<mkRTKey(RandomInit)>(loc, builder);
186   llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
187       builder, loc, func.getType(), repeatable, imageDistinct);
188   builder.create<fir::CallOp>(loc, func, args);
189 }
190 
191 void Fortran::lower::genRandomNumber(fir::FirOpBuilder &builder,
192                                      mlir::Location loc, mlir::Value harvest) {
193   mlir::FuncOp func =
194       fir::runtime::getRuntimeFunc<mkRTKey(RandomNumber)>(loc, builder);
195   mlir::FunctionType funcTy = func.getType();
196   mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
197   mlir::Value sourceLine =
198       fir::factory::locationToLineNo(builder, loc, funcTy.getInput(2));
199   llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
200       builder, loc, funcTy, harvest, sourceFile, sourceLine);
201   builder.create<fir::CallOp>(loc, func, args);
202 }
203 
204 void Fortran::lower::genRandomSeed(fir::FirOpBuilder &builder,
205                                    mlir::Location loc, int argIndex,
206                                    mlir::Value argBox) {
207   mlir::FuncOp func;
208   // argIndex is the nth (0-origin) argument in declaration order,
209   // or -1 if no argument is present.
210   switch (argIndex) {
211   case -1:
212     func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeedDefaultPut)>(loc,
213                                                                        builder);
214     builder.create<fir::CallOp>(loc, func);
215     return;
216   case 0:
217     func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeedSize)>(loc, builder);
218     break;
219   case 1:
220     func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeedPut)>(loc, builder);
221     break;
222   case 2:
223     func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeedGet)>(loc, builder);
224     break;
225   default:
226     llvm::report_fatal_error("invalid RANDOM_SEED argument index");
227   }
228   mlir::FunctionType funcTy = func.getType();
229   mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
230   mlir::Value sourceLine =
231       fir::factory::locationToLineNo(builder, loc, funcTy.getInput(2));
232   llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
233       builder, loc, funcTy, argBox, sourceFile, sourceLine);
234   builder.create<fir::CallOp>(loc, func, args);
235 }
236 
237 /// generate system_clock runtime call/s
238 /// all intrinsic arguments are optional and may appear here as mlir::Value{}
239 void Fortran::lower::genSystemClock(fir::FirOpBuilder &builder,
240                                     mlir::Location loc, mlir::Value count,
241                                     mlir::Value rate, mlir::Value max) {
242   auto makeCall = [&](mlir::FuncOp func, mlir::Value arg) {
243     mlir::Type kindTy = func.getType().getInput(0);
244     int integerKind = 8;
245     if (auto intType =
246             fir::unwrapRefType(arg.getType()).dyn_cast<mlir::IntegerType>())
247       integerKind = intType.getWidth() / 8;
248     mlir::Value kind = builder.createIntegerConstant(loc, kindTy, integerKind);
249     mlir::Value res =
250         builder.create<fir::CallOp>(loc, func, mlir::ValueRange{kind})
251             .getResult(0);
252     mlir::Value castRes =
253         builder.createConvert(loc, fir::dyn_cast_ptrEleTy(arg.getType()), res);
254     builder.create<fir::StoreOp>(loc, castRes, arg);
255   };
256   using fir::runtime::getRuntimeFunc;
257   if (count)
258     makeCall(getRuntimeFunc<mkRTKey(SystemClockCount)>(loc, builder), count);
259   if (rate)
260     makeCall(getRuntimeFunc<mkRTKey(SystemClockCountRate)>(loc, builder), rate);
261   if (max)
262     makeCall(getRuntimeFunc<mkRTKey(SystemClockCountMax)>(loc, builder), max);
263 }
264