Showing xoshiro256.pl (raw)


  1. #!/usr/bin/env perl
  2.  
  3. use strict;
  4. use warnings;
  5. use v5.16;
  6. use Getopt::Long;
  7.  
  8. ###############################################################################
  9. # 2025-01-22: Pure Perl implementation of PRNG xoshiro256 family of PRNGs
  10. # Scott Baker / https://www.perturb.org/
  11. ###############################################################################
  12. # A lot of work was done here to mimic how C handles overflow multiplication
  13. # on large uint64_t numbers. Perl converts scalars that are larger than 2^64-1
  14. # to floating point on the backend. We do *NOT* want that, because xoshiro256
  15. # (and most PRNGs) rely on overflow math to do their magic. We utilize
  16. # 'use integer' to force Perl to do all math with regular 64bit values. When
  17. # overflow occurs Perl likes to convert those values to negative numbers. In
  18. # the original C all math is done with uint64_t, so we have to convert the
  19. # IV/negative numbers back into UV/unsigned (positive) values.
  20. ###############################################################################
  21.  
  22. my $use_random_seed = 0;
  23. GetOptions(
  24.     'random_seed' => \$use_random_seed,
  25. );
  26.  
  27. # Initial seeds for testing
  28. # 256bit functions need 4x 64bit integers, and 512 needs 8x
  29. my $seeds = [
  30.     1216172134540287360 , 607988272756665600 , 16172922978634559625, 8476171486693032832,
  31. ];
  32.  
  33. # Get random 64bit seeds
  34. if ($use_random_seed) {
  35.     print color('yellow', "Using random seeds\n\n");
  36.     foreach my $seed (@$seeds) {
  37.         $seed = perl_rand64();
  38.     }
  39. }
  40.  
  41. my $iterations = int($ARGV[0] || 8);
  42.  
  43. print "Seeds: \n" . color(123, join("\n", @$seeds) . "\n\n");
  44. for (my $i = 1; $i <= $iterations; $i++) {
  45.     my $num;
  46.     $num = xoshiro256starstar($seeds);
  47.     #$num = xoshiro256plus($seeds);
  48.     #$num = xoshiro256plusplus($seeds);
  49.  
  50.     #As a bonus we include one of the 512 bit variants also
  51.     #$num = xoshiro512plus($seeds);
  52.  
  53.     printf("%2d) %s\n", $i, color('white', $num));
  54. }
  55.  
  56. ###############################################################################
  57. ###############################################################################
  58.  
  59. #my $seeds = [1216172134540287360, 607988272756665600, 16172922978634559625, 8476171486693032832];
  60. #my $num   = xoshiro256starstar($seeds);
  61. # xoshiro256**
  62. sub xoshiro256starstar {
  63.     # Seeds are passed in by reference so we can update them
  64.     my ($s) = @_;
  65.  
  66.     # We use integer math here because we need the large multiplication to
  67.     # overflow. Without this Perl will try and convert this big number to a
  68.     # float and we don't want that.
  69.     use integer;
  70.     my $result = rotl($s->[1] * 5, 7) * 9;
  71.     # We have to unconvert the overflowed number from an IV to UV after the big math
  72.     $result    = iv_2_uv($result);
  73.     no integer;
  74.  
  75.     my $t = $s->[1] << 17;
  76.  
  77.     $s->[2] ^= $s->[0];
  78.     $s->[3] ^= $s->[1];
  79.     $s->[1] ^= $s->[2];
  80.     $s->[0] ^= $s->[3];
  81.  
  82.     $s->[2] ^= $t;
  83.  
  84.     $s->[3] = rotl($s->[3], 45);
  85.  
  86.     return $result;
  87. }
  88.  
  89. # xoshiro256+
  90. sub xoshiro256plus {
  91.     # Seeds are passed in by reference so we can update them
  92.     my ($s) = @_;
  93.  
  94.     # We use integer math here because we need the large multiplication to
  95.     # overflow. Without this Perl will try and convert this big number to a
  96.     # float and we don't want that.
  97.     use integer;
  98.     my $result = $s->[0] + $s->[3];
  99.     # We have to unconvert the overflowed number from an IV to UV after the big math
  100.     $result    = iv_2_uv($result);
  101.     no integer;
  102.  
  103.     my $t = $s->[1] << 17;
  104.  
  105.     $s->[2] ^= $s->[0];
  106.     $s->[3] ^= $s->[1];
  107.     $s->[1] ^= $s->[2];
  108.     $s->[0] ^= $s->[3];
  109.  
  110.     $s->[2] ^= $t;
  111.  
  112.     $s->[3] = rotl($s->[3], 45);
  113.  
  114.     return $result;
  115. }
  116.  
  117. # xoshiro256++
  118. sub xoshiro256plusplus {
  119.     # Seeds are passed in by reference so we can update them
  120.     my ($s) = @_;
  121.  
  122.     # We use integer math here because we need the large multiplication to
  123.     # overflow. Without this Perl will try and convert this big number to a
  124.     # float and we don't want that.
  125.     use integer;
  126.     my $result = rotl($s->[0] + $s->[3], 23) + $s->[0];
  127.     # We have to unconvert the overflowed number from an IV to UV after the big math
  128.     $result    = iv_2_uv($result);
  129.     no integer;
  130.  
  131.     my $t = $s->[1] << 17;
  132.  
  133.     $s->[2] ^= $s->[0];
  134.     $s->[3] ^= $s->[1];
  135.     $s->[1] ^= $s->[2];
  136.     $s->[0] ^= $s->[3];
  137.  
  138.     $s->[2] ^= $t;
  139.  
  140.     $s->[3] = rotl($s->[3], 45);
  141.  
  142.     return $result;
  143. }
  144.  
  145. # Bonus: xoshiro512+
  146. # This requires 8x 64bit seeds to run
  147. sub xoshiro512plus {
  148.     # Seeds are passed in by reference so we can update them
  149.     my ($s) = @_;
  150.  
  151.     # We use integer math here because we need the large multiplication to
  152.     # overflow. Without this Perl will try and convert this big number to a
  153.     # float and we don't want that.
  154.     use integer;
  155.     my $result = $s->[0] + $s->[2];
  156.     # We have to unconvert the overflowed number from an IV to UV after the big math
  157.     $result    = iv_2_uv($result);
  158.     no integer;
  159.  
  160.     my $t = $s->[1] << 11;
  161.  
  162.     $s->[2] ^= $s->[0];
  163.     $s->[5] ^= $s->[1];
  164.     $s->[1] ^= $s->[2];
  165.     $s->[7] ^= $s->[3];
  166.     $s->[3] ^= $s->[4];
  167.     $s->[4] ^= $s->[5];
  168.     $s->[0] ^= $s->[6];
  169.     $s->[6] ^= $s->[7];
  170.  
  171.     $s->[6] ^= $t;
  172.  
  173.     $s->[7] = rotl($s->[7], 21);
  174.  
  175.     return $result;
  176. }
  177.  
  178. # During large integer math when a UV overflows and wraps back around
  179. # Perl casts it as a IV value. For the purposes of PCG we need that
  180. # wraparound math to stay in place. We need uint64_t all the time.
  181. sub iv_2_uv {
  182.     my $x = $_[0];
  183.  
  184.     # Flip it from a IV (signed) to a UV (unsigned)
  185.     # use Devel::Peek; Dump($var) # See the internal Perl type
  186.     if ($x < 0) {
  187.         no integer;
  188.         $x += 18446744073709551615;
  189.         $x += 1;
  190.     }
  191.  
  192.     return $x;
  193. }
  194.  
  195. # Rotate the bits in a 64bit integer to the left and wrap back
  196. # around to the right side.
  197. sub rotl {
  198.     my ($num, $shift) = @_;
  199.     my $ret           = ($num << $shift) | ($num >> (64 - $shift));
  200.  
  201.     return $ret;
  202. }
  203.  
  204. #######################################################
  205.  
  206. sub rotl_mini {
  207.     return ($_[0] << $_[1]) | ($_[0] >> (64 - $_[1]));
  208. }
  209.  
  210. sub iv_2_uv_mini {
  211.     my $x = $_[0];
  212.     if ($x < 0) { no integer; $x += 18446744073709551615; $x += 1; }
  213.  
  214.     return $x;
  215. }
  216.  
  217. sub trim {
  218.     my ($s) = (@_, $_); # Passed in var, or default to $_
  219.     if (!defined($s) || length($s) == 0) { return ""; }
  220.     $s =~ s/^\s*//;
  221.     $s =~ s/\s*$//;
  222.  
  223.     return $s;
  224. }
  225.  
  226. # String format: '115', '165_bold', '10_on_140', 'reset', 'on_173', 'red', 'white_on_blue'
  227. sub color {
  228.     my ($str, $txt) = @_;
  229.  
  230.     # If we're NOT connected to a an interactive terminal don't do color
  231.     if (-t STDOUT == 0) { return $txt || ""; }
  232.  
  233.     # No string sent in, so we just reset
  234.     if (!length($str) || $str eq 'reset') { return "\e[0m"; }
  235.  
  236.     # Some predefined colors
  237.     my %color_map = qw(red 160 blue 27 green 34 yellow 226 orange 214 purple 93 white 15 black 0);
  238.     $str =~ s|([A-Za-z]+)|$color_map{$1} // $1|eg;
  239.  
  240.     # Get foreground/background and any commands
  241.     my ($fc,$cmd) = $str =~ /^(\d{1,3})?_?(\w+)?$/g;
  242.     my ($bc)      = $str =~ /on_(\d{1,3})$/g;
  243.  
  244.     if (defined($fc) && int($fc) > 255) { $fc = undef; } # above 255 is invalid
  245.  
  246.     # Some predefined commands
  247.     my %cmd_map = qw(bold 1 italic 3 underline 4 blink 5 inverse 7);
  248.     my $cmd_num = $cmd_map{$cmd // 0};
  249.  
  250.     my $ret = '';
  251.     if ($cmd_num)      { $ret .= "\e[${cmd_num}m"; }
  252.     if (defined($fc))  { $ret .= "\e[38;5;${fc}m"; }
  253.     if (defined($bc))  { $ret .= "\e[48;5;${bc}m"; }
  254.     if (defined($txt)) { $ret .= $txt . "\e[0m";   }
  255.  
  256.     return $ret;
  257. }
  258.  
  259. sub perl_rand64 {
  260.     my $ret = int(rand() * (2**64-1));
  261.  
  262.     return $ret;
  263. }
  264.  
  265. # Creates methods k() and kd() to print, and print & die respectively
  266. BEGIN {
  267.     if (eval { require Data::Dump::Color }) {
  268.         *k = sub { Data::Dump::Color::dd(@_) };
  269.     } else {
  270.         require Data::Dumper;
  271.         *k = sub { print Data::Dumper::Dumper(\@_) };
  272.     }
  273.  
  274.     sub kd {
  275.         k(@_);
  276.  
  277.         printf("Died at %2\$s line #%3\$s\n",caller());
  278.         exit(15);
  279.     }
  280. }
  281.  
  282. # vim: tabstop=4 shiftwidth=4 noexpandtab autoindent softtabstop=4