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