Showing biski64.pl (raw)

  1. #!/usr/bin/env perl
  2.  
  3. ###############################################################################
  4. # Perl implementation of biski64 PRNG: https://github.com/danielcota/biski64
  5. #
  6. # # A lot of work was done here to mimic how C handles overflow multiplication
  7. # on large uint64_t numbers. Perl converts scalars that are larger than 2^64 - 1
  8. # to floating point on the backend. We do *NOT* want that, because biski64
  9. # (and most PRNGs) rely on overflow math to do their magic. We utilize
  10. # 'use integer' to force Perl to do all math with integer 64bit values. When
  11. # overflow occurs Perl likes to convert those values to signed integers. In
  12. # the original C all math is done with uint64_t, so we have to convert the
  13. # IV/negative numbers back into UV/unsigned (positive) values.
  14. #
  15. # 2025-12-23 - Scott Baker
  16. ###############################################################################
  17. #
  18. # typedef struct {
  19. #     uint64_t fast_loop;
  20. #     uint64_t mix;
  21. #     uint64_t loop_mix;
  22. # } biski64_state;
  23. #
  24. # uint64_t biski64_next(biski64_state* state) {
  25. #     const uint64_t output = state->mix + state->loop_mix;
  26. #     const uint64_t old_loop_mix = state->loop_mix;
  27. #
  28. #     state->loop_mix = state->fast_loop ^ state->mix;
  29. #     state->mix = rotate_left(state->mix, 16) +
  30. #                  rotate_left(old_loop_mix, 40);
  31. #     state->fast_loop += 0x9999999999999999ULL; // Additive constant for the Weyl sequence.
  32. #     return output;
  33. # }
  34. #
  35. ###############################################################################
  36.  
  37. use strict;
  38. use warnings;
  39. use v5.16;
  40. use Getopt::Long;
  41.  
  42. ###############################################################################
  43. ###############################################################################
  44.  
  45. my $s1     = 0; # Default 64bit seed1
  46. my $s2     = 0; # Default 64bit seed2
  47. my $s3     = 0; # Default 64bit seed3
  48. my $random = 0;
  49. my $seeds  = [];
  50.  
  51. GetOptions(
  52.     'seed1=i'    => \$s1,
  53.     'seed2=i'    => \$s2,
  54.     'seed3=i'    => \$s3,
  55.     'random'     => \$random,
  56.     'unit-tests' => \&run_unit_tests,
  57. );
  58.  
  59. if (!$s1 || !$s2 || !$s3 || $random) {
  60.     randomize_seeds();
  61. }
  62.  
  63. my $iterations = $ARGV[0] || 30;
  64. $seeds         = [$s1, $s2, $s3];
  65.  
  66. print color('yellow', "Seeding PRNG with: MIX:$s2 LOOPMIX:$s3 FL:$s1\n\n");
  67.  
  68. for (my $i = 1; $i <= $iterations; $i++) {
  69.     my $num64 = biski64($seeds);
  70.     printf("%2d) %20u\n", $i, $num64);
  71. }
  72.  
  73. ################################################################################
  74. ################################################################################
  75. ################################################################################
  76.  
  77. #my $seeds = [12, 34, 56];
  78. #my $rand  = biski64($seeds);
  79. sub biski64 {
  80.     my $seeds = $_[0];
  81.  
  82.     use integer;
  83.     my $output = $seeds->[1] + $seeds->[2];
  84.     my $old_lm = $seeds->[2];
  85.  
  86.     $seeds->[2] = $seeds->[0] ^ $seeds->[1];
  87.     $seeds->[1] = rotl($seeds->[1], 16) + rotl($old_lm, 40);
  88.  
  89.     $seeds->[0] += 11068046444225730969;
  90.  
  91.     #$seeds->[0] |= 0; # Not needed?
  92.     #$seeds->[1] |= 0; # Not needed?
  93.  
  94.     no integer;
  95.  
  96.     return $output | 0;
  97. }
  98.  
  99. # Rotate the bits in a 64bit integer to the left and wrap back
  100. # around to the right side.
  101. sub rotl {
  102.     my ($num, $shift) = @_;
  103.     my $ret           = ($num << $shift) | ($num >> (64 - $shift));
  104.  
  105.     return $ret;
  106. }
  107.  
  108. ###############################################################################
  109. ###############################################################################
  110.  
  111. # String format: '115', '165_bold', '10_on_140', 'reset', 'on_173', 'red', 'white_on_blue'
  112. sub color {
  113.     my ($str, $txt) = @_;
  114.  
  115.     # If we're NOT connected to a an interactive terminal don't do color
  116.     if (-t STDOUT == 0) { return $txt || ""; }
  117.  
  118.     # No string sent in, so we just reset
  119.     if (!length($str) || $str eq 'reset') { return "\e[0m"; }
  120.  
  121.     # Some predefined colors
  122.     my %color_map = qw(red 160 blue 27 green 34 yellow 226 orange 214 purple 93 white 15 black 0);
  123.     $str =~ s|([A-Za-z]+)|$color_map{$1} // $1|eg;
  124.  
  125.     # Get foreground/background and any commands
  126.     my ($fc,$cmd) = $str =~ /^(\d{1,3})?_?(\w+)?$/g;
  127.     my ($bc)      = $str =~ /on_(\d{1,3})$/g;
  128.  
  129.     if (defined($fc) && int($fc) > 255) { $fc = undef; } # above 255 is invalid
  130.  
  131.     # Some predefined commands
  132.     my %cmd_map = qw(bold 1 italic 3 underline 4 blink 5 inverse 7);
  133.     my $cmd_num = $cmd_map{$cmd // 0};
  134.  
  135.     my $ret = '';
  136.     if ($cmd_num)      { $ret .= "\e[${cmd_num}m"; }
  137.     if (defined($fc))  { $ret .= "\e[38;5;${fc}m"; }
  138.     if (defined($bc))  { $ret .= "\e[48;5;${bc}m"; }
  139.     if (defined($txt)) { $ret .= $txt . "\e[0m";   }
  140.  
  141.     return $ret;
  142. }
  143.  
  144. sub randomize_seeds {
  145.     print color(51, "Using random seeds\n");
  146.  
  147.     $s1 = perl_rand64();
  148.     $s2 = perl_rand64();
  149.     $s3 = perl_rand64();
  150. }
  151.  
  152. sub perl_rand64 {
  153.     my $low  = int(rand() * (2**32-1));
  154.     my $high = int(rand() * (2**32-1));
  155.  
  156.     my $ret = ($high << 32) | $low;
  157.  
  158.     return $ret;
  159. }
  160.  
  161. sub run_unit_tests {
  162.     my $seeds = [111, 222, 333];
  163.  
  164.     print color('228');
  165.     printf("Using seeds: %lu / %lu / %lu\n\n", $seeds->[0], $seeds->[1], $seeds->[2]);
  166.     print color('reset');
  167.  
  168.     my $vectors = {
  169.         1979  => 4568322959681969378,
  170.         5000  => 5866684681516290615,
  171.         10000 => 17911923907726985146,
  172.         15000 => 15110515585085173267,
  173.         25000 => 15779866536674568433,
  174.     };
  175.  
  176.     my $bad = 0;
  177.     for (my $i = 1; $i <= 100000; $i++) {
  178.         my $num64 = biski64($seeds);
  179.  
  180.         if (defined($vectors->{$i}) && $num64 == $vectors->{$i}) {
  181.             printf("Test vector #%-5d passed (%s)\n", $i, $vectors->{$i});
  182.         } elsif ($vectors->{$i}) {
  183.             printf("Test vector #%-5d failed (%s)\n", $i, $num64);
  184.             $bad++;
  185.         }
  186.     }
  187.  
  188.     print "\n";
  189.  
  190.     if ($bad) {
  191.         print color('red', "Failed $bad tests\n");
  192.         exit(9);
  193.     } else {
  194.         print color('green', "All tests passed\n");
  195.     }
  196.  
  197.     exit;
  198. }
  199.  
  200. # Creates methods k() and kd() to print, and print & die respectively
  201. BEGIN {
  202.     if (eval { require Dump::Krumo }) {
  203.         Dump::Krumo->import(qw/k kd/);
  204.     } else {
  205.         require Data::Dumper;
  206.         *k  = sub { print Data::Dumper::Dumper(\@_) };
  207.         *kd = sub { print Data::Dumper::Dumper(\@_); die; };
  208.     }
  209. }
  210.  
  211. # vim: tabstop=4 shiftwidth=4 noexpandtab autoindent softtabstop=4