Always initialize PRNG using random data from the OS.

libgfortran:

2016-08-16  Janne Blomqvist  <jb@gcc.gnu.org>

        * intrinsics/random.c (master_init): New variable.
        (init_rand_state): Move below getosrandom (), maybe initialize
        master_state.
        (random_seed_i4): If called with no arguments, set master_init to
        false, and reinitialize. If called with PUT=, set master_init to
        true.
        (random_seed_i8): Likewise.

testsuite:

2016-08-16  Janne Blomqvist  <jb@gcc.gnu.org>

        * gfortran.dg/random_4.f90: Initialize seed before using, handle
        the last special seed value.
        * gfortran.dg/random_7.f90: Use size for last array member instead
        of hardcoded value.

From-SVN: r239611
This commit is contained in:
Janne Blomqvist 2016-08-19 17:12:32 +03:00
parent f0c90610e3
commit 91151a7334
5 changed files with 55 additions and 27 deletions

View File

@ -1,3 +1,10 @@
2016-08-19 Janne Blomqvist <jb@gcc.gnu.org>
* gfortran.dg/random_4.f90: Initialize seed before using, handle
the last special seed value.
* gfortran.dg/random_7.f90: Use size for last array member instead
of hardcoded value.
2016-08-19 Prathamesh Kulkarni <prathamesh.kulkarni@linaro.org>
* gcc.dg/cpp/warn-undef.c: Append "evaluates to 0" to dg-error.

View File

@ -6,8 +6,11 @@ program trs
integer, allocatable, dimension(:) :: seed, check
call test_random_seed(size)
allocate(seed(size),check(size))
seed = 42
call test_random_seed(put=seed)
call test_random_seed(get=check)
! With xorshift1024* the last seed value is special
seed(size) = check(size)
if (any (seed /= check)) call abort
contains
subroutine test_random_seed(size, put, get)

View File

@ -10,8 +10,9 @@ program trs
seed(:) = huge(seed) / 17
call test_random_seed(put=seed)
call test_random_seed(get=check)
! In the current implementation seed(17) is special
seed(17) = check(17)
! In the current xorshift1024* implementation the last seed value is
! special
seed(size) = check(size)
if (any (seed /= check)) call abort
contains
subroutine test_random_seed(size, put, get)

View File

@ -1,3 +1,13 @@
2016-08-16 Janne Blomqvist <jb@gcc.gnu.org>
* intrinsics/random.c (master_init): New variable.
(init_rand_state): Move below getosrandom (), maybe initialize
master_state.
(random_seed_i4): If called with no arguments, set master_init to
false, and reinitialize. If called with PUT=, set master_init to
true.
(random_seed_i8): Likewise.
2016-08-11 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE>
* intrinsics/random.c: Include <stdlib.h>.

View File

@ -193,9 +193,10 @@ typedef struct
xorshift1024star_state;
/* How many times we have jumped. This and master_state are the only
variables protected by random_lock. */
static unsigned njumps;
/* master_init, njumps, and master_state are the only variables
protected by random_lock. */
static bool master_init;
static unsigned njumps; /* How many times we have jumped. */
static uint64_t master_state[] = {
0xad63fa1ed3b55f36ULL, 0xd94473e78978b497ULL, 0xbc60592a98172477ULL,
0xa3de7c6e81265301ULL, 0x586640c5e785af27ULL, 0x7a2a3f63b67ce5eaULL,
@ -272,24 +273,6 @@ jump (xorshift1024star_state* rs)
}
/* Initialize the random number generator for the current thread,
using the master state and the number of times we must jump. */
static void
init_rand_state (xorshift1024star_state* rs, const bool locked)
{
if (!locked)
__gthread_mutex_lock (&random_lock);
memcpy (&rs->s, master_state, sizeof (master_state));
unsigned n = njumps++;
if (!locked)
__gthread_mutex_unlock (&random_lock);
for (unsigned i = 0; i < n; i++)
jump (rs);
rs->init = true;
}
/* Super-simple LCG generator used in getosrandom () if /dev/urandom
doesn't exist. */
@ -359,6 +342,30 @@ getosrandom (void *buf, size_t buflen)
}
/* Initialize the random number generator for the current thread,
using the master state and the number of times we must jump. */
static void
init_rand_state (xorshift1024star_state* rs, const bool locked)
{
if (!locked)
__gthread_mutex_lock (&random_lock);
if (!master_init)
{
getosrandom (master_state, sizeof (master_state));
njumps = 0;
master_init = true;
}
memcpy (&rs->s, master_state, sizeof (master_state));
unsigned n = njumps++;
if (!locked)
__gthread_mutex_unlock (&random_lock);
for (unsigned i = 0; i < n; i++)
jump (rs);
rs->init = true;
}
/* This function produces a REAL(4) value from the uniform distribution
with range [0,1). */
@ -791,8 +798,7 @@ random_seed_i4 (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get)
a processor-dependent value to the seed." */
if (size == NULL && put == NULL && get == NULL)
{
getosrandom (master_state, sizeof (master_state));
njumps = 0;
master_init = false;
init_rand_state (rs, true);
}
@ -816,6 +822,7 @@ random_seed_i4 (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get)
provide seeds with quality only in the lower or upper part. */
scramble_seed ((unsigned char *) master_state, seed, sizeof seed);
njumps = 0;
master_init = true;
init_rand_state (rs, true);
rs->p = put->base_addr[SZ * GFC_DESCRIPTOR_STRIDE(put, 0)] & 15;
@ -873,8 +880,7 @@ random_seed_i8 (GFC_INTEGER_8 *size, gfc_array_i8 *put, gfc_array_i8 *get)
a processor-dependent value to the seed." */
if (size == NULL && put == NULL && get == NULL)
{
getosrandom (master_state, sizeof (master_state));
njumps = 0;
master_init = false;
init_rand_state (rs, true);
}
@ -894,6 +900,7 @@ random_seed_i8 (GFC_INTEGER_8 *size, gfc_array_i8 *put, gfc_array_i8 *get)
sizeof (GFC_UINTEGER_8));
njumps = 0;
master_init = true;
init_rand_state (rs, true);
rs->p = put->base_addr[SZ * GFC_DESCRIPTOR_STRIDE(put, 0)] & 15;
}