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] || 10;
  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.     #$seeds->[1] |= 0; # Convert IV to UV (not needed here?)
  89.  
  90.     $seeds->[0] += 11068046444225730969;
  91.  
  92.     return $output;
  93. }
  94.  
  95. # Rotate the bits in a 64bit integer to the left and wrap back
  96. # around to the right side.
  97. sub rotl {
  98.     my ($num, $shift) = @_;
  99.     my $ret           = ($num << $shift) | ($num >> (64 - $shift));
  100.  
  101.     return $ret;
  102. }
  103.  
  104. ###############################################################################
  105. ###############################################################################
  106.  
  107. # String format: '115', '165_bold', '10_on_140', 'reset', 'on_173', 'red', 'white_on_blue'
  108. sub color {
  109.     my ($str, $txt) = @_;
  110.  
  111.     # If we're NOT connected to a an interactive terminal don't do color
  112.     if (-t STDOUT == 0) { return $txt || ""; }
  113.  
  114.     # No string sent in, so we just reset
  115.     if (!length($str) || $str eq 'reset') { return "\e[0m"; }
  116.  
  117.     # Some predefined colors
  118.     my %color_map = qw(red 160 blue 27 green 34 yellow 226 orange 214 purple 93 white 15 black 0);
  119.     $str =~ s|([A-Za-z]+)|$color_map{$1} // $1|eg;
  120.  
  121.     # Get foreground/background and any commands
  122.     my ($fc,$cmd) = $str =~ /^(\d{1,3})?_?(\w+)?$/g;
  123.     my ($bc)      = $str =~ /on_(\d{1,3})$/g;
  124.  
  125.     if (defined($fc) && int($fc) > 255) { $fc = undef; } # above 255 is invalid
  126.  
  127.     # Some predefined commands
  128.     my %cmd_map = qw(bold 1 italic 3 underline 4 blink 5 inverse 7);
  129.     my $cmd_num = $cmd_map{$cmd // 0};
  130.  
  131.     my $ret = '';
  132.     if ($cmd_num)      { $ret .= "\e[${cmd_num}m"; }
  133.     if (defined($fc))  { $ret .= "\e[38;5;${fc}m"; }
  134.     if (defined($bc))  { $ret .= "\e[48;5;${bc}m"; }
  135.     if (defined($txt)) { $ret .= $txt . "\e[0m";   }
  136.  
  137.     return $ret;
  138. }
  139.  
  140. sub randomize_seeds {
  141.     print color(51, "Using random seeds\n");
  142.  
  143.     $s1 = perl_rand64();
  144.     $s2 = perl_rand64();
  145.     $s3 = perl_rand64();
  146. }
  147.  
  148. sub perl_rand64 {
  149.     my $low  = int(rand() * (2**32-1));
  150.     my $high = int(rand() * (2**32-1));
  151.  
  152.     my $ret = ($high << 32) | $low;
  153.  
  154.     return $ret;
  155. }
  156.  
  157. # Creates methods k() and kd() to print, and print & die respectively
  158. BEGIN {
  159.     if (eval { require Data::Dump::Color }) {
  160.         *k = sub { Data::Dump::Color::dd(@_) };
  161.     } else {
  162.         require Data::Dumper;
  163.         *k = sub { print Data::Dumper::Dumper(\@_) };
  164.     }
  165.  
  166.     sub kd {
  167.         k(@_);
  168.  
  169.         printf("Died at %2\$s line #%3\$s\n",caller());
  170.         exit(15);
  171.     }
  172. }
  173.  
  174. # vim: tabstop=4 shiftwidth=4 noexpandtab autoindent softtabstop=4