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
28using namespace Fortran::runtime;
29
30namespace {
31/// Placeholder for real*16 version of RandomNumber Intrinsic
32struct 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
47mlir::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
58mlir::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
65void 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
108void 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
122void 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
131mlir::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
146mlir::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
155mlir::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
163mlir::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
171mlir::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
182void 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
192void 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
212void 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
262void 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
280mlir::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
287void 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
303void 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{}
321void 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
369void 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
410void 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
420mlir::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

source code of flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp