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