[flang-commits] [flang] e0738cc - [flang] Moved REAL(16) RANDOM_NUMBER to Float128Math library. (#85002)
via flang-commits
flang-commits at lists.llvm.org
Wed Mar 13 08:26:37 PDT 2024
Author: Slava Zakharin
Date: 2024-03-13T08:26:33-07:00
New Revision: e0738cc65865c31975b5bdbbf89c5a4dbbe06dc5
URL: https://github.com/llvm/llvm-project/commit/e0738cc65865c31975b5bdbbf89c5a4dbbe06dc5
DIFF: https://github.com/llvm/llvm-project/commit/e0738cc65865c31975b5bdbbf89c5a4dbbe06dc5.diff
LOG: [flang] Moved REAL(16) RANDOM_NUMBER to Float128Math library. (#85002)
Added:
flang/runtime/Float128Math/random.cpp
flang/runtime/random-templates.h
flang/test/Lower/Intrinsics/random_number_real16.f90
Modified:
flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
flang/runtime/Float128Math/CMakeLists.txt
flang/runtime/random.cpp
Removed:
################################################################################
diff --git a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
index 638bfd60a246a6..57c47da0f3f85c 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
@@ -27,6 +27,24 @@
using namespace Fortran::runtime;
+namespace {
+/// Placeholder for real*16 version of RandomNumber Intrinsic
+struct ForcedRandomNumberReal16 {
+ static constexpr const char *name = ExpandAndQuoteKey(RTNAME(RandomNumber16));
+ static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+ return [](mlir::MLIRContext *ctx) {
+ auto boxTy =
+ fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
+ auto strTy = fir::runtime::getModel<const char *>()(ctx);
+ auto intTy = fir::runtime::getModel<int>()(ctx);
+ ;
+ return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy},
+ mlir::NoneType::get(ctx));
+ };
+ }
+};
+} // namespace
+
mlir::Value fir::runtime::genAssociated(fir::FirOpBuilder &builder,
mlir::Location loc, mlir::Value pointer,
mlir::Value target) {
@@ -100,8 +118,15 @@ void fir::runtime::genRandomInit(fir::FirOpBuilder &builder, mlir::Location loc,
void fir::runtime::genRandomNumber(fir::FirOpBuilder &builder,
mlir::Location loc, mlir::Value harvest) {
- mlir::func::FuncOp func =
- fir::runtime::getRuntimeFunc<mkRTKey(RandomNumber)>(loc, builder);
+ mlir::func::FuncOp func;
+ auto boxEleTy = fir::dyn_cast_ptrOrBoxEleTy(harvest.getType());
+ auto eleTy = fir::unwrapSequenceType(boxEleTy);
+ if (eleTy.isF128()) {
+ func = fir::runtime::getRuntimeFunc<ForcedRandomNumberReal16>(loc, builder);
+ } else {
+ func = fir::runtime::getRuntimeFunc<mkRTKey(RandomNumber)>(loc, builder);
+ }
+
mlir::FunctionType funcTy = func.getFunctionType();
mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
mlir::Value sourceLine =
diff --git a/flang/runtime/Float128Math/CMakeLists.txt b/flang/runtime/Float128Math/CMakeLists.txt
index 980356131b680e..33f73a9c54451b 100644
--- a/flang/runtime/Float128Math/CMakeLists.txt
+++ b/flang/runtime/Float128Math/CMakeLists.txt
@@ -48,6 +48,7 @@ set(sources
nearest.cpp
norm2.cpp
pow.cpp
+ random.cpp
round.cpp
rrspacing.cpp
scale.cpp
diff --git a/flang/runtime/Float128Math/random.cpp b/flang/runtime/Float128Math/random.cpp
new file mode 100644
index 00000000000000..cda962b416144e
--- /dev/null
+++ b/flang/runtime/Float128Math/random.cpp
@@ -0,0 +1,23 @@
+//===-- runtime/Float128Math/random.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 "math-entries.h"
+#include "numeric-template-specs.h"
+#include "random-templates.h"
+
+using namespace Fortran::runtime::random;
+extern "C" {
+
+#if LDBL_MANT_DIG == 113 || HAS_FLOAT128
+void RTDEF(RandomNumber16)(
+ const Descriptor &harvest, const char *source, int line) {
+ return Generate<CppTypeFor<TypeCategory::Real, 16>, 113>(harvest);
+}
+#endif
+
+} // extern "C"
diff --git a/flang/runtime/random-templates.h b/flang/runtime/random-templates.h
new file mode 100644
index 00000000000000..ce64a94901a281
--- /dev/null
+++ b/flang/runtime/random-templates.h
@@ -0,0 +1,87 @@
+//===-- runtime/random-templates.h ------------------------------*- C++ -*-===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_RUNTIME_RANDOM_TEMPLATES_H_
+#define FORTRAN_RUNTIME_RANDOM_TEMPLATES_H_
+
+#include "lock.h"
+#include "numeric-templates.h"
+#include "flang/Runtime/descriptor.h"
+#include <algorithm>
+#include <random>
+
+namespace Fortran::runtime::random {
+
+// Newer "Minimum standard", recommended by Park, Miller, and Stockmeyer in
+// 1993. Same as C++17 std::minstd_rand, but explicitly instantiated for
+// permanence.
+using Generator =
+ std::linear_congruential_engine<std::uint_fast32_t, 48271, 0, 2147483647>;
+
+using GeneratedWord = typename Generator::result_type;
+static constexpr std::uint64_t range{
+ static_cast<std::uint64_t>(Generator::max() - Generator::min() + 1)};
+static constexpr bool rangeIsPowerOfTwo{(range & (range - 1)) == 0};
+static constexpr int rangeBits{
+ 64 - common::LeadingZeroBitCount(range) - !rangeIsPowerOfTwo};
+
+extern Lock lock;
+extern Generator generator;
+extern std::optional<GeneratedWord> nextValue;
+
+// Call only with lock held
+static GeneratedWord GetNextValue() {
+ GeneratedWord result;
+ if (nextValue.has_value()) {
+ result = *nextValue;
+ nextValue.reset();
+ } else {
+ result = generator();
+ }
+ return result;
+}
+
+template <typename REAL, int PREC>
+inline void Generate(const Descriptor &harvest) {
+ static constexpr std::size_t minBits{
+ std::max<std::size_t>(PREC, 8 * sizeof(GeneratedWord))};
+ using Int = common::HostUnsignedIntType<minBits>;
+ static constexpr std::size_t words{
+ static_cast<std::size_t>(PREC + rangeBits - 1) / rangeBits};
+ std::size_t elements{harvest.Elements()};
+ SubscriptValue at[maxRank];
+ harvest.GetLowerBounds(at);
+ {
+ CriticalSection critical{lock};
+ for (std::size_t j{0}; j < elements; ++j) {
+ while (true) {
+ Int fraction{GetNextValue()};
+ if constexpr (words > 1) {
+ for (std::size_t k{1}; k < words; ++k) {
+ static constexpr auto rangeMask{
+ (GeneratedWord{1} << rangeBits) - 1};
+ GeneratedWord word{(GetNextValue() - generator.min()) & rangeMask};
+ fraction = (fraction << rangeBits) | word;
+ }
+ }
+ fraction >>= words * rangeBits - PREC;
+ REAL next{
+ LDEXPTy<REAL>::compute(static_cast<REAL>(fraction), -(PREC + 1))};
+ if (next >= 0.0 && next < 1.0) {
+ *harvest.Element<REAL>(at) = next;
+ break;
+ }
+ }
+ harvest.IncrementSubscripts(at);
+ }
+ }
+}
+
+} // namespace Fortran::runtime::random
+
+#endif // FORTRAN_RUNTIME_RANDOM_TEMPLATES_H_
diff --git a/flang/runtime/random.cpp b/flang/runtime/random.cpp
index 642091a06aff55..13bed1f0abe10c 100644
--- a/flang/runtime/random.cpp
+++ b/flang/runtime/random.cpp
@@ -11,85 +11,24 @@
#include "flang/Runtime/random.h"
#include "lock.h"
+#include "random-templates.h"
#include "terminator.h"
#include "flang/Common/float128.h"
#include "flang/Common/leading-zero-bit-count.h"
#include "flang/Common/uint128.h"
#include "flang/Runtime/cpp-type.h"
#include "flang/Runtime/descriptor.h"
-#include <algorithm>
#include <cmath>
#include <cstdint>
#include <limits>
#include <memory>
-#include <random>
#include <time.h>
-namespace Fortran::runtime {
+namespace Fortran::runtime::random {
-// Newer "Minimum standard", recommended by Park, Miller, and Stockmeyer in
-// 1993. Same as C++17 std::minstd_rand, but explicitly instantiated for
-// permanence.
-using Generator =
- std::linear_congruential_engine<std::uint_fast32_t, 48271, 0, 2147483647>;
-
-using GeneratedWord = typename Generator::result_type;
-static constexpr std::uint64_t range{
- static_cast<std::uint64_t>(Generator::max() - Generator::min() + 1)};
-static constexpr bool rangeIsPowerOfTwo{(range & (range - 1)) == 0};
-static constexpr int rangeBits{
- 64 - common::LeadingZeroBitCount(range) - !rangeIsPowerOfTwo};
-
-static Lock lock;
-static Generator generator;
-static std::optional<GeneratedWord> nextValue;
-
-// Call only with lock held
-static GeneratedWord GetNextValue() {
- GeneratedWord result;
- if (nextValue.has_value()) {
- result = *nextValue;
- nextValue.reset();
- } else {
- result = generator();
- }
- return result;
-}
-
-template <typename REAL, int PREC>
-inline void Generate(const Descriptor &harvest) {
- static constexpr std::size_t minBits{
- std::max<std::size_t>(PREC, 8 * sizeof(GeneratedWord))};
- using Int = common::HostUnsignedIntType<minBits>;
- static constexpr std::size_t words{
- static_cast<std::size_t>(PREC + rangeBits - 1) / rangeBits};
- std::size_t elements{harvest.Elements()};
- SubscriptValue at[maxRank];
- harvest.GetLowerBounds(at);
- {
- CriticalSection critical{lock};
- for (std::size_t j{0}; j < elements; ++j) {
- while (true) {
- Int fraction{GetNextValue()};
- if constexpr (words > 1) {
- for (std::size_t k{1}; k < words; ++k) {
- static constexpr auto rangeMask{
- (GeneratedWord{1} << rangeBits) - 1};
- GeneratedWord word{(GetNextValue() - generator.min()) & rangeMask};
- fraction = (fraction << rangeBits) | word;
- }
- }
- fraction >>= words * rangeBits - PREC;
- REAL next{std::ldexp(static_cast<REAL>(fraction), -(PREC + 1))};
- if (next >= 0.0 && next < 1.0) {
- *harvest.Element<REAL>(at) = next;
- break;
- }
- }
- harvest.IncrementSubscripts(at);
- }
- }
-}
+Lock lock;
+Generator generator;
+std::optional<GeneratedWord> nextValue;
extern "C" {
@@ -130,14 +69,6 @@ void RTNAME(RandomNumber)(
#if LDBL_MANT_DIG == 64
Generate<CppTypeFor<TypeCategory::Real, 10>, 64>(harvest);
return;
-#endif
- }
- break;
- case 16:
- if constexpr (HasCppTypeFor<TypeCategory::Real, 16>) {
-#if LDBL_MANT_DIG == 113
- Generate<CppTypeFor<TypeCategory::Real, 16>, 113>(harvest);
- return;
#endif
}
break;
@@ -263,4 +194,4 @@ void RTNAME(RandomSeed)(const Descriptor *size, const Descriptor *put,
}
} // extern "C"
-} // namespace Fortran::runtime
+} // namespace Fortran::runtime::random
diff --git a/flang/test/Lower/Intrinsics/random_number_real16.f90 b/flang/test/Lower/Intrinsics/random_number_real16.f90
new file mode 100644
index 00000000000000..76fed258d8afc8
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/random_number_real16.f90
@@ -0,0 +1,16 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+! RUN: %flang_fc1 -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func @_QPtest_scalar
+! CHECK: fir.call @_FortranARandomNumber16({{.*}}){{.*}}: (!fir.box<none>, !fir.ref<i8>, i32) -> none
+subroutine test_scalar
+ real(16) :: r
+ call random_number(r)
+end
+
+! CHECK-LABEL: func @_QPtest_array
+! CHECK: fir.call @_FortranARandomNumber16({{.*}}){{.*}}: (!fir.box<none>, !fir.ref<i8>, i32) -> none
+subroutine test_array(r)
+ real(16) :: r(:)
+ call random_number(r)
+end
More information about the flang-commits
mailing list