From 5ae64c38f71f64067f6e7a35e787a83482bbec5d Mon Sep 17 00:00:00 2001
From: Scott Baker <scott@perturb.org>
Date: Mon, 24 Feb 2025 09:55:46 -0800
Subject: [PATCH] Add xoroshiro128** as an option for PRNG

---
 Configure | 13 ++++++++++---
 embed.fnc |  4 ++++
 prng.h    | 45 +++++++++++++++++++++++++++++++++++++++++++++
 proto.h   |  8 ++++++++
 4 files changed, 67 insertions(+), 3 deletions(-)

diff --git a/Configure b/Configure
index a340f0714365..7973b5e3103a 100755
--- a/Configure
+++ b/Configure
@@ -21349,11 +21349,18 @@ esac
 #randbits=48
 #randseedtype=U32
 
-randfunc=Perl_pcg32_random_double
-drand01="Perl_pcg32_random_double()"
-seedfunc="Perl_pcg32_seed"
+# Use xoroshiro128** as the PRNG for rand()
+randfunc=Perl_xoroshiro128starstar_random_double
+drand01="Perl_xoroshiro128starstar_random_double()"
+seedfunc="Perl_xoroshiro128starstar_seed"
 randseedtype=U64
 
+# Use PCG32 as the PRNG for rand()
+#randfunc=Perl_pcg32_random_double
+#drand01="Perl_pcg32_random_double()"
+#seedfunc="Perl_pcg32_seed"
+#randseedtype=U64
+
 : Probe whether dtrace builds an object, as newer Illumos requires an input
 : object file that uses at least one of the probes defined in the .d file
 case "$usedtrace" in
diff --git a/embed.fnc b/embed.fnc
index fabbad3929bb..220672e37759 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -3935,6 +3935,10 @@ Adp	|void	|wrap_op_checker|Optype opcode				\
 				|NN Perl_check_t *old_checker_p
 : Used in pp_ctl.c
 p	|void	|write_to_stderr|NN SV *msv
+
+TXop	|double |xoroshiro128starstar_random_double
+TXop	|void	|xoroshiro128starstar_seed				\
+				|U64 seed1
 Xp	|void	|xs_boot_epilog |const SSize_t ax
 
 FTXopv	|Stack_off_t|xs_handshake					\
diff --git a/prng.h b/prng.h
index 3865e3775407..4bf63c48ae19 100644
--- a/prng.h
+++ b/prng.h
@@ -100,3 +100,48 @@ Perl_pcg32_random_double()
 
 	return ret;
 }
+
+//////////////////////////////////////////////////////////////
+// xoroshiro128** functions
+//////////////////////////////////////////////////////////////
+
+static inline uint64_t rotl(const uint64_t x, int k) {
+	return (x << k) | (x >> (64 - k));
+}
+
+static uint64_t XOSSS_SEED[2];
+
+// Perl can only send one seed, so we have to deterministically
+// create the other seeds needed for our PRNG
+void
+Perl_xoroshiro128starstar_seed(U64 seed) {
+	XOSSS_SEED[0] = hash_msh(seed);
+	XOSSS_SEED[1] = hash_msh(XOSSS_SEED[0]);
+
+	DEBUG_U(PerlIO_printf(Perl_error_log, "Xoroshiro128** INIT: %lu => %lu / %lu\n", seed, XOSSS_SEED[0], XOSSS_SEED[1]));
+}
+
+U64
+xoroshiro128starstar_rand64()
+{
+	const uint64_t s0 = XOSSS_SEED[0];
+	uint64_t s1 = XOSSS_SEED[1];
+	const uint64_t result = rotl(s0 * 5, 7) * 9;
+
+	s1 ^= s0;
+	XOSSS_SEED[0] = rotl(s0, 24) ^ s1 ^ (s1 << 16); // a, b
+	XOSSS_SEED[1] = rotl(s1, 37); // c
+
+	return result;
+}
+
+double
+Perl_xoroshiro128starstar_random_double()
+{
+	U64 num    = xoroshiro128starstar_rand64();
+	double ret = uint64_to_double(num);
+
+	/*DEBUG_U(PerlIO_printf(Perl_error_log, "Xoroshiro128** Double: %lu => %0.15f\n", num, ret));*/
+
+	return ret;
+}
diff --git a/proto.h b/proto.h
index 4037e4648640..356eaa34cdf8 100644
--- a/proto.h
+++ b/proto.h
@@ -5634,6 +5634,14 @@ Perl_write_to_stderr(pTHX_ SV *msv)
 #define PERL_ARGS_ASSERT_WRITE_TO_STDERR        \
         assert(msv)
 
+PERL_CALLCONV double
+Perl_xoroshiro128starstar_random_double(void);
+#define PERL_ARGS_ASSERT_XOROSHIRO128STARSTAR_RANDOM_DOUBLE
+
+PERL_CALLCONV void
+Perl_xoroshiro128starstar_seed(U64 seed1);
+#define PERL_ARGS_ASSERT_XOROSHIRO128STARSTAR_SEED
+
 PERL_CALLCONV void
 Perl_xs_boot_epilog(pTHX_ const SSize_t ax);
 #define PERL_ARGS_ASSERT_XS_BOOT_EPILOG