[perl #115928] a consistent (public) rand() implementation

Based on Yves's random branch work.

This version makes the new random number visible to external modules,
for example, List::Util's XS shuffle() implementation.

I've also added a 64-bit implementation when HAS_QUAD is true, this
should be significantly faster, even on 32-bit CPUs.  This is intended to
produce exactly the same sequence as the original implementation.

The original version of this commit retained the "freebsd" name from
Yves's original work for the function and data structure names.  I've
removed "freebsd" from most function names so the name isn't an issue
if we choose to replace the implementation,

11 files changed, 157 insertions, 13 deletions

diff --git a/config_h.SH b/config_h.SH
index 4af9925b7c..c2d69f4920 100755
--- a/config_h.SH
+++ b/config_h.SH
@@ -3147,10 +3147,10 @@ sed <<!GROK!THIS! >$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un
  *	function used to generate normalized random numbers.
  *	Values include 15, 16, 31, and 48.
  */
-#define Drand01()		$drand01		/**/
-#define Rand_seed_t		$randseedtype		/**/
-#define seedDrand01(x)	$seedfunc((Rand_seed_t)x)	/**/
-#define RANDBITS		$randbits		/**/
+#define Drand01()		Perl_drand48()		/**/
+#define Rand_seed_t		U32		/**/
+#define seedDrand01(x)	Perl_drand48_init((Rand_seed_t)x)	/**/
+#define RANDBITS		48		/**/
 
 /* Select_fd_set_t:
  *	This symbol holds the type used for the 2nd, 3rd, and 4th
diff --git a/embed.fnc b/embed.fnc
index aff36ef936..343472ace7 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1571,6 +1571,8 @@ p	|I32	|wait4pid	|Pid_t pid|NN int* statusp|int flags
 : Used in locale.c and perl.c
 p	|U32	|parse_unicode_opts|NN const char **popt
 Ap	|U32	|seed
+Xpno	|double	|drand48_r	|NN perl_drand48_t *random_state
+Xpno	|void	|drand48_init_r |NN perl_drand48_t *random_state|U32 seed
 : Only used in perl.c
 p        |void        |get_hash_seed        |NN unsigned char * const seed_buffer
 : Used in doio.c, pp_hot.c, pp_sys.c
diff --git a/embedvar.h b/embedvar.h
index 3643bd132e..7c721edebc 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -243,6 +243,7 @@
 #define PL_psig_pend		(vTHX->Ipsig_pend)
 #define PL_psig_ptr		(vTHX->Ipsig_ptr)
 #define PL_ptr_table		(vTHX->Iptr_table)
+#define PL_random_state		(vTHX->Irandom_state)
 #define PL_reentrant_buffer	(vTHX->Ireentrant_buffer)
 #define PL_reentrant_retint	(vTHX->Ireentrant_retint)
 #define PL_reg_curpm		(vTHX->Ireg_curpm)
diff --git a/intrpvar.h b/intrpvar.h
index c6ee593d0e..768267b6a0 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -784,6 +784,8 @@ PERLVARA(I, op_exec_cnt, OP_max+2, UV)	/* Counts of executed OPs of the given ty
                                            DEBUGGING is enabled, too. */
 #endif
 
+PERLVAR(I, random_state, PL_RANDOM_STATE_TYPE)
+
 /* If you are adding a U8 or U16, check to see if there are 'Space' comments
  * above on where there are gaps which currently will be structure padding.  */
 
diff --git a/pp.c b/pp.c
index 860db37f10..5e0b02ca16 100644
--- a/pp.c
+++ b/pp.c
@@ -2712,10 +2712,6 @@ PP(pp_sin)
    --Jarkko Hietaniemi	27 September 1998
  */
 
-#ifndef HAS_DRAND48_PROTO
-extern double drand48 (void);
-#endif
-
 PP(pp_rand)
 {
     dVAR;
diff --git a/proto.h b/proto.h
index 790c885538..2ed34d627c 100644
--- a/proto.h
+++ b/proto.h
@@ -1024,6 +1024,16 @@ PERL_CALLCONV void	Perl_dounwind(pTHX_ I32 cxix);
 PERL_CALLCONV I32	Perl_dowantarray(pTHX)
 			__attribute__warn_unused_result__;
 
+PERL_CALLCONV void	Perl_drand48_init_r(perl_drand48_t *random_state, U32 seed)
+			__attribute__nonnull__(1);
+#define PERL_ARGS_ASSERT_DRAND48_INIT_R	\
+	assert(random_state)
+
+PERL_CALLCONV double	Perl_drand48_r(perl_drand48_t *random_state)
+			__attribute__nonnull__(1);
+#define PERL_ARGS_ASSERT_DRAND48_R	\
+	assert(random_state)
+
 PERL_CALLCONV void	Perl_dump_all(pTHX);
 PERL_CALLCONV void	Perl_dump_all_perl(pTHX_ bool justperl);
 PERL_CALLCONV void	Perl_dump_eval(pTHX);
diff --git a/sv.c b/sv.c
index a3c4752c0a..83841db822 100644
--- a/sv.c
+++ b/sv.c
@@ -13439,6 +13439,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_last_swash_slen	= 0;
 
     PL_srand_called	= proto_perl->Isrand_called;
+    Copy(&(proto_perl->Irandom_state), &PL_random_state, 1, PL_RANDOM_STATE_TYPE);
 
     if (flags & CLONEf_COPY_STACKS) {
 	/* next allocation will be PL_tmps_stack[PL_tmps_ix+1] */
diff --git a/t/op/rand.t b/t/op/rand.t
index 24b2bf9baf..90d1c375d1 100644
--- a/t/op/rand.t
+++ b/t/op/rand.t
@@ -24,7 +24,7 @@ use strict;
 use Config;
 
 require "test.pl";
-plan(tests => 8);
+plan(tests => 10);
 
 
 my $reps = 15000;	# How many times to try rand each time.
@@ -242,3 +242,8 @@ DIAG
     ok($r < 1,        'rand() without args is under 1');
 }
 
+{ # [perl #115928] use a standard rand() implementation
+    srand(1);
+    is(int rand(1000), 41, "our own implementation behaves consistently");
+    is(int rand(1000), 454, "and still consistently");
+}
diff --git a/uconfig.h b/uconfig.h
index 2ae2ff2436..3e206dd291 100644
--- a/uconfig.h
+++ b/uconfig.h
@@ -3112,9 +3112,9 @@
  *	function used to generate normalized random numbers.
  *	Values include 15, 16, 31, and 48.
  */
-#define Drand01()		((rand() & 0x7FFF) / (double) ((unsigned long)1 << 15))		/**/
-#define Rand_seed_t		int		/**/
-#define seedDrand01(x)	srand((Rand_seed_t)x)	/**/
+#define Drand01()		Perl_drand48()		/**/
+#define Rand_seed_t		U32		/**/
+#define seedDrand01(x)	Perl_drand48_init((Rand_seed_t)x)	/**/
 #define RANDBITS		48		/**/
 
 /* Select_fd_set_t:
@@ -4753,6 +4753,6 @@
 #endif
 
 /* Generated from:
- * 3631b2b781d1779dc1855cb35ab72d5176a9eb36a527f74231c7e3f274021182 config_h.SH
+ * eea5809659d1cac397ca3a1a48f51bcb5bfc60eb2dca2ef00b9b2015ee87729a config_h.SH
  * 3dc6c26adfbf4f2e111d90b34d50e317e18555a76a270fbac2899d08a42f2fd1 uconfig.sh
  * ex: set ro: */
diff --git a/util.c b/util.c
index 55f6d9ee88..28cc7064ed 100644
--- a/util.c
+++ b/util.c
@@ -37,6 +37,9 @@
 #endif
 #endif
 
+#include <math.h>
+#include <stdlib.h>
+
 #ifdef __Lynx__
 /* Missing protos on LynxOS */
 int putenv(char *);
@@ -6213,6 +6216,103 @@ Perl_get_re_arg(pTHX_ SV *sv) {
 }
 
 /*
+ * This code is derived from drand48() implementation from FreeBSD,
+ * found in lib/libc/gen/_rand48.c.
+ *
+ * The U64 implementation is original, based on the POSIX
+ * specification for drand48().
+ */
+
+/*
+* Copyright (c) 1993 Martin Birgmeier
+* All rights reserved.
+*
+* You may redistribute unmodified or modified versions of this source
+* code provided that the above copyright notice and this and the
+* following conditions are retained.
+*
+* This software is provided ``as is'', and comes with no warranties
+* of any kind. I shall in no event be liable for anything that happens
+* to anyone/anything when using this software.
+*/
+
+#define FREEBSD_DRAND48_SEED_0   (0x330e)
+
+#ifdef PERL_DRAND48_QUAD
+
+#define DRAND48_MULT 0x5deece66d
+#define DRAND48_ADD  0xb
+#define DRAND48_MASK 0xffffffffffff
+
+#else
+
+#define FREEBSD_DRAND48_SEED_1   (0xabcd)
+#define FREEBSD_DRAND48_SEED_2   (0x1234)
+#define FREEBSD_DRAND48_MULT_0   (0xe66d)
+#define FREEBSD_DRAND48_MULT_1   (0xdeec)
+#define FREEBSD_DRAND48_MULT_2   (0x0005)
+#define FREEBSD_DRAND48_ADD      (0x000b)
+
+const unsigned short _rand48_mult[3] = {
+                FREEBSD_DRAND48_MULT_0,
+                FREEBSD_DRAND48_MULT_1,
+                FREEBSD_DRAND48_MULT_2
+};
+const unsigned short _rand48_add = FREEBSD_DRAND48_ADD;
+
+#endif
+
+void
+Perl_drand48_init_r(perl_drand48_t *random_state, U32 seed)
+{
+    PERL_ARGS_ASSERT_DRAND48_INIT_R;
+
+#ifdef PERL_DRAND48_QUAD
+    *random_state = FREEBSD_DRAND48_SEED_0 + ((U64TYPE)seed << 16);
+#else
+    random_state->seed[0] = FREEBSD_DRAND48_SEED_0;
+    random_state->seed[1] = (U16) seed;
+    random_state->seed[2] = (U16) (seed >> 16);
+#endif
+}
+
+double
+Perl_drand48_r(perl_drand48_t *random_state)
+{
+    PERL_ARGS_ASSERT_DRAND48_R;
+
+#ifdef PERL_DRAND48_QUAD
+    *random_state = (*random_state * DRAND48_MULT + DRAND48_ADD)
+        & DRAND48_MASK;
+
+    return ldexp(*random_state, -48);
+#else
+    U32 accu;
+    U16 temp[2];
+
+    accu = (U32) _rand48_mult[0] * (U32) random_state->seed[0]
+         + (U32) _rand48_add;
+    temp[0] = (U16) accu;        /* lower 16 bits */
+    accu >>= sizeof(U16) * 8;
+    accu += (U32) _rand48_mult[0] * (U32) random_state->seed[1]
+          + (U32) _rand48_mult[1] * (U32) random_state->seed[0];
+    temp[1] = (U16) accu;        /* middle 16 bits */
+    accu >>= sizeof(U16) * 8;
+    accu += _rand48_mult[0] * random_state->seed[2]
+          + _rand48_mult[1] * random_state->seed[1]
+          + _rand48_mult[2] * random_state->seed[0];
+    random_state->seed[0] = temp[0];
+    random_state->seed[1] = temp[1];
+    random_state->seed[2] = (U16) accu;
+
+    return ldexp((double) random_state->seed[0], -48) +
+           ldexp((double) random_state->seed[1], -32) +
+           ldexp((double) random_state->seed[2], -16);
+#endif
+}
+ 
+
+/*
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
diff --git a/util.h b/util.h
index ed133c464b..4e5b97d88b 100644
--- a/util.h
+++ b/util.h
@@ -52,6 +52,33 @@ This is a synonym for (! foldEQ_locale())
 #define ibcmp(s1, s2, len)         cBOOL(! foldEQ(s1, s2, len))
 #define ibcmp_locale(s1, s2, len)  cBOOL(! foldEQ_locale(s1, s2, len))
 
+/* perl.h undefs HAS_QUAD if IV isn't 64-bit */
+#ifdef U64TYPE
+/* use a faster implementation when quads are available */
+#define PERL_DRAND48_QUAD
+#endif
+
+#ifdef PERL_DRAND48_QUAD
+
+/* U64 is only defined under PERL_CORE, but this needs to be visible
+ * elsewhere so the definition of PerlInterpreter is complete.
+ */
+typedef U64TYPE perl_drand48_t;
+
+#else
+
+struct PERL_DRAND48_T {
+    U16 seed[3];
+};
+
+typedef struct PERL_DRAND48_T perl_drand48_t;
+
+#endif
+
+#define PL_RANDOM_STATE_TYPE perl_drand48_t
+
+#define Perl_drand48_init(seed) (Perl_drand48_init_r(&PL_random_state, (seed)))
+#define Perl_drand48() (Perl_drand48_r(&PL_random_state))
 
 /*
  * Local variables: