diff --git a/flang/include/flang/Lower/Runtime.h b/flang/include/flang/Lower/Runtime.h --- a/flang/include/flang/Lower/Runtime.h +++ b/flang/include/flang/Lower/Runtime.h @@ -63,6 +63,12 @@ mlir::Value genAssociated(fir::FirOpBuilder &, mlir::Location, mlir::Value pointer, mlir::Value target); +void genRandomInit(fir::FirOpBuilder &, mlir::Location, mlir::Value repeatable, + mlir::Value imageDistinct); +void genRandomNumber(fir::FirOpBuilder &, mlir::Location, mlir::Value harvest); +void genRandomSeed(fir::FirOpBuilder &, mlir::Location, int argIndex, + mlir::Value argBox); + } // namespace lower } // namespace Fortran diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp --- a/flang/lib/Lower/IntrinsicCall.cpp +++ b/flang/lib/Lower/IntrinsicCall.cpp @@ -455,6 +455,9 @@ fir::ExtendedValue genMaxval(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genMinloc(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genMinval(mlir::Type, llvm::ArrayRef); + void genRandomInit(llvm::ArrayRef); + void genRandomNumber(llvm::ArrayRef); + void genRandomSeed(llvm::ArrayRef); fir::ExtendedValue genSize(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genSum(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genUbound(mlir::Type, llvm::ArrayRef); @@ -463,7 +466,9 @@ /// generate the related code. using ElementalGenerator = decltype(&IntrinsicLibrary::genAbs); using ExtendedGenerator = decltype(&IntrinsicLibrary::genSum); - using Generator = std::variant; + using SubroutineGenerator = decltype(&IntrinsicLibrary::genRandomInit); + using Generator = + std::variant; template fir::ExtendedValue @@ -491,6 +496,8 @@ mlir::Value invokeGenerator(ExtendedGenerator generator, mlir::Type resultType, llvm::ArrayRef args); + mlir::Value invokeGenerator(SubroutineGenerator generator, + llvm::ArrayRef args); /// Add clean-up for \p temp to the current statement context; void addCleanUpForTemp(mlir::Location loc, mlir::Value temp); @@ -614,6 +621,17 @@ {{{"array", asBox}, {"dim", asValue}, {"mask", asBox, handleDynamicOptional}}}, + {"random_init", + &I::genRandomInit, + {{{"repeatable", asValue}, {"image_distinct", asValue}}}, + /*isElemental=*/false}, + {"random_number", + &I::genRandomNumber, + {{{"harvest", asBox}}}, + /*isElemental=*/false}, + {"random_seed", + &I::genRandomSeed, + {{{"size", asBox}, {"put", asBox}, {"get", asBox}}}, /*isElemental=*/false}, {"sum", &I::genSum, @@ -1051,6 +1069,21 @@ return std::invoke(generator, *this, resultType, args); } +template <> +fir::ExtendedValue +IntrinsicLibrary::genElementalCall( + SubroutineGenerator generator, llvm::StringRef name, mlir::Type resultType, + llvm::ArrayRef args, bool outline) { + for (const fir::ExtendedValue &arg : args) + if (!arg.getUnboxed() && !arg.getCharBox()) + // fir::emitFatalError(loc, "nonscalar intrinsic argument"); + crashOnMissingIntrinsic(loc, name); + if (outline) + return outlineInExtendedWrapper(generator, name, resultType, args); + std::invoke(generator, *this, args); + return mlir::Value(); +} + static fir::ExtendedValue invokeHandler(IntrinsicLibrary::ElementalGenerator generator, const IntrinsicHandler &handler, @@ -1078,6 +1111,22 @@ return std::invoke(generator, lib, *resultType, args); } +static fir::ExtendedValue +invokeHandler(IntrinsicLibrary::SubroutineGenerator generator, + const IntrinsicHandler &handler, + llvm::Optional resultType, + llvm::ArrayRef args, bool outline, + IntrinsicLibrary &lib) { + if (handler.isElemental) + return lib.genElementalCall(generator, handler.name, mlir::Type{}, args, + outline); + if (outline) + return lib.outlineInExtendedWrapper(generator, handler.name, resultType, + args); + std::invoke(generator, lib, args); + return mlir::Value{}; +} + fir::ExtendedValue IntrinsicLibrary::genIntrinsicCall(llvm::StringRef name, llvm::Optional resultType, @@ -1145,6 +1194,16 @@ return toValue(extendedResult, builder, loc); } +mlir::Value +IntrinsicLibrary::invokeGenerator(SubroutineGenerator generator, + llvm::ArrayRef args) { + llvm::SmallVector extendedArgs; + for (mlir::Value arg : args) + extendedArgs.emplace_back(toExtendedValue(arg, builder, loc)); + std::invoke(generator, *this, extendedArgs); + return {}; +} + template mlir::FuncOp IntrinsicLibrary::getWrapper(GeneratorType generator, llvm::StringRef name, @@ -1184,12 +1243,17 @@ IntrinsicLibrary localLib{*localBuilder, localLoc}; - assert(funcType.getNumResults() == 1 && - "expect one result for intrinsic function wrapper type"); - mlir::Type resultType = funcType.getResult(0); - auto result = - localLib.invokeGenerator(generator, resultType, localArguments); - localBuilder->create(localLoc, result); + if constexpr (std::is_same_v) { + localLib.invokeGenerator(generator, localArguments); + localBuilder->create(localLoc); + } else { + assert(funcType.getNumResults() == 1 && + "expect one result for intrinsic function wrapper type"); + mlir::Type resultType = funcType.getResult(0); + auto result = + localLib.invokeGenerator(generator, resultType, localArguments); + localBuilder->create(localLoc, result); + } } else { // Wrapper was already built, ensure it has the sought type assert(function.getType() == funcType && @@ -1737,6 +1801,31 @@ return fir::MutableBoxValue(boxStorage, mold->nonDeferredLenParams(), {}); } +// RANDOM_INIT +void IntrinsicLibrary::genRandomInit(llvm::ArrayRef args) { + assert(args.size() == 2); + Fortran::lower::genRandomInit(builder, loc, fir::getBase(args[0]), + fir::getBase(args[1])); +} + +// RANDOM_NUMBER +void IntrinsicLibrary::genRandomNumber( + llvm::ArrayRef args) { + assert(args.size() == 1); + Fortran::lower::genRandomNumber(builder, loc, fir::getBase(args[0])); +} + +// RANDOM_SEED +void IntrinsicLibrary::genRandomSeed(llvm::ArrayRef args) { + assert(args.size() == 3); + for (int i = 0; i < 3; ++i) + if (isPresent(args[i])) { + Fortran::lower::genRandomSeed(builder, loc, i, fir::getBase(args[i])); + return; + } + Fortran::lower::genRandomSeed(builder, loc, -1, mlir::Value{}); +} + // SUM fir::ExtendedValue IntrinsicLibrary::genSum(mlir::Type resultType, diff --git a/flang/lib/Lower/Runtime.cpp b/flang/lib/Lower/Runtime.cpp --- a/flang/lib/Lower/Runtime.cpp +++ b/flang/lib/Lower/Runtime.cpp @@ -14,6 +14,7 @@ #include "flang/Optimizer/Builder/Runtime/RTBuilder.h" #include "flang/Parser/parse-tree.h" #include "flang/Runtime/pointer.h" +#include "flang/Runtime/random.h" #include "flang/Runtime/stop.h" #include "flang/Semantics/tools.h" #include "llvm/Support/Debug.h" @@ -125,3 +126,59 @@ builder, loc, func.getType(), pointer, target); return builder.create(loc, func, args).getResult(0); } + +void Fortran::lower::genRandomInit(fir::FirOpBuilder &builder, + mlir::Location loc, mlir::Value repeatable, + mlir::Value imageDistinct) { + mlir::FuncOp func = + fir::runtime::getRuntimeFunc(loc, builder); + llvm::SmallVector args = fir::runtime::createArguments( + builder, loc, func.getType(), repeatable, imageDistinct); + builder.create(loc, func, args); +} + +void Fortran::lower::genRandomNumber(fir::FirOpBuilder &builder, + mlir::Location loc, mlir::Value harvest) { + mlir::FuncOp func = + fir::runtime::getRuntimeFunc(loc, builder); + mlir::FunctionType funcTy = func.getType(); + mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc); + mlir::Value sourceLine = + fir::factory::locationToLineNo(builder, loc, funcTy.getInput(2)); + llvm::SmallVector args = fir::runtime::createArguments( + builder, loc, funcTy, harvest, sourceFile, sourceLine); + builder.create(loc, func, args); +} + +void Fortran::lower::genRandomSeed(fir::FirOpBuilder &builder, + mlir::Location loc, int argIndex, + mlir::Value argBox) { + mlir::FuncOp func; + // argIndex is the nth (0-origin) argument in declaration order, + // or -1 if no argument is present. + switch (argIndex) { + case -1: + func = fir::runtime::getRuntimeFunc(loc, + builder); + builder.create(loc, func); + return; + case 0: + func = fir::runtime::getRuntimeFunc(loc, builder); + break; + case 1: + func = fir::runtime::getRuntimeFunc(loc, builder); + break; + case 2: + func = fir::runtime::getRuntimeFunc(loc, builder); + break; + default: + llvm::report_fatal_error("invalid RANDOM_SEED argument index"); + } + mlir::FunctionType funcTy = func.getType(); + mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc); + mlir::Value sourceLine = + fir::factory::locationToLineNo(builder, loc, funcTy.getInput(2)); + llvm::SmallVector args = fir::runtime::createArguments( + builder, loc, funcTy, argBox, sourceFile, sourceLine); + builder.create(loc, func, args); +} diff --git a/flang/test/Lower/random.f90 b/flang/test/Lower/random.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/random.f90 @@ -0,0 +1,41 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: func @_QPrandom_test +subroutine random_test + ! CHECK-DAG: [[ss:%[0-9]+]] = fir.alloca {{.*}}random_testEss + ! CHECK-DAG: [[vv:%[0-9]+]] = fir.alloca {{.*}}random_testEvv + integer ss, vv(40) + ! CHECK-DAG: [[rr:%[0-9]+]] = fir.alloca {{.*}}random_testErr + ! CHECK-DAG: [[aa:%[0-9]+]] = fir.alloca {{.*}}random_testEaa + real rr, aa(5) + ! CHECK: fir.call @_FortranARandomInit(%true{{.*}}, %false{{.*}}) : (i1, i1) -> none + call random_init(.true., .false.) + ! CHECK: [[box:%[0-9]+]] = fir.embox [[ss]] + ! CHECK: [[argbox:%[0-9]+]] = fir.convert [[box]] + ! CHECK: fir.call @_FortranARandomSeedSize([[argbox]] + call random_seed(size=ss) + print*, 'size: ', ss + ! CHECK: fir.call @_FortranARandomSeedDefaultPut() : () -> none + call random_seed() + ! CHECK: [[box:%[0-9]+]] = fir.embox [[rr]] + ! CHECK: [[argbox:%[0-9]+]] = fir.convert [[box]] + ! CHECK: fir.call @_FortranARandomNumber([[argbox]] + call random_number(rr) + print*, rr + ! CHECK: [[box:%[0-9]+]] = fir.embox [[vv]] + ! CHECK: [[argbox:%[0-9]+]] = fir.convert [[box]] + ! CHECK: fir.call @_FortranARandomSeedGet([[argbox]] + call random_seed(get=vv) + ! print*, 'get: ', vv(1:ss) + ! CHECK: [[box:%[0-9]+]] = fir.embox [[vv]] + ! CHECK: [[argbox:%[0-9]+]] = fir.convert [[box]] + ! CHECK: fir.call @_FortranARandomSeedPut([[argbox]] + call random_seed(put=vv) + print*, 'put: ', vv(1:ss) + ! CHECK: [[box:%[0-9]+]] = fir.embox [[aa]] + ! CHECK: [[argbox:%[0-9]+]] = fir.convert [[box]] + ! CHECK: fir.call @_FortranARandomNumber([[argbox]] + call random_number(aa) + print*, aa + end + \ No newline at end of file