[perl #115928] use a consistent internal rand on all platforms

Author: tonycoz

Configure

@@ -19489,26 +19489,7 @@ esac
 
 : How can we generate normalized random numbers ?
 echo " "
-echo "Looking for a random number function..." >&4
-case "$randfunc" in
-'')
-	if set drand48 val -f; eval $csym; $val; then
-		dflt="drand48"
-		echo "Good, found drand48()." >&4
-	elif set random val -f; eval $csym; $val; then
-		dflt="random"
-		echo "OK, found random()." >&4
-	else
-		dflt="rand"
-		echo "Yuck, looks like I have to use rand()." >&4
-	fi
-	echo " "
-	;;
-*)
-	dflt="$randfunc"
-	;;
-esac
-cont=true
+echo "Using our internal random number implementation..." >&4
 
 case "$ccflags" in
 *-Dmy_rand=*|*-Dmy_srand=*)
@@ -19519,103 +19500,11 @@ case "$ccflags" in
 	;;
 esac
 
-while $test "$cont"; do
-	rp="Use which function to generate random numbers?"
-	. ./myread
-	if $test "$ans" = "$dflt"; then
-		: null
-	else
-		randbits=''
-	fi
-	randfunc="$ans"
-	if set $ans val -f; eval $csym; $val; then
-		cont=''
-	else
-		dflt=y
-		rp="I cannot find function $ans. Use that name anyway?"
-		. ./myread
-		dflt=rand
-		case "$ans" in
-			[yY]*) cont='';;
-		esac
-	fi
-	case "$cont" in
-	'')
-		case "$randfunc" in
-		drand48)
-			drand01="drand48()"
-			seedfunc="srand48"
-			randbits=48
-			randseedtype=long
-			;;
-		rand|random)
-			case "$randbits" in
-			'')
-echo "Checking to see how many bits your $randfunc() function produces..." >&4
-				$cat >try.c <<EOCP
-#$i_unistd I_UNISTD
-#$i_stdlib I_STDLIB
-#include <stdio.h>
-#ifdef I_UNISTD
-#  include <unistd.h>
-#endif
-#ifdef I_STDLIB
-#  include <stdlib.h>
-#endif
-int main()
-{
-	int i;
-	unsigned long tmp;
-	unsigned long max = 0L;
-
-	for (i = 1000; i; i--) {
-		tmp = (unsigned long) $randfunc();
-		if (tmp > max) max = tmp;
-	}
-	for (i = 0; max; i++)
-		max /= 2;
-	printf("%d\n",i);
-}
-EOCP
-				set try
-				if eval $compile_ok; then
-					dflt=`try`
-				else
-					dflt='?'
-					echo "(I can't seem to compile the test program...)"
-				fi
-				;;
-			*)
-				dflt="$randbits"
-				;;
-			esac
-			rp="How many bits does your $randfunc() function produce?"
-			. ./myread
-			randbits="$ans"
-			$rm_try
-			drand01="($randfunc() / (double) ((unsigned long)1 << $randbits))"
-			seedfunc="s$randfunc"
-			randseedtype=unsigned
-			;;
-		*)
-			dflt="31"
-			rp="How many bits does your $randfunc() function produce?"
-			. ./myread
-			randbits="$ans"
-			seedfunc="s$randfunc"
-			drand01="($randfunc() / (double) ((unsigned long)1 << $randbits))"
-			if set $seedfunc val -f; eval $csym; $val; then
-				echo "(Using $seedfunc() to seed random generator)"
-			else
-				echo "(Warning: no $seedfunc() to seed random generator)"
-				seedfunc=rand
-			fi
-			randseedtype=unsigned
-			;;
-		esac
-		;;
-	esac
-done
+randfunc=Perl_drand48
+drand01="Perl_drand48()"
+seedfunc="Perl_drand48_init"
+randbits=48
+randseedtype=U32
 
 : Check how to flush
 echo " "

Cross/config.sh-arm-linux

