util.c - add support for building with WELLRNG512a

Author: demerphq

embed.fnc

@@ -1149,9 +1149,6 @@ p	|void	|do_vop 	|I32 optype				\
 				|NN SV *left				\
 				|NN SV *right
 CDRdp	|U8	|dowantarray
-TXop	|void	|drand48_init_r |NN perl_drand48_t *random_state	\
-				|U32 seed
-TXop	|double |drand48_r	|NN perl_drand48_t *random_state
 Adp	|void	|dump_all
 p	|void	|dump_all_perl	|bool justperl
 Adhp	|void	|dump_eval
@@ -6273,6 +6270,18 @@ Tp	|Signal_t|sighandler	|int sig				\
 CTp	|Signal_t|csighandler	|int sig
 Tp	|Signal_t|sighandler	|int sig
 #endif
+#if defined(PERL_USE_WELL512A_RNG)
+TXop	|double |drand01_wellrng512a_r					\
+				|NN U32 *random_state
+TXop	|void	|wellrng512a_init_r					\
+				|NN U32 *random_state			\
+				|U32 seed
+TXop	|U32	|wellrng512a_u_r|NN U32 *random_state
+#else
+TXop	|void	|drand48_init_r |NN perl_drand48_t *random_state	\
+				|U32 seed
+TXop	|double |drand48_r	|NN perl_drand48_t *random_state
+#endif
 #if defined(U64TYPE)
 CRTip	|unsigned|lsbit_pos64	|U64 word
 CRTip	|unsigned|msbit_pos64	|U64 word

embedvar.h

@@ -43,8 +43,9 @@ from it, and are very unlikely to change
 =for apidoc_defn Amu|token|CAT2|token x|token y
 =for apidoc_defn Amu|string|STRINGIFY|token x
 
-=for apidoc_defn Am|double|Drand01
-=for apidoc_defn Am|void|seedDrand01|Rand_seed_t x
+=for apidoc_defn AmT|double|Drand01
+=for apidoc_defn AmT|void|seedDrand01|Rand_seed_t x
+
 =for apidoc_defn Am|char *|Gconvert|double x|Size_t n|bool t|char * b
 
 =cut

handy.h

@@ -1018,17 +1018,24 @@ PERLVARA(I, op_exec_cnt, OP_max+2, UV)  /* Counts of executed OPs of the given t
                                            for profiling in DEBUGGING mode. */
 #endif
 
-PERLVAR(I, random_state, PL_RANDOM_STATE_TYPE)
-
 PERLVARI(I, dump_re_max_len, STRLEN, 60)
 
+#ifndef PERL_USE_WELL512A_RNG
+PERLVAR(I, random_state, PL_RANDOM_STATE_TYPE)
+#else
+PERLVARA(I, random_state, PL_RANDOM_STATE_LENGTH, PL_RANDOM_STATE_TYPE)
+#endif
+
 /* For internal uses of randomness, this ensures the sequence of
  * random numbers returned by rand() isn't modified by perl's internal
  * use of randomness.
  * This is important if the user has called srand() with a seed.
  */
-
+#ifndef PERL_USE_WELL512A_RNG
 PERLVAR(I, random_state_internal, PL_RANDOM_STATE_TYPE)
+#else
+PERLVARA(I, random_state_internal, PL_RANDOM_STATE_LENGTH, PL_RANDOM_STATE_TYPE)
+#endif
 
 PERLVARA(I, TR_SPECIAL_HANDLING_UTF8, UTF8_MAXBYTES, char)
 

intrpvar.h

@@ -288,7 +288,7 @@ perl_construct(pTHXx)
     /* This is NOT the state used for C<rand()>, this is only
      * used in internal functionality */
 #ifdef NO_PERL_INTERNAL_RAND_SEED
-    Perl_drand48_init_r(PL_PTR_RANDOM_STATE_INTERNAL, seed());
+    Perl_drand01_init_r(PL_PTR_RANDOM_STATE_INTERNAL, seed());
 #else
     {
         UV seed;
@@ -301,7 +301,7 @@ perl_construct(pTHXx)
             /* use a randomly generated seed */
             seed = seed();
         }
-        Perl_drand48_init_r(PL_PTR_RANDOM_STATE_INTERNAL, (U32)seed);
+        Perl_drand01_init_r(PL_PTR_RANDOM_STATE_INTERNAL, (U32)seed);
     }
 #endif
 
@@ -2070,6 +2070,10 @@ S_Internals_V(pTHX_ CV *cv)
 #  ifdef PERL_USE_UNSHARED_KEYS_IN_LARGE_HASHES
                              " PERL_USE_UNSHARED_KEYS_IN_LARGE_HASHES"
 #  endif
+#  ifdef PERL_USE_WELL512A_RNG
+                             " PERL_USE_WELL512A_RNG"
+#  endif
+
 #  ifdef SILENT_NO_TAINT_SUPPORT
                              " SILENT_NO_TAINT_SUPPORT"
 #  endif
@@ -2475,7 +2479,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     if (TAINT_get &&
         PerlProc_getuid() == PerlProc_geteuid() &&
         PerlProc_getgid() == PerlProc_getegid()) {
-        Perl_drand48_init_r(PL_PTR_RANDOM_STATE_INTERNAL, seed());
+        Perl_drand01_init_r(PL_PTR_RANDOM_STATE_INTERNAL, seed());
     }
 #endif
     if (DEBUG_h_TEST)

perl.c

@@ -15918,8 +15918,10 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_globhook		= proto_perl->Iglobhook;
 
     PL_srand_called	= proto_perl->Isrand_called;
-    Copy(PL_PTR_PROTO_RANDOM_STATE, PL_PTR_RANDOM_STATE, 1, PL_RANDOM_STATE_TYPE);
-    Copy(PL_PTR_PROTO_RANDOM_STATE_INTERNAL, PL_PTR_RANDOM_STATE_INTERNAL, 1, PL_RANDOM_STATE_TYPE);
+    Copy(PL_PTR_PROTO_RANDOM_STATE, PL_PTR_RANDOM_STATE,
+            PL_RANDOM_STATE_LENGTH, PL_RANDOM_STATE_TYPE);
+    Copy(PL_PTR_PROTO_RANDOM_STATE_INTERNAL, PL_PTR_RANDOM_STATE_INTERNAL,
+            PL_RANDOM_STATE_LENGTH, PL_RANDOM_STATE_TYPE);
     PL_srand_override   = proto_perl->Isrand_override;
     PL_srand_override_next = proto_perl->Isrand_override_next;
 

proto.h

@@ -126,15 +126,19 @@ EOM
     srand 12345;
     is(rand(1),  $r,  'rand() without args is rand(1)');
 
-
     # This checks that rand without an argument is not
     # rand($_). (In case somebody got overzealous.)
     # 
     cmp_ok($r, '<', 1,   'rand() without args is under 1');
 }
 
-{ # [perl #115928] use a standard rand() implementation
+if ($Config{ccflags}!~/PERL_USE_WELL512A_RNG/){ 
+    # [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");
+} else {
+    srand(1);
+    is(int rand(1000), 133, "our implementation of WELLRNG512A behaves consistently");
+    is(int rand(1000), 346, "and still consistently");
 }

sv.c

@@ -13,56 +13,91 @@ skip_all("This perl is built with NO_PERL_RAND_SEED")
     if $Config{ccflags} =~ /-DNO_PERL_RAND_SEED\b/;
 use strict;
 use warnings;
+my $test_code = <<'EOF_TEST_CODE';
+    for my $l ("A".."E") {
+        my $pid= fork;
+        if ($pid) {
+            push @pids, $pid;
+        }
+        elsif (!defined $pid) {
+            print "$l:failed fork";
+        } elsif (!$pid) {
+            print "$l:", map { chr(utf8::unicode_to_native(rand(26)+65)) } 1..10;
+            exit;
+        }
+    }
+    waitpid $_,0 for @pids;
+EOF_TEST_CODE
 
-for (1..2) {
-    local $ENV{PERL_RAND_SEED} = 1;
-    fresh_perl_is("print map { chr(utf8::unicode_to_native(rand(26)+65)) } 1..10",
-                  "BLVIOAEZTJ", undef, "Test randomness with PERL_RAND_SEED=1");
-}
+if ($Config{ccflags}!~/PERL_USE_WELL512A_RNG/){
+    for (1..2) {
+        local $ENV{PERL_RAND_SEED} = 1;
+        fresh_perl_is("print map { chr(utf8::unicode_to_native(rand(26)+65)) } 1..10",
+                      "BLVIOAEZTJ", undef, "Test randomness with PERL_RAND_SEED=1");
+    }
 
-for (1..2) {
-    local $ENV{PERL_RAND_SEED} = 2;
-    fresh_perl_is("print map { chr(utf8::unicode_to_native(rand(26)+65)) } 1..10",
-                  "XEOUOFRPQZ", undef, "Test randomness with PERL_RAND_SEED=2");
-}
+    for (1..2) {
+        local $ENV{PERL_RAND_SEED} = 2;
+        fresh_perl_is("print map { chr(utf8::unicode_to_native(rand(26)+65)) } 1..10",
+                      "XEOUOFRPQZ", undef, "Test randomness with PERL_RAND_SEED=2");
+    }
 
-my %got;
-for my $try (1..10) {
-    local $ENV{PERL_RAND_SEED};
-    my ($out,$err)= runperl_and_capture({}, ['-e',"print map { chr(rand(26)+65) } 1..10;"]);
-    if ($err) { diag $err }
-    $got{$out}++;
-}
-ok(8 <= keys %got, "Got at least 8 different strings");
-for (1..2) {
-    local $ENV{PERL_RAND_SEED} = 1;
-    my ($out,$err)= runperl_and_capture({}, ['-le',
-            <<'EOF_TEST_CODE'
-            for my $l ("A".."E") {
-                my $pid= fork;
-                if ($pid) {
-                    push @pids, $pid;
-                }
-                elsif (!defined $pid) {
-                    print "$l:failed fork";
-                } elsif (!$pid) {
-                    print "$l:", map { chr(utf8::unicode_to_native(rand(26)+65)) } 1..10;
-                    exit;
-                }
-            }
-            waitpid $_,0 for @pids;
-EOF_TEST_CODE
-        ]);
-    is($err, "", "No exceptions forking.");
-    my @parts= sort { $a cmp $b } split /\n/, $out;
-    my @want= (
-            "A:KNXDITWWJZ",
-            "B:WDQJGTBJQS",
-            "C:ZGYCCINIHE",
-            "D:UGLGAEXFBP",
-            "E:MQLTNZGZQB"
-    );
-    is("@parts","@want","Works as expected with forks.");
-}
+    my %got;
+    for my $try (1..10) {
+        local $ENV{PERL_RAND_SEED};
+        my ($out,$err)= runperl_and_capture({}, ['-e',"print map { chr(rand(26)+65) } 1..10;"]);
+        if ($err) { diag $err }
+        $got{$out}++;
+    }
+    ok(8 <= keys %got, "Got at least 8 different strings");
+    for (1..2) {
+        local $ENV{PERL_RAND_SEED} = 1;
+        my ($out,$err)= runperl_and_capture({}, ['-le', $test_code]);
+        is($err, "", "No exceptions forking.");
+        my @parts= sort { $a cmp $b } split /\n/, $out;
+        my @want= (
+                "A:KNXDITWWJZ",
+                "B:WDQJGTBJQS",
+                "C:ZGYCCINIHE",
+                "D:UGLGAEXFBP",
+                "E:MQLTNZGZQB"
+        );
+        is("@parts","@want","Works as expected with forks.");
+    }
+} else {
+    for (1..2) {
+        local $ENV{PERL_RAND_SEED} = 1;
+        fresh_perl_is("print map { chr(utf8::unicode_to_native(rand(26)+65)) } 1..10",
+                      "DJSFVUOCEP", undef, "Test randomness with PERL_RAND_SEED=1");
+    }
 
+    for (1..2) {
+        local $ENV{PERL_RAND_SEED} = 2;
+        fresh_perl_is("print map { chr(utf8::unicode_to_native(rand(26)+65)) } 1..10",
+                      "HYLBKECYNV", undef, "Test randomness with PERL_RAND_SEED=2");
+    }
+
+    my %got;
+    for my $try (1..10) {
+        local $ENV{PERL_RAND_SEED};
+        my ($out,$err)= runperl_and_capture({}, ['-e',"print map { chr(rand(26)+65) } 1..10;"]);
+        if ($err) { diag $err }
+        $got{$out}++;
+    }
+    ok(8 <= keys %got, "Got at least 8 different strings");
+    for (1..2) {
+        local $ENV{PERL_RAND_SEED} = 1;
+        my ($out,$err)= runperl_and_capture({}, ['-le', $test_code]);
+        is($err, "", "No exceptions forking.");
+        my @parts= sort { $a cmp $b } split /\n/, $out;
+        my @want= (
+                "A:GPYNXCIGON",
+                "B:FAIKJCRQID",
+                "C:TOSQBPNSUS",
+                "D:POQSAQWNFD",
+                "E:LXUSDWIRZB"
+        );
+        is("@parts","@want","Works as expected with forks.");
+    }
+}
 done_testing();