From patchwork Tue Aug 16 08:19:25 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Janne Blomqvist X-Patchwork-Id: 659521 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 3sD4z85Qtnz9t2M for ; Tue, 16 Aug 2016 18:19:48 +1000 (AEST) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=j847pfth; dkim-atps=neutral DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :mime-version:from:date:message-id:subject:to:content-type; q= dns; s=default; b=Y+08UP1uvgOnFHYlqhyn9bung4d6kf8j7gtqB7NvwF74qo EdmfxUPlYg00Z+kFS6Rg2Vqr8T/2ZPb82YAWkrHTvm3kNHlPNROO3Yjys6xUg3JH fIu7h7kKBQqM/SYhaMq8HezitGy77eoWr+CsfJ5QJhGzuulO8/zxr2q++4Gss= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :mime-version:from:date:message-id:subject:to:content-type; s= default; bh=el4f4gdXHBzL5kM0IsziRLFWudw=; b=j847pfthuHKV34eGoNXA KSzZ8QYEvvYbT5mvENf1KIkYKiiw1In9McO92Wfrqv+nF7c1vsKQCh77gsRMDU34 4foSqUUO+rgekm01O/lMkQmlui3EvfPRXripqJoqIMOEaBaFlGJCbRIjm/Bfod9g zZLB3n1nLFkZJ7v61YMFB3U= Received: (qmail 92325 invoked by alias); 16 Aug 2016 08:19:41 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 92300 invoked by uid 89); 16 Aug 2016 08:19:39 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-2.6 required=5.0 tests=AWL, BAYES_00, FREEMAIL_FROM, RCVD_IN_DNSWL_LOW, SPF_PASS autolearn=ham version=3.3.2 spammy=0, 1, trs, hardcoded, jumped X-Spam-User: qpsmtpd, 2 recipients X-HELO: mail-wm0-f52.google.com Received: from mail-wm0-f52.google.com (HELO mail-wm0-f52.google.com) (74.125.82.52) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Tue, 16 Aug 2016 08:19:28 +0000 Received: by mail-wm0-f52.google.com with SMTP id i5so150323202wmg.0; Tue, 16 Aug 2016 01:19:28 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20130820; h=x-gm-message-state:mime-version:from:date:message-id:subject:to; bh=GVYuq/E/rKAbiRiGUT8fRBdnzZTktMLgqSl4RyUl7po=; b=PxQFciMphRFdSpB8g2QNd+HQRb17kTTUdcQzWAGIRGZIltPmBF1wUQ3rSID3YI7QxZ 4y4xpodkAgn6QJX1e9+GCxMWSCsrVp1Xc3KYCmtrLmXK4vZbV+4MMgN0bSAZY1kWZmUK Sb7umssQauMrxT3ioGqo6GPxAX59QFcrVDyQNUxYz/xwHu3qjwCxO4eD6atDUYT81gQE tJrJgxBLI65s1AEn8IOSM32Ocyx9fbv22d+nkAqq1JLkiKrrLqsubWd+ulJPtSReEIVw h83nW2wnJYfRbxBA54e9stM/h+RILV54QEkPBrokGAixfiokZoKJM5AxXFffo09Gaerl 1TwA== X-Gm-Message-State: AEkoouvql3KV9Em+x5KLsH6NZrKbjGJc9kTsI8QNfm216MEYw2tsx20p8hlS5ihTdqXJJk4UBiCIUjQCVq/cog== X-Received: by 10.28.222.194 with SMTP id v185mr4768532wmg.119.1471335566716; Tue, 16 Aug 2016 01:19:26 -0700 (PDT) MIME-Version: 1.0 Received: by 10.194.173.40 with HTTP; Tue, 16 Aug 2016 01:19:25 -0700 (PDT) From: Janne Blomqvist Date: Tue, 16 Aug 2016 11:19:25 +0300 Message-ID: Subject: [PATCH, libgfortran] Always seed the PRNG from the OS To: Fortran List , GCC Patches Hi, now that I have changed the PRNG algorithm behind RANDOM_NUMBER, and thus breaking compatibility (in the weak sense that the stream of random numbers will be different), one might also do a few other minor improvements. The attached patch makes sure to always initialize the PRNG seed from the OS (/dev/urandom or falling back to gettimeofday ^ getpid) so that the random generator state is different every time one runs a program. This is probably closer to what people intuitively expect, and if one wants a constant seed, it's easy enough to do by explicitly calling RANDOM_SEED. Unless there are objections, I intend to commit this in a few days. Regtested on x86_64-pc-linux-gnu. libgfortran: 2016-08-16 Janne Blomqvist * 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 * 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. diff --git a/gcc/testsuite/gfortran.dg/random_4.f90 b/gcc/testsuite/gfortran.dg/random_4.f90 index 416b17c..e60698f 100644 --- a/gcc/testsuite/gfortran.dg/random_4.f90 +++ b/gcc/testsuite/gfortran.dg/random_4.f90 @@ -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) diff --git a/gcc/testsuite/gfortran.dg/random_7.f90 b/gcc/testsuite/gfortran.dg/random_7.f90 index aafe346..8cd9c43 100644 --- a/gcc/testsuite/gfortran.dg/random_7.f90 +++ b/gcc/testsuite/gfortran.dg/random_7.f90 @@ -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) diff --git a/libgfortran/intrinsics/random.c b/libgfortran/intrinsics/random.c index 3b91389..35c7611 100644 --- a/libgfortran/intrinsics/random.c +++ b/libgfortran/intrinsics/random.c @@ -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; }