@@ -556,7 +556,7 @@ direntrytype='struct dirent'
 dlext='so'
 dlsrc='dl_dlopen.xs'
 doublesize='8'
-drand01='drand48()'
+drand01='Perl_drand48()'
 drand48_r_proto='0'
 dtrace=''
 dynamic_ext='B ByteLoader Cwd Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Collate Unicode/Normalize XS/APItest XS/Typemap attributes re threads threads/shared'
@@ -882,9 +882,9 @@ ptrsize='4'
 quadkind='3'
 quadtype='long long'
 randbits='48'
-randfunc='drand48'
+randfunc='Perl_drand48'
 random_r_proto='0'
-randseedtype='long'
+randseedtype='U32'
 ranlib=':'
 rd_nodata='-1'
 readdir64_r_proto='0'
@@ -915,7 +915,7 @@ sched_yield='sched_yield()'
 scriptdir='/usr/bin'
 scriptdirexp='/usr/bin'
 sed='sed'
-seedfunc='srand48'
+seedfunc='Perl_drand48_init'
 selectminbits='32'
 selecttype='fd_set *'
 sendmail=''

Cross/config.sh-arm-linux-n770

@@ -529,7 +529,7 @@ direntrytype='struct dirent'
 dlext='so'
 dlsrc='dl_dlopen.xs'
 doublesize='8'
-drand01='drand48()'
+drand01='Perl_drand48()'
 drand48_r_proto='0'
 dynamic_ext='B ByteLoader Cwd Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Collate Unicode/Normalize XS/APItest XS/Typemap attributes re threads threads/shared'
 eagain='EAGAIN'
@@ -852,9 +852,9 @@ ptrsize='4'
 quadkind='3'
 quadtype='long long'
 randbits='48'
-randfunc='drand48'
+randfunc='Perl_drand48'
 random_r_proto='0'
-randseedtype='long'
+randseedtype='U32'
 ranlib=':'
 rd_nodata='-1'
 readdir64_r_proto='0'
@@ -881,7 +881,7 @@ sched_yield='sched_yield()'
 scriptdir='/usr/bin'
 scriptdirexp='/usr/bin'
 sed='sed'
-seedfunc='srand48'
+seedfunc='Perl_drand48_init'
 selectminbits='32'
 selecttype='fd_set *'
 sendmail=''

NetWare/config.wc

@@ -547,7 +547,7 @@ direntrytype='DIR'
 dlext='nlm'
 dlsrc='dl_netware.xs'
 doublesize='8'
-drand01='(rand()/(double)((unsigned)1<<RANDBITS))'
+drand01='Perl_drand48()'
 drand48_r_proto='0'
 dtrace=''
 dynamic_ext='Socket IO Fcntl Opcode SDBM_File attributes'
@@ -854,10 +854,10 @@ prototype='define'
 ptrsize='4'
 quadkind='5'
 quadtype='__int64'
-randbits='15'
-randfunc='rand'
+randbits='48'
+randfunc='Perl_drand48'
 random_r_proto='0'
-randseedtype='unsigned'
+randseedtype='U32'
 ranlib='rem'
 rd_nodata='-1'
 readdir64_r_proto='0'
@@ -887,7 +887,7 @@ sched_yield=''
 scriptdir='~INST_TOP~~INST_VER~\bin'
 scriptdirexp='~INST_TOP~~INST_VER~\bin'
 sed='sed'
-seedfunc='srand'
+seedfunc='Perl_drand48_init'
 selectminbits='32'
 selecttype='fd_set *'
 sendmail='blat'

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()              $drand01                /**/
+#define Rand_seed_t            $randseedtype           /**/
+#define seedDrand01(x) $seedfunc((Rand_seed_t)x)       /**/
+#define RANDBITS               $randbits               /**/
 
 /* Select_fd_set_t:
  *	This symbol holds the type used for the 2nd, 3rd, and 4th

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

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)

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.  */
 

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;

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);