diff options
Diffstat (limited to 'gnu/usr.bin/perl/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm')
| -rw-r--r-- | gnu/usr.bin/perl/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm | 609 |
1 files changed, 296 insertions, 313 deletions
diff --git a/gnu/usr.bin/perl/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm b/gnu/usr.bin/perl/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm index 2bb06a0976b..cd8f1ee44e6 100644 --- a/gnu/usr.bin/perl/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm +++ b/gnu/usr.bin/perl/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm @@ -7,7 +7,7 @@ use warnings; use Carp qw< carp croak >; use Math::BigInt::Lib; -our $VERSION = '1.999816'; +our $VERSION = '1.999818'; our @ISA = ('Math::BigInt::Lib'); @@ -35,9 +35,6 @@ our @ISA = ('Math::BigInt::Lib'); ############################################################################## # global constants, flags and accessory -# announce that we are compatible with MBI v1.83 and up -sub api_version () { 2; } - # constants for easier life my ($BASE, $BASE_LEN, $RBASE, $MAX_VAL); my ($AND_BITS, $XOR_BITS, $OR_BITS); @@ -50,9 +47,7 @@ sub _base_len { my ($class, $b, $int) = @_; if (defined $b) { - # avoid redefinitions - undef &_mul; - undef &_div; + no warnings "redefine"; if ($] >= 5.008 && $int && $b > 7) { $BASE_LEN = $b; @@ -403,13 +398,14 @@ sub _mul_use_mul { my ($c, $xv, $yv) = @_; if (@$yv == 1) { - # shortcut for two very short numbers (improved by Nathan Zook) - # works also if xv and yv are the same reference, and handles also $x == 0 + # shortcut for two very short numbers (improved by Nathan Zook) works + # also if xv and yv are the same reference, and handles also $x == 0 if (@$xv == 1) { if (($xv->[0] *= $yv->[0]) >= $BASE) { - $xv->[0] = $xv->[0] - ($xv->[1] = int($xv->[0] * $RBASE)) * $BASE; + my $rem = $xv->[0] % $BASE; + $xv->[1] = ($xv->[0] - $rem) * $RBASE; + $xv->[0] = $rem; } - ; return $xv; } # $x * 0 => 0 @@ -417,56 +413,44 @@ sub _mul_use_mul { @$xv = (0); return $xv; } + # multiply a large number a by a single element one, so speed up my $y = $yv->[0]; my $car = 0; + my $rem; foreach my $i (@$xv) { $i = $i * $y + $car; - $car = int($i * $RBASE); - $i -= $car * $BASE; + $rem = $i % $BASE; + $car = ($i - $rem) * $RBASE; + $i = $rem; } push @$xv, $car if $car != 0; return $xv; } + # shortcut for result $x == 0 => result = 0 return $xv if @$xv == 1 && $xv->[0] == 0; # since multiplying $x with $x fails, make copy in this case - $yv = [ @$xv ] if $xv == $yv; # same references? + $yv = $c->_copy($xv) if $xv == $yv; # same references? my @prod = (); - my ($prod, $car, $cty, $xi, $yi); - + my ($prod, $rem, $car, $cty, $xi, $yi); for $xi (@$xv) { $car = 0; $cty = 0; - - # slow variant - # for $yi (@$yv) - # { - # $prod = $xi * $yi + ($prod[$cty] || 0) + $car; - # $prod[$cty++] = - # $prod - ($car = int($prod * RBASE)) * $BASE; # see USE_MUL - # } - # $prod[$cty] += $car if $car; # need really to check for 0? - # $xi = shift @prod; - - # faster variant # looping through this if $xi == 0 is silly - so optimize it away! - $xi = (shift @prod || 0), next if $xi == 0; + $xi = (shift(@prod) || 0), next if $xi == 0; for $yi (@$yv) { $prod = $xi * $yi + ($prod[$cty] || 0) + $car; - ## this is actually a tad slower - ## $prod = $prod[$cty]; $prod += ($car + $xi * $yi); # no ||0 here - $prod[$cty++] = - $prod - ($car = int($prod * $RBASE)) * $BASE; # see USE_MUL + $rem = $prod % $BASE; + $car = int(($prod - $rem) * $RBASE); + $prod[$cty++] = $rem; } - $prod[$cty] += $car if $car; # need really to check for 0? - $xi = shift @prod || 0; # || 0 makes v5.005_3 happy + $prod[$cty] += $car if $car; # need really to check for 0? + $xi = shift(@prod) || 0; # || 0 makes v5.005_3 happy } push @$xv, @prod; - # can't have leading zeros - # __strip_zeros($xv); $xv; } @@ -478,11 +462,11 @@ sub _mul_use_div_64 { my ($c, $xv, $yv) = @_; use integer; + if (@$yv == 1) { - # shortcut for two small numbers, also handles $x == 0 + # shortcut for two very short numbers (improved by Nathan Zook) works + # also if xv and yv are the same reference, and handles also $x == 0 if (@$xv == 1) { - # shortcut for two very short numbers (improved by Nathan Zook) - # works also if xv and yv are the same reference, and handles also $x == 0 if (($xv->[0] *= $yv->[0]) >= $BASE) { $xv->[0] = $xv->[0] - ($xv->[1] = $xv->[0] / $BASE) * $BASE; @@ -494,6 +478,7 @@ sub _mul_use_div_64 { @$xv = (0); return $xv; } + # multiply a large number a by a single element one, so speed up my $y = $yv->[0]; my $car = 0; @@ -505,11 +490,12 @@ sub _mul_use_div_64 { push @$xv, $car if $car != 0; return $xv; } + # shortcut for result $x == 0 => result = 0 - return $xv if ( ((@$xv == 1) && ($xv->[0] == 0)) ); + return $xv if @$xv == 1 && $xv->[0] == 0; # since multiplying $x with $x fails, make copy in this case - $yv = $c->_copy($xv) if $xv == $yv; # same references? + $yv = $c->_copy($xv) if $xv == $yv; # same references? my @prod = (); my ($prod, $car, $cty, $xi, $yi); @@ -517,13 +503,13 @@ sub _mul_use_div_64 { $car = 0; $cty = 0; # looping through this if $xi == 0 is silly - so optimize it away! - $xi = (shift @prod || 0), next if $xi == 0; + $xi = (shift(@prod) || 0), next if $xi == 0; for $yi (@$yv) { $prod = $xi * $yi + ($prod[$cty] || 0) + $car; $prod[$cty++] = $prod - ($car = $prod / $BASE) * $BASE; } - $prod[$cty] += $car if $car; # need really to check for 0? - $xi = shift @prod || 0; # || 0 makes v5.005_3 happy + $prod[$cty] += $car if $car; # need really to check for 0? + $xi = shift(@prod) || 0; # || 0 makes v5.005_3 happy } push @$xv, @prod; $xv; @@ -536,15 +522,14 @@ sub _mul_use_div { my ($c, $xv, $yv) = @_; if (@$yv == 1) { - # shortcut for two small numbers, also handles $x == 0 + # shortcut for two very short numbers (improved by Nathan Zook) works + # also if xv and yv are the same reference, and handles also $x == 0 if (@$xv == 1) { - # shortcut for two very short numbers (improved by Nathan Zook) - # works also if xv and yv are the same reference, and handles also $x == 0 if (($xv->[0] *= $yv->[0]) >= $BASE) { - $xv->[0] = - $xv->[0] - ($xv->[1] = int($xv->[0] / $BASE)) * $BASE; + my $rem = $xv->[0] % $BASE; + $xv->[1] = ($xv->[0] - $rem) / $BASE; + $xv->[0] = $rem; } - ; return $xv; } # $x * 0 => 0 @@ -552,42 +537,44 @@ sub _mul_use_div { @$xv = (0); return $xv; } + # multiply a large number a by a single element one, so speed up my $y = $yv->[0]; my $car = 0; + my $rem; foreach my $i (@$xv) { $i = $i * $y + $car; - $car = int($i / $BASE); - $i -= $car * $BASE; - # This (together with use integer;) does not work on 32-bit Perls - #$i = $i * $y + $car; $i -= ($car = $i / $BASE) * $BASE; + $rem = $i % $BASE; + $car = ($i - $rem) / $BASE; + $i = $rem; } push @$xv, $car if $car != 0; return $xv; } + # shortcut for result $x == 0 => result = 0 - return $xv if ( ((@$xv == 1) && ($xv->[0] == 0)) ); + return $xv if @$xv == 1 && $xv->[0] == 0; # since multiplying $x with $x fails, make copy in this case - $yv = $c->_copy($xv) if $xv == $yv; # same references? + $yv = $c->_copy($xv) if $xv == $yv; # same references? my @prod = (); - my ($prod, $car, $cty, $xi, $yi); + my ($prod, $rem, $car, $cty, $xi, $yi); for $xi (@$xv) { $car = 0; $cty = 0; # looping through this if $xi == 0 is silly - so optimize it away! - $xi = (shift @prod || 0), next if $xi == 0; + $xi = (shift(@prod) || 0), next if $xi == 0; for $yi (@$yv) { $prod = $xi * $yi + ($prod[$cty] || 0) + $car; - $prod[$cty++] = $prod - ($car = int($prod / $BASE)) * $BASE; + $rem = $prod % $BASE; + $car = ($prod - $rem) / $BASE; + $prod[$cty++] = $rem; } - $prod[$cty] += $car if $car; # need really to check for 0? - $xi = shift @prod || 0; # || 0 makes v5.005_3 happy + $prod[$cty] += $car if $car; # need really to check for 0? + $xi = shift(@prod) || 0; # || 0 makes v5.005_3 happy } push @$xv, @prod; - # can't have leading zeros - # __strip_zeros($xv); $xv; } @@ -595,28 +582,19 @@ sub _div_use_mul { # ref to array, ref to array, modify first array and return remainder if # in list context - # see comments in _div_use_div() for more explanations - my ($c, $x, $yorg) = @_; # the general div algorithm here is about O(N*N) and thus quite slow, so # we first check for some special cases and use shortcuts to handle them. - # This works, because we store the numbers in a chunked format where each - # element contains 5..7 digits (depending on system). - # if both numbers have only one element: if (@$x == 1 && @$yorg == 1) { # shortcut, $yorg and $x are two small numbers - if (wantarray) { - my $rem = [ $x->[0] % $yorg->[0] ]; - bless $rem, $c; - $x->[0] = int($x->[0] / $yorg->[0]); - return ($x, $rem); - } else { - $x->[0] = int($x->[0] / $yorg->[0]); - return $x; - } + my $rem = [ $x->[0] % $yorg->[0] ]; + bless $rem, $c; + $x->[0] = ($x->[0] - $rem->[0]) / $yorg->[0]; + return ($x, $rem) if wantarray; + return $x; } # if x has more than one, but y has only one element: @@ -631,120 +609,120 @@ sub _div_use_mul { my $b; while ($j-- > 0) { $b = $r * $BASE + $x->[$j]; - $x->[$j] = int($b/$y); $r = $b % $y; + $x->[$j] = ($b - $r) / $y; } - pop @$x if @$x > 1 && $x->[-1] == 0; # splice up a leading zero + pop(@$x) if @$x > 1 && $x->[-1] == 0; # remove any trailing zero return ($x, $rem) if wantarray; return $x; } # now x and y have more than one element - # check whether y has more elements than x, if yet, the result will be 0 + # check whether y has more elements than x, if so, the result is 0 if (@$yorg > @$x) { my $rem; - $rem = $c->_copy($x) if wantarray; # make copy - @$x = 0; # set to 0 - return ($x, $rem) if wantarray; # including remainder? - return $x; # only x, which is [0] now + $rem = $c->_copy($x) if wantarray; # make copy + @$x = 0; # set to 0 + return ($x, $rem) if wantarray; # including remainder? + return $x; # only x, which is [0] now } + # check whether the numbers have the same number of elements, in that case # the result will fit into one element and can be computed efficiently if (@$yorg == @$x) { + my $cmp = 0; + for (my $j = $#$x ; $j >= 0 ; --$j) { + last if $cmp = $x->[$j] - $yorg->[$j]; + } - # if $yorg has more digits than $x (it's leading element is longer than - # the one from $x), the result will also be 0: - if (length(int($yorg->[-1])) > length(int($x->[-1]))) { - my $rem = $c->_copy($x) if wantarray; # make copy - @$x = 0; # set to 0 - return ($x, $rem) if wantarray; # including remainder? + if ($cmp == 0) { # x = y + @$x = 1; + return $x, $c->_zero() if wantarray; return $x; } - # now calculate $x / $yorg - if (length(int($yorg->[-1])) == length(int($x->[-1]))) { - # same length, so make full compare - my $a = 0; - my $j = @$x - 1; - # manual way (abort if unequal, good for early ne) - while ($j >= 0) { - last if ($a = $x->[$j] - $yorg->[$j]); - $j--; - } - # $a contains the result of the compare between X and Y - # a < 0: x < y, a == 0: x == y, a > 0: x > y - if ($a <= 0) { - # a = 0 => x == y => rem 0 - # a < 0 => x < y => rem = x - my $rem = $a == 0 ? $c->_zero() : $c->_copy($x); - @$x = 0; # if $a < 0 - $x->[0] = 1 if $a == 0; # $x == $y - return ($x, $rem) if wantarray; - return $x; + if ($cmp < 0) { # x < y + if (wantarray) { + my $rem = $c->_copy($x); + @$x = 0; + return $x, $rem; } - # $x >= $y, so proceed normally + @$x = 0; + return $x; } } # all other cases: - my $y = $c->_copy($yorg); # always make copy to preserve + my $y = $c->_copy($yorg); # always make copy to preserve - my ($car, $bar, $prd, $dd, $xi, $yi, @q, $v2, $v1, $tmp, $q, $u2, $u1, $u0); - - $car = $bar = $prd = 0; - if (($dd = int($BASE / ($y->[-1] + 1))) != 1) { - for $xi (@$x) { + my $tmp = $y->[-1] + 1; + my $rem = $BASE % $tmp; + my $dd = ($BASE - $rem) / $tmp; + if ($dd != 1) { + my $car = 0; + for my $xi (@$x) { $xi = $xi * $dd + $car; - $xi -= ($car = int($xi * $RBASE)) * $BASE; # see USE_MUL + $xi -= ($car = int($xi * $RBASE)) * $BASE; # see USE_MUL } push(@$x, $car); $car = 0; - for $yi (@$y) { + for my $yi (@$y) { $yi = $yi * $dd + $car; - $yi -= ($car = int($yi * $RBASE)) * $BASE; # see USE_MUL + $yi -= ($car = int($yi * $RBASE)) * $BASE; # see USE_MUL } } else { push(@$x, 0); } - @q = (); - ($v2, $v1) = @$y[-2, -1]; + + # @q will accumulate the final result, $q contains the current computed + # part of the final result + + my @q = (); + my ($v2, $v1) = @$y[-2, -1]; $v2 = 0 unless $v2; while ($#$x > $#$y) { - ($u2, $u1, $u0) = @$x[-3 .. -1]; + my ($u2, $u1, $u0) = @$x[-3 .. -1]; $u2 = 0 unless $u2; #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n" # if $v1 == 0; - $q = (($u0 == $v1) ? $MAX_VAL : int(($u0 * $BASE + $u1) / $v1)); - --$q while ($v2 * $q > ($u0 * $BASE + $u1 - $q * $v1) * $BASE + $u2); + my $tmp = $u0 * $BASE + $u1; + my $rem = $tmp % $v1; + my $q = $u0 == $v1 ? $MAX_VAL : (($tmp - $rem) / $v1); + --$q while $v2 * $q > ($u0 * $BASE + $u1 - $q * $v1) * $BASE + $u2; if ($q) { - ($car, $bar) = (0, 0); - for ($yi = 0, $xi = $#$x - $#$y-1; $yi <= $#$y; ++$yi, ++$xi) { + my $prd; + my ($car, $bar) = (0, 0); + for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) { $prd = $q * $y->[$yi] + $car; - $prd -= ($car = int($prd * $RBASE)) * $BASE; # see USE_MUL - $x->[$xi] += $BASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0)); + $prd -= ($car = int($prd * $RBASE)) * $BASE; # see USE_MUL + $x->[$xi] += $BASE if $bar = (($x->[$xi] -= $prd + $bar) < 0); } if ($x->[-1] < $car + $bar) { $car = 0; --$q; - for ($yi = 0, $xi = $#$x - $#$y-1; $yi <= $#$y; ++$yi, ++$xi) { + for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) { $x->[$xi] -= $BASE - if ($car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE)); + if $car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE); } } } pop(@$x); unshift(@q, $q); } + if (wantarray) { my $d = bless [], $c; if ($dd != 1) { - $car = 0; - for $xi (reverse @$x) { + my $car = 0; + my ($prd, $rem); + for my $xi (reverse @$x) { $prd = $car * $BASE + $xi; - $car = $prd - ($tmp = int($prd / $dd)) * $dd; # see USE_MUL - unshift(@$d, $tmp); + $rem = $prd % $dd; + $tmp = ($prd - $rem) / $dd; + $car = $rem; + unshift @$d, $tmp; } } else { @$d = @$x; @@ -762,29 +740,29 @@ sub _div_use_mul { sub _div_use_div_64 { # ref to array, ref to array, modify first array and return remainder if # in list context - # This version works on 64 bit integers - my ($c, $x, $yorg) = @_; + # This version works on integers use integer; + + my ($c, $x, $yorg) = @_; + # the general div algorithm here is about O(N*N) and thus quite slow, so # we first check for some special cases and use shortcuts to handle them. - # This works, because we store the numbers in a chunked format where each - # element contains 5..7 digits (depending on system). - # if both numbers have only one element: if (@$x == 1 && @$yorg == 1) { # shortcut, $yorg and $x are two small numbers if (wantarray) { my $rem = [ $x->[0] % $yorg->[0] ]; bless $rem, $c; - $x->[0] = int($x->[0] / $yorg->[0]); + $x->[0] = $x->[0] / $yorg->[0]; return ($x, $rem); } else { - $x->[0] = int($x->[0] / $yorg->[0]); + $x->[0] = $x->[0] / $yorg->[0]; return $x; } } + # if x has more than one, but y has only one element: if (@$yorg == 1) { my $rem; @@ -797,78 +775,67 @@ sub _div_use_div_64 { my $b; while ($j-- > 0) { $b = $r * $BASE + $x->[$j]; - $x->[$j] = int($b/$y); $r = $b % $y; + $x->[$j] = $b / $y; } - pop @$x if @$x > 1 && $x->[-1] == 0; # splice up a leading zero + pop(@$x) if @$x > 1 && $x->[-1] == 0; # remove any trailing zero return ($x, $rem) if wantarray; return $x; } + # now x and y have more than one element - # check whether y has more elements than x, if yet, the result will be 0 + # check whether y has more elements than x, if so, the result is 0 if (@$yorg > @$x) { my $rem; - $rem = $c->_copy($x) if wantarray; # make copy - @$x = 0; # set to 0 - return ($x, $rem) if wantarray; # including remainder? - return $x; # only x, which is [0] now + $rem = $c->_copy($x) if wantarray; # make copy + @$x = 0; # set to 0 + return ($x, $rem) if wantarray; # including remainder? + return $x; # only x, which is [0] now } + # check whether the numbers have the same number of elements, in that case # the result will fit into one element and can be computed efficiently if (@$yorg == @$x) { - my $rem; - # if $yorg has more digits than $x (it's leading element is longer than - # the one from $x), the result will also be 0: - if (length(int($yorg->[-1])) > length(int($x->[-1]))) { - $rem = $c->_copy($x) if wantarray; # make copy - @$x = 0; # set to 0 - return ($x, $rem) if wantarray; # including remainder? - return $x; + my $cmp = 0; + for (my $j = $#$x ; $j >= 0 ; --$j) { + last if $cmp = $x->[$j] - $yorg->[$j]; } - # now calculate $x / $yorg - if (length(int($yorg->[-1])) == length(int($x->[-1]))) { - # same length, so make full compare + if ($cmp == 0) { # x = y + @$x = 1; + return $x, $c->_zero() if wantarray; + return $x; + } - my $a = 0; - my $j = @$x - 1; - # manual way (abort if unequal, good for early ne) - while ($j >= 0) { - last if ($a = $x->[$j] - $yorg->[$j]); - $j--; - } - # $a contains the result of the compare between X and Y - # a < 0: x < y, a == 0: x == y, a > 0: x > y - if ($a <= 0) { - $rem = $c->_zero(); # a = 0 => x == y => rem 0 - $rem = $c->_copy($x) if $a != 0; # a < 0 => x < y => rem = x - @$x = 0; # if $a < 0 - $x->[0] = 1 if $a == 0; # $x == $y - return ($x, $rem) if wantarray; # including remainder? - return $x; + if ($cmp < 0) { # x < y + if (wantarray) { + my $rem = $c->_copy($x); + @$x = 0; + return $x, $rem; } - # $x >= $y, so proceed normally + @$x = 0; + return $x; } } # all other cases: - my $y = $c->_copy($yorg); # always make copy to preserve - - my ($car, $bar, $prd, $dd, $xi, $yi, @q, $v2, $v1, $tmp, $q, $u2, $u1, $u0); + my $y = $c->_copy($yorg); # always make copy to preserve - $car = $bar = $prd = 0; - if (($dd = int($BASE / ($y->[-1] + 1))) != 1) { - for $xi (@$x) { + my $tmp; + my $dd = $BASE / ($y->[-1] + 1); + if ($dd != 1) { + my $car = 0; + for my $xi (@$x) { $xi = $xi * $dd + $car; - $xi -= ($car = int($xi / $BASE)) * $BASE; + $xi -= ($car = $xi / $BASE) * $BASE; } push(@$x, $car); $car = 0; - for $yi (@$y) { + for my $yi (@$y) { $yi = $yi * $dd + $car; - $yi -= ($car = int($yi / $BASE)) * $BASE; + $yi -= ($car = $yi / $BASE) * $BASE; } } else { push(@$x, 0); @@ -877,43 +844,48 @@ sub _div_use_div_64 { # @q will accumulate the final result, $q contains the current computed # part of the final result - @q = (); - ($v2, $v1) = @$y[-2, -1]; + my @q = (); + my ($v2, $v1) = @$y[-2, -1]; $v2 = 0 unless $v2; while ($#$x > $#$y) { - ($u2, $u1, $u0) = @$x[-3..-1]; + my ($u2, $u1, $u0) = @$x[-3 .. -1]; $u2 = 0 unless $u2; #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n" # if $v1 == 0; - $q = (($u0 == $v1) ? $MAX_VAL : int(($u0 * $BASE + $u1) / $v1)); - --$q while ($v2 * $q > ($u0 * $BASE +$ u1- $q*$v1) * $BASE + $u2); + my $tmp = $u0 * $BASE + $u1; + my $rem = $tmp % $v1; + my $q = $u0 == $v1 ? $MAX_VAL : (($tmp - $rem) / $v1); + --$q while $v2 * $q > ($u0 * $BASE + $u1 - $q * $v1) * $BASE + $u2; if ($q) { - ($car, $bar) = (0, 0); - for ($yi = 0, $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) { + my $prd; + my ($car, $bar) = (0, 0); + for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) { $prd = $q * $y->[$yi] + $car; $prd -= ($car = int($prd / $BASE)) * $BASE; - $x->[$xi] += $BASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0)); + $x->[$xi] += $BASE if $bar = (($x->[$xi] -= $prd + $bar) < 0); } if ($x->[-1] < $car + $bar) { $car = 0; --$q; - for ($yi = 0, $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) { + for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) { $x->[$xi] -= $BASE - if ($car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE)); + if $car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE); } } } pop(@$x); unshift(@q, $q); } + if (wantarray) { my $d = bless [], $c; if ($dd != 1) { - $car = 0; - for $xi (reverse @$x) { + my $car = 0; + my $prd; + for my $xi (reverse @$x) { $prd = $car * $BASE + $xi; - $car = $prd - ($tmp = int($prd / $dd)) * $dd; - unshift(@$d, $tmp); + $car = $prd - ($tmp = $prd / $dd) * $dd; + unshift @$d, $tmp; } } else { @$d = @$x; @@ -931,27 +903,22 @@ sub _div_use_div_64 { sub _div_use_div { # ref to array, ref to array, modify first array and return remainder if # in list context + my ($c, $x, $yorg) = @_; # the general div algorithm here is about O(N*N) and thus quite slow, so # we first check for some special cases and use shortcuts to handle them. - # This works, because we store the numbers in a chunked format where each - # element contains 5..7 digits (depending on system). - # if both numbers have only one element: if (@$x == 1 && @$yorg == 1) { # shortcut, $yorg and $x are two small numbers - if (wantarray) { - my $rem = [ $x->[0] % $yorg->[0] ]; - bless $rem, $c; - $x->[0] = int($x->[0] / $yorg->[0]); - return ($x, $rem); - } else { - $x->[0] = int($x->[0] / $yorg->[0]); - return $x; - } + my $rem = [ $x->[0] % $yorg->[0] ]; + bless $rem, $c; + $x->[0] = ($x->[0] - $rem->[0]) / $yorg->[0]; + return ($x, $rem) if wantarray; + return $x; } + # if x has more than one, but y has only one element: if (@$yorg == 1) { my $rem; @@ -964,80 +931,72 @@ sub _div_use_div { my $b; while ($j-- > 0) { $b = $r * $BASE + $x->[$j]; - $x->[$j] = int($b/$y); $r = $b % $y; + $x->[$j] = ($b - $r) / $y; } - pop @$x if @$x > 1 && $x->[-1] == 0; # splice up a leading zero + pop(@$x) if @$x > 1 && $x->[-1] == 0; # remove any trailing zero return ($x, $rem) if wantarray; return $x; } + # now x and y have more than one element - # check whether y has more elements than x, if yet, the result will be 0 + # check whether y has more elements than x, if so, the result is 0 if (@$yorg > @$x) { my $rem; - $rem = $c->_copy($x) if wantarray; # make copy - @$x = 0; # set to 0 - return ($x, $rem) if wantarray; # including remainder? - return $x; # only x, which is [0] now + $rem = $c->_copy($x) if wantarray; # make copy + @$x = 0; # set to 0 + return ($x, $rem) if wantarray; # including remainder? + return $x; # only x, which is [0] now } + # check whether the numbers have the same number of elements, in that case # the result will fit into one element and can be computed efficiently if (@$yorg == @$x) { - my $rem; - # if $yorg has more digits than $x (it's leading element is longer than - # the one from $x), the result will also be 0: - if (length(int($yorg->[-1])) > length(int($x->[-1]))) { - $rem = $c->_copy($x) if wantarray; # make copy - @$x = 0; # set to 0 - return ($x, $rem) if wantarray; # including remainder? - return $x; + my $cmp = 0; + for (my $j = $#$x ; $j >= 0 ; --$j) { + last if $cmp = $x->[$j] - $yorg->[$j]; } - # now calculate $x / $yorg - if (length(int($yorg->[-1])) == length(int($x->[-1]))) { - # same length, so make full compare + if ($cmp == 0) { # x = y + @$x = 1; + return $x, $c->_zero() if wantarray; + return $x; + } - my $a = 0; - my $j = @$x - 1; - # manual way (abort if unequal, good for early ne) - while ($j >= 0) { - last if ($a = $x->[$j] - $yorg->[$j]); - $j--; - } - # $a contains the result of the compare between X and Y - # a < 0: x < y, a == 0: x == y, a > 0: x > y - if ($a <= 0) { - $rem = $c->_zero(); # a = 0 => x == y => rem 0 - $rem = $c->_copy($x) if $a != 0; # a < 0 => x < y => rem = x + if ($cmp < 0) { # x < y + if (wantarray) { + my $rem = $c->_copy($x); @$x = 0; - $x->[0] = 0; # if $a < 0 - $x->[0] = 1 if $a == 0; # $x == $y - return ($x, $rem) if wantarray; # including remainder? - return $x; + return $x, $rem; } - # $x >= $y, so proceed normally - + @$x = 0; + return $x; } } # all other cases: - my $y = $c->_copy($yorg); # always make copy to preserve - - my ($car, $bar, $prd, $dd, $xi, $yi, @q, $v2, $v1, @d, $tmp, $q, $u2, $u1, $u0); + my $y = $c->_copy($yorg); # always make copy to preserve - $car = $bar = $prd = 0; - if (($dd = int($BASE / ($y->[-1] + 1))) != 1) { - for $xi (@$x) { + my $tmp = $y->[-1] + 1; + my $rem = $BASE % $tmp; + my $dd = ($BASE - $rem) / $tmp; + if ($dd != 1) { + my $car = 0; + for my $xi (@$x) { $xi = $xi * $dd + $car; - $xi -= ($car = int($xi / $BASE)) * $BASE; + $rem = $xi % $BASE; + $car = ($xi - $rem) / $BASE; + $xi = $rem; } push(@$x, $car); $car = 0; - for $yi (@$y) { + for my $yi (@$y) { $yi = $yi * $dd + $car; - $yi -= ($car = int($yi / $BASE)) * $BASE; + $rem = $yi % $BASE; + $car = ($yi - $rem) / $BASE; + $yi = $rem; } } else { push(@$x, 0); @@ -1046,43 +1005,52 @@ sub _div_use_div { # @q will accumulate the final result, $q contains the current computed # part of the final result - @q = (); - ($v2, $v1) = @$y[-2, -1]; + my @q = (); + my ($v2, $v1) = @$y[-2, -1]; $v2 = 0 unless $v2; while ($#$x > $#$y) { - ($u2, $u1, $u0) = @$x[-3..-1]; + my ($u2, $u1, $u0) = @$x[-3 .. -1]; $u2 = 0 unless $u2; #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n" # if $v1 == 0; - $q = (($u0 == $v1) ? $MAX_VAL : int(($u0 * $BASE + $u1) / $v1)); - --$q while ($v2 * $q > ($u0 * $BASE + $u1 - $q * $v1) * $BASE + $u2); + my $tmp = $u0 * $BASE + $u1; + my $rem = $tmp % $v1; + my $q = $u0 == $v1 ? $MAX_VAL : (($tmp - $rem) / $v1); + --$q while $v2 * $q > ($u0 * $BASE + $u1 - $q * $v1) * $BASE + $u2; if ($q) { - ($car, $bar) = (0, 0); - for ($yi = 0, $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) { + my $prd; + my ($car, $bar) = (0, 0); + for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) { $prd = $q * $y->[$yi] + $car; - $prd -= ($car = int($prd / $BASE)) * $BASE; - $x->[$xi] += $BASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0)); + $rem = $prd % $BASE; + $car = ($prd - $rem) / $BASE; + $prd -= $car * $BASE; + $x->[$xi] += $BASE if $bar = (($x->[$xi] -= $prd + $bar) < 0); } if ($x->[-1] < $car + $bar) { $car = 0; --$q; - for ($yi = 0, $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) { + for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) { $x->[$xi] -= $BASE - if ($car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE)); + if $car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE); } } } pop(@$x); unshift(@q, $q); } + if (wantarray) { my $d = bless [], $c; if ($dd != 1) { - $car = 0; - for $xi (reverse @$x) { + my $car = 0; + my ($prd, $rem); + for my $xi (reverse @$x) { $prd = $car * $BASE + $xi; - $car = $prd - ($tmp = int($prd / $dd)) * $dd; - unshift(@$d, $tmp); + $rem = $prd % $dd; + $tmp = ($prd - $rem) / $dd; + $car = $rem; + unshift @$d, $tmp; } } else { @$d = @$x; @@ -1385,7 +1353,7 @@ sub _rsft { $dst++; } splice(@$x, $dst) if $dst > 0; # kill left-over array elems - pop @$x if $x->[-1] == 0 && @$x > 1; # kill last element if 0 + pop(@$x) if $x->[-1] == 0 && @$x > 1; # kill last element if 0 } # else rem == 0 $x; } @@ -1393,49 +1361,64 @@ sub _rsft { sub _lsft { my ($c, $x, $n, $b) = @_; - return $x if $c->_is_zero($x); - - # Handle the special case when the base is a power of 10. Don't check - # whether log($b)/log(10) is an integer, because log(1000)/log(10) is not - # exactly 3. - - my $log10 = sprintf "%.0f", log($b) / log(10); - if ($b == 10 ** $log10) { - $b = 10; - $n = $c->_mul($n, $c->_new($log10)); - - # shortcut (faster) for shifting by 10) since we are in base 10eX - # multiples of $BASE_LEN: - my $src = @$x; # source - my $len = $c->_num($n); # shift-len as normal int - my $rem = $len % $BASE_LEN; # remainder to shift - my $dst = $src + int($len / $BASE_LEN); # destination - my $vd; # further speedup - $x->[$src] = 0; # avoid first ||0 for speed - my $z = '0' x $BASE_LEN; - while ($src >= 0) { - $vd = $x->[$src]; - $vd = $z . $vd; - $vd = substr($vd, -$BASE_LEN + $rem, $BASE_LEN - $rem); - $vd .= $src > 0 ? substr($z . $x->[$src - 1], -$BASE_LEN, $rem) - : '0' x $rem; - $vd = substr($vd, -$BASE_LEN, $BASE_LEN) if length($vd) > $BASE_LEN; - $x->[$dst] = int($vd); - $dst--; - $src--; + return $x if $c->_is_zero($x) || $c->_is_zero($n); + + # For backwards compatibility, allow the base $b to be a scalar. + + $b = $c->_new($b) unless ref $b; + + # If the base is a power of 10, use shifting, since the internal + # representation is in base 10eX. + + my $bstr = $c->_str($b); + if ($bstr =~ /^1(0+)\z/) { + + # Adjust $n so that we're shifting in base 10. Do this by multiplying + # $n by the base 10 logarithm of $b: $b ** $n = 10 ** (log10($b) * $n). + + my $log10b = length($1); + $n = $c->_mul($c->_new($log10b), $n); + $n = $c->_num($n); # shift-len as normal int + + # $q is the number of places to shift the elements within the array, + # and $r is the number of places to shift the values within the + # elements. + + my $r = $n % $BASE_LEN; + my $q = ($n - $r) / $BASE_LEN; + + # If we must shift the values within the elements ... + + if ($r) { + my $i = @$x; # index + $x->[$i] = 0; # initialize most significant element + my $z = '0' x $BASE_LEN; + my $vd; + while ($i >= 0) { + $vd = $x->[$i]; + $vd = $z . $vd; + $vd = substr($vd, $r - $BASE_LEN, $BASE_LEN - $r); + $vd .= $i > 0 ? substr($z . $x->[$i - 1], -$BASE_LEN, $r) + : '0' x $r; + $vd = substr($vd, -$BASE_LEN, $BASE_LEN) if length($vd) > $BASE_LEN; + $x->[$i] = int($vd); # e.g., "0...048" -> 48 etc. + $i--; + } + + pop(@$x) if $x->[-1] == 0; # if most significant element is zero } - # set lowest parts to 0 - while ($dst >= 0) { - $x->[$dst--] = 0; + + # If we must shift the elements within the array ... + + if ($q) { + unshift @$x, (0) x $q; } - # fix spurious last zero element - splice @$x, -1 if $x->[-1] == 0; - return $x; + } else { - $b = $c->_new($b); - #print $c->_str($b); - return $c->_mul($x, $c->_pow($b, $n)); + $x = $c->_mul($x, $c->_pow($b, $n)); } + + return $x; } sub _pow { |