fir::ExtendedValue genMaxval(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genMinloc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genMinval(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+ void genRandomInit(llvm::ArrayRef<fir::ExtendedValue>);
+ void genRandomNumber(llvm::ArrayRef<fir::ExtendedValue>);
+ void genRandomSeed(llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genSize(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genSum(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genUbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
/// generate the related code.
using ElementalGenerator = decltype(&IntrinsicLibrary::genAbs);
using ExtendedGenerator = decltype(&IntrinsicLibrary::genSum);
- using Generator = std::variant<ElementalGenerator, ExtendedGenerator>;
+ using SubroutineGenerator = decltype(&IntrinsicLibrary::genRandomInit);
+ using Generator =
+ std::variant<ElementalGenerator, ExtendedGenerator, SubroutineGenerator>;
template <typename GeneratorType>
fir::ExtendedValue
mlir::Value invokeGenerator(ExtendedGenerator generator,
mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args);
+ mlir::Value invokeGenerator(SubroutineGenerator generator,
+ llvm::ArrayRef<mlir::Value> args);
/// Add clean-up for \p temp to the current statement context;
void addCleanUpForTemp(mlir::Location loc, mlir::Value temp);
{{{"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,
return std::invoke(generator, *this, resultType, args);
}
+template <>
+fir::ExtendedValue
+IntrinsicLibrary::genElementalCall<IntrinsicLibrary::SubroutineGenerator>(
+ SubroutineGenerator generator, llvm::StringRef name, mlir::Type resultType,
+ llvm::ArrayRef<fir::ExtendedValue> 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,
return std::invoke(generator, lib, *resultType, args);
}
+static fir::ExtendedValue
+invokeHandler(IntrinsicLibrary::SubroutineGenerator generator,
+ const IntrinsicHandler &handler,
+ llvm::Optional<mlir::Type> resultType,
+ llvm::ArrayRef<fir::ExtendedValue> 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<mlir::Type> resultType,
return toValue(extendedResult, builder, loc);
}
+mlir::Value
+IntrinsicLibrary::invokeGenerator(SubroutineGenerator generator,
+ llvm::ArrayRef<mlir::Value> args) {
+ llvm::SmallVector<fir::ExtendedValue> extendedArgs;
+ for (mlir::Value arg : args)
+ extendedArgs.emplace_back(toExtendedValue(arg, builder, loc));
+ std::invoke(generator, *this, extendedArgs);
+ return {};
+}
+
template <typename GeneratorType>
mlir::FuncOp IntrinsicLibrary::getWrapper(GeneratorType generator,
llvm::StringRef name,
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<mlir::func::ReturnOp>(localLoc, result);
+ if constexpr (std::is_same_v<GeneratorType, SubroutineGenerator>) {
+ localLib.invokeGenerator(generator, localArguments);
+ localBuilder->create<mlir::func::ReturnOp>(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<mlir::func::ReturnOp>(localLoc, result);
+ }
} else {
// Wrapper was already built, ensure it has the sought type
assert(function.getType() == funcType &&
return fir::MutableBoxValue(boxStorage, mold->nonDeferredLenParams(), {});
}
+// RANDOM_INIT
+void IntrinsicLibrary::genRandomInit(llvm::ArrayRef<fir::ExtendedValue> 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<fir::ExtendedValue> args) {
+ assert(args.size() == 1);
+ Fortran::lower::genRandomNumber(builder, loc, fir::getBase(args[0]));
+}
+
+// RANDOM_SEED
+void IntrinsicLibrary::genRandomSeed(llvm::ArrayRef<fir::ExtendedValue> 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,
#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"
builder, loc, func.getType(), pointer, target);
return builder.create<fir::CallOp>(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<mkRTKey(RandomInit)>(loc, builder);
+ llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
+ builder, loc, func.getType(), repeatable, imageDistinct);
+ builder.create<fir::CallOp>(loc, func, args);
+}
+
+void Fortran::lower::genRandomNumber(fir::FirOpBuilder &builder,
+ mlir::Location loc, mlir::Value harvest) {
+ mlir::FuncOp func =
+ fir::runtime::getRuntimeFunc<mkRTKey(RandomNumber)>(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<mlir::Value> args = fir::runtime::createArguments(
+ builder, loc, funcTy, harvest, sourceFile, sourceLine);
+ builder.create<fir::CallOp>(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<mkRTKey(RandomSeedDefaultPut)>(loc,
+ builder);
+ builder.create<fir::CallOp>(loc, func);
+ return;
+ case 0:
+ func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeedSize)>(loc, builder);
+ break;
+ case 1:
+ func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeedPut)>(loc, builder);
+ break;
+ case 2:
+ func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeedGet)>(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<mlir::Value> args = fir::runtime::createArguments(
+ builder, loc, funcTy, argBox, sourceFile, sourceLine);
+ builder.create<fir::CallOp>(loc, func, args);
+}
--- /dev/null
+! 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