Showing sfc64.pl (raw)

  1. #!/usr/bin/env perl
  2.  
  3. ###############################################################################
  4. # Perl implementation of SFC64 - https://github.com/scottchiefbaker/SmokeRand/blob/main/generators/sfc64.c
  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 SFC64
  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. #/**
  19. # * @brief sfc64 state.
  20. # */
  21. #typedef struct {
  22. #    uint64_t a;
  23. #    uint64_t b;
  24. #    uint64_t c;
  25. #    uint64_t counter;
  26. #} Sfc64State;
  27. #
  28. #static inline uint64_t get_bits_raw(void *state)
  29. #{
  30. #    enum {BARREL_SHIFT = 24, RSHIFT = 11, LSHIFT = 3};
  31. #    Sfc64State *obj = state;
  32. #    const uint64_t tmp = obj->a + obj->b + obj->counter++;
  33. #    obj->a = obj->b ^ (obj->b >> RSHIFT);
  34. #    obj->b = obj->c + (obj->c << LSHIFT);
  35. #    obj->c = ((obj->c << BARREL_SHIFT) | (obj->c >> (64-BARREL_SHIFT))) + tmp;
  36. #    return tmp;
  37. #}
  38. ###############################################################################
  39.  
  40. use strict;
  41. use warnings;
  42. use v5.16;
  43. use Getopt::Long;
  44.  
  45. ###############################################################################
  46. ###############################################################################
  47.  
  48. my $s1     = 0; # Default 64bit seed1
  49. my $s2     = 0; # Default 64bit seed2
  50. my $s3     = 0; # Default 64bit seed3
  51. my $cnt    = 1;
  52. my $random = 0;
  53. my $seeds  = [];
  54.  
  55. GetOptions(
  56.     'seed1=i'    => \$s1,
  57.     'seed2=i'    => \$s2,
  58.     'seed3=i'    => \$s3,
  59.     'random'     => \$random,
  60.     'unit-tests' => \&run_unit_tests,
  61. );
  62.  
  63. if (!$s1 || !$s2 || !$s3 || $random) {
  64.     randomize_seeds();
  65. }
  66.  
  67. my $iterations = $ARGV[0] || 10;
  68. $seeds         = [$s1, $s2, $s3, $cnt];
  69.  
  70. print color('yellow', "Seeding PRNG with: $s1 / $s2 / $s3\n\n");
  71.  
  72. for (my $i = 1; $i <= $iterations; $i++) {
  73.     my $num64 = sfc64($seeds);
  74.     printf("%2d) %20u\n", $i, $num64);
  75. }
  76.  
  77. ################################################################################
  78. ################################################################################
  79. ################################################################################
  80.  
  81. #my $seeds = [12, 34, 56];
  82. #my $rand  = sfc64($seeds);
  83. sub sfc64 {
  84.     my $seeds = $_[0];
  85.  
  86.     use integer;
  87.     my $tmp  = $seeds->[0] + $seeds->[1] + $seeds->[3]++;
  88.     no integer;
  89.  
  90.     # Make sure tmp is a UV
  91.     $tmp |= 0;
  92.  
  93.     # Bitwise shifts need to be 'no integer' so the shift is unsigned
  94.     $seeds->[0] = $seeds->[1] ^ ($seeds->[1] >> 11);
  95.  
  96.     my $x = ($seeds->[2] << 3);
  97.  
  98.     use integer;
  99.     $seeds->[1] = $seeds->[2] + $x;
  100.     no integer;
  101.  
  102.     $seeds->[2] = (($seeds->[2] << 24) | ($seeds->[2] >> 40));
  103.  
  104.     use integer;
  105.     $seeds->[2] += $tmp;
  106.  
  107.     return $tmp;
  108. }
  109.  
  110. ###############################################################################
  111. ###############################################################################
  112.  
  113. # String format: '115', '165_bold', '10_on_140', 'reset', 'on_173', 'red', 'white_on_blue'
  114. sub color {
  115.     my ($str, $txt) = @_;
  116.  
  117.     # If we're NOT connected to a an interactive terminal don't do color
  118.     if (-t STDOUT == 0) { return $txt || ""; }
  119.  
  120.     # No string sent in, so we just reset
  121.     if (!length($str) || $str eq 'reset') { return "\e[0m"; }
  122.  
  123.     # Some predefined colors
  124.     my %color_map = qw(red 160 blue 27 green 34 yellow 226 orange 214 purple 93 white 15 black 0);
  125.     $str =~ s|([A-Za-z]+)|$color_map{$1} // $1|eg;
  126.  
  127.     # Get foreground/background and any commands
  128.     my ($fc,$cmd) = $str =~ /^(\d{1,3})?_?(\w+)?$/g;
  129.     my ($bc)      = $str =~ /on_(\d{1,3})$/g;
  130.  
  131.     if (defined($fc) && int($fc) > 255) { $fc = undef; } # above 255 is invalid
  132.  
  133.     # Some predefined commands
  134.     my %cmd_map = qw(bold 1 italic 3 underline 4 blink 5 inverse 7);
  135.     my $cmd_num = $cmd_map{$cmd // 0};
  136.  
  137.     my $ret = '';
  138.     if ($cmd_num)      { $ret .= "\e[${cmd_num}m"; }
  139.     if (defined($fc))  { $ret .= "\e[38;5;${fc}m"; }
  140.     if (defined($bc))  { $ret .= "\e[48;5;${bc}m"; }
  141.     if (defined($txt)) { $ret .= $txt . "\e[0m";   }
  142.  
  143.     return $ret;
  144. }
  145.  
  146. sub randomize_seeds {
  147.     print color(51, "Using random seeds\n");
  148.  
  149.     $s1 = perl_rand64();
  150.     $s2 = perl_rand64();
  151.     $s3 = perl_rand64();
  152. }
  153.  
  154. sub perl_rand64 {
  155.     my $low  = int(rand() * (2**32-1));
  156.     my $high = int(rand() * (2**32-1));
  157.  
  158.     my $ret = ($high << 32) | $low;
  159.  
  160.     return $ret;
  161. }
  162.  
  163. # Creates methods k() and kd() to print, and print & die respectively
  164. BEGIN {
  165.     if (!defined(&trim)) {
  166.         *trim = sub {
  167.             my ($s) = (@_, $_); # Passed in var, or default to $_
  168.             if (length($s) == 0) { return ""; }
  169.             $s =~ s/^\s*//;
  170.             $s =~ s/\s*$//;
  171.  
  172.             return $s;
  173.         }
  174.     }
  175.  
  176.     if (eval { require Dump::Krumo }) {
  177.         *k  = sub { Dump::Krumo::kx(@_) };
  178.         *kd = sub { Dump::Krumo::kxd(@_) };
  179.     } else {
  180.         require Data::Dumper;
  181.         *k  = sub { print Data::Dumper::Dumper(\@_) };
  182.         *kd = sub { print Data::Dumper::Dumper(\@_); die; };
  183.     }
  184. }
  185.  
  186. # vim: tabstop=4 shiftwidth=4 noexpandtab autoindent softtabstop=4