480 lines · cpp
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-exception6//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 Intrinsic32struct 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} // namespace46 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 fir::CallOp::create(builder, 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 fir::CallOp::create(builder, loc, func, mlir::ValueRange{})63 .getResult(0);64}65 66void fir::runtime::genDateAndTime(fir::FirOpBuilder &builder,67 mlir::Location loc,68 std::optional<fir::CharBoxValue> date,69 std::optional<fir::CharBoxValue> time,70 std::optional<fir::CharBoxValue> zone,71 mlir::Value values) {72 mlir::func::FuncOp callee =73 fir::runtime::getRuntimeFunc<mkRTKey(DateAndTime)>(loc, builder);74 mlir::FunctionType funcTy = callee.getFunctionType();75 mlir::Type idxTy = builder.getIndexType();76 mlir::Value zero;77 auto splitArg = [&](std::optional<fir::CharBoxValue> arg, mlir::Value &buffer,78 mlir::Value &len) {79 if (arg) {80 buffer = arg->getBuffer();81 len = arg->getLen();82 } else {83 if (!zero)84 zero = builder.createIntegerConstant(loc, idxTy, 0);85 buffer = zero;86 len = zero;87 }88 };89 mlir::Value dateBuffer;90 mlir::Value dateLen;91 splitArg(date, dateBuffer, dateLen);92 mlir::Value timeBuffer;93 mlir::Value timeLen;94 splitArg(time, timeBuffer, timeLen);95 mlir::Value zoneBuffer;96 mlir::Value zoneLen;97 splitArg(zone, zoneBuffer, zoneLen);98 99 mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);100 mlir::Value sourceLine =101 fir::factory::locationToLineNo(builder, loc, funcTy.getInput(7));102 103 llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(104 builder, loc, funcTy, dateBuffer, dateLen, timeBuffer, timeLen,105 zoneBuffer, zoneLen, sourceFile, sourceLine, values);106 fir::CallOp::create(builder, loc, callee, args);107}108 109mlir::Value fir::runtime::genDsecnds(fir::FirOpBuilder &builder,110 mlir::Location loc, mlir::Value refTime) {111 auto runtimeFunc =112 fir::runtime::getRuntimeFunc<mkRTKey(Dsecnds)>(loc, builder);113 114 mlir::FunctionType runtimeFuncTy = runtimeFunc.getFunctionType();115 116 mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);117 mlir::Value sourceLine =118 fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(2));119 120 llvm::SmallVector<mlir::Value> args = {refTime, sourceFile, sourceLine};121 args = fir::runtime::createArguments(builder, loc, runtimeFuncTy, args);122 123 return fir::CallOp::create(builder, loc, runtimeFunc, args).getResult(0);124}125 126void fir::runtime::genEtime(fir::FirOpBuilder &builder, mlir::Location loc,127 mlir::Value values, mlir::Value time) {128 auto runtimeFunc = fir::runtime::getRuntimeFunc<mkRTKey(Etime)>(loc, builder);129 mlir::FunctionType runtimeFuncTy = runtimeFunc.getFunctionType();130 131 mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);132 mlir::Value sourceLine =133 fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(3));134 135 llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(136 builder, loc, runtimeFuncTy, values, time, sourceFile, sourceLine);137 fir::CallOp::create(builder, loc, runtimeFunc, args);138}139 140void fir::runtime::genFlush(fir::FirOpBuilder &builder, mlir::Location loc,141 mlir::Value unit) {142 auto runtimeFunc = fir::runtime::getRuntimeFunc<mkRTKey(Flush)>(loc, builder);143 llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(144 builder, loc, runtimeFunc.getFunctionType(), unit);145 146 fir::CallOp::create(builder, loc, runtimeFunc, args);147}148 149void fir::runtime::genFree(fir::FirOpBuilder &builder, mlir::Location loc,150 mlir::Value ptr) {151 auto runtimeFunc = fir::runtime::getRuntimeFunc<mkRTKey(Free)>(loc, builder);152 mlir::Type intPtrTy = builder.getIntPtrType();153 154 fir::CallOp::create(builder, loc, runtimeFunc,155 builder.createConvert(loc, intPtrTy, ptr));156}157 158mlir::Value fir::runtime::genFseek(fir::FirOpBuilder &builder,159 mlir::Location loc, mlir::Value unit,160 mlir::Value offset, mlir::Value whence) {161 auto runtimeFunc = fir::runtime::getRuntimeFunc<mkRTKey(Fseek)>(loc, builder);162 mlir::FunctionType runtimeFuncTy = runtimeFunc.getFunctionType();163 mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);164 mlir::Value sourceLine =165 fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(2));166 llvm::SmallVector<mlir::Value> args =167 fir::runtime::createArguments(builder, loc, runtimeFuncTy, unit, offset,168 whence, sourceFile, sourceLine);169 return fir::CallOp::create(builder, loc, runtimeFunc, args).getResult(0);170 ;171}172 173mlir::Value fir::runtime::genFtell(fir::FirOpBuilder &builder,174 mlir::Location loc, mlir::Value unit) {175 auto runtimeFunc = fir::runtime::getRuntimeFunc<mkRTKey(Ftell)>(loc, builder);176 mlir::FunctionType runtimeFuncTy = runtimeFunc.getFunctionType();177 llvm::SmallVector<mlir::Value> args =178 fir::runtime::createArguments(builder, loc, runtimeFuncTy, unit);179 return fir::CallOp::create(builder, loc, runtimeFunc, args).getResult(0);180}181 182mlir::Value fir::runtime::genGetGID(fir::FirOpBuilder &builder,183 mlir::Location loc) {184 auto runtimeFunc =185 fir::runtime::getRuntimeFunc<mkRTKey(GetGID)>(loc, builder);186 187 return fir::CallOp::create(builder, loc, runtimeFunc).getResult(0);188}189 190mlir::Value fir::runtime::genGetUID(fir::FirOpBuilder &builder,191 mlir::Location loc) {192 auto runtimeFunc =193 fir::runtime::getRuntimeFunc<mkRTKey(GetUID)>(loc, builder);194 195 return fir::CallOp::create(builder, loc, runtimeFunc).getResult(0);196}197 198mlir::Value fir::runtime::genMalloc(fir::FirOpBuilder &builder,199 mlir::Location loc, mlir::Value size) {200 auto runtimeFunc =201 fir::runtime::getRuntimeFunc<mkRTKey(Malloc)>(loc, builder);202 auto argTy = runtimeFunc.getArgumentTypes()[0];203 return fir::CallOp::create(builder, loc, runtimeFunc,204 builder.createConvert(loc, argTy, size))205 .getResult(0);206}207 208void fir::runtime::genRandomInit(fir::FirOpBuilder &builder, mlir::Location loc,209 mlir::Value repeatable,210 mlir::Value imageDistinct) {211 mlir::func::FuncOp func =212 fir::runtime::getRuntimeFunc<mkRTKey(RandomInit)>(loc, builder);213 llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(214 builder, loc, func.getFunctionType(), repeatable, imageDistinct);215 fir::CallOp::create(builder, loc, func, args);216}217 218void fir::runtime::genRandomNumber(fir::FirOpBuilder &builder,219 mlir::Location loc, mlir::Value harvest) {220 mlir::func::FuncOp func;221 auto boxEleTy = fir::dyn_cast_ptrOrBoxEleTy(harvest.getType());222 auto eleTy = fir::unwrapSequenceType(boxEleTy);223 if (eleTy.isF128()) {224 func = fir::runtime::getRuntimeFunc<ForcedRandomNumberReal16>(loc, builder);225 } else {226 func = fir::runtime::getRuntimeFunc<mkRTKey(RandomNumber)>(loc, builder);227 }228 229 mlir::FunctionType funcTy = func.getFunctionType();230 mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);231 mlir::Value sourceLine =232 fir::factory::locationToLineNo(builder, loc, funcTy.getInput(2));233 llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(234 builder, loc, funcTy, harvest, sourceFile, sourceLine);235 fir::CallOp::create(builder, loc, func, args);236}237 238void fir::runtime::genRandomSeed(fir::FirOpBuilder &builder, mlir::Location loc,239 mlir::Value size, mlir::Value put,240 mlir::Value get) {241 bool sizeIsPresent =242 !mlir::isa_and_nonnull<fir::AbsentOp>(size.getDefiningOp());243 bool putIsPresent =244 !mlir::isa_and_nonnull<fir::AbsentOp>(put.getDefiningOp());245 bool getIsPresent =246 !mlir::isa_and_nonnull<fir::AbsentOp>(get.getDefiningOp());247 mlir::func::FuncOp func;248 int staticArgCount = sizeIsPresent + putIsPresent + getIsPresent;249 if (staticArgCount == 0) {250 func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeedDefaultPut)>(loc,251 builder);252 fir::CallOp::create(builder, loc, func);253 return;254 }255 mlir::FunctionType funcTy;256 mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);257 mlir::Value sourceLine;258 mlir::Value argBox;259 llvm::SmallVector<mlir::Value> args;260 if (staticArgCount > 1) {261 func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeed)>(loc, builder);262 funcTy = func.getFunctionType();263 sourceLine =264 fir::factory::locationToLineNo(builder, loc, funcTy.getInput(4));265 args = fir::runtime::createArguments(builder, loc, funcTy, size, put, get,266 sourceFile, sourceLine);267 fir::CallOp::create(builder, loc, func, args);268 return;269 }270 if (sizeIsPresent) {271 func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeedSize)>(loc, builder);272 argBox = size;273 } else if (putIsPresent) {274 func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeedPut)>(loc, builder);275 argBox = put;276 } else {277 func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeedGet)>(loc, builder);278 argBox = get;279 }280 funcTy = func.getFunctionType();281 sourceLine = fir::factory::locationToLineNo(builder, loc, funcTy.getInput(2));282 args = fir::runtime::createArguments(builder, loc, funcTy, argBox, sourceFile,283 sourceLine);284 fir::CallOp::create(builder, loc, func, args);285}286 287/// generate rename runtime call288void fir::runtime::genRename(fir::FirOpBuilder &builder, mlir::Location loc,289 mlir::Value path1, mlir::Value path2,290 mlir::Value status) {291 auto runtimeFunc =292 fir::runtime::getRuntimeFunc<mkRTKey(Rename)>(loc, builder);293 mlir::FunctionType runtimeFuncTy = runtimeFunc.getFunctionType();294 295 mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);296 mlir::Value sourceLine =297 fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(4));298 299 llvm::SmallVector<mlir::Value> args =300 fir::runtime::createArguments(builder, loc, runtimeFuncTy, path1, path2,301 status, sourceFile, sourceLine);302 fir::CallOp::create(builder, loc, runtimeFunc, args);303}304 305mlir::Value fir::runtime::genSecnds(fir::FirOpBuilder &builder,306 mlir::Location loc, mlir::Value refTime) {307 auto runtimeFunc =308 fir::runtime::getRuntimeFunc<mkRTKey(Secnds)>(loc, builder);309 310 mlir::FunctionType runtimeFuncTy = runtimeFunc.getFunctionType();311 312 mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);313 mlir::Value sourceLine =314 fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(2));315 316 llvm::SmallVector<mlir::Value> args = {refTime, sourceFile, sourceLine};317 args = fir::runtime::createArguments(builder, loc, runtimeFuncTy, args);318 319 return fir::CallOp::create(builder, loc, runtimeFunc, args).getResult(0);320}321 322/// generate runtime call to time intrinsic323mlir::Value fir::runtime::genTime(fir::FirOpBuilder &builder,324 mlir::Location loc) {325 auto func = fir::runtime::getRuntimeFunc<mkRTKey(time)>(loc, builder);326 return fir::CallOp::create(builder, loc, func, mlir::ValueRange{})327 .getResult(0);328}329 330/// generate runtime call to transfer intrinsic with no size argument331void fir::runtime::genTransfer(fir::FirOpBuilder &builder, mlir::Location loc,332 mlir::Value resultBox, mlir::Value sourceBox,333 mlir::Value moldBox) {334 335 mlir::func::FuncOp func =336 fir::runtime::getRuntimeFunc<mkRTKey(Transfer)>(loc, builder);337 mlir::FunctionType fTy = func.getFunctionType();338 mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);339 mlir::Value sourceLine =340 fir::factory::locationToLineNo(builder, loc, fTy.getInput(4));341 llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(342 builder, loc, fTy, resultBox, sourceBox, moldBox, sourceFile, sourceLine);343 fir::CallOp::create(builder, loc, func, args);344}345 346/// generate runtime call to transfer intrinsic with size argument347void fir::runtime::genTransferSize(fir::FirOpBuilder &builder,348 mlir::Location loc, mlir::Value resultBox,349 mlir::Value sourceBox, mlir::Value moldBox,350 mlir::Value size) {351 mlir::func::FuncOp func =352 fir::runtime::getRuntimeFunc<mkRTKey(TransferSize)>(loc, builder);353 mlir::FunctionType fTy = func.getFunctionType();354 mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);355 mlir::Value sourceLine =356 fir::factory::locationToLineNo(builder, loc, fTy.getInput(4));357 llvm::SmallVector<mlir::Value> args =358 fir::runtime::createArguments(builder, loc, fTy, resultBox, sourceBox,359 moldBox, sourceFile, sourceLine, size);360 fir::CallOp::create(builder, loc, func, args);361}362 363/// generate system_clock runtime call/s364/// all intrinsic arguments are optional and may appear here as mlir::Value{}365void fir::runtime::genSystemClock(fir::FirOpBuilder &builder,366 mlir::Location loc, mlir::Value count,367 mlir::Value rate, mlir::Value max) {368 auto makeCall = [&](mlir::func::FuncOp func, mlir::Value arg) {369 mlir::Type type = arg.getType();370 fir::IfOp ifOp{};371 const bool isOptionalArg =372 fir::valueHasFirAttribute(arg, fir::getOptionalAttrName());373 if (mlir::dyn_cast<fir::PointerType>(type) ||374 mlir::dyn_cast<fir::HeapType>(type)) {375 // Check for a disassociated pointer or an unallocated allocatable.376 assert(!isOptionalArg && "invalid optional argument");377 ifOp = fir::IfOp::create(builder, loc, builder.genIsNotNullAddr(loc, arg),378 /*withElseRegion=*/false);379 } else if (isOptionalArg) {380 ifOp = fir::IfOp::create(381 builder, loc,382 fir::IsPresentOp::create(builder, loc, builder.getI1Type(), arg),383 /*withElseRegion=*/false);384 }385 if (ifOp)386 builder.setInsertionPointToStart(&ifOp.getThenRegion().front());387 mlir::Type kindTy = func.getFunctionType().getInput(0);388 int integerKind = 8;389 if (auto intType =390 mlir::dyn_cast<mlir::IntegerType>(fir::unwrapRefType(type)))391 integerKind = intType.getWidth() / 8;392 mlir::Value kind = builder.createIntegerConstant(loc, kindTy, integerKind);393 mlir::Value res =394 fir::CallOp::create(builder, loc, func, mlir::ValueRange{kind})395 .getResult(0);396 mlir::Value castRes =397 builder.createConvert(loc, fir::dyn_cast_ptrEleTy(type), res);398 fir::StoreOp::create(builder, loc, castRes, arg);399 if (ifOp)400 builder.setInsertionPointAfter(ifOp);401 };402 using fir::runtime::getRuntimeFunc;403 if (count)404 makeCall(getRuntimeFunc<mkRTKey(SystemClockCount)>(loc, builder), count);405 if (rate)406 makeCall(getRuntimeFunc<mkRTKey(SystemClockCountRate)>(loc, builder), rate);407 if (max)408 makeCall(getRuntimeFunc<mkRTKey(SystemClockCountMax)>(loc, builder), max);409}410 411// CALL SIGNAL(NUMBER, HANDLER [, STATUS])412// The definition of the SIGNAL intrinsic allows HANDLER to be a function413// pointer or an integer. STATUS can be dynamically optional414void fir::runtime::genSignal(fir::FirOpBuilder &builder, mlir::Location loc,415 mlir::Value number, mlir::Value handler,416 mlir::Value status) {417 assert(mlir::isa<mlir::IntegerType>(number.getType()));418 mlir::Type int64 = builder.getIntegerType(64);419 number = fir::ConvertOp::create(builder, loc, int64, number);420 421 mlir::Type handlerUnwrappedTy = fir::unwrapRefType(handler.getType());422 if (mlir::isa_and_nonnull<mlir::IntegerType>(handlerUnwrappedTy)) {423 // pass the integer as a function pointer like one would to signal(2)424 handler = fir::LoadOp::create(builder, loc, handler);425 mlir::Type fnPtrTy = fir::LLVMPointerType::get(426 mlir::FunctionType::get(handler.getContext(), {}, {}));427 handler = fir::ConvertOp::create(builder, loc, fnPtrTy, handler);428 } else {429 assert(mlir::isa<fir::BoxProcType>(handler.getType()));430 handler = fir::BoxAddrOp::create(builder, loc, handler);431 }432 433 mlir::func::FuncOp func{434 fir::runtime::getRuntimeFunc<mkRTKey(Signal)>(loc, builder)};435 mlir::Value stat =436 fir::CallOp::create(builder, loc, func, mlir::ValueRange{number, handler})437 ->getResult(0);438 439 // return status code via status argument (if present)440 if (status) {441 assert(mlir::isa<mlir::IntegerType>(fir::unwrapRefType(status.getType())));442 // status might be dynamically optional, so test if it is present443 mlir::Value isPresent =444 IsPresentOp::create(builder, loc, builder.getI1Type(), status);445 builder.genIfOp(loc, /*results=*/{}, isPresent, /*withElseRegion=*/false)446 .genThen([&]() {447 stat = fir::ConvertOp::create(448 builder, loc, fir::unwrapRefType(status.getType()), stat);449 fir::StoreOp::create(builder, loc, stat, status);450 })451 .end();452 }453}454 455void fir::runtime::genSleep(fir::FirOpBuilder &builder, mlir::Location loc,456 mlir::Value seconds) {457 mlir::Type int64 = builder.getIntegerType(64);458 seconds = fir::ConvertOp::create(builder, loc, int64, seconds);459 mlir::func::FuncOp func{460 fir::runtime::getRuntimeFunc<mkRTKey(Sleep)>(loc, builder)};461 fir::CallOp::create(builder, loc, func, seconds);462}463 464/// generate chdir runtime call465mlir::Value fir::runtime::genChdir(fir::FirOpBuilder &builder,466 mlir::Location loc, mlir::Value name) {467 mlir::func::FuncOp func{468 fir::runtime::getRuntimeFunc<mkRTKey(Chdir)>(loc, builder)};469 llvm::SmallVector<mlir::Value> args =470 fir::runtime::createArguments(builder, loc, func.getFunctionType(), name);471 return fir::CallOp::create(builder, loc, func, args).getResult(0);472}473 474void fir::runtime::genShowDescriptor(fir::FirOpBuilder &builder,475 mlir::Location loc, mlir::Value descAddr) {476 mlir::func::FuncOp func{477 fir::runtime::getRuntimeFunc<mkRTKey(ShowDescriptor)>(loc, builder)};478 fir::CallOp::create(builder, loc, func, descAddr);479}480