This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #115928] use a consistent internal rand on all platforms
authorTony Cook <tony@develop-help.com>
Fri, 13 Sep 2013 01:34:16 +0000 (11:34 +1000)
committerTony Cook <tony@develop-help.com>
Fri, 13 Sep 2013 01:34:16 +0000 (11:34 +1000)
22 files changed:
Configure
Cross/config.sh-arm-linux
Cross/config.sh-arm-linux-n770
NetWare/config.wc
config_h.SH
embed.fnc
embedvar.h
intrpvar.h
pp.c
proto.h
reentr.c
reentr.h
regen/reentr.pl
sv.c
t/op/rand.t
uconfig.h
uconfig.sh
util.c
util.h
win32/config.ce
win32/config.gc
win32/config.vc

index 7976c13..74806ef 100755 (executable)
--- a/Configure
+++ b/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 " "
index fea06f1..07fc8d2 100644 (file)
@@ -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=''
index c3b8daf..e3ebe6a 100644 (file)
@@ -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=''
index 1182d47..016748d 100644 (file)
@@ -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'
index 4af9925..be47a6b 100755 (executable)
@@ -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
index aff36ef..343472a 100644 (file)
--- 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
index 3643bd1..7c721ed 100644 (file)
 #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)
index c6ee593..768267b 100644 (file)
@@ -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 860db37..5e0b02c 100644 (file)
--- 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 790c885..2ed34d6 100644 (file)
--- 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);
index 31b933c..a5ea192 100644 (file)
--- a/reentr.c
+++ b/reentr.c
@@ -40,8 +40,6 @@ Perl_reentrant_size(pTHX) {
 #ifdef HAS_CTIME_R
        PL_reentrant_buffer->_ctime_size = REENTRANTSMALLSIZE;
 #endif /* HAS_CTIME_R */
-#ifdef HAS_DRAND48_R
-#endif /* HAS_DRAND48_R */
 #ifdef HAS_GETGRNAM_R
 #   if defined(HAS_SYSCONF) && defined(_SC_GETGR_R_SIZE_MAX) && !defined(__GLIBC__)
        PL_reentrant_buffer->_grent_size = sysconf(_SC_GETGR_R_SIZE_MAX);
@@ -116,8 +114,6 @@ Perl_reentrant_size(pTHX) {
 #       endif
 #   endif 
 #endif /* HAS_GETSPNAM_R */
-#ifdef HAS_RANDOM_R
-#endif /* HAS_RANDOM_R */
 #ifdef HAS_READDIR_R
        /* This is the size Solaris recommends.
         * (though we go static, should use pathconf() instead) */
@@ -131,8 +127,6 @@ Perl_reentrant_size(pTHX) {
 #ifdef HAS_SETLOCALE_R
        PL_reentrant_buffer->_setlocale_size = REENTRANTSMALLSIZE;
 #endif /* HAS_SETLOCALE_R */
-#ifdef HAS_SRANDOM_R
-#endif /* HAS_SRANDOM_R */
 #ifdef HAS_STRERROR_R
        PL_reentrant_buffer->_strerror_size = REENTRANTSMALLSIZE;
 #endif /* HAS_STRERROR_R */
@@ -159,8 +153,6 @@ Perl_reentrant_init(pTHX) {
 #ifdef HAS_CTIME_R
        Newx(PL_reentrant_buffer->_ctime_buffer, PL_reentrant_buffer->_ctime_size, char);
 #endif /* HAS_CTIME_R */
-#ifdef HAS_DRAND48_R
-#endif /* HAS_DRAND48_R */
 #ifdef HAS_GETGRNAM_R
 #   ifdef USE_GRENT_FPTR
        PL_reentrant_buffer->_grent_fptr = NULL;
@@ -202,8 +194,6 @@ Perl_reentrant_init(pTHX) {
 #   endif
        Newx(PL_reentrant_buffer->_spent_buffer, PL_reentrant_buffer->_spent_size, char);
 #endif /* HAS_GETSPNAM_R */
-#ifdef HAS_RANDOM_R
-#endif /* HAS_RANDOM_R */
 #ifdef HAS_READDIR_R
        PL_reentrant_buffer->_readdir_struct = (struct dirent*)safemalloc(PL_reentrant_buffer->_readdir_size);
 #endif /* HAS_READDIR_R */
@@ -213,8 +203,6 @@ Perl_reentrant_init(pTHX) {
 #ifdef HAS_SETLOCALE_R
        Newx(PL_reentrant_buffer->_setlocale_buffer, PL_reentrant_buffer->_setlocale_size, char);
 #endif /* HAS_SETLOCALE_R */
-#ifdef HAS_SRANDOM_R
-#endif /* HAS_SRANDOM_R */
 #ifdef HAS_STRERROR_R
        Newx(PL_reentrant_buffer->_strerror_buffer, PL_reentrant_buffer->_strerror_size, char);
 #endif /* HAS_STRERROR_R */
@@ -239,8 +227,6 @@ Perl_reentrant_free(pTHX) {
 #ifdef HAS_CTIME_R
        Safefree(PL_reentrant_buffer->_ctime_buffer);
 #endif /* HAS_CTIME_R */
-#ifdef HAS_DRAND48_R
-#endif /* HAS_DRAND48_R */
 #ifdef HAS_GETGRNAM_R
        Safefree(PL_reentrant_buffer->_grent_buffer);
 #endif /* HAS_GETGRNAM_R */
@@ -273,8 +259,6 @@ Perl_reentrant_free(pTHX) {
 #ifdef HAS_GETSPNAM_R
        Safefree(PL_reentrant_buffer->_spent_buffer);
 #endif /* HAS_GETSPNAM_R */
-#ifdef HAS_RANDOM_R
-#endif /* HAS_RANDOM_R */
 #ifdef HAS_READDIR_R
        Safefree(PL_reentrant_buffer->_readdir_struct);
 #endif /* HAS_READDIR_R */
@@ -284,8 +268,6 @@ Perl_reentrant_free(pTHX) {
 #ifdef HAS_SETLOCALE_R
        Safefree(PL_reentrant_buffer->_setlocale_buffer);
 #endif /* HAS_SETLOCALE_R */
-#ifdef HAS_SRANDOM_R
-#endif /* HAS_SRANDOM_R */
 #ifdef HAS_STRERROR_R
        Safefree(PL_reentrant_buffer->_strerror_buffer);
 #endif /* HAS_STRERROR_R */
index 3510fc5..c268851 100644 (file)
--- a/reentr.h
+++ b/reentr.h
 
 #ifdef __hpux
 #   undef HAS_CRYPT_R
-#   undef HAS_DRAND48_R
 #   undef HAS_ENDGRENT_R
 #   undef HAS_ENDPWENT_R
 #   undef HAS_GETGRENT_R
 #   undef HAS_GETPWENT_R
 #   undef HAS_SETLOCALE_R
-#   undef HAS_SRAND48_R
 #   undef HAS_STRERROR_R
 #   define NETDB_R_OBSOLETE
 #endif
 #ifdef I_NETDB
 #   include <netdb.h>
 #endif
-#ifdef I_STDLIB
-#   include <stdlib.h> /* drand48_data */
-#endif
 #ifdef I_CRYPT
 #   ifdef I_CRYPT
 #       include <crypt.h>
 #define REENTRANT_PROTO_I_ISD  33
 #define REENTRANT_PROTO_I_LISBI        34
 #define REENTRANT_PROTO_I_LISD 35
-#define REENTRANT_PROTO_I_LS   36
-#define REENTRANT_PROTO_I_SB   37
-#define REENTRANT_PROTO_I_SBI  38
-#define REENTRANT_PROTO_I_SBIE 39
-#define REENTRANT_PROTO_I_SBIH 40
-#define REENTRANT_PROTO_I_SBIR 41
-#define REENTRANT_PROTO_I_SBWR 42
-#define REENTRANT_PROTO_I_SBWRE        43
-#define REENTRANT_PROTO_I_SD   44
-#define REENTRANT_PROTO_I_ST   45
-#define REENTRANT_PROTO_I_St   46
-#define REENTRANT_PROTO_I_TISD 47
-#define REENTRANT_PROTO_I_TS   48
-#define REENTRANT_PROTO_I_TSBI 49
-#define REENTRANT_PROTO_I_TSBIR        50
-#define REENTRANT_PROTO_I_TSBWR        51
-#define REENTRANT_PROTO_I_TSR  52
-#define REENTRANT_PROTO_I_TsISBWRE     53
-#define REENTRANT_PROTO_I_UISBWRE      54
-#define REENTRANT_PROTO_I_iS   55
-#define REENTRANT_PROTO_I_lS   56
-#define REENTRANT_PROTO_I_uISBWRE      57
-#define REENTRANT_PROTO_S_CBI  58
-#define REENTRANT_PROTO_S_CCSBI        59
-#define REENTRANT_PROTO_S_CIISBIE      60
-#define REENTRANT_PROTO_S_CSBI 61
-#define REENTRANT_PROTO_S_CSBIE        62
-#define REENTRANT_PROTO_S_CWISBIE      63
-#define REENTRANT_PROTO_S_CWISBWIE     64
-#define REENTRANT_PROTO_S_ICSBI        65
-#define REENTRANT_PROTO_S_ISBI 66
-#define REENTRANT_PROTO_S_LISBI        67
-#define REENTRANT_PROTO_S_SBI  68
-#define REENTRANT_PROTO_S_SBIE 69
-#define REENTRANT_PROTO_S_SBW  70
-#define REENTRANT_PROTO_S_TISBI        71
-#define REENTRANT_PROTO_S_TSBI 72
-#define REENTRANT_PROTO_S_TSBIE        73
-#define REENTRANT_PROTO_S_TWISBIE      74
-#define REENTRANT_PROTO_V_D    75
-#define REENTRANT_PROTO_V_H    76
-#define REENTRANT_PROTO_V_ID   77
+#define REENTRANT_PROTO_I_SB   36
+#define REENTRANT_PROTO_I_SBI  37
+#define REENTRANT_PROTO_I_SBIE 38
+#define REENTRANT_PROTO_I_SBIH 39
+#define REENTRANT_PROTO_I_SBIR 40
+#define REENTRANT_PROTO_I_SBWR 41
+#define REENTRANT_PROTO_I_SBWRE        42
+#define REENTRANT_PROTO_I_SD   43
+#define REENTRANT_PROTO_I_TISD 44
+#define REENTRANT_PROTO_I_TS   45
+#define REENTRANT_PROTO_I_TSBI 46
+#define REENTRANT_PROTO_I_TSBIR        47
+#define REENTRANT_PROTO_I_TSBWR        48
+#define REENTRANT_PROTO_I_TSR  49
+#define REENTRANT_PROTO_I_TsISBWRE     50
+#define REENTRANT_PROTO_I_UISBWRE      51
+#define REENTRANT_PROTO_I_uISBWRE      52
+#define REENTRANT_PROTO_S_CBI  53
+#define REENTRANT_PROTO_S_CCSBI        54
+#define REENTRANT_PROTO_S_CIISBIE      55
+#define REENTRANT_PROTO_S_CSBI 56
+#define REENTRANT_PROTO_S_CSBIE        57
+#define REENTRANT_PROTO_S_CWISBIE      58
+#define REENTRANT_PROTO_S_CWISBWIE     59
+#define REENTRANT_PROTO_S_ICSBI        60
+#define REENTRANT_PROTO_S_ISBI 61
+#define REENTRANT_PROTO_S_LISBI        62
+#define REENTRANT_PROTO_S_SBI  63
+#define REENTRANT_PROTO_S_SBIE 64
+#define REENTRANT_PROTO_S_SBW  65
+#define REENTRANT_PROTO_S_TISBI        66
+#define REENTRANT_PROTO_S_TSBI 67
+#define REENTRANT_PROTO_S_TSBIE        68
+#define REENTRANT_PROTO_S_TWISBIE      69
+#define REENTRANT_PROTO_V_D    70
+#define REENTRANT_PROTO_V_H    71
+#define REENTRANT_PROTO_V_ID   72
 
 /* Defines for indicating which special features are supported. */
 
@@ -639,10 +629,6 @@ typedef struct {
        char*   _ctime_buffer;
        size_t  _ctime_size;
 #endif /* HAS_CTIME_R */
-#ifdef HAS_DRAND48_R
-       struct drand48_data _drand48_struct;
-       double  _drand48_double;
-#endif /* HAS_DRAND48_R */
 #ifdef HAS_GETGRNAM_R
        struct group    _grent_struct;
        char*   _grent_buffer;
@@ -740,18 +726,6 @@ typedef struct {
        FILE*   _spent_fptr;
 #   endif
 #endif /* HAS_GETSPNAM_R */
-#ifdef HAS_RANDOM_R
-       struct random_data _random_struct;
-#   if RANDOM_R_PROTO == REENTRANT_PROTO_I_iS
-       int     _random_retval;
-#   endif
-#   if RANDOM_R_PROTO == REENTRANT_PROTO_I_lS
-       long    _random_retval;
-#   endif
-#   if RANDOM_R_PROTO == REENTRANT_PROTO_I_St
-       int32_t _random_retval;
-#   endif
-#endif /* HAS_RANDOM_R */
 #ifdef HAS_READDIR_R
        struct dirent*  _readdir_struct;
        size_t  _readdir_size;
@@ -770,9 +744,6 @@ typedef struct {
        char*   _setlocale_buffer;
        size_t  _setlocale_size;
 #endif /* HAS_SETLOCALE_R */
-#ifdef HAS_SRANDOM_R
-       struct random_data _srandom_struct;
-#endif /* HAS_SRANDOM_R */
 #ifdef HAS_STRERROR_R
        char*   _strerror_buffer;
        size_t  _strerror_size;
@@ -844,15 +815,6 @@ typedef struct {
 #  endif
 #endif /* HAS_CTIME_R */
 
-#ifdef HAS_DRAND48_R
-#  if defined(PERL_REENTR_API) && (PERL_REENTR_API+0 == 1)
-#   undef drand48
-#   if !defined(drand48) && DRAND48_R_PROTO == REENTRANT_PROTO_I_ST
-#       define drand48() (drand48_r(&PL_reentrant_buffer->_drand48_struct, &PL_reentrant_buffer->_drand48_double) == 0 ? PL_reentrant_buffer->_drand48_double : 0)
-#   endif
-#  endif
-#endif /* HAS_DRAND48_R */
-
 #ifdef HAS_ENDGRENT_R
 #  if defined(PERL_REENTR_API) && (PERL_REENTR_API+0 == 1)
 #   undef endgrent
@@ -1324,21 +1286,6 @@ typedef struct {
 #  endif
 #endif /* HAS_GETSPNAM_R */
 
-#ifdef HAS_RANDOM_R
-#  if defined(PERL_REENTR_API) && (PERL_REENTR_API+0 == 1)
-#   undef random
-#   if !defined(random) && RANDOM_R_PROTO == REENTRANT_PROTO_I_iS
-#       define random() (random_r(&PL_reentrant_buffer->_random_retval, &PL_reentrant_buffer->_random_struct) == 0 ? PL_reentrant_buffer->_random_retval : 0)
-#   endif
-#   if !defined(random) && RANDOM_R_PROTO == REENTRANT_PROTO_I_lS
-#       define random() (random_r(&PL_reentrant_buffer->_random_retval, &PL_reentrant_buffer->_random_struct) == 0 ? PL_reentrant_buffer->_random_retval : 0)
-#   endif
-#   if !defined(random) && RANDOM_R_PROTO == REENTRANT_PROTO_I_St
-#       define random() (random_r(&PL_reentrant_buffer->_random_struct, &PL_reentrant_buffer->_random_retval) == 0 ? PL_reentrant_buffer->_random_retval : 0)
-#   endif
-#  endif
-#endif /* HAS_RANDOM_R */
-
 #ifdef HAS_READDIR_R
 #  if defined(PERL_REENTR_API) && (PERL_REENTR_API+0 == 1)
 #   undef readdir
@@ -1444,24 +1391,6 @@ typedef struct {
 #  endif
 #endif /* HAS_SETSERVENT_R */
 
-#ifdef HAS_SRAND48_R
-#  if defined(PERL_REENTR_API) && (PERL_REENTR_API+0 == 1)
-#   undef srand48
-#   if !defined(srand48) && SRAND48_R_PROTO == REENTRANT_PROTO_I_LS
-#       define srand48(a) (srand48_r(a, &PL_reentrant_buffer->_drand48_struct) == 0 ? &PL_reentrant_buffer->_drand48_struct : 0)
-#   endif
-#  endif
-#endif /* HAS_SRAND48_R */
-
-#ifdef HAS_SRANDOM_R
-#  if defined(PERL_REENTR_API) && (PERL_REENTR_API+0 == 1)
-#   undef srandom
-#   if !defined(srandom) && SRANDOM_R_PROTO == REENTRANT_PROTO_I_TS
-#       define srandom(a) (srandom_r(a, &PL_reentrant_buffer->_srandom_struct) == 0 ? &PL_reentrant_buffer->_srandom_struct : 0)
-#   endif
-#  endif
-#endif /* HAS_SRANDOM_R */
-
 #ifdef HAS_STRERROR_R
 #  if defined(PERL_REENTR_API) && (PERL_REENTR_API+0 == 1)
 #   undef strerror
index c5e7129..6dac299 100644 (file)
@@ -91,13 +91,11 @@ print $h <<EOF;
 
 #ifdef __hpux
 #   undef HAS_CRYPT_R
-#   undef HAS_DRAND48_R
 #   undef HAS_ENDGRENT_R
 #   undef HAS_ENDPWENT_R
 #   undef HAS_GETGRENT_R
 #   undef HAS_GETPWENT_R
 #   undef HAS_SETLOCALE_R
-#   undef HAS_SRAND48_R
 #   undef HAS_STRERROR_R
 #   define NETDB_R_OBSOLETE
 #endif
@@ -151,9 +149,6 @@ print $h <<EOF;
 #ifdef I_NETDB
 #   include <netdb.h>
 #endif
-#ifdef I_STDLIB
-#   include <stdlib.h> /* drand48_data */
-#endif
 #ifdef I_CRYPT
 #   ifdef I_CRYPT
 #       include <crypt.h>
@@ -504,30 +499,6 @@ EOF
 EOF
            pushssif $endif;
        }
-        elsif ($func =~ /^(drand48|random|srandom)$/) {
-           pushssif $ifdef;
-           push @struct, <<EOF;
-       $seent{$func} _${func}_struct;
-EOF
-           if ($1 eq 'drand48') {
-               push @struct, <<EOF;
-       double  _${func}_double;
-EOF
-           } elsif ($1 eq 'random') {
-           push @struct, <<EOF;
-#   if RANDOM_R_PROTO == REENTRANT_PROTO_I_iS
-       int     _${func}_retval;
-#   endif
-#   if RANDOM_R_PROTO == REENTRANT_PROTO_I_lS
-       long    _${func}_retval;
-#   endif
-#   if RANDOM_R_PROTO == REENTRANT_PROTO_I_St
-       int32_t _${func}_retval;
-#   endif
-EOF
-           }
-           pushssif $endif;
-       }
         elsif ($func =~ /^(getgrnam|getpwnam|getspnam)$/) {
            pushssif $ifdef;
            # 'genfunc' can be read either as 'generic' or 'genre',
@@ -664,18 +635,12 @@ EOF
            my $genfunc = $func;
            if ($genfunc =~ /^(?:get|set|end)(pw|gr|host|net|proto|serv|sp)/) {
                $genfunc = "${1}ent";
-           } elsif ($genfunc eq 'srand48') {
-               $genfunc = "drand48";
            }
            my $b = $a;
            my $w = '';
            substr($b, 0, $seenu{$func}) = '';
-           if ($func =~ /^random$/) {
-               $true = "PL_reentrant_buffer->_random_retval";
-           } elsif ($b =~ /R/) {
+           if ($b =~ /R/) {
                $true = "PL_reentrant_buffer->_${genfunc}_ptr";
-           } elsif ($b =~ /T/ && $func eq 'drand48') {
-               $true = "PL_reentrant_buffer->_${genfunc}_double";
            } elsif ($b =~ /S/) {
                if ($func =~ /^readdir/) {
                    $true = "PL_reentrant_buffer->_${genfunc}_struct";
@@ -706,10 +671,6 @@ EOF
                                  $func =~ /^crypt$/ ?
                                  "PL_reentrant_buffer->_${genfunc}_struct_buffer" :
                                  "&PL_reentrant_buffer->_${genfunc}_struct") :
-                            $_ eq 'T' && $func eq 'drand48' ?
-                                "&PL_reentrant_buffer->_${genfunc}_double" :
-                            $_ =~ /^[ilt]$/ && $func eq 'random' ?
-                                "&PL_reentrant_buffer->_random_retval" :
                                 $_
                         } split '', $b;
                $w = ", $w" if length $v;
@@ -1076,7 +1037,6 @@ asctime S |time   |const struct tm|B_SB|B_SBI|I_SB|I_SBI
 crypt CC       |crypt  |struct crypt_data|B_CCS|B_CCD|D=CRYPTD*
 ctermid        B       |stdio  |               |B_B
 ctime S                |time   |const time_t   |B_SB|B_SBI|I_SB|I_SBI
-drand48                |stdlib |struct drand48_data    |I_ST|T=double*
 endgrent       |grp    |               |I_H|V_H
 endhostent     |netdb  |               |I_D|V_D|D=struct hostent_data*
 endnetent      |netdb  |               |I_D|V_D|D=struct netent_data*
@@ -1103,7 +1063,6 @@ getservbyname CC|netdb    |struct servent |I_CCSBWR|S_CCSBI|I_CCSD|D=struct servent
 getservbyport IC|netdb |struct servent |I_ICSBWR|S_ICSBI|I_ICSD|D=struct servent_data*
 getservent     |netdb  |struct servent |I_SBWR|I_SBI|S_SBI|I_SD|D=struct servent_data*
 getspnam C     |shadow |struct spwd    |I_CSBWR|S_CSBI
-random         |stdlib |struct random_data|I_iS|I_lS|I_St|i=int*|l=long*|t=int32_t*
 readdir T      |dirent |struct dirent  |I_TSR|I_TS|T=DIR*
 readdir64 T    |dirent |struct dirent64|I_TSR|I_TS|T=DIR*
 setgrent       |grp    |               |I_H|V_H
@@ -1113,8 +1072,6 @@ setnetent I       |netdb  |               |I_ID|V_ID|D=struct netent_data*
 setprotoent I  |netdb  |               |I_ID|V_ID|D=struct protoent_data*
 setpwent       |pwd    |               |I_H|V_H
 setservent I   |netdb  |               |I_ID|V_ID|D=struct servent_data*
-srand48 L      |stdlib |struct drand48_data    |I_LS
-srandom        T       |stdlib |struct random_data|I_TS|T=unsigned int
 strerror I     |string |               |I_IBW|I_IBI|B_IBW
 tmpnam B       |stdio  |               |B_B
 ttyname        I       |unistd |               |I_IBW|I_IBI|B_IBI
diff --git a/sv.c b/sv.c
index a3c4752..83841db 100644 (file)
--- 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] */
index 24b2bf9..90d1c37 100644 (file)
@@ -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");
+}
index 2ae2ff2..1a59f23 100644 (file)
--- a/uconfig.h
+++ b/uconfig.h
  *     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 RANDBITS               48              /**/
+#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
 #endif
 
 /* Generated from:
- * 3631b2b781d1779dc1855cb35ab72d5176a9eb36a527f74231c7e3f274021182 config_h.SH
- * 3dc6c26adfbf4f2e111d90b34d50e317e18555a76a270fbac2899d08a42f2fd1 uconfig.sh
+ * fd2554fe3bee85bee863afd558a83caa6c1a317e9a044639199eda0827db903e config_h.SH
+ * 2a46be0c2dea164ef0186898854f667c064d678c6927d13e926c1bb37d9d4d0e uconfig.sh
  * ex: set ro: */
index 374e65d..00f06d6 100644 (file)
@@ -491,7 +491,7 @@ db_version_patch='0'
 defvoidused=1
 direntrytype='struct dirent'
 doublesize='8'
-drand01="((rand() & 0x7FFF) / (double) ((unsigned long)1 << 15))"
+drand01="Perl_drand48()"
 drand48_r_proto='0'
 dtrace=''
 eagain='EAGAIN'
@@ -691,9 +691,9 @@ ptrsize='4'
 quadkind='4'
 quadtype='int64_t'
 randbits='48'
-randfunc='drand48'
+randfunc='Perl_drand48'
 random_r_proto='0'
-randseedtype='int'
+randseedtype='U32'
 rd_nodata='-1'
 readdir64_r_proto='0'
 readdir_r_proto='0'
@@ -717,7 +717,7 @@ sSCNfldbl='"llf"'
 sched_yield='sched_yield()'
 scriptdir='/usr/local/bin'
 scriptdirexp='/usr/local/bin'
-seedfunc='srand'
+seedfunc='Perl_drand48_init'
 selectminbits='32'
 selecttype=int
 setgrent_r_proto='0'
diff --git a/util.c b/util.c
index 55f6d9e..28cc706 100644 (file)
--- 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 ed133c4..4e5b97d 100644 (file)
--- 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:
index c3e3678..46c0673 100644 (file)
@@ -543,7 +543,7 @@ direntrytype='struct direct'
 dlext='dll'
 dlsrc='dl_win32.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'
@@ -844,10 +844,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'
@@ -877,7 +877,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='Perl_fd_set *'
 sendmail='blat'
index ca098f3..d816795 100644 (file)
@@ -545,7 +545,7 @@ dlext='dll'
 dlltool='~ARCHPREFIX~dlltool'
 dlsrc='dl_win32.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'
@@ -877,10 +877,10 @@ prototype='define'
 ptrsize='4'
 quadkind='3'
 quadtype='long long'
-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'
@@ -912,7 +912,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='Perl_fd_set *'
 sendmail='blat'
index 829e0b4..fbfd7ce 100644 (file)
@@ -544,7 +544,7 @@ direntrytype='struct direct'
 dlext='dll'
 dlsrc='dl_win32.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'
@@ -876,10 +876,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'
@@ -911,7 +911,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='Perl_fd_set *'
 sendmail='blat'