diff options
| -rwxr-xr-x | config_h.SH | 8 | ||||
| -rw-r--r-- | embed.fnc | 2 | ||||
| -rw-r--r-- | embedvar.h | 1 | ||||
| -rw-r--r-- | intrpvar.h | 2 | ||||
| -rw-r--r-- | pp.c | 4 | ||||
| -rw-r--r-- | proto.h | 10 | ||||
| -rw-r--r-- | sv.c | 1 | ||||
| -rw-r--r-- | t/op/rand.t | 7 | ||||
| -rw-r--r-- | uconfig.h | 8 | ||||
| -rw-r--r-- | util.c | 100 | ||||
| -rw-r--r-- | util.h | 27 |
11 files changed, 157 insertions, 13 deletions
diff --git a/config_h.SH b/config_h.SH index 4af9925b7c..c2d69f4920 100755 --- a/config_h.SH +++ b/config_h.SH @@ -3147,10 +3147,10 @@ sed <<!GROK!THIS! >$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un * function used to generate normalized random numbers. * Values include 15, 16, 31, and 48. */ -#define Drand01() $drand01 /**/ -#define Rand_seed_t $randseedtype /**/ -#define seedDrand01(x) $seedfunc((Rand_seed_t)x) /**/ -#define RANDBITS $randbits /**/ +#define Drand01() Perl_drand48() /**/ +#define Rand_seed_t U32 /**/ +#define seedDrand01(x) Perl_drand48_init((Rand_seed_t)x) /**/ +#define RANDBITS 48 /**/ /* Select_fd_set_t: * This symbol holds the type used for the 2nd, 3rd, and 4th @@ -1571,6 +1571,8 @@ p |I32 |wait4pid |Pid_t pid|NN int* statusp|int flags : Used in locale.c and perl.c p |U32 |parse_unicode_opts|NN const char **popt Ap |U32 |seed +Xpno |double |drand48_r |NN perl_drand48_t *random_state +Xpno |void |drand48_init_r |NN perl_drand48_t *random_state|U32 seed : Only used in perl.c p |void |get_hash_seed |NN unsigned char * const seed_buffer : Used in doio.c, pp_hot.c, pp_sys.c diff --git a/embedvar.h b/embedvar.h index 3643bd132e..7c721edebc 100644 --- a/embedvar.h +++ b/embedvar.h @@ -243,6 +243,7 @@ #define PL_psig_pend (vTHX->Ipsig_pend) #define PL_psig_ptr (vTHX->Ipsig_ptr) #define PL_ptr_table (vTHX->Iptr_table) +#define PL_random_state (vTHX->Irandom_state) #define PL_reentrant_buffer (vTHX->Ireentrant_buffer) #define PL_reentrant_retint (vTHX->Ireentrant_retint) #define PL_reg_curpm (vTHX->Ireg_curpm) diff --git a/intrpvar.h b/intrpvar.h index c6ee593d0e..768267b6a0 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -784,6 +784,8 @@ PERLVARA(I, op_exec_cnt, OP_max+2, UV) /* Counts of executed OPs of the given ty DEBUGGING is enabled, too. */ #endif +PERLVAR(I, random_state, PL_RANDOM_STATE_TYPE) + /* If you are adding a U8 or U16, check to see if there are 'Space' comments * above on where there are gaps which currently will be structure padding. */ @@ -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; @@ -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); @@ -13439,6 +13439,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_last_swash_slen = 0; PL_srand_called = proto_perl->Isrand_called; + Copy(&(proto_perl->Irandom_state), &PL_random_state, 1, PL_RANDOM_STATE_TYPE); if (flags & CLONEf_COPY_STACKS) { /* next allocation will be PL_tmps_stack[PL_tmps_ix+1] */ diff --git a/t/op/rand.t b/t/op/rand.t index 24b2bf9baf..90d1c375d1 100644 --- a/t/op/rand.t +++ b/t/op/rand.t @@ -24,7 +24,7 @@ use strict; use Config; require "test.pl"; -plan(tests => 8); +plan(tests => 10); my $reps = 15000; # How many times to try rand each time. @@ -242,3 +242,8 @@ DIAG ok($r < 1, 'rand() without args is under 1'); } +{ # [perl #115928] use a standard rand() implementation + srand(1); + is(int rand(1000), 41, "our own implementation behaves consistently"); + is(int rand(1000), 454, "and still consistently"); +} @@ -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: */ @@ -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 @@ -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: |