New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
rand() on Windows only uses 15 bits of entropy #12620
Comments
From Perl@ResonatorSoft.orgCreated by Perl@ResonatorSoft.orgThe Win32 version of Perl doesn't seem to generate random numbers Here's an example script detailing the problem: my %nums; The purpose of the script is to reveal how many duplicate numbers If I test this same script on a Debian Linux box, I actually get no Perl Info
|
From @wchristianI replicated the behavior with ActivePerl v5.12.4 (MSWin32-x86-multi- |
The RT System itself - Status changed from 'new' to 'open' |
From @LeontOn Tue, Nov 27, 2012 at 3:59 PM, Perl@ResonatorSoft.org
Perl already chooses between a bunch of random number sources. If That said, I don't really think this is really severity=medium. rand() Leon |
From @wchristianOn Tue Nov 27 07:19:53 2012, LeonT wrote:
On Windows XP and higher, there is RtlGenRandom, would that fit the bill? http://msdn.microsoft.com/en-us/library/aa387694(v=vs.80).aspx |
From @LeontOn Tue, Nov 27, 2012 at 4:40 PM, Christian Walde via RT
Looks workable, though it's linking is horrible even by Windows standards. Leon |
From BitCard@ResonatorSoft.orgOn Tue Nov 27 07:49:28 2012, LeonT wrote:
BTW, what does Perl currently use for random functionality on Windows? |
From @wchristianOn Tue Nov 27 07:49:28 2012, LeonT wrote:
Well, as the doc says, if you don't mind a bit of extra memory use, you |
From @wchristianOn Tue Nov 27 07:53:01 2012, SineSwiper wrote:
Windows currently supplies a rand() in the stdlib that uses 15 bits and |
From @craigberryOn Tue, Nov 27, 2012 at 10:11 AM, Christian Walde via RT
It might be as simple as changing the configuration code (e.g., in #define Drand01() to point to something more capable. |
From @kmxOn 27.11.2012 16:40, Christian Walde via RT wrote:
What about CryptGenRandom (available on WinXP+) { http://msdn.microsoft.com/en-us/library/windows/desktop/aa379942%28v=vs.85%29.aspx -- |
From @demerphqOn 27 November 2012 20:43, kmx <kmx@atlas.cz> wrote:
Just curious but wouldnt something like that be pretty slow? I would think that ideally the Win32 version of Perl should "out of Yves -- |
From @kmxOn 27.11.2012 20:52, demerphq wrote:
[resending as I forget to Cc: the list] CryptGenRandom itself is IMO pretty fast the trouble might be with the time -- |
From @bulk88On Tue Nov 27 08:11:01 2012, Mithaldu wrote:
Why not call the CRT's rand twice or thrice, once for low 15 bits, 2nd This is the implementation of rand in MS's CRT -- |
From @wchristianOn Wed Nov 28 00:15:00 2012, bulk88 wrote:
That sounds like a very reasonable solution. Can you maybe implement a |
From @demerphqOn 28 November 2012 14:43, Christian Walde via RT
I am just curious why would that be preferable to just coding your own Afaik they amount to a handful of lines of C. Yves -- |
From @wchristianOn Wed Nov 28 00:15:00 2012, bulk88 wrote:
Alright, i talked this through on #p5p and here's the summary as i First off, the offending property of the windows RNG is granularity in Further, in Perl the case is that the random bits gotten from the system On linux, drand48 is used, which provides 48 bits of entropy. demerphq suggested that it might be possible to select an RNG that could To the issue at hand, granularity on windows, a solution that seems useful I am unsure if it could be extended to provide 53 bits of entropy in a |
From @craigberryOn Wed, Nov 28, 2012 at 7:51 AM, demerphq <demerphq@gmail.com> wrote:
The FreeBSD implementation of drand48() is indeed short and sweet even <http://fxr.watson.org/fxr/source/gen/drand48.c?v=FREEBSD-LIBC;im=bigexcerpts> It might just work verbatim on Windows. |
From @kmxOn 28.11.2012 17:11, Craig A. Berry wrote:
Another candidate (long period, good speed, good randomness) that can be The actual implementation (approx. 100 lines of code) can look like this: -- |
From @bulk88On Wed Nov 28 05:43:55 2012, Mithaldu wrote:
I am going to try to fix this by spreading the bits of whatever rand a |
From @paulg1973FWIW, the C-1990 and C-1999 standards define the rand() function as follows (relevant language extracted): "The rand function computes a sequence of pseudo-random integers in the range 0 to RAND_MAX. ... The value of the RAND_MAX shall be at least 32767." The Stratus OpenVOS implementation of rand() also limits itself to a RAND_MAX of 32767; I suspect this is due to a desire to maintain compatibility with legacy C programs. Once these limits are defined and widely used, it is impossible to change them without breaking working code. PG |
From @hvds"Christian Walde via RT" <perlbug-followup@perl.org> wrote: If the RNG has a period of 2^15, I believe this solution will have Hugo |
From @tonycozOn Wed, Nov 28, 2012 at 12:54:36PM -0500, Green, Paul wrote:
That doesn't prevent the implementation storing more than 15 bits of It could simply return the lower 15 bits of the result from a 32 or Tony |
From BitCard@ResonatorSoft.orgOn Wed Nov 28 09:55:18 2012, paulg wrote:
Perl isn't C. We document that rand returns "a random fractional number I like bulk77's solution. It's fast and portably achieves the maximum |
From @ap* bulk88 via RT <perlbug-followup@perl.org> [2012-11-28 09:20]:
That doesn’t increase the entropy available, it just draws from the pool Don’t. Randomness is a treacherous sea – easy to get it wrong, hard to notice Find a syscall that draws from a deeper pool or put in some other known Or just leave it as it is. If it’s bad, just let it look bad. Being bad The documentation already covers everything it needs to, so nothing to Regards, |
From @ap* Aristotle Pagaltzis <pagaltzis@gmx.de> [2012-11-29 03:01]:
And just as I send this mail, I notice that last week’s LWN has come out LCE: Don’t play dice with random numbers Regards, |
From @doyOn Thu, Nov 29, 2012 at 03:01:00AM +0100, Aristotle Pagaltzis wrote:
As was pointed out on IRC, there are actually two orthogonal concerns That said, I do tend to agree with Yves here - if we're actually -doy |
From @bulk88On Wed Nov 28 09:41:59 2012, bulk88 wrote:
Windows only right now. NV new time=6.786747, opt= -O1 -G7 -GL -Oi -Og -- |
From @bulk88 |
From @bulk88On Wed Nov 28 23:13:32 2012, bulk88 wrote:
On the collisions test posted by Brendan Byrd, the new rand returned 0. -- |
From @tonycozOn Thu Aug 08 05:10:52 2013, craig.a.berry@gmail.com wrote:
Both GCC and MSVC implement 64-bit integers in software on 32-bit For 64-bit platforms the code generated is roughly* equivalent between It turned out both changes failed to build on MSVC due to an excess Tony * if you close one eye and squint |
From @demerphqOn 19 July 2013 09:59, Tony Cook via RT <perlbug-followup@perl.org> wrote:
It was on my "bring up later" todo list, but I am fine that you have And I am fine with you making it just use the drand48 implementation. Yves -- |
From @tonycozOn Thu Aug 08 00:03:28 2013, tonyc wrote:
One problem with not updating $Config{randbits} in particular is that So I'm wondering whether Configure should be updated to set the new If Configure is updated, configure.com will also need to be updated. Tony |
From @craigberryOn Thu, Aug 22, 2013 at 6:24 PM, Tony Cook via RT
The current test for randbits in configure.com will return 48 on all |
From @TuxOn Thu, 22 Aug 2013 16:24:01 -0700, "Tony Cook via RT"
No anymore. git helps. Only backportable patches are picked to So yes, I think having Configure in sync would help: $ perl -V:.*rand.*
-- |
From @tonycozOn Thu Aug 22 23:39:36 2013, hmbrand wrote:
tonyc/drandpublic now includes a Configure change to always use the new I'm not sure whether we should support continuing to use the older Tony |
From @nwc10On Thu, Aug 08, 2013 at 12:03:30AM -0700, Tony Cook via RT wrote:
I don't know why. It dates from this commit commit de1c261 Add HAS_QUAD ($Config{d_quad}); use it. which adds the #undef into # if IVSIZE == 8 I think that the uses of HAS_QUAD in the core to conditionally compile code Of the 26 references to it on CPAN outside of ppport.h, 6 are in the core http://grep.cpan.me/?q=%5CbHAS_QUAD%5Cb+-file%3Appport.h I don't think that the current perl.h is correct (or useful) - (I'll finish this e-mail, then create a ticket, then reference it from here) On Tue, Sep 03, 2013 at 06:33:24PM -0700, Tony Cook via RT wrote:
seed|rand seems to be a better search pattern.
I think that we should drop them. Of all the random number related config.sh $ perl -wlne '++$h{$1} if /^(.*(rand|seed).*)=/; END {print "http://grep.cpan.me/?q=\\b(" . join("|", sort keys %h) . ")\\b"}' config.shhttp://grep.cpan.me/?q=\b(d_drand48_r|d_drand48proto|d_random_r|d_srand48_r|d_srandom_r|drand01|drand48_r_proto|randbits|randfunc|random_r_proto|randseedtype|seedfunc|srand48_r_proto|srandom_r_proto)\b $ perl -wlne 'next unless /^#.*(seed|rand)/; if (/^#define ([a-zA-Z_0-9]+)/) {++$h{$1}} elsif (/^#\$\S+\s+(\S+)/) {++$h{$1}} else {die $_}; END {print "http://grep.cpan.me/?q=\\b(" . join("|", sort keys %h) . ")\\b"}' config_h.SH Aside from one module from Ton Hospel, the only C macros which are used are That use is in https://metacpan.org/release/Graph-Layout-Aesthetic /* Needed on systems that use drand48 for Drand01 but have no prototype */ it's not going to break if HAS_DRAND48_PROTO goes away (unless the system All the (other) config.sh values can safely become undef without causing randfunc=freebsd_drand48_generate_double We can remove all the probing code from Configure, and the reentr.[hc] code Configure | 200 ++----------------------------------------------------- [all tests pass] but probably can be a lot better as we can delete 9 lines from every potted d_drand48_r d_drand48proto d_random_r d_srand48_r d_srandom_r along with Glossary, config_h.SH and maybe more. Nicholas Clark |
From @nwc10Inline Patchdiff --git a/Configure b/Configure
index e1e9241..e8a0d9a 100755
--- a/Configure
+++ b/Configure
@@ -418,9 +418,6 @@ d_dlopen=''
d_dlsymun=''
d_dosuid=''
d_suidsafe=''
-d_drand48_r=''
-drand48_r_proto=''
-d_drand48proto=''
d_dup2=''
d_eaccess=''
d_endgrent=''
@@ -640,8 +637,6 @@ d_pthread_yield=''
d_sched_yield=''
sched_yield=''
d_qgcvt=''
-d_random_r=''
-random_r_proto=''
d_readdir64_r=''
readdir64_r_proto=''
d_readdir=''
@@ -746,10 +741,6 @@ d_socklen_t=''
d_socks5_init=''
d_sprintf_returns_strlen=''
d_sqrtl=''
-d_srand48_r=''
-srand48_r_proto=''
-d_srandom_r=''
-srandom_r_proto=''
d_sresgproto=''
d_sresuproto=''
d_statblks=''
@@ -12175,52 +12166,6 @@ $rm -f fred fred.* dyna.$dlext dyna.* tmp-dyna.*
set d_dlsymun
eval $setvar
-: see if drand48_r exists
-set drand48_r d_drand48_r
-eval $inlibc
-case "$d_drand48_r" in
-"$define")
- hdrs="$i_systypes sys/types.h define stdio.h $i_stdlib stdlib.h"
- case "$d_drand48_r_proto:$usethreads" in
- ":define") d_drand48_r_proto=define
- set d_drand48_r_proto drand48_r $hdrs
- eval $hasproto ;;
- *) ;;
- esac
- case "$d_drand48_r_proto" in
- define)
- case "$drand48_r_proto" in
- ''|0) try='int drand48_r(struct drand48_data*, double*);'
- ./protochk "$extern_C $try" $hdrs && drand48_r_proto=I_ST ;;
- esac
- case "$drand48_r_proto" in
- ''|0) d_drand48_r=undef
- drand48_r_proto=0
- echo "Disabling drand48_r, cannot determine prototype." >&4 ;;
- * ) case "$drand48_r_proto" in
- REENTRANT_PROTO*) ;;
- *) drand48_r_proto="REENTRANT_PROTO_$drand48_r_proto" ;;
- esac
- echo "Prototype: $try" ;;
- esac
- ;;
- *) case "$usethreads" in
- define) echo "drand48_r has no prototype, not using it." >&4 ;;
- esac
- d_drand48_r=undef
- drand48_r_proto=0
- ;;
- esac
- ;;
-*) drand48_r_proto=0
- ;;
-esac
-
-: see if prototype for drand48 is available
-echo " "
-set d_drand48proto drand48 $i_stdlib stdlib.h $i_unistd unistd.h
-eval $hasproto
-
: see if dup2 exists
set dup2 d_dup2
eval $inlibc
@@ -16483,55 +16428,6 @@ case "$sched_yield" in
esac
$rm_try
-: see if random_r exists
-set random_r d_random_r
-eval $inlibc
-case "$d_random_r" in
-"$define")
- hdrs="$i_systypes sys/types.h define stdio.h $i_stdlib stdlib.h"
- case "$d_random_r_proto:$usethreads" in
- ":define") d_random_r_proto=define
- set d_random_r_proto random_r $hdrs
- eval $hasproto ;;
- *) ;;
- esac
- case "$d_random_r_proto" in
- define)
- case "$random_r_proto" in
- ''|0) try='int random_r(int*, struct random_data*);'
- ./protochk "$extern_C $try" $hdrs && random_r_proto=I_iS ;;
- esac
- case "$random_r_proto" in
- ''|0) try='int random_r(long*, struct random_data*);'
- ./protochk "$extern_C $try" $hdrs && random_r_proto=I_lS ;;
- esac
- case "$random_r_proto" in
- ''|0) try='int random_r(struct random_data*, int32_t*);'
- ./protochk "$extern_C $try" $hdrs && random_r_proto=I_St ;;
- esac
- case "$random_r_proto" in
- ''|0) d_random_r=undef
- random_r_proto=0
- echo "Disabling random_r, cannot determine prototype." >&4 ;;
- * ) case "$random_r_proto" in
- REENTRANT_PROTO*) ;;
- *) random_r_proto="REENTRANT_PROTO_$random_r_proto" ;;
- esac
- echo "Prototype: $try" ;;
- esac
- ;;
- *) case "$usethreads" in
- define) echo "random_r has no prototype, not using it." >&4 ;;
- esac
- d_random_r=undef
- random_r_proto=0
- ;;
- esac
- ;;
-*) random_r_proto=0
- ;;
-esac
-
: see if readdir and friends exist
set readdir d_readdir
eval $inlibc
@@ -17954,88 +17850,6 @@ else
fi
$rm_try
-: see if srand48_r exists
-set srand48_r d_srand48_r
-eval $inlibc
-case "$d_srand48_r" in
-"$define")
- hdrs="$i_systypes sys/types.h define stdio.h $i_stdlib stdlib.h"
- case "$d_srand48_r_proto:$usethreads" in
- ":define") d_srand48_r_proto=define
- set d_srand48_r_proto srand48_r $hdrs
- eval $hasproto ;;
- *) ;;
- esac
- case "$d_srand48_r_proto" in
- define)
- case "$srand48_r_proto" in
- ''|0) try='int srand48_r(long, struct drand48_data*);'
- ./protochk "$extern_C $try" $hdrs && srand48_r_proto=I_LS ;;
- esac
- case "$srand48_r_proto" in
- ''|0) d_srand48_r=undef
- srand48_r_proto=0
- echo "Disabling srand48_r, cannot determine prototype." >&4 ;;
- * ) case "$srand48_r_proto" in
- REENTRANT_PROTO*) ;;
- *) srand48_r_proto="REENTRANT_PROTO_$srand48_r_proto" ;;
- esac
- echo "Prototype: $try" ;;
- esac
- ;;
- *) case "$usethreads" in
- define) echo "srand48_r has no prototype, not using it." >&4 ;;
- esac
- d_srand48_r=undef
- srand48_r_proto=0
- ;;
- esac
- ;;
-*) srand48_r_proto=0
- ;;
-esac
-
-: see if srandom_r exists
-set srandom_r d_srandom_r
-eval $inlibc
-case "$d_srandom_r" in
-"$define")
- hdrs="$i_systypes sys/types.h define stdio.h $i_stdlib stdlib.h"
- case "$d_srandom_r_proto:$usethreads" in
- ":define") d_srandom_r_proto=define
- set d_srandom_r_proto srandom_r $hdrs
- eval $hasproto ;;
- *) ;;
- esac
- case "$d_srandom_r_proto" in
- define)
- case "$srandom_r_proto" in
- ''|0) try='int srandom_r(unsigned int, struct random_data*);'
- ./protochk "$extern_C $try" $hdrs && srandom_r_proto=I_TS ;;
- esac
- case "$srandom_r_proto" in
- ''|0) d_srandom_r=undef
- srandom_r_proto=0
- echo "Disabling srandom_r, cannot determine prototype." >&4 ;;
- * ) case "$srandom_r_proto" in
- REENTRANT_PROTO*) ;;
- *) srandom_r_proto="REENTRANT_PROTO_$srandom_r_proto" ;;
- esac
- echo "Prototype: $try" ;;
- esac
- ;;
- *) case "$usethreads" in
- define) echo "srandom_r has no prototype, not using it." >&4 ;;
- esac
- d_srandom_r=undef
- srandom_r_proto=0
- ;;
- esac
- ;;
-*) srandom_r_proto=0
- ;;
-esac
-
: see if prototype for setresgid is available
echo " "
set d_sresgproto setresgid $i_unistd unistd.h
@@ -22943,8 +22757,8 @@ d_dlerror='$d_dlerror'
d_dlopen='$d_dlopen'
d_dlsymun='$d_dlsymun'
d_dosuid='$d_dosuid'
-d_drand48_r='$d_drand48_r'
-d_drand48proto='$d_drand48proto'
+d_drand48_r='undef'
+d_drand48proto='undef'
d_dup2='$d_dup2'
d_eaccess='$d_eaccess'
d_endgrent='$d_endgrent'
@@ -23163,7 +22977,7 @@ d_pwpasswd='$d_pwpasswd'
d_pwquota='$d_pwquota'
d_qgcvt='$d_qgcvt'
d_quad='$d_quad'
-d_random_r='$d_random_r'
+d_random_r='undef'
d_readdir64_r='$d_readdir64_r'
d_readdir='$d_readdir'
d_readdir_r='$d_readdir_r'
@@ -23245,8 +23059,8 @@ d_sockpair='$d_sockpair'
d_socks5_init='$d_socks5_init'
d_sprintf_returns_strlen='$d_sprintf_returns_strlen'
d_sqrtl='$d_sqrtl'
-d_srand48_r='$d_srand48_r'
-d_srandom_r='$d_srandom_r'
+d_srand48_r='undef'
+d_srandom_r='undef'
d_sresgproto='$d_sresgproto'
d_sresuproto='$d_sresuproto'
d_statblks='$d_statblks'
@@ -23339,7 +23153,6 @@ dlext='$dlext'
dlsrc='$dlsrc'
doublesize='$doublesize'
drand01='$drand01'
-drand48_r_proto='$drand48_r_proto'
dtrace='$dtrace'
dynamic_ext='$dynamic_ext'
eagain='$eagain'
@@ -23672,7 +23485,6 @@ quadkind='$quadkind'
quadtype='$quadtype'
randbits='$randbits'
randfunc='$randfunc'
-random_r_proto='$random_r_proto'
randseedtype='$randseedtype'
ranlib='$ranlib'
rd_nodata='$rd_nodata'
@@ -23760,8 +23572,6 @@ socksizetype='$socksizetype'
sort='$sort'
spackage='$spackage'
spitshell='$spitshell'
-srand48_r_proto='$srand48_r_proto'
-srandom_r_proto='$srandom_r_proto'
src='$src'
ssizetype='$ssizetype'
st_ino_sign='$st_ino_sign'
diff --git a/reentr.c b/reentr.c
index 31b933c..a5ea192 100644
--- 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 */
diff --git a/reentr.h b/reentr.h
index 3510fc5..c268851 100644
--- a/reentr.h
+++ b/reentr.h
@@ -41,13 +41,11 @@
#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
@@ -101,9 +99,6 @@
#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>
@@ -150,48 +145,43 @@
#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
diff --git a/regen/reentr.pl b/regen/reentr.pl
index c5e7129..6dac299 100644
--- a/regen/reentr.pl
+++ b/regen/reentr.pl
@@ -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 |
From @demerphqOn 4 September 2013 03:33, Tony Cook via RT <perlbug-followup@perl.org> wrote:
Thanks for all the work Tony. I appreciate you picked this up. I have one concern, the internal API makes it difficult/impossible to IOW, it would be better if we provided the _r interfaces internally What this would mean is that: Drand01() => macro, equivalent to perl rand() Which would then call into: freebsd_drand48_generate_double_r(state) That way the internals can have their own seed if necessary, without If you dont object id be happy to work on the patch, on the other hand Thanks again for your work, -- |
From @demerphqOn 6 September 2013 11:58, Nicholas Clark <nick@ccl4.org> wrote:
Not sure if this relates to what you say here above, but... I just wanted to register that I think only providing a global state When I worked on the hash seed logic the lack of an easy way to create Yves |
From @tonycozOn Fri Sep 06 04:02:51 2013, demerphq wrote:
I've pushed an updated tonyc/drandpublic branch that replaces the I then added macros Perl_drand48() and Perl_drand48_init() that I added a change to regen/reentr.pl to remove the now unused random_r(), I haven't updated Configure to remove the units, I believe this should Tony |
From @tonycoz0004-perl-115928-we-don-t-use-drand48_r-or-random_r-any-l.patchFrom 9d60200f78f0f4520102641542beab8882f6ab1a Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 10 Sep 2013 10:09:43 +1000
Subject: [PATCH 4/4] [perl #115928] we don't use drand48_r or random_r any
longer
Removing this should mean that metaconfig will remove the units from
the built Configure
---
reentr.c | 18 -------
reentr.h | 145 ++++++++++++++-----------------------------------------
regen/reentr.pl | 45 +----------------
3 files changed, 38 insertions(+), 170 deletions(-)
diff --git a/reentr.c b/reentr.c
index 31b933c..a5ea192 100644
--- 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 */
diff --git a/reentr.h b/reentr.h
index 3510fc5..c268851 100644
--- a/reentr.h
+++ b/reentr.h
@@ -41,13 +41,11 @@
#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
@@ -101,9 +99,6 @@
#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>
@@ -150,48 +145,43 @@
#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
diff --git a/regen/reentr.pl b/regen/reentr.pl
index c5e7129..6dac299 100644
--- a/regen/reentr.pl
+++ b/regen/reentr.pl
@@ -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
--
1.7.10.4
|
From @tonycoz0002-revert-config_h.SH-changes-now-handled-by-Configure.patchFrom 0670996e22aee36bdb5568331861ba0e392388b0 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Thu, 29 Aug 2013 14:52:15 +1000
Subject: [PATCH 2/4] revert config_h.SH changes, now handled by Configure
---
config_h.SH | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/config_h.SH b/config_h.SH
index c2d69f4..be47a6b 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() Perl_drand48() /**/
-#define Rand_seed_t U32 /**/
-#define seedDrand01(x) Perl_drand48_init((Rand_seed_t)x) /**/
-#define RANDBITS 48 /**/
+#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
--
1.7.10.4
|
From @tonycoz0001-perl-115928-a-consistent-public-rand-implementation.patchFrom a343923893c78ace0952133a6397e57a2e9aee28 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 9 Sep 2013 14:44:57 +1000
Subject: [PATCH 1/4] [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,
---
config_h.SH | 8 ++---
embed.fnc | 2 ++
embedvar.h | 1 +
intrpvar.h | 2 ++
pp.c | 4 ---
proto.h | 10 ++++++
sv.c | 1 +
t/op/rand.t | 7 ++++-
uconfig.h | 8 ++---
util.c | 100 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
util.h | 27 ++++++++++++++++
11 files changed, 157 insertions(+), 13 deletions(-)
diff --git a/config_h.SH b/config_h.SH
index 4af9925..c2d69f4 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 0f686d4..2fef45f 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 3643bd1..7c721ed 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 c6ee593..768267b 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 6fc6c9f..9dbe2f8 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 7281242..c4d52ff 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 e7be001..bfbe38b 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 24b2bf9..90d1c37 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 2ae2ff2..3e206dd 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 d2380b2..9c387c1 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 *);
@@ -6179,6 +6182,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
--- 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:
--
1.7.10.4
|
From @tonycoz0003-perl-115928-Configure-now-selects-our-internal-drand.patchFrom e2cc96bceca8a4a41422ea33b8d5bbf3e590ef10 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 9 Sep 2013 14:06:35 +1000
Subject: [PATCH 3/4] [perl #115928] Configure now selects our internal
drand48()
---
Configure | 123 ++--------------------------------------
Cross/config.sh-arm-linux | 8 +--
Cross/config.sh-arm-linux-n770 | 8 +--
NetWare/config.wc | 10 ++--
uconfig.h | 12 ++--
uconfig.sh | 8 +--
win32/config.ce | 10 ++--
win32/config.gc | 10 ++--
win32/config.vc | 10 ++--
9 files changed, 44 insertions(+), 155 deletions(-)
diff --git a/Configure b/Configure
index 7976c13..74806ef 100755
--- 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 " "
diff --git a/Cross/config.sh-arm-linux b/Cross/config.sh-arm-linux
index fea06f1..07fc8d2 100644
--- a/Cross/config.sh-arm-linux
+++ b/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=''
diff --git a/Cross/config.sh-arm-linux-n770 b/Cross/config.sh-arm-linux-n770
index c3b8daf..e3ebe6a 100644
--- a/Cross/config.sh-arm-linux-n770
+++ b/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=''
diff --git a/NetWare/config.wc b/NetWare/config.wc
index 1182d47..016748d 100644
--- a/NetWare/config.wc
+++ b/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'
diff --git a/uconfig.h b/uconfig.h
index 3e206dd..1a59f23 100644
--- a/uconfig.h
+++ b/uconfig.h
@@ -3112,10 +3112,10 @@
* function used to generate normalized random numbers.
* Values include 15, 16, 31, and 48.
*/
-#define Drand01() Perl_drand48() /**/
-#define Rand_seed_t U32 /**/
-#define seedDrand01(x) Perl_drand48_init((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
@@ -4753,6 +4753,6 @@
#endif
/* Generated from:
- * eea5809659d1cac397ca3a1a48f51bcb5bfc60eb2dca2ef00b9b2015ee87729a config_h.SH
- * 3dc6c26adfbf4f2e111d90b34d50e317e18555a76a270fbac2899d08a42f2fd1 uconfig.sh
+ * fd2554fe3bee85bee863afd558a83caa6c1a317e9a044639199eda0827db903e config_h.SH
+ * 2a46be0c2dea164ef0186898854f667c064d678c6927d13e926c1bb37d9d4d0e uconfig.sh
* ex: set ro: */
diff --git a/uconfig.sh b/uconfig.sh
index 374e65d..00f06d6 100644
--- a/uconfig.sh
+++ b/uconfig.sh
@@ -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/win32/config.ce b/win32/config.ce
index c3e3678..46c0673 100644
--- a/win32/config.ce
+++ b/win32/config.ce
@@ -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'
diff --git a/win32/config.gc b/win32/config.gc
index ca098f3..d816795 100644
--- a/win32/config.gc
+++ b/win32/config.gc
@@ -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'
diff --git a/win32/config.vc b/win32/config.vc
index 829e0b4..fbfd7ce 100644
--- a/win32/config.vc
+++ b/win32/config.vc
@@ -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'
--
1.7.10.4
|
From @nwc10On Fri, Sep 06, 2013 at 01:02:03PM +0200, demerphq wrote:
I think that it was independent.
I think that you'd said this before somewhere, because I vaguely remember it. Yes, agree. It makes sense. It makes things a lot more flexible, and I don't On Fri, Sep 06, 2013 at 12:57:26PM +0200, demerphq wrote:
Seems that Tony has already done this, but I don't think that he asked RT https://rt-archive.perl.org/perl5/Ticket/Display.html?id=115928#txn-1252961
Ditto. Nicholas Clark |
From @demerphqOn 12 September 2013 16:55, Nicholas Clark <nick@ccl4.org> wrote:
Oh goodie. I can clean stuff up once that is applied. Thanks for noticing! cheers, -- |
From @tonycozOn Thu Sep 12 07:56:27 2013, nicholas wrote:
It looks like clicking "Add More Files" removes the CC, which I didn't Tony |
From @bulk88On Thu Sep 12 17:58:03 2013, tonyc wrote:
I can confirm that is an RT bug. Also keeping javascript off leaves CC -- |
From @rjbs* bulk88 via RT <perlbug-followup@perl.org> [2013-09-12T21:31:33]
I will get this passed along to our generous RT hosters. Thanks. -- |
@tonycoz - Status changed from 'open' to 'resolved' |
From @TuxOn Thu, 12 Sep 2013 18:57:38 -0700, "Tony Cook via RT"
All of that backported to meta and regenerated into blead -- |
From p5p@jibsheet.comOn Thu, Sep 12, 2013 at 09:47:59PM -0400, Ricardo Signes wrote:
I've had a fix for this for a few days but finally had time to pull it -kevin |
Migrated from rt.perl.org#115928 (status was 'resolved')
Searchable as RT115928$
The text was updated successfully, but these errors were encountered: