Showing squares.pl (raw)

  1. #!/usr/bin/env perl
  2.  
  3. use strict;
  4. use warnings;
  5. use v5.16;
  6.  
  7. ###############################################################################
  8. # Scott Baker - 2025-10-29 - https://www.perturb.org/
  9. ###############################################################################
  10. # Pure Perl versions of the squares32 and squares64 PRNGs.
  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 PRNGs rely
  15. # on overflow math to do their magic. We utilize 'use integer' to force Perl
  16. # to do all math with regular 64bit values. When overflow occurs Perl likes to
  17. # convert large values to negative numbers. In the original C all math is done
  18. # with uint64_t, so we have to convert the IV/negative numbers back into
  19. # UV/unsigned (positive) values.
  20. #
  21. # Note: Bitshift operations are unsigned, unless you're in a `use integer`
  22. # block which switches to signed bitshift. We do a lot of `use integer` and
  23. # then immediately do `no integer` to get the appropriate math type
  24. ###############################################################################
  25. # /* Borrowed from: https://squaresrng.wixsite.com/rand */
  26. #
  27. # inline static uint64_t squares64(uint64_t ctr, uint64_t key) {
  28. #    uint64_t t, x, y, z;
  29. #    y = x = ctr * key; z = y + key;
  30. #    x = x*x + y; x = (x>>32) | (x<<32);       /* round 1 */
  31. #    x = x*x + z; x = (x>>32) | (x<<32);       /* round 2 */
  32. #    x = x*x + y; x = (x>>32) | (x<<32);       /* round 3 */
  33. #    t = x = x*x + z; x = (x>>32) | (x<<32);   /* round 4 */
  34. #    return t ^ ((x*x + y) >> 32);             /* round 5 */
  35. # }
  36. ###############################################################################
  37.  
  38. use Getopt::Long;
  39.  
  40. my $seed;
  41.  
  42. GetOptions(
  43.     'seed=i' => \$seed,
  44. );
  45.  
  46. my $iterations = $ARGV[0] || 10;
  47.  
  48. ###############################################################################
  49. ###############################################################################
  50.  
  51. if (!$seed) {
  52.     $seed = perl_rand64();
  53.     print color('yellow', "Using random seed $seed\n\n");
  54. }
  55.  
  56. print color('white');
  57. printf("%2s    %6s %16s\n", "", "squares32", "squares64");
  58. print color('reset');
  59.  
  60. for (1 .. $iterations) {
  61.     printf("%2d) %11u %21u\n", $_, squares32($_, $seed), squares64($_, $seed));
  62. }
  63.  
  64. ###############################################################################
  65. ###############################################################################
  66.  
  67. sub squares64 {
  68.     my ($ctr, $key) = @_;
  69.  
  70.     my ($t, $x, $y, $z);
  71.  
  72.     use integer;
  73.     $y = $x = $ctr * $key; $z = $y + $key;
  74.  
  75.     # Round 1
  76.     $x = ($x * $x) + $y;
  77.     no integer;
  78.     $x = ($x >> 32) | ($x << 32);
  79.  
  80.     # Round 2
  81.     use integer;
  82.     $x = ($x * $x) + $z;
  83.     no integer;
  84.     $x = ($x >> 32) | ($x << 32);
  85.  
  86.     # Round 3
  87.     use integer;
  88.     $x = ($x * $x) + $y;
  89.     no integer;
  90.     $x = ($x >> 32) | ($x << 32);
  91.  
  92.     # Round 4
  93.     use integer;
  94.     $t = $x = ($x * $x) + $z;
  95.     no integer;
  96.     $x = ($x >> 32) | ($x << 32);
  97.  
  98.     use integer;
  99.     my $part = ($x * $x + $y);
  100.     no integer;
  101.  
  102.     my $ret = $t ^ ($part >> 32);
  103.  
  104.     return $ret;
  105. }
  106.  
  107. sub squares32 {
  108.     my ($ctr, $key) = @_;
  109.  
  110.     my ($x, $y, $z);
  111.  
  112.     use integer;
  113.     $y = $x = $ctr * $key; $z = $y + $key;
  114.  
  115.     # Round 1
  116.     $x = ($x * $x) + $y;
  117.     no integer;
  118.     $x = ($x >> 32) | ($x << 32);
  119.  
  120.     # Round 2
  121.     use integer;
  122.     $x = ($x * $x) + $z;
  123.     no integer;
  124.     $x = ($x >> 32) | ($x << 32);
  125.  
  126.     # Round 3
  127.     use integer;
  128.     $x = ($x * $x) + $y;
  129.     no integer;
  130.     $x = ($x >> 32) | ($x << 32);
  131.  
  132.     use integer;
  133.     my $part = ($x * $x + $z);
  134.     no integer;
  135.  
  136.     my $ret = ($part >> 32) & 4294967295;
  137.  
  138.     return $ret;
  139. }
  140.  
  141.  
  142. sub trim {
  143.     my ($s) = (@_, $_); # Passed in var, or default to $_
  144.     if (!defined($s) || length($s) == 0) { return ""; }
  145.     $s =~ s/^\s*//;
  146.     $s =~ s/\s*$//;
  147.  
  148.     return $s;
  149. }
  150.  
  151. # String format: '115', '165_bold', '10_on_140', 'reset', 'on_173', 'red', 'white_on_blue'
  152. sub color {
  153.     my ($str, $txt) = @_;
  154.  
  155.     # If we're NOT connected to a an interactive terminal don't do color
  156.     if (-t STDOUT == 0) { return $txt || ""; }
  157.  
  158.     # No string sent in, so we just reset
  159.     if (!length($str) || $str eq 'reset') { return "\e[0m"; }
  160.  
  161.     # Some predefined colors
  162.     my %color_map = qw(red 160 blue 27 green 34 yellow 226 orange 214 purple 93 white 15 black 0);
  163.     $str =~ s|([A-Za-z]+)|$color_map{$1} // $1|eg;
  164.  
  165.     # Get foreground/background and any commands
  166.     my ($fc,$cmd) = $str =~ /^(\d{1,3})?_?(\w+)?$/g;
  167.     my ($bc)      = $str =~ /on_(\d{1,3})$/g;
  168.  
  169.     if (defined($fc) && int($fc) > 255) { $fc = undef; } # above 255 is invalid
  170.  
  171.     # Some predefined commands
  172.     my %cmd_map = qw(bold 1 italic 3 underline 4 blink 5 inverse 7);
  173.     my $cmd_num = $cmd_map{$cmd // 0};
  174.  
  175.     my $ret = '';
  176.     if ($cmd_num)      { $ret .= "\e[${cmd_num}m"; }
  177.     if (defined($fc))  { $ret .= "\e[38;5;${fc}m"; }
  178.     if (defined($bc))  { $ret .= "\e[48;5;${bc}m"; }
  179.     if (defined($txt)) { $ret .= $txt . "\e[0m";   }
  180.  
  181.     return $ret;
  182. }
  183.  
  184. sub file_get_contents {
  185.     open(my $fh, "<", $_[0]) or return undef;
  186.     binmode($fh, ":encoding(UTF-8)");
  187.  
  188.     my $array_mode = ($_[1]) || (!defined($_[1]) && wantarray);
  189.  
  190.     if ($array_mode) { # Line mode
  191.         my @lines  = readline($fh);
  192.  
  193.         # Right trim all lines
  194.         foreach my $line (@lines) { $line =~ s/[\r\n]+$//; }
  195.  
  196.         return @lines;
  197.     } else { # String mode
  198.         local $/       = undef; # Input rec separator (slurp)
  199.         return my $ret = readline($fh);
  200.     }
  201. }
  202.  
  203. sub file_put_contents {
  204.     my ($file, $data) = @_;
  205.  
  206.     open(my $fh, ">", $file) or return undef;
  207.     binmode($fh, ":encoding(UTF-8)");
  208.     print $fh $data;
  209.     close($fh);
  210.  
  211.     return length($data);
  212. }
  213.  
  214. sub perl_rand64 {
  215.     my $high = int(rand() * 2**32 - 1);
  216.     my $low  = int(rand() * 2**32 - 1);
  217.  
  218.     my $ret = ($high << 32) | $low;
  219.  
  220.     return $ret;
  221. }
  222.  
  223. # Creates methods k() and kd() to print, and print & die respectively
  224. BEGIN {
  225.     if (eval { require Data::Dump::Color }) {
  226.         *k = sub { Data::Dump::Color::dd(@_) };
  227.     } else {
  228.         require Data::Dumper;
  229.         *k = sub { print Data::Dumper::Dumper(\@_) };
  230.     }
  231.  
  232.     sub kd {
  233.         k(@_);
  234.  
  235.         printf("Died at %2\$s line #%3\$s\n",caller());
  236.         exit(15);
  237.     }
  238. }
  239.  
  240. # vim: tabstop=4 shiftwidth=4 noexpandtab autoindent softtabstop=4