[flang] Lower random_[init|number|seed] intrinsics

[clementval]

Summary

Thsi patch add the infrastructure to lower the random related
intrinsics:

• random_init
• random_number
• random_seed

This patch is part of the upstreaming effort from fir-dev branch.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/include/flang/Lower/Runtime.h

void genSyncMemoryStatement(AbstractConverter &,
                             const parser::SyncMemoryStmt &);
 void genSyncTeamStatement(AbstractConverter &, const parser::SyncTeamStmt &);
 void genUnlockStatement(AbstractConverter &, const parser::UnlockStmt &);
 void genPauseStatement(AbstractConverter &, const parser::PauseStmt &);
 
 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
 
 #endif // FORTRAN_LOWER_RUNTIME_H

flang/lib/Lower/IntrinsicCall.cpp

struct IntrinsicLibrary {
   fir::ExtendedValue genLbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genLen(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genLenTrim(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genMaxloc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   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>);
 
   /// Define the different FIR generators that can be mapped to intrinsic to
   /// 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
   outlineInExtendedWrapper(GeneratorType, llvm::StringRef name,
                            llvm::Optional<mlir::Type> resultType,
                            llvm::ArrayRef<fir::ExtendedValue> args);
 
   template <typename GeneratorType>
mlir::Value invokeGenerator(ElementalGenerator generator,
                               mlir::Type resultType,
                               llvm::ArrayRef<mlir::Value> args);
   mlir::Value invokeGenerator(RuntimeCallGenerator generator,
                               mlir::Type resultType,
                               llvm::ArrayRef<mlir::Value> args);
   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);
   /// Helper function for generating code clean-up for result descriptors
   fir::ExtendedValue readAndAddCleanUp(fir::MutableBoxValue resultMutableBox,
                                        mlir::Type resultType,
                                        llvm::StringRef errMsg);
 
&I::genMinloc,
        {"kind", asValue},
        {"back", asValue, handleDynamicOptional}}},
      /*isElemental=*/false},
     {"minval",
      &I::genMinval,
      {{{"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,
      {{{"array", asBox},
        {"dim", asValue},
        {"mask", asBox, handleDynamicOptional}}},
      /*isElemental=*/false},
     {"ubound",
IntrinsicLibrary::genElementalCall<IntrinsicLibrary::ExtendedGenerator>(
   for (const fir::ExtendedValue &arg : args)
     if (!arg.getUnboxed() && !arg.getCharBox())
       fir::emitFatalError(loc, "nonscalar intrinsic argument");
   if (outline)
     return outlineInExtendedWrapper(generator, name, resultType, args);
   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,
               llvm::Optional<mlir::Type> resultType,
               llvm::ArrayRef<fir::ExtendedValue> args, bool outline,
               IntrinsicLibrary &lib) {
   assert(resultType && "expect elemental intrinsic to be functions");
   return lib.genElementalCall(generator, handler.name, *resultType, args,
if (handler.isElemental)
     return lib.genElementalCall(generator, handler.name, *resultType, args,
                                 outline);
   if (outline)
     return lib.outlineInExtendedWrapper(generator, handler.name, *resultType,
                                         args);
   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,
                                    llvm::ArrayRef<fir::ExtendedValue> args) {
   if (const IntrinsicHandler *handler = findIntrinsicHandler(name)) {
     bool outline = handler->outline || outlineAllIntrinsics;
     return std::visit(
         [&](auto &generator) -> fir::ExtendedValue {
IntrinsicLibrary::invokeGenerator(ExtendedGenerator generator,
                                   llvm::ArrayRef<mlir::Value> args) {
   llvm::SmallVector<fir::ExtendedValue> extendedArgs;
   for (mlir::Value arg : args)
     extendedArgs.emplace_back(toExtendedValue(arg, builder, loc));
   auto extendedResult = std::invoke(generator, *this, resultType, extendedArgs);
   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,
                                           mlir::FunctionType funcType,
                                           bool loadRefArguments) {
   std::string wrapperName = fir::mangleIntrinsicProcedure(name, funcType);
   mlir::FuncOp function = builder.getNamedFunction(wrapperName);
   if (!function) {
for (mlir::BlockArgument bArg : function.front().getArguments()) {
         localArguments.push_back(loaded);
       } else {
         localArguments.push_back(bArg);
       }
     }
 
     IntrinsicLibrary localLib{*localBuilder, localLoc};
 
+    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 &&
            "conflict between intrinsic wrapper types");
   }
   return function;
 }
 
IntrinsicLibrary::genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue> args) {
   fir::BoxType boxType = mold->getBoxTy();
   mlir::Value boxStorage = builder.createTemporary(loc, boxType);
   mlir::Value box = fir::factory::createUnallocatedBox(
       builder, loc, boxType, mold->nonDeferredLenParams());
   builder.create<fir::StoreOp>(loc, box, boxStorage);
   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,
                          llvm::ArrayRef<fir::ExtendedValue> args) {
   return genProdOrSum(fir::runtime::genSum, fir::runtime::genSumDim, resultType,
                       builder, loc, stmtCtx, "unexpected result for Sum", args);
 }
 

flang/lib/Lower/Runtime.cpp

 //===-- Runtime.cpp -------------------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Lower/Runtime.h"
 #include "flang/Lower/Bridge.h"
 #include "flang/Lower/StatementContext.h"
 #include "flang/Lower/Todo.h"
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #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"
 
 #define DEBUG_TYPE "flang-lower-runtime"
 
 using namespace Fortran::runtime;
 
mlir::Value Fortran::lower::genAssociated(fir::FirOpBuilder &builder,
                                           mlir::Value target) {
   mlir::FuncOp func =
       fir::runtime::getRuntimeFunc<mkRTKey(PointerIsAssociatedWith)>(loc,
                                                                      builder);
   llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
       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);
+}

flang/test/Lower/random.f90

+! 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