Skip to content

Commit e0738cc

Browse files
authored
[flang] Moved REAL(16) RANDOM_NUMBER to Float128Math library. (#85002)
1 parent 732f536 commit e0738cc

File tree

6 files changed

+160
-77
lines changed

6 files changed

+160
-77
lines changed

flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp

Lines changed: 27 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,24 @@
2727

2828
using namespace Fortran::runtime;
2929

30+
namespace {
31+
/// Placeholder for real*16 version of RandomNumber Intrinsic
32+
struct ForcedRandomNumberReal16 {
33+
static constexpr const char *name = ExpandAndQuoteKey(RTNAME(RandomNumber16));
34+
static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
35+
return [](mlir::MLIRContext *ctx) {
36+
auto boxTy =
37+
fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
38+
auto strTy = fir::runtime::getModel<const char *>()(ctx);
39+
auto intTy = fir::runtime::getModel<int>()(ctx);
40+
;
41+
return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy},
42+
mlir::NoneType::get(ctx));
43+
};
44+
}
45+
};
46+
} // namespace
47+
3048
mlir::Value fir::runtime::genAssociated(fir::FirOpBuilder &builder,
3149
mlir::Location loc, mlir::Value pointer,
3250
mlir::Value target) {
@@ -100,8 +118,15 @@ void fir::runtime::genRandomInit(fir::FirOpBuilder &builder, mlir::Location loc,
100118

101119
void fir::runtime::genRandomNumber(fir::FirOpBuilder &builder,
102120
mlir::Location loc, mlir::Value harvest) {
103-
mlir::func::FuncOp func =
104-
fir::runtime::getRuntimeFunc<mkRTKey(RandomNumber)>(loc, builder);
121+
mlir::func::FuncOp func;
122+
auto boxEleTy = fir::dyn_cast_ptrOrBoxEleTy(harvest.getType());
123+
auto eleTy = fir::unwrapSequenceType(boxEleTy);
124+
if (eleTy.isF128()) {
125+
func = fir::runtime::getRuntimeFunc<ForcedRandomNumberReal16>(loc, builder);
126+
} else {
127+
func = fir::runtime::getRuntimeFunc<mkRTKey(RandomNumber)>(loc, builder);
128+
}
129+
105130
mlir::FunctionType funcTy = func.getFunctionType();
106131
mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
107132
mlir::Value sourceLine =

flang/runtime/Float128Math/CMakeLists.txt

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -48,6 +48,7 @@ set(sources
4848
nearest.cpp
4949
norm2.cpp
5050
pow.cpp
51+
random.cpp
5152
round.cpp
5253
rrspacing.cpp
5354
scale.cpp

flang/runtime/Float128Math/random.cpp

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
//===-- runtime/Float128Math/random.cpp -----------------------------------===//
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-exception
6+
//
7+
//===----------------------------------------------------------------------===//
8+
9+
#include "math-entries.h"
10+
#include "numeric-template-specs.h"
11+
#include "random-templates.h"
12+
13+
using namespace Fortran::runtime::random;
14+
extern "C" {
15+
16+
#if LDBL_MANT_DIG == 113 || HAS_FLOAT128
17+
void RTDEF(RandomNumber16)(
18+
const Descriptor &harvest, const char *source, int line) {
19+
return Generate<CppTypeFor<TypeCategory::Real, 16>, 113>(harvest);
20+
}
21+
#endif
22+
23+
} // extern "C"

flang/runtime/random-templates.h

Lines changed: 87 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,87 @@
1+
//===-- runtime/random-templates.h ------------------------------*- C++ -*-===//
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-exception
6+
//
7+
//===----------------------------------------------------------------------===//
8+
9+
#ifndef FORTRAN_RUNTIME_RANDOM_TEMPLATES_H_
10+
#define FORTRAN_RUNTIME_RANDOM_TEMPLATES_H_
11+
12+
#include "lock.h"
13+
#include "numeric-templates.h"
14+
#include "flang/Runtime/descriptor.h"
15+
#include <algorithm>
16+
#include <random>
17+
18+
namespace Fortran::runtime::random {
19+
20+
// Newer "Minimum standard", recommended by Park, Miller, and Stockmeyer in
21+
// 1993. Same as C++17 std::minstd_rand, but explicitly instantiated for
22+
// permanence.
23+
using Generator =
24+
std::linear_congruential_engine<std::uint_fast32_t, 48271, 0, 2147483647>;
25+
26+
using GeneratedWord = typename Generator::result_type;
27+
static constexpr std::uint64_t range{
28+
static_cast<std::uint64_t>(Generator::max() - Generator::min() + 1)};
29+
static constexpr bool rangeIsPowerOfTwo{(range & (range - 1)) == 0};
30+
static constexpr int rangeBits{
31+
64 - common::LeadingZeroBitCount(range) - !rangeIsPowerOfTwo};
32+
33+
extern Lock lock;
34+
extern Generator generator;
35+
extern std::optional<GeneratedWord> nextValue;
36+
37+
// Call only with lock held
38+
static GeneratedWord GetNextValue() {
39+
GeneratedWord result;
40+
if (nextValue.has_value()) {
41+
result = *nextValue;
42+
nextValue.reset();
43+
} else {
44+
result = generator();
45+
}
46+
return result;
47+
}
48+
49+
template <typename REAL, int PREC>
50+
inline void Generate(const Descriptor &harvest) {
51+
static constexpr std::size_t minBits{
52+
std::max<std::size_t>(PREC, 8 * sizeof(GeneratedWord))};
53+
using Int = common::HostUnsignedIntType<minBits>;
54+
static constexpr std::size_t words{
55+
static_cast<std::size_t>(PREC + rangeBits - 1) / rangeBits};
56+
std::size_t elements{harvest.Elements()};
57+
SubscriptValue at[maxRank];
58+
harvest.GetLowerBounds(at);
59+
{
60+
CriticalSection critical{lock};
61+
for (std::size_t j{0}; j < elements; ++j) {
62+
while (true) {
63+
Int fraction{GetNextValue()};
64+
if constexpr (words > 1) {
65+
for (std::size_t k{1}; k < words; ++k) {
66+
static constexpr auto rangeMask{
67+
(GeneratedWord{1} << rangeBits) - 1};
68+
GeneratedWord word{(GetNextValue() - generator.min()) & rangeMask};
69+
fraction = (fraction << rangeBits) | word;
70+
}
71+
}
72+
fraction >>= words * rangeBits - PREC;
73+
REAL next{
74+
LDEXPTy<REAL>::compute(static_cast<REAL>(fraction), -(PREC + 1))};
75+
if (next >= 0.0 && next < 1.0) {
76+
*harvest.Element<REAL>(at) = next;
77+
break;
78+
}
79+
}
80+
harvest.IncrementSubscripts(at);
81+
}
82+
}
83+
}
84+
85+
} // namespace Fortran::runtime::random
86+
87+
#endif // FORTRAN_RUNTIME_RANDOM_TEMPLATES_H_

flang/runtime/random.cpp

Lines changed: 6 additions & 75 deletions
Original file line numberDiff line numberDiff line change
@@ -11,85 +11,24 @@
1111

1212
#include "flang/Runtime/random.h"
1313
#include "lock.h"
14+
#include "random-templates.h"
1415
#include "terminator.h"
1516
#include "flang/Common/float128.h"
1617
#include "flang/Common/leading-zero-bit-count.h"
1718
#include "flang/Common/uint128.h"
1819
#include "flang/Runtime/cpp-type.h"
1920
#include "flang/Runtime/descriptor.h"
20-
#include <algorithm>
2121
#include <cmath>
2222
#include <cstdint>
2323
#include <limits>
2424
#include <memory>
25-
#include <random>
2625
#include <time.h>
2726

28-
namespace Fortran::runtime {
27+
namespace Fortran::runtime::random {
2928

30-
// Newer "Minimum standard", recommended by Park, Miller, and Stockmeyer in
31-
// 1993. Same as C++17 std::minstd_rand, but explicitly instantiated for
32-
// permanence.
33-
using Generator =
34-
std::linear_congruential_engine<std::uint_fast32_t, 48271, 0, 2147483647>;
35-
36-
using GeneratedWord = typename Generator::result_type;
37-
static constexpr std::uint64_t range{
38-
static_cast<std::uint64_t>(Generator::max() - Generator::min() + 1)};
39-
static constexpr bool rangeIsPowerOfTwo{(range & (range - 1)) == 0};
40-
static constexpr int rangeBits{
41-
64 - common::LeadingZeroBitCount(range) - !rangeIsPowerOfTwo};
42-
43-
static Lock lock;
44-
static Generator generator;
45-
static std::optional<GeneratedWord> nextValue;
46-
47-
// Call only with lock held
48-
static GeneratedWord GetNextValue() {
49-
GeneratedWord result;
50-
if (nextValue.has_value()) {
51-
result = *nextValue;
52-
nextValue.reset();
53-
} else {
54-
result = generator();
55-
}
56-
return result;
57-
}
58-
59-
template <typename REAL, int PREC>
60-
inline void Generate(const Descriptor &harvest) {
61-
static constexpr std::size_t minBits{
62-
std::max<std::size_t>(PREC, 8 * sizeof(GeneratedWord))};
63-
using Int = common::HostUnsignedIntType<minBits>;
64-
static constexpr std::size_t words{
65-
static_cast<std::size_t>(PREC + rangeBits - 1) / rangeBits};
66-
std::size_t elements{harvest.Elements()};
67-
SubscriptValue at[maxRank];
68-
harvest.GetLowerBounds(at);
69-
{
70-
CriticalSection critical{lock};
71-
for (std::size_t j{0}; j < elements; ++j) {
72-
while (true) {
73-
Int fraction{GetNextValue()};
74-
if constexpr (words > 1) {
75-
for (std::size_t k{1}; k < words; ++k) {
76-
static constexpr auto rangeMask{
77-
(GeneratedWord{1} << rangeBits) - 1};
78-
GeneratedWord word{(GetNextValue() - generator.min()) & rangeMask};
79-
fraction = (fraction << rangeBits) | word;
80-
}
81-
}
82-
fraction >>= words * rangeBits - PREC;
83-
REAL next{std::ldexp(static_cast<REAL>(fraction), -(PREC + 1))};
84-
if (next >= 0.0 && next < 1.0) {
85-
*harvest.Element<REAL>(at) = next;
86-
break;
87-
}
88-
}
89-
harvest.IncrementSubscripts(at);
90-
}
91-
}
92-
}
29+
Lock lock;
30+
Generator generator;
31+
std::optional<GeneratedWord> nextValue;
9332

9433
extern "C" {
9534

@@ -130,14 +69,6 @@ void RTNAME(RandomNumber)(
13069
#if LDBL_MANT_DIG == 64
13170
Generate<CppTypeFor<TypeCategory::Real, 10>, 64>(harvest);
13271
return;
133-
#endif
134-
}
135-
break;
136-
case 16:
137-
if constexpr (HasCppTypeFor<TypeCategory::Real, 16>) {
138-
#if LDBL_MANT_DIG == 113
139-
Generate<CppTypeFor<TypeCategory::Real, 16>, 113>(harvest);
140-
return;
14172
#endif
14273
}
14374
break;
@@ -263,4 +194,4 @@ void RTNAME(RandomSeed)(const Descriptor *size, const Descriptor *put,
263194
}
264195

265196
} // extern "C"
266-
} // namespace Fortran::runtime
197+
} // namespace Fortran::runtime::random
Lines changed: 16 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,16 @@
1+
! RUN: bbc -emit-fir %s -o - | FileCheck %s
2+
! RUN: %flang_fc1 -emit-fir %s -o - | FileCheck %s
3+
4+
! CHECK-LABEL: func @_QPtest_scalar
5+
! CHECK: fir.call @_FortranARandomNumber16({{.*}}){{.*}}: (!fir.box<none>, !fir.ref<i8>, i32) -> none
6+
subroutine test_scalar
7+
real(16) :: r
8+
call random_number(r)
9+
end
10+
11+
! CHECK-LABEL: func @_QPtest_array
12+
! CHECK: fir.call @_FortranARandomNumber16({{.*}}){{.*}}: (!fir.box<none>, !fir.ref<i8>, i32) -> none
13+
subroutine test_array(r)
14+
real(16) :: r(:)
15+
call random_number(r)
16+
end

0 commit comments

Comments
 (0)