1 | //===-- Intrinsics.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/Optimizer/Builder/Runtime/Intrinsics.h" |
10 | #include "flang/Optimizer/Builder/BoxValue.h" |
11 | #include "flang/Optimizer/Builder/FIRBuilder.h" |
12 | #include "flang/Optimizer/Builder/Runtime/RTBuilder.h" |
13 | #include "flang/Optimizer/Dialect/FIROpsSupport.h" |
14 | #include "flang/Parser/parse-tree.h" |
15 | #include "flang/Runtime/extensions.h" |
16 | #include "flang/Runtime/misc-intrinsic.h" |
17 | #include "flang/Runtime/pointer.h" |
18 | #include "flang/Runtime/random.h" |
19 | #include "flang/Runtime/stop.h" |
20 | #include "flang/Runtime/time-intrinsic.h" |
21 | #include "flang/Semantics/tools.h" |
22 | #include "llvm/Support/Debug.h" |
23 | #include <optional> |
24 | #include <signal.h> |
25 | |
26 | #define DEBUG_TYPE "flang-lower-runtime" |
27 | |
28 | using namespace Fortran::runtime; |
29 | |
30 | namespace { |
31 | /// Placeholder for real*16 version of RandomNumber Intrinsic |
32 | struct ForcedRandomNumberReal16 { |
33 | static constexpr const char *name = ExpandAndQuoteKey(RTNAME(RandomNumber16)); |
34 | static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() { |
35 | return [](mlir::MLIRContext *ctx) { |
36 | auto boxTy = |
37 | fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx); |
38 | auto strTy = fir::runtime::getModel<const char *>()(ctx); |
39 | auto intTy = fir::runtime::getModel<int>()(ctx); |
40 | ; |
41 | return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy}, {}); |
42 | }; |
43 | } |
44 | }; |
45 | } // namespace |
46 | |
47 | mlir::Value fir::runtime::genAssociated(fir::FirOpBuilder &builder, |
48 | mlir::Location loc, mlir::Value pointer, |
49 | mlir::Value target) { |
50 | mlir::func::FuncOp func = |
51 | fir::runtime::getRuntimeFunc<mkRTKey(PointerIsAssociatedWith)>(loc, |
52 | builder); |
53 | llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments( |
54 | builder, loc, func.getFunctionType(), pointer, target); |
55 | return builder.create<fir::CallOp>(loc, func, args).getResult(0); |
56 | } |
57 | |
58 | mlir::Value fir::runtime::genCpuTime(fir::FirOpBuilder &builder, |
59 | mlir::Location loc) { |
60 | mlir::func::FuncOp func = |
61 | fir::runtime::getRuntimeFunc<mkRTKey(CpuTime)>(loc, builder); |
62 | return builder.create<fir::CallOp>(loc, func, std::nullopt).getResult(0); |
63 | } |
64 | |
65 | void fir::runtime::genDateAndTime(fir::FirOpBuilder &builder, |
66 | mlir::Location loc, |
67 | std::optional<fir::CharBoxValue> date, |
68 | std::optional<fir::CharBoxValue> time, |
69 | std::optional<fir::CharBoxValue> zone, |
70 | mlir::Value values) { |
71 | mlir::func::FuncOp callee = |
72 | fir::runtime::getRuntimeFunc<mkRTKey(DateAndTime)>(loc, builder); |
73 | mlir::FunctionType funcTy = callee.getFunctionType(); |
74 | mlir::Type idxTy = builder.getIndexType(); |
75 | mlir::Value zero; |
76 | auto splitArg = [&](std::optional<fir::CharBoxValue> arg, mlir::Value &buffer, |
77 | mlir::Value &len) { |
78 | if (arg) { |
79 | buffer = arg->getBuffer(); |
80 | len = arg->getLen(); |
81 | } else { |
82 | if (!zero) |
83 | zero = builder.createIntegerConstant(loc, idxTy, 0); |
84 | buffer = zero; |
85 | len = zero; |
86 | } |
87 | }; |
88 | mlir::Value dateBuffer; |
89 | mlir::Value dateLen; |
90 | splitArg(date, dateBuffer, dateLen); |
91 | mlir::Value timeBuffer; |
92 | mlir::Value timeLen; |
93 | splitArg(time, timeBuffer, timeLen); |
94 | mlir::Value zoneBuffer; |
95 | mlir::Value zoneLen; |
96 | splitArg(zone, zoneBuffer, zoneLen); |
97 | |
98 | mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc); |
99 | mlir::Value sourceLine = |
100 | fir::factory::locationToLineNo(builder, loc, funcTy.getInput(7)); |
101 | |
102 | llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments( |
103 | builder, loc, funcTy, dateBuffer, dateLen, timeBuffer, timeLen, |
104 | zoneBuffer, zoneLen, sourceFile, sourceLine, values); |
105 | builder.create<fir::CallOp>(loc, callee, args); |
106 | } |
107 | |
108 | void fir::runtime::genEtime(fir::FirOpBuilder &builder, mlir::Location loc, |
109 | mlir::Value values, mlir::Value time) { |
110 | auto runtimeFunc = fir::runtime::getRuntimeFunc<mkRTKey(Etime)>(loc, builder); |
111 | mlir::FunctionType runtimeFuncTy = runtimeFunc.getFunctionType(); |
112 | |
113 | mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc); |
114 | mlir::Value sourceLine = |
115 | fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(3)); |
116 | |
117 | llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments( |
118 | builder, loc, runtimeFuncTy, values, time, sourceFile, sourceLine); |
119 | builder.create<fir::CallOp>(loc, runtimeFunc, args); |
120 | } |
121 | |
122 | void fir::runtime::genFree(fir::FirOpBuilder &builder, mlir::Location loc, |
123 | mlir::Value ptr) { |
124 | auto runtimeFunc = fir::runtime::getRuntimeFunc<mkRTKey(Free)>(loc, builder); |
125 | mlir::Type intPtrTy = builder.getIntPtrType(); |
126 | |
127 | builder.create<fir::CallOp>(loc, runtimeFunc, |
128 | builder.createConvert(loc, intPtrTy, ptr)); |
129 | } |
130 | |
131 | mlir::Value fir::runtime::genFseek(fir::FirOpBuilder &builder, |
132 | mlir::Location loc, mlir::Value unit, |
133 | mlir::Value offset, mlir::Value whence) { |
134 | auto runtimeFunc = fir::runtime::getRuntimeFunc<mkRTKey(Fseek)>(loc, builder); |
135 | mlir::FunctionType runtimeFuncTy = runtimeFunc.getFunctionType(); |
136 | mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc); |
137 | mlir::Value sourceLine = |
138 | fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(2)); |
139 | llvm::SmallVector<mlir::Value> args = |
140 | fir::runtime::createArguments(builder, loc, runtimeFuncTy, unit, offset, |
141 | whence, sourceFile, sourceLine); |
142 | return builder.create<fir::CallOp>(loc, runtimeFunc, args).getResult(0); |
143 | ; |
144 | } |
145 | |
146 | mlir::Value fir::runtime::genFtell(fir::FirOpBuilder &builder, |
147 | mlir::Location loc, mlir::Value unit) { |
148 | auto runtimeFunc = fir::runtime::getRuntimeFunc<mkRTKey(Ftell)>(loc, builder); |
149 | mlir::FunctionType runtimeFuncTy = runtimeFunc.getFunctionType(); |
150 | llvm::SmallVector<mlir::Value> args = |
151 | fir::runtime::createArguments(builder, loc, runtimeFuncTy, unit); |
152 | return builder.create<fir::CallOp>(loc, runtimeFunc, args).getResult(0); |
153 | } |
154 | |
155 | mlir::Value fir::runtime::genGetGID(fir::FirOpBuilder &builder, |
156 | mlir::Location loc) { |
157 | auto runtimeFunc = |
158 | fir::runtime::getRuntimeFunc<mkRTKey(GetGID)>(loc, builder); |
159 | |
160 | return builder.create<fir::CallOp>(loc, runtimeFunc).getResult(0); |
161 | } |
162 | |
163 | mlir::Value fir::runtime::genGetUID(fir::FirOpBuilder &builder, |
164 | mlir::Location loc) { |
165 | auto runtimeFunc = |
166 | fir::runtime::getRuntimeFunc<mkRTKey(GetUID)>(loc, builder); |
167 | |
168 | return builder.create<fir::CallOp>(loc, runtimeFunc).getResult(0); |
169 | } |
170 | |
171 | mlir::Value fir::runtime::genMalloc(fir::FirOpBuilder &builder, |
172 | mlir::Location loc, mlir::Value size) { |
173 | auto runtimeFunc = |
174 | fir::runtime::getRuntimeFunc<mkRTKey(Malloc)>(loc, builder); |
175 | auto argTy = runtimeFunc.getArgumentTypes()[0]; |
176 | return builder |
177 | .create<fir::CallOp>(loc, runtimeFunc, |
178 | builder.createConvert(loc, argTy, size)) |
179 | .getResult(0); |
180 | } |
181 | |
182 | void fir::runtime::genRandomInit(fir::FirOpBuilder &builder, mlir::Location loc, |
183 | mlir::Value repeatable, |
184 | mlir::Value imageDistinct) { |
185 | mlir::func::FuncOp func = |
186 | fir::runtime::getRuntimeFunc<mkRTKey(RandomInit)>(loc, builder); |
187 | llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments( |
188 | builder, loc, func.getFunctionType(), repeatable, imageDistinct); |
189 | builder.create<fir::CallOp>(loc, func, args); |
190 | } |
191 | |
192 | void fir::runtime::genRandomNumber(fir::FirOpBuilder &builder, |
193 | mlir::Location loc, mlir::Value harvest) { |
194 | mlir::func::FuncOp func; |
195 | auto boxEleTy = fir::dyn_cast_ptrOrBoxEleTy(harvest.getType()); |
196 | auto eleTy = fir::unwrapSequenceType(boxEleTy); |
197 | if (eleTy.isF128()) { |
198 | func = fir::runtime::getRuntimeFunc<ForcedRandomNumberReal16>(loc, builder); |
199 | } else { |
200 | func = fir::runtime::getRuntimeFunc<mkRTKey(RandomNumber)>(loc, builder); |
201 | } |
202 | |
203 | mlir::FunctionType funcTy = func.getFunctionType(); |
204 | mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc); |
205 | mlir::Value sourceLine = |
206 | fir::factory::locationToLineNo(builder, loc, funcTy.getInput(2)); |
207 | llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments( |
208 | builder, loc, funcTy, harvest, sourceFile, sourceLine); |
209 | builder.create<fir::CallOp>(loc, func, args); |
210 | } |
211 | |
212 | void fir::runtime::genRandomSeed(fir::FirOpBuilder &builder, mlir::Location loc, |
213 | mlir::Value size, mlir::Value put, |
214 | mlir::Value get) { |
215 | bool sizeIsPresent = |
216 | !mlir::isa_and_nonnull<fir::AbsentOp>(size.getDefiningOp()); |
217 | bool putIsPresent = |
218 | !mlir::isa_and_nonnull<fir::AbsentOp>(put.getDefiningOp()); |
219 | bool getIsPresent = |
220 | !mlir::isa_and_nonnull<fir::AbsentOp>(get.getDefiningOp()); |
221 | mlir::func::FuncOp func; |
222 | int staticArgCount = sizeIsPresent + putIsPresent + getIsPresent; |
223 | if (staticArgCount == 0) { |
224 | func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeedDefaultPut)>(loc, |
225 | builder); |
226 | builder.create<fir::CallOp>(loc, func); |
227 | return; |
228 | } |
229 | mlir::FunctionType funcTy; |
230 | mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc); |
231 | mlir::Value sourceLine; |
232 | mlir::Value argBox; |
233 | llvm::SmallVector<mlir::Value> args; |
234 | if (staticArgCount > 1) { |
235 | func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeed)>(loc, builder); |
236 | funcTy = func.getFunctionType(); |
237 | sourceLine = |
238 | fir::factory::locationToLineNo(builder, loc, funcTy.getInput(4)); |
239 | args = fir::runtime::createArguments(builder, loc, funcTy, size, put, get, |
240 | sourceFile, sourceLine); |
241 | builder.create<fir::CallOp>(loc, func, args); |
242 | return; |
243 | } |
244 | if (sizeIsPresent) { |
245 | func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeedSize)>(loc, builder); |
246 | argBox = size; |
247 | } else if (putIsPresent) { |
248 | func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeedPut)>(loc, builder); |
249 | argBox = put; |
250 | } else { |
251 | func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeedGet)>(loc, builder); |
252 | argBox = get; |
253 | } |
254 | funcTy = func.getFunctionType(); |
255 | sourceLine = fir::factory::locationToLineNo(builder, loc, funcTy.getInput(2)); |
256 | args = fir::runtime::createArguments(builder, loc, funcTy, argBox, sourceFile, |
257 | sourceLine); |
258 | builder.create<fir::CallOp>(loc, func, args); |
259 | } |
260 | |
261 | /// generate rename runtime call |
262 | void fir::runtime::genRename(fir::FirOpBuilder &builder, mlir::Location loc, |
263 | mlir::Value path1, mlir::Value path2, |
264 | mlir::Value status) { |
265 | auto runtimeFunc = |
266 | fir::runtime::getRuntimeFunc<mkRTKey(Rename)>(loc, builder); |
267 | mlir::FunctionType runtimeFuncTy = runtimeFunc.getFunctionType(); |
268 | |
269 | mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc); |
270 | mlir::Value sourceLine = |
271 | fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(4)); |
272 | |
273 | llvm::SmallVector<mlir::Value> args = |
274 | fir::runtime::createArguments(builder, loc, runtimeFuncTy, path1, path2, |
275 | status, sourceFile, sourceLine); |
276 | builder.create<fir::CallOp>(loc, runtimeFunc, args); |
277 | } |
278 | |
279 | /// generate runtime call to time intrinsic |
280 | mlir::Value fir::runtime::genTime(fir::FirOpBuilder &builder, |
281 | mlir::Location loc) { |
282 | auto func = fir::runtime::getRuntimeFunc<mkRTKey(time)>(loc, builder); |
283 | return builder.create<fir::CallOp>(loc, func, std::nullopt).getResult(0); |
284 | } |
285 | |
286 | /// generate runtime call to transfer intrinsic with no size argument |
287 | void fir::runtime::genTransfer(fir::FirOpBuilder &builder, mlir::Location loc, |
288 | mlir::Value resultBox, mlir::Value sourceBox, |
289 | mlir::Value moldBox) { |
290 | |
291 | mlir::func::FuncOp func = |
292 | fir::runtime::getRuntimeFunc<mkRTKey(Transfer)>(loc, builder); |
293 | mlir::FunctionType fTy = func.getFunctionType(); |
294 | mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc); |
295 | mlir::Value sourceLine = |
296 | fir::factory::locationToLineNo(builder, loc, fTy.getInput(4)); |
297 | llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments( |
298 | builder, loc, fTy, resultBox, sourceBox, moldBox, sourceFile, sourceLine); |
299 | builder.create<fir::CallOp>(loc, func, args); |
300 | } |
301 | |
302 | /// generate runtime call to transfer intrinsic with size argument |
303 | void fir::runtime::genTransferSize(fir::FirOpBuilder &builder, |
304 | mlir::Location loc, mlir::Value resultBox, |
305 | mlir::Value sourceBox, mlir::Value moldBox, |
306 | mlir::Value size) { |
307 | mlir::func::FuncOp func = |
308 | fir::runtime::getRuntimeFunc<mkRTKey(TransferSize)>(loc, builder); |
309 | mlir::FunctionType fTy = func.getFunctionType(); |
310 | mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc); |
311 | mlir::Value sourceLine = |
312 | fir::factory::locationToLineNo(builder, loc, fTy.getInput(4)); |
313 | llvm::SmallVector<mlir::Value> args = |
314 | fir::runtime::createArguments(builder, loc, fTy, resultBox, sourceBox, |
315 | moldBox, sourceFile, sourceLine, size); |
316 | builder.create<fir::CallOp>(loc, func, args); |
317 | } |
318 | |
319 | /// generate system_clock runtime call/s |
320 | /// all intrinsic arguments are optional and may appear here as mlir::Value{} |
321 | void fir::runtime::genSystemClock(fir::FirOpBuilder &builder, |
322 | mlir::Location loc, mlir::Value count, |
323 | mlir::Value rate, mlir::Value max) { |
324 | auto makeCall = [&](mlir::func::FuncOp func, mlir::Value arg) { |
325 | mlir::Type type = arg.getType(); |
326 | fir::IfOp ifOp{}; |
327 | const bool isOptionalArg = |
328 | fir::valueHasFirAttribute(arg, fir::getOptionalAttrName()); |
329 | if (mlir::dyn_cast<fir::PointerType>(type) || |
330 | mlir::dyn_cast<fir::HeapType>(type)) { |
331 | // Check for a disassociated pointer or an unallocated allocatable. |
332 | assert(!isOptionalArg && "invalid optional argument" ); |
333 | ifOp = builder.create<fir::IfOp>(loc, builder.genIsNotNullAddr(loc, arg), |
334 | /*withElseRegion=*/false); |
335 | } else if (isOptionalArg) { |
336 | ifOp = builder.create<fir::IfOp>( |
337 | loc, builder.create<fir::IsPresentOp>(loc, builder.getI1Type(), arg), |
338 | /*withElseRegion=*/false); |
339 | } |
340 | if (ifOp) |
341 | builder.setInsertionPointToStart(&ifOp.getThenRegion().front()); |
342 | mlir::Type kindTy = func.getFunctionType().getInput(0); |
343 | int integerKind = 8; |
344 | if (auto intType = |
345 | mlir::dyn_cast<mlir::IntegerType>(fir::unwrapRefType(type))) |
346 | integerKind = intType.getWidth() / 8; |
347 | mlir::Value kind = builder.createIntegerConstant(loc, kindTy, integerKind); |
348 | mlir::Value res = |
349 | builder.create<fir::CallOp>(loc, func, mlir::ValueRange{kind}) |
350 | .getResult(0); |
351 | mlir::Value castRes = |
352 | builder.createConvert(loc, fir::dyn_cast_ptrEleTy(type), res); |
353 | builder.create<fir::StoreOp>(loc, castRes, arg); |
354 | if (ifOp) |
355 | builder.setInsertionPointAfter(ifOp); |
356 | }; |
357 | using fir::runtime::getRuntimeFunc; |
358 | if (count) |
359 | makeCall(getRuntimeFunc<mkRTKey(SystemClockCount)>(loc, builder), count); |
360 | if (rate) |
361 | makeCall(getRuntimeFunc<mkRTKey(SystemClockCountRate)>(loc, builder), rate); |
362 | if (max) |
363 | makeCall(getRuntimeFunc<mkRTKey(SystemClockCountMax)>(loc, builder), max); |
364 | } |
365 | |
366 | // CALL SIGNAL(NUMBER, HANDLER [, STATUS]) |
367 | // The definition of the SIGNAL intrinsic allows HANDLER to be a function |
368 | // pointer or an integer. STATUS can be dynamically optional |
369 | void fir::runtime::genSignal(fir::FirOpBuilder &builder, mlir::Location loc, |
370 | mlir::Value number, mlir::Value handler, |
371 | mlir::Value status) { |
372 | assert(mlir::isa<mlir::IntegerType>(number.getType())); |
373 | mlir::Type int64 = builder.getIntegerType(64); |
374 | number = builder.create<fir::ConvertOp>(loc, int64, number); |
375 | |
376 | mlir::Type handlerUnwrappedTy = fir::unwrapRefType(handler.getType()); |
377 | if (mlir::isa_and_nonnull<mlir::IntegerType>(handlerUnwrappedTy)) { |
378 | // pass the integer as a function pointer like one would to signal(2) |
379 | handler = builder.create<fir::LoadOp>(loc, handler); |
380 | mlir::Type fnPtrTy = fir::LLVMPointerType::get( |
381 | mlir::FunctionType::get(handler.getContext(), {}, {})); |
382 | handler = builder.create<fir::ConvertOp>(loc, fnPtrTy, handler); |
383 | } else { |
384 | assert(mlir::isa<fir::BoxProcType>(handler.getType())); |
385 | handler = builder.create<fir::BoxAddrOp>(loc, handler); |
386 | } |
387 | |
388 | mlir::func::FuncOp func{ |
389 | fir::runtime::getRuntimeFunc<mkRTKey(Signal)>(loc, builder)}; |
390 | mlir::Value stat = |
391 | builder.create<fir::CallOp>(loc, func, mlir::ValueRange{number, handler}) |
392 | ->getResult(0); |
393 | |
394 | // return status code via status argument (if present) |
395 | if (status) { |
396 | assert(mlir::isa<mlir::IntegerType>(fir::unwrapRefType(status.getType()))); |
397 | // status might be dynamically optional, so test if it is present |
398 | mlir::Value isPresent = |
399 | builder.create<IsPresentOp>(loc, builder.getI1Type(), status); |
400 | builder.genIfOp(loc, /*results=*/{}, isPresent, /*withElseRegion=*/false) |
401 | .genThen([&]() { |
402 | stat = builder.create<fir::ConvertOp>( |
403 | loc, fir::unwrapRefType(status.getType()), stat); |
404 | builder.create<fir::StoreOp>(loc, stat, status); |
405 | }) |
406 | .end(); |
407 | } |
408 | } |
409 | |
410 | void fir::runtime::genSleep(fir::FirOpBuilder &builder, mlir::Location loc, |
411 | mlir::Value seconds) { |
412 | mlir::Type int64 = builder.getIntegerType(64); |
413 | seconds = builder.create<fir::ConvertOp>(loc, int64, seconds); |
414 | mlir::func::FuncOp func{ |
415 | fir::runtime::getRuntimeFunc<mkRTKey(Sleep)>(loc, builder)}; |
416 | builder.create<fir::CallOp>(loc, func, seconds); |
417 | } |
418 | |
419 | /// generate chdir runtime call |
420 | mlir::Value fir::runtime::genChdir(fir::FirOpBuilder &builder, |
421 | mlir::Location loc, mlir::Value name) { |
422 | mlir::func::FuncOp func{ |
423 | fir::runtime::getRuntimeFunc<mkRTKey(Chdir)>(loc, builder)}; |
424 | llvm::SmallVector<mlir::Value> args = |
425 | fir::runtime::createArguments(builder, loc, func.getFunctionType(), name); |
426 | return builder.create<fir::CallOp>(loc, func, args).getResult(0); |
427 | } |
428 | |