655 lines · cpp
1//===-- Numeric.cpp -- runtime API for numeric intrinsics -----------------===//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/Numeric.h"10#include "flang/Optimizer/Builder/BoxValue.h"11#include "flang/Optimizer/Builder/Character.h"12#include "flang/Optimizer/Builder/FIRBuilder.h"13#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"14#include "flang/Optimizer/Support/Utils.h"15#include "flang/Runtime/numeric.h"16#include "mlir/Dialect/Func/IR/FuncOps.h"17 18using namespace Fortran::runtime;19 20// The real*10 and real*16 placeholders below are used to force the21// compilation of the real*10 and real*16 method names on systems that22// may not have them in their runtime library. This can occur in the23// case of cross compilation, for example.24 25/// Placeholder for real*10 version of ErfcScaled Intrinsic26struct ForcedErfcScaled10 {27 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(ErfcScaled10));28 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {29 return [](mlir::MLIRContext *ctx) {30 auto ty = mlir::Float80Type::get(ctx);31 return mlir::FunctionType::get(ctx, {ty}, {ty});32 };33 }34};35 36/// Placeholder for real*16 version of ErfcScaled Intrinsic37struct ForcedErfcScaled16 {38 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(ErfcScaled16));39 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {40 return [](mlir::MLIRContext *ctx) {41 auto ty = mlir::Float128Type::get(ctx);42 return mlir::FunctionType::get(ctx, {ty}, {ty});43 };44 }45};46 47/// Placeholder for real*10 version of Exponent Intrinsic48struct ForcedExponent10_4 {49 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Exponent10_4));50 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {51 return [](mlir::MLIRContext *ctx) {52 auto fltTy = mlir::Float80Type::get(ctx);53 auto intTy = mlir::IntegerType::get(ctx, 32);54 return mlir::FunctionType::get(ctx, fltTy, intTy);55 };56 }57};58 59struct ForcedExponent10_8 {60 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Exponent10_8));61 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {62 return [](mlir::MLIRContext *ctx) {63 auto fltTy = mlir::Float80Type::get(ctx);64 auto intTy = mlir::IntegerType::get(ctx, 64);65 return mlir::FunctionType::get(ctx, fltTy, intTy);66 };67 }68};69 70/// Placeholder for real*16 version of Exponent Intrinsic71struct ForcedExponent16_4 {72 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Exponent16_4));73 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {74 return [](mlir::MLIRContext *ctx) {75 auto fltTy = mlir::Float128Type::get(ctx);76 auto intTy = mlir::IntegerType::get(ctx, 32);77 return mlir::FunctionType::get(ctx, fltTy, intTy);78 };79 }80};81 82struct ForcedExponent16_8 {83 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Exponent16_8));84 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {85 return [](mlir::MLIRContext *ctx) {86 auto fltTy = mlir::Float128Type::get(ctx);87 auto intTy = mlir::IntegerType::get(ctx, 64);88 return mlir::FunctionType::get(ctx, fltTy, intTy);89 };90 }91};92 93/// Placeholder for real*10 version of Fraction Intrinsic94struct ForcedFraction10 {95 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Fraction10));96 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {97 return [](mlir::MLIRContext *ctx) {98 auto ty = mlir::Float80Type::get(ctx);99 return mlir::FunctionType::get(ctx, {ty}, {ty});100 };101 }102};103 104/// Placeholder for real*16 version of Fraction Intrinsic105struct ForcedFraction16 {106 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Fraction16));107 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {108 return [](mlir::MLIRContext *ctx) {109 auto ty = mlir::Float128Type::get(ctx);110 return mlir::FunctionType::get(ctx, {ty}, {ty});111 };112 }113};114 115/// Placeholder for real*10 version of Mod Intrinsic116struct ForcedMod10 {117 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(ModReal10));118 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {119 return [](mlir::MLIRContext *ctx) {120 auto fltTy = mlir::Float80Type::get(ctx);121 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));122 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));123 return mlir::FunctionType::get(ctx, {fltTy, fltTy, strTy, intTy},124 {fltTy});125 };126 }127};128 129/// Placeholder for real*16 version of Mod Intrinsic130struct ForcedMod16 {131 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(ModReal16));132 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {133 return [](mlir::MLIRContext *ctx) {134 auto fltTy = mlir::Float128Type::get(ctx);135 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));136 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));137 return mlir::FunctionType::get(ctx, {fltTy, fltTy, strTy, intTy},138 {fltTy});139 };140 }141};142 143/// Placeholder for real*10 version of Modulo Intrinsic144struct ForcedModulo10 {145 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(ModuloReal10));146 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {147 return [](mlir::MLIRContext *ctx) {148 auto fltTy = mlir::Float80Type::get(ctx);149 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));150 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));151 return mlir::FunctionType::get(ctx, {fltTy, fltTy, strTy, intTy},152 {fltTy});153 };154 }155};156 157/// Placeholder for real*16 version of Modulo Intrinsic158struct ForcedModulo16 {159 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(ModuloReal16));160 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {161 return [](mlir::MLIRContext *ctx) {162 auto fltTy = mlir::Float128Type::get(ctx);163 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));164 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));165 return mlir::FunctionType::get(ctx, {fltTy, fltTy, strTy, intTy},166 {fltTy});167 };168 }169};170 171/// Placeholder for real*10 version of Nearest Intrinsic172struct ForcedNearest10 {173 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Nearest10));174 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {175 return [](mlir::MLIRContext *ctx) {176 auto fltTy = mlir::Float80Type::get(ctx);177 auto boolTy = mlir::IntegerType::get(ctx, 1);178 return mlir::FunctionType::get(ctx, {fltTy, boolTy}, {fltTy});179 };180 }181};182 183/// Placeholder for real*16 version of Nearest Intrinsic184struct ForcedNearest16 {185 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Nearest16));186 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {187 return [](mlir::MLIRContext *ctx) {188 auto fltTy = mlir::Float128Type::get(ctx);189 auto boolTy = mlir::IntegerType::get(ctx, 1);190 return mlir::FunctionType::get(ctx, {fltTy, boolTy}, {fltTy});191 };192 }193};194 195/// Placeholder for real*10 version of RRSpacing Intrinsic196struct ForcedRRSpacing10 {197 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(RRSpacing10));198 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {199 return [](mlir::MLIRContext *ctx) {200 auto ty = mlir::Float80Type::get(ctx);201 return mlir::FunctionType::get(ctx, {ty}, {ty});202 };203 }204};205 206/// Placeholder for real*16 version of RRSpacing Intrinsic207struct ForcedRRSpacing16 {208 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(RRSpacing16));209 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {210 return [](mlir::MLIRContext *ctx) {211 auto ty = mlir::Float128Type::get(ctx);212 return mlir::FunctionType::get(ctx, {ty}, {ty});213 };214 }215};216 217/// Placeholder for real*10 version of Scale Intrinsic218struct ForcedScale10 {219 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Scale10));220 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {221 return [](mlir::MLIRContext *ctx) {222 auto fltTy = mlir::Float80Type::get(ctx);223 auto intTy = mlir::IntegerType::get(ctx, 64);224 return mlir::FunctionType::get(ctx, {fltTy, intTy}, {fltTy});225 };226 }227};228 229/// Placeholder for real*16 version of Scale Intrinsic230struct ForcedScale16 {231 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Scale16));232 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {233 return [](mlir::MLIRContext *ctx) {234 auto fltTy = mlir::Float128Type::get(ctx);235 auto intTy = mlir::IntegerType::get(ctx, 64);236 return mlir::FunctionType::get(ctx, {fltTy, intTy}, {fltTy});237 };238 }239};240 241/// Placeholder for real*10 version of RRSpacing Intrinsic242struct ForcedSetExponent10 {243 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(SetExponent10));244 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {245 return [](mlir::MLIRContext *ctx) {246 auto fltTy = mlir::Float80Type::get(ctx);247 auto intTy = mlir::IntegerType::get(ctx, 64);248 return mlir::FunctionType::get(ctx, {fltTy, intTy}, {fltTy});249 };250 }251};252 253/// Placeholder for real*10 version of RRSpacing Intrinsic254struct ForcedSetExponent16 {255 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(SetExponent16));256 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {257 return [](mlir::MLIRContext *ctx) {258 auto fltTy = mlir::Float128Type::get(ctx);259 auto intTy = mlir::IntegerType::get(ctx, 64);260 return mlir::FunctionType::get(ctx, {fltTy, intTy}, {fltTy});261 };262 }263};264 265/// Placeholder for real*10 version of Spacing Intrinsic266struct ForcedSpacing10 {267 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Spacing10));268 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {269 return [](mlir::MLIRContext *ctx) {270 auto ty = mlir::Float80Type::get(ctx);271 return mlir::FunctionType::get(ctx, {ty}, {ty});272 };273 }274};275 276/// Placeholder for real*16 version of Spacing Intrinsic277struct ForcedSpacing16 {278 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Spacing16));279 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {280 return [](mlir::MLIRContext *ctx) {281 auto ty = mlir::Float128Type::get(ctx);282 return mlir::FunctionType::get(ctx, {ty}, {ty});283 };284 }285};286 287/// Generate call to Exponent intrinsic runtime routine.288mlir::Value fir::runtime::genExponent(fir::FirOpBuilder &builder,289 mlir::Location loc, mlir::Type resultType,290 mlir::Value x) {291 mlir::func::FuncOp func;292 mlir::Type fltTy = x.getType();293 if (fltTy.isF32()) {294 if (resultType.isInteger(32))295 func = fir::runtime::getRuntimeFunc<mkRTKey(Exponent4_4)>(loc, builder);296 else if (resultType.isInteger(64))297 func = fir::runtime::getRuntimeFunc<mkRTKey(Exponent4_8)>(loc, builder);298 } else if (fltTy.isF64()) {299 if (resultType.isInteger(32))300 func = fir::runtime::getRuntimeFunc<mkRTKey(Exponent8_4)>(loc, builder);301 else if (resultType.isInteger(64))302 func = fir::runtime::getRuntimeFunc<mkRTKey(Exponent8_8)>(loc, builder);303 } else if (fltTy.isF80()) {304 if (resultType.isInteger(32))305 func = fir::runtime::getRuntimeFunc<ForcedExponent10_4>(loc, builder);306 else if (resultType.isInteger(64))307 func = fir::runtime::getRuntimeFunc<ForcedExponent10_8>(loc, builder);308 } else if (fltTy.isF128()) {309 if (resultType.isInteger(32))310 func = fir::runtime::getRuntimeFunc<ForcedExponent16_4>(loc, builder);311 else if (resultType.isInteger(64))312 func = fir::runtime::getRuntimeFunc<ForcedExponent16_8>(loc, builder);313 } else314 fir::intrinsicTypeTODO(builder, fltTy, loc, "EXPONENT");315 316 auto funcTy = func.getFunctionType();317 llvm::SmallVector<mlir::Value> args = {318 builder.createConvert(loc, funcTy.getInput(0), x)};319 320 return fir::CallOp::create(builder, loc, func, args).getResult(0);321}322 323/// Generate call to Fraction intrinsic runtime routine.324mlir::Value fir::runtime::genFraction(fir::FirOpBuilder &builder,325 mlir::Location loc, mlir::Value x) {326 mlir::func::FuncOp func;327 mlir::Type fltTy = x.getType();328 if (fltTy.isF32())329 func = fir::runtime::getRuntimeFunc<mkRTKey(Fraction4)>(loc, builder);330 else if (fltTy.isF64())331 func = fir::runtime::getRuntimeFunc<mkRTKey(Fraction8)>(loc, builder);332 else if (fltTy.isF80())333 func = fir::runtime::getRuntimeFunc<ForcedFraction10>(loc, builder);334 else if (fltTy.isF128())335 func = fir::runtime::getRuntimeFunc<ForcedFraction16>(loc, builder);336 else337 fir::intrinsicTypeTODO(builder, fltTy, loc, "FRACTION");338 339 auto funcTy = func.getFunctionType();340 llvm::SmallVector<mlir::Value> args = {341 builder.createConvert(loc, funcTy.getInput(0), x)};342 343 return fir::CallOp::create(builder, loc, func, args).getResult(0);344}345 346/// Generate call to Mod intrinsic runtime routine.347mlir::Value fir::runtime::genMod(fir::FirOpBuilder &builder, mlir::Location loc,348 mlir::Value a, mlir::Value p) {349 mlir::func::FuncOp func;350 mlir::Type fltTy = a.getType();351 352 if (fltTy != p.getType())353 fir::emitFatalError(loc, "arguments type mismatch in MOD");354 355 if (fltTy.isF32())356 func = fir::runtime::getRuntimeFunc<mkRTKey(ModReal4)>(loc, builder);357 else if (fltTy.isF64())358 func = fir::runtime::getRuntimeFunc<mkRTKey(ModReal8)>(loc, builder);359 else if (fltTy.isF80())360 func = fir::runtime::getRuntimeFunc<ForcedMod10>(loc, builder);361 else if (fltTy.isF128())362 func = fir::runtime::getRuntimeFunc<ForcedMod16>(loc, builder);363 else364 fir::intrinsicTypeTODO(builder, fltTy, loc, "MOD");365 366 auto funcTy = func.getFunctionType();367 auto sourceFile = fir::factory::locationToFilename(builder, loc);368 auto sourceLine =369 fir::factory::locationToLineNo(builder, loc, funcTy.getInput(3));370 auto args = fir::runtime::createArguments(builder, loc, funcTy, a, p,371 sourceFile, sourceLine);372 373 return fir::CallOp::create(builder, loc, func, args).getResult(0);374}375 376/// Generate call to Modulo intrinsic runtime routine.377mlir::Value fir::runtime::genModulo(fir::FirOpBuilder &builder,378 mlir::Location loc, mlir::Value a,379 mlir::Value p) {380 mlir::func::FuncOp func;381 mlir::Type fltTy = a.getType();382 383 if (fltTy != p.getType())384 fir::emitFatalError(loc, "arguments type mismatch in MOD");385 386 // MODULO is lowered into math operations in intrinsics lowering,387 // so genModulo() should only be used for F128 data type now.388 if (fltTy.isF32())389 func = fir::runtime::getRuntimeFunc<mkRTKey(ModuloReal4)>(loc, builder);390 else if (fltTy.isF64())391 func = fir::runtime::getRuntimeFunc<mkRTKey(ModuloReal8)>(loc, builder);392 else if (fltTy.isF80())393 func = fir::runtime::getRuntimeFunc<ForcedModulo10>(loc, builder);394 else if (fltTy.isF128())395 func = fir::runtime::getRuntimeFunc<ForcedModulo16>(loc, builder);396 else397 fir::intrinsicTypeTODO(builder, fltTy, loc, "MODULO");398 399 auto funcTy = func.getFunctionType();400 auto sourceFile = fir::factory::locationToFilename(builder, loc);401 auto sourceLine =402 fir::factory::locationToLineNo(builder, loc, funcTy.getInput(3));403 auto args = fir::runtime::createArguments(builder, loc, funcTy, a, p,404 sourceFile, sourceLine);405 406 return fir::CallOp::create(builder, loc, func, args).getResult(0);407}408 409/// Generate call to Nearest intrinsic or a "Next" intrinsic module procedure.410mlir::Value fir::runtime::genNearest(fir::FirOpBuilder &builder,411 mlir::Location loc, mlir::Value x,412 mlir::Value valueUp) {413 mlir::func::FuncOp func;414 mlir::Type fltTy = x.getType();415 416 if (fltTy.isF32())417 func = fir::runtime::getRuntimeFunc<mkRTKey(Nearest4)>(loc, builder);418 else if (fltTy.isF64())419 func = fir::runtime::getRuntimeFunc<mkRTKey(Nearest8)>(loc, builder);420 else if (fltTy.isF80())421 func = fir::runtime::getRuntimeFunc<ForcedNearest10>(loc, builder);422 else if (fltTy.isF128())423 func = fir::runtime::getRuntimeFunc<ForcedNearest16>(loc, builder);424 else425 fir::intrinsicTypeTODO(builder, fltTy, loc, "NEAREST");426 427 auto funcTy = func.getFunctionType();428 auto args = fir::runtime::createArguments(builder, loc, funcTy, x, valueUp);429 430 return fir::CallOp::create(builder, loc, func, args).getResult(0);431}432 433/// Generate call to RRSpacing intrinsic runtime routine.434mlir::Value fir::runtime::genRRSpacing(fir::FirOpBuilder &builder,435 mlir::Location loc, mlir::Value x) {436 mlir::func::FuncOp func;437 mlir::Type fltTy = x.getType();438 439 if (fltTy.isF32())440 func = fir::runtime::getRuntimeFunc<mkRTKey(RRSpacing4)>(loc, builder);441 else if (fltTy.isF64())442 func = fir::runtime::getRuntimeFunc<mkRTKey(RRSpacing8)>(loc, builder);443 else if (fltTy.isF80())444 func = fir::runtime::getRuntimeFunc<ForcedRRSpacing10>(loc, builder);445 else if (fltTy.isF128())446 func = fir::runtime::getRuntimeFunc<ForcedRRSpacing16>(loc, builder);447 else448 fir::intrinsicTypeTODO(builder, fltTy, loc, "RRSPACING");449 450 auto funcTy = func.getFunctionType();451 llvm::SmallVector<mlir::Value> args = {452 builder.createConvert(loc, funcTy.getInput(0), x)};453 454 return fir::CallOp::create(builder, loc, func, args).getResult(0);455}456 457/// Generate call to ErfcScaled intrinsic runtime routine.458mlir::Value fir::runtime::genErfcScaled(fir::FirOpBuilder &builder,459 mlir::Location loc, mlir::Value x) {460 mlir::func::FuncOp func;461 mlir::Type fltTy = x.getType();462 463 if (fltTy.isF32())464 func = fir::runtime::getRuntimeFunc<mkRTKey(ErfcScaled4)>(loc, builder);465 else if (fltTy.isF64())466 func = fir::runtime::getRuntimeFunc<mkRTKey(ErfcScaled8)>(loc, builder);467 else if (fltTy.isF80())468 func = fir::runtime::getRuntimeFunc<ForcedErfcScaled10>(loc, builder);469 else if (fltTy.isF128())470 func = fir::runtime::getRuntimeFunc<ForcedErfcScaled16>(loc, builder);471 else472 fir::intrinsicTypeTODO(builder, fltTy, loc, "ERFC_SCALED");473 474 auto funcTy = func.getFunctionType();475 llvm::SmallVector<mlir::Value> args = {476 builder.createConvert(loc, funcTy.getInput(0), x)};477 478 return fir::CallOp::create(builder, loc, func, args).getResult(0);479}480 481/// Generate call to Scale intrinsic runtime routine.482mlir::Value fir::runtime::genScale(fir::FirOpBuilder &builder,483 mlir::Location loc, mlir::Value x,484 mlir::Value i) {485 mlir::func::FuncOp func;486 mlir::Type fltTy = x.getType();487 488 if (fltTy.isF32())489 func = fir::runtime::getRuntimeFunc<mkRTKey(Scale4)>(loc, builder);490 else if (fltTy.isF64())491 func = fir::runtime::getRuntimeFunc<mkRTKey(Scale8)>(loc, builder);492 else if (fltTy.isF80())493 func = fir::runtime::getRuntimeFunc<ForcedScale10>(loc, builder);494 else if (fltTy.isF128())495 func = fir::runtime::getRuntimeFunc<ForcedScale16>(loc, builder);496 else497 fir::intrinsicTypeTODO(builder, fltTy, loc, "SCALE");498 499 auto funcTy = func.getFunctionType();500 auto args = fir::runtime::createArguments(builder, loc, funcTy, x, i);501 502 return fir::CallOp::create(builder, loc, func, args).getResult(0);503}504 505/// Generate call to Selected_char_kind intrinsic runtime routine.506mlir::Value fir::runtime::genSelectedCharKind(fir::FirOpBuilder &builder,507 mlir::Location loc,508 mlir::Value name,509 mlir::Value length) {510 mlir::func::FuncOp func =511 fir::runtime::getRuntimeFunc<mkRTKey(SelectedCharKind)>(loc, builder);512 auto fTy = func.getFunctionType();513 auto sourceFile = fir::factory::locationToFilename(builder, loc);514 auto sourceLine =515 fir::factory::locationToLineNo(builder, loc, fTy.getInput(1));516 if (!fir::isa_ref_type(name.getType()))517 fir::emitFatalError(loc, "argument address for runtime not found");518 519 auto args = fir::runtime::createArguments(builder, loc, fTy, sourceFile,520 sourceLine, name, length);521 522 return fir::CallOp::create(builder, loc, func, args).getResult(0);523}524 525/// Generate call to Selected_int_kind intrinsic runtime routine.526mlir::Value fir::runtime::genSelectedIntKind(fir::FirOpBuilder &builder,527 mlir::Location loc,528 mlir::Value x) {529 mlir::func::FuncOp func =530 fir::runtime::getRuntimeFunc<mkRTKey(SelectedIntKind)>(loc, builder);531 auto fTy = func.getFunctionType();532 auto sourceFile = fir::factory::locationToFilename(builder, loc);533 auto sourceLine =534 fir::factory::locationToLineNo(builder, loc, fTy.getInput(1));535 if (!fir::isa_ref_type(x.getType()))536 fir::emitFatalError(loc, "argument address for runtime not found");537 mlir::Type eleTy = fir::unwrapRefType(x.getType());538 mlir::Value xKind = builder.createIntegerConstant(539 loc, fTy.getInput(3), eleTy.getIntOrFloatBitWidth() / 8);540 auto args = fir::runtime::createArguments(builder, loc, fTy, sourceFile,541 sourceLine, x, xKind);542 543 return fir::CallOp::create(builder, loc, func, args).getResult(0);544}545 546/// Generate call to Selected_logical_kind intrinsic runtime routine.547mlir::Value fir::runtime::genSelectedLogicalKind(fir::FirOpBuilder &builder,548 mlir::Location loc,549 mlir::Value x) {550 mlir::func::FuncOp func =551 fir::runtime::getRuntimeFunc<mkRTKey(SelectedLogicalKind)>(loc, builder);552 auto fTy = func.getFunctionType();553 auto sourceFile = fir::factory::locationToFilename(builder, loc);554 auto sourceLine =555 fir::factory::locationToLineNo(builder, loc, fTy.getInput(1));556 if (!fir::isa_ref_type(x.getType()))557 fir::emitFatalError(loc, "argument address for runtime not found");558 mlir::Type eleTy = fir::unwrapRefType(x.getType());559 mlir::Value xKind = builder.createIntegerConstant(560 loc, fTy.getInput(3), eleTy.getIntOrFloatBitWidth() / 8);561 auto args = fir::runtime::createArguments(builder, loc, fTy, sourceFile,562 sourceLine, x, xKind);563 564 return fir::CallOp::create(builder, loc, func, args).getResult(0);565}566 567/// Generate call to Selected_real_kind intrinsic runtime routine.568mlir::Value fir::runtime::genSelectedRealKind(fir::FirOpBuilder &builder,569 mlir::Location loc,570 mlir::Value precision,571 mlir::Value range,572 mlir::Value radix) {573 mlir::func::FuncOp func =574 fir::runtime::getRuntimeFunc<mkRTKey(SelectedRealKind)>(loc, builder);575 auto fTy = func.getFunctionType();576 auto getArgKinds = [&](mlir::Value arg, int argKindIndex) -> mlir::Value {577 if (fir::isa_ref_type(arg.getType())) {578 mlir::Type eleTy = fir::unwrapRefType(arg.getType());579 return builder.createIntegerConstant(loc, fTy.getInput(argKindIndex),580 eleTy.getIntOrFloatBitWidth() / 8);581 } else {582 return builder.createIntegerConstant(loc, fTy.getInput(argKindIndex), 0);583 }584 };585 586 auto sourceFile = fir::factory::locationToFilename(builder, loc);587 auto sourceLine =588 fir::factory::locationToLineNo(builder, loc, fTy.getInput(1));589 mlir::Value pKind = getArgKinds(precision, 3);590 mlir::Value rKind = getArgKinds(range, 5);591 mlir::Value dKind = getArgKinds(radix, 7);592 auto args = fir::runtime::createArguments(builder, loc, fTy, sourceFile,593 sourceLine, precision, pKind, range,594 rKind, radix, dKind);595 596 return fir::CallOp::create(builder, loc, func, args).getResult(0);597}598 599/// Generate call to Set_exponent intrinsic runtime routine.600mlir::Value fir::runtime::genSetExponent(fir::FirOpBuilder &builder,601 mlir::Location loc, mlir::Value x,602 mlir::Value i) {603 mlir::func::FuncOp func;604 mlir::Type fltTy = x.getType();605 606 if (fltTy.isF32())607 func = fir::runtime::getRuntimeFunc<mkRTKey(SetExponent4)>(loc, builder);608 else if (fltTy.isF64())609 func = fir::runtime::getRuntimeFunc<mkRTKey(SetExponent8)>(loc, builder);610 else if (fltTy.isF80())611 func = fir::runtime::getRuntimeFunc<ForcedSetExponent10>(loc, builder);612 else if (fltTy.isF128())613 func = fir::runtime::getRuntimeFunc<ForcedSetExponent16>(loc, builder);614 else615 fir::intrinsicTypeTODO(builder, fltTy, loc, "SET_EXPONENT");616 617 auto funcTy = func.getFunctionType();618 auto args = fir::runtime::createArguments(builder, loc, funcTy, x, i);619 620 return fir::CallOp::create(builder, loc, func, args).getResult(0);621}622 623/// Generate call to Spacing intrinsic runtime routine.624mlir::Value fir::runtime::genSpacing(fir::FirOpBuilder &builder,625 mlir::Location loc, mlir::Value x) {626 mlir::func::FuncOp func;627 mlir::Type fltTy = x.getType();628 // TODO: for f16/bf16, there are better alternatives that do not require629 // casting the argument (resp. result) to (resp. from) f32, but this requires630 // knowing that the target runtime has been compiled with std::float16_t or631 // std::bfloat16_t support, which is not an information available here for632 // now.633 if (fltTy.isF32())634 func = fir::runtime::getRuntimeFunc<mkRTKey(Spacing4)>(loc, builder);635 else if (fltTy.isF64())636 func = fir::runtime::getRuntimeFunc<mkRTKey(Spacing8)>(loc, builder);637 else if (fltTy.isF80())638 func = fir::runtime::getRuntimeFunc<ForcedSpacing10>(loc, builder);639 else if (fltTy.isF128())640 func = fir::runtime::getRuntimeFunc<ForcedSpacing16>(loc, builder);641 else if (fltTy.isF16())642 func = fir::runtime::getRuntimeFunc<mkRTKey(Spacing2By4)>(loc, builder);643 else if (fltTy.isBF16())644 func = fir::runtime::getRuntimeFunc<mkRTKey(Spacing3By4)>(loc, builder);645 else646 fir::intrinsicTypeTODO(builder, fltTy, loc, "SPACING");647 648 auto funcTy = func.getFunctionType();649 llvm::SmallVector<mlir::Value> args = {650 builder.createConvert(loc, funcTy.getInput(0), x)};651 652 mlir::Value res = fir::CallOp::create(builder, loc, func, args).getResult(0);653 return builder.createConvert(loc, fltTy, res);654}655