use vars qw/$VERSION/;
-$VERSION = '0.38';
+$VERSION = '0.40';
# Package to store unsigned big integers in decimal and do math with them
##############################################################################
# global constants, flags and accessory
+
+# announce that we are compatible with MBI v1.70 and up
+sub api_version () { 1; }
# constants for easier life
my $nan = 'NaN';
$RBASE = abs('1e-'.$BASE_LEN_SMALL); # see USE_MUL
$MAX_VAL = $MBASE-1;
- #print "BASE_LEN: $BASE_LEN MAX_VAL: $MAX_VAL BASE: $BASE RBASE: $RBASE ";
- #print "BASE_LEN_SMALL: $BASE_LEN_SMALL MBASE: $MBASE\n";
-
undef &_mul;
undef &_div;
# & here.
if ($caught == 2) # 2
{
- # print "# use mul\n";
# must USE_MUL since we cannot use DIV
*{_mul} = \&_mul_use_mul;
*{_div} = \&_div_use_mul;
}
else # 0 or 1
{
- # print "# use div\n";
# can USE_DIV instead
*{_mul} = \&_mul_use_div;
*{_div} = \&_div_use_div;
# (ref to string) return ref to num_array
# Convert a number from string format (without sign) to internal base
# 1ex format. Assumes normalized value as input.
- my $d = $_[1];
- my $il = length($$d)-1;
+ my $il = length($_[1])-1;
# < BASE_LEN due len-1 above
- return [ int($$d) ] if $il < $BASE_LEN; # shortcut for short numbers
+ return [ int($_[1]) ] if $il < $BASE_LEN; # shortcut for short numbers
# this leaves '00000' instead of int 0 and will be corrected after any op
[ reverse(unpack("a" . ($il % $BASE_LEN+1)
- . ("a$BASE_LEN" x ($il / $BASE_LEN)), $$d)) ];
+ . ("a$BASE_LEN" x ($il / $BASE_LEN)), $_[1])) ];
}
BEGIN
{
- $AND_MASK = __PACKAGE__->_new( \( 2 ** $AND_BITS ));
- $XOR_MASK = __PACKAGE__->_new( \( 2 ** $XOR_BITS ));
- $OR_MASK = __PACKAGE__->_new( \( 2 ** $OR_BITS ));
+ $AND_MASK = __PACKAGE__->_new( ( 2 ** $AND_BITS ));
+ $XOR_MASK = __PACKAGE__->_new( ( 2 ** $XOR_BITS ));
+ $OR_MASK = __PACKAGE__->_new( ( 2 ** $OR_BITS ));
}
sub _zero
[ 2 ];
}
+sub _ten
+ {
+ # create a 10 (used internally for shifting)
+ [ 10 ];
+ }
+
sub _copy
{
# make a true copy
$ret .= substr($z.$ar->[$l],-$BASE_LEN); # fastest way I could think of
$l--;
}
- \$ret;
+ $ret;
}
sub _num
{
- # Make a number (scalar int/float) from a BigInt object
+ # Make a number (scalar int/float) from a BigInt object
my $x = $_[1];
- return $x->[0] if scalar @$x == 1; # below $BASE
+
+ return 0+$x->[0] if scalar @$x == 1; # below $BASE
my $fac = 1;
my $num = 0;
foreach (@$x)
my $car = 0; my $i; my $j = 0;
if (!$s)
{
- #print "case 2\n";
for $i (@$sx)
{
last unless defined $sy->[$j] || $car;
# might leave leading zeros, so fix that
return __strip_zeros($sx);
}
- #print "case 1 (swap)\n";
for $i (@$sx)
{
# we can't do an early out if $x is < than $y, since we
# check each array elem in _m for having 0 at end as long as elem == 0
# Upon finding a elem != 0, stop
my $x = $_[1];
+
+ return 0 if scalar @$x == 1 && $x->[0] == 0;
+
my $zeros = 0; my $elem;
foreach my $e (@$x)
{
sub _is_zero
{
- # return true if arg (BINT or num_str) is zero (array '+', '0')
- my $x = $_[1];
-
- (((scalar @$x == 1) && ($x->[0] == 0))) <=> 0;
+ # return true if arg is zero
+ (((scalar @{$_[1]} == 1) && ($_[1]->[0] == 0))) <=> 0;
}
sub _is_even
{
- # return true if arg (BINT or num_str) is even
- my $x = $_[1];
- (!($x->[0] & 1)) <=> 0;
+ # return true if arg is even
+ (!($_[1]->[0] & 1)) <=> 0;
}
sub _is_odd
{
- # return true if arg (BINT or num_str) is even
- my $x = $_[1];
-
- (($x->[0] & 1)) <=> 0;
+ # return true if arg is even
+ (($_[1]->[0] & 1)) <=> 0;
}
sub _is_one
{
- # return true if arg (BINT or num_str) is one (array '+', '1')
- my $x = $_[1];
+ # return true if arg is one
+ (scalar @{$_[1]} == 1) && ($_[1]->[0] == 1) <=> 0;
+ }
+
+sub _is_two
+ {
+ # return true if arg is two
+ (scalar @{$_[1]} == 1) && ($_[1]->[0] == 2) <=> 0;
+ }
- (scalar @$x == 1) && ($x->[0] == 1) <=> 0;
+sub _is_ten
+ {
+ # return true if arg is ten
+ (scalar @{$_[1]} == 1) && ($_[1]->[0] == 10) <=> 0;
}
sub __strip_zeros
###############################################################################
-###############################################################################
-# some optional routines to make BigInt faster
sub _mod
{
if ($n != 10)
{
- $n = _new($c,\$n); return _div($c,$x, _pow($c,$n,$y));
+ $n = _new($c,$n); return _div($c,$x, _pow($c,$n,$y));
}
# shortcut (faster) for shifting by 10)
if ($n != 10)
{
- $n = _new($c,\$n); return _mul($c,$x, _pow($c,$n,$y));
+ $n = _new($c,$n); return _mul($c,$x, _pow($c,$n,$y));
}
# shortcut (faster) for shifting by 10) since we are in base 10eX
my $pow2 = _one();
- my $y_bin = ${_as_bin($c,$cy)}; $y_bin =~ s/^0b//;
+ my $y_bin = _as_bin($c,$cy); $y_bin =~ s/^0b//;
my $len = length($y_bin);
while (--$len > 0)
{
$cx; # return result
}
+#############################################################################
+
sub _log_int
{
# calculate integer log of $x to base $base
my $a;
my $base_mul = _mul($c, _copy($c,$base), $base);
- while (($a = _acmp($x,$trial,$x_org)) < 0)
+ while (($a = _acmp($c,$trial,$x_org)) < 0)
{
_mul($c,$trial,$base_mul); _add($c, $x, [2]);
}
# overstepped the result
_dec($c, $x);
_div($c,$trial,$base);
- $a = _acmp($x,$trial,$x_org);
+ $a = _acmp($c,$trial,$x_org);
if ($a > 0)
{
_dec($c, $x);
# an even better guess. Not implemented yet. Does it improve performance?
$x->[$l--] = 0 while ($l >= 0); # all other digits of guess are zero
- print "start x= ",${_str($c,$x)},"\n" if DEBUG;
+ print "start x= ",_str($c,$x),"\n" if DEBUG;
my $two = _two();
my $last = _zero();
my $lastlast = _zero();
$last = _copy($c,$x);
_add($c,$x, _div($c,_copy($c,$y),$x));
_div($c,$x, $two );
- print " x= ",${_str($c,$x)},"\n" if DEBUG;
+ print " x= ",_str($c,$x),"\n" if DEBUG;
}
print "\nsteps in sqrt: $steps, " if DEBUG;
_dec($c,$x) if _acmp($c,$y,_mul($c,_copy($c,$x),$x)) < 0; # overshot?
# if $n is a power of two, we can repeatedly take sqrt($X) and find the
# proper result, because sqrt(sqrt($x)) == root($x,4)
my $b = _as_bin($c,$n);
- if ($$b =~ /0b1(0+)$/)
+ if ($b =~ /0b1(0+)$/)
{
my $count = CORE::length($1); # 0b100 => len('00') => 2
my $cnt = $count; # counter for loop
($y1, $yr) = _div($c,$y1,$mask);
# make ints() from $xr, $yr
- # this is when the AND_BITS are greater tahn $BASE and is slower for
+ # this is when the AND_BITS are greater than $BASE and is slower for
# small (<256 bits) numbers, but faster for large numbers. Disabled
# due to KISS principle
# $b = 1; $xrr = 0; foreach (@$xr) { $xrr += $_ * $b; $b *= $BASE; }
# $b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; }
-# _add($c,$x, _mul($c, _new( $c, \($xrr & $yrr) ), $m) );
+# _add($c,$x, _mul($c, _new( $c, ($xrr & $yrr) ), $m) );
# 0+ due to '&' doesn't work in strings
_add($c,$x, _mul($c, [ 0+$xr->[0] & 0+$yr->[0] ], $m) );
# make ints() from $xr, $yr (see _and())
#$b = 1; $xrr = 0; foreach (@$xr) { $xrr += $_ * $b; $b *= $BASE; }
#$b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; }
- #_add($c,$x, _mul($c, _new( $c, \($xrr ^ $yrr) ), $m) );
+ #_add($c,$x, _mul($c, _new( $c, ($xrr ^ $yrr) ), $m) );
# 0+ due to '^' doesn't work in strings
_add($c,$x, _mul($c, [ 0+$xr->[0] ^ 0+$yr->[0] ], $m) );
# make ints() from $xr, $yr (see _and())
# $b = 1; $xrr = 0; foreach (@$xr) { $xrr += $_ * $b; $b *= $BASE; }
# $b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; }
-# _add($c,$x, _mul($c, _new( $c, \($xrr | $yrr) ), $m) );
+# _add($c,$x, _mul($c, _new( $c, ($xrr | $yrr) ), $m) );
# 0+ due to '|' doesn't work in strings
_add($c,$x, _mul($c, [ 0+$xr->[0] | 0+$yr->[0] ], $m) );
if (@$x == 1)
{
my $t = sprintf("0x%x",$x->[0]);
- return \$t;
+ return $t;
}
my $x1 = _copy($c,$x);
$es = reverse $es;
$es =~ s/^[0]+//; # strip leading zeros
$es = '0x' . $es;
- \$es;
+ $es;
}
sub _as_bin
# handle zero case for older Perls
if ($] <= 5.005 && @$x == 1 && $x->[0] == 0)
{
- my $t = '0b0'; return \$t;
+ my $t = '0b0'; return $t;
}
if (@$x == 1 && $] >= 5.006)
{
my $t = sprintf("0b%b",$x->[0]);
- return \$t;
+ return $t;
}
my $x1 = _copy($c,$x);
$es = reverse $es;
$es =~ s/^[0]+//; # strip leading zeros
$es = '0b' . $es;
- \$es;
+ $es;
}
sub _from_hex
my $m = [ 0x10000 ]; # 16 bit at a time
my $x = _zero();
- my $len = length($$hs)-2;
+ my $len = length($hs)-2;
$len = int($len/4); # 4-digit parts, w/o '0x'
my $val; my $i = -4;
while ($len >= 0)
{
- $val = substr($$hs,$i,4);
+ $val = substr($hs,$i,4);
$val =~ s/^[+-]?0x// if $len == 0; # for last part only because
$val = hex($val); # hex does not like wrong chars
$i -= 4; $len --;
# instead of converting X (8) bit at a time, it is faster to "convert" the
# number to hex, and then call _from_hex.
- my $hs = $$bs;
+ my $hs = $bs;
$hs =~ s/^[+-]?0b//; # remove sign and 0b
my $l = length($hs); # bits
$hs = '0' x (8-($l % 8)) . $hs if ($l % 8) != 0; # padd left side w/ 0
my $h = unpack('H*', pack ('B*', $hs)); # repack as hex
- $c->_from_hex(\('0x'.$h));
+ $c->_from_hex('0x'.$h);
}
##############################################################################
my $acc = _copy($c,$num); my $t = _one();
- my $expbin = ${_as_bin($c,$exp)}; $expbin =~ s/^0b//;
+ my $expbin = _as_bin($c,$exp); $expbin =~ s/^0b//;
my $len = length($expbin);
while (--$len >= 0)
{
$num;
}
+sub _gcd
+ {
+ # greatest common divisor
+ my ($c,$x,$y) = @_;
+
+ while (! _is_zero($c,$y))
+ {
+ my $t = _copy($c,$y);
+ $y = _mod($c, $x, $y);
+ $x = $t;
+ }
+ $x;
+ }
+
##############################################################################
##############################################################################
=head1 METHODS
The following functions MUST be defined in order to support the use by
-Math::BigInt:
+Math::BigInt v1.70 or later:
+ api_version() return API version, minimum 1 for v1.70
_new(string) return ref to new object from ref to decimal string
_zero() return a new object with value 0
_one() return a new object with value 1
+ _two() return a new object with value 2
+ _ten() return a new object with value 10
_str(obj) return ref to a string representing the object
_num(obj) returns a Perl integer/floating point number
_len(obj) returns count of the decimal digits of the object
_digit(obj,n) returns the n'th decimal digit of object
- _is_one(obj) return true if argument is +1
+ _is_one(obj) return true if argument is 1
+ _is_two(obj) return true if argument is 2
+ _is_ten(obj) return true if argument is 10
_is_zero(obj) return true if argument is 0
_is_even(obj) return true if argument is even (0,2,4,6..)
_is_odd(obj) return true if argument is odd (1,3,5,7..)
_check(obj) check whether internal representation is still intact
return 0 for ok, otherwise error message as string
-The following functions are optional, and can be defined if the underlying lib
-has a fast way to do them. If undefined, Math::BigInt will use pure Perl (hence
-slow) fallback routines to emulate these:
-
_from_hex(str) return ref to new object from ref to hexadecimal string
_from_bin(str) return ref to new object from ref to binary string
- _as_hex(str) return ref to scalar string containing the value as
+ _as_hex(str) return string containing the value as
unsigned hex string, with the '0x' prepended.
Leading zeros must be stripped.
_as_bin(str) Like as_hex, only as binary string containing only
'0b' must be prepended.
_rsft(obj,N,B) shift object in base B by N 'digits' right
- For unsupported bases B, return undef to signal failure
_lsft(obj,N,B) shift object in base B by N 'digits' left
- For unsupported bases B, return undef to signal failure
_xor(obj1,obj2) XOR (bit-wise) object 1 with object 2
Note: XOR, AND and OR pad with zeros if size mismatches
_and(obj1,obj2) AND (bit-wise) object 1 with object 2
_or(obj1,obj2) OR (bit-wise) object 1 with object 2
- _signed_or
- _signed_and
- _signed_xor
-
_mod(obj,obj) Return remainder of div of the 1st by the 2nd object
_sqrt(obj) return the square root of object (truncated to int)
_root(obj) return the n'th (n >= 3) root of obj (truncated to int)
_fac(obj) return factorial of object 1 (1*2*3*4..)
_pow(obj,obj) return object 1 to the power of object 2
return undef for NaN
- _gcd(obj,obj) return Greatest Common Divisor of two objects
-
_zeros(obj) return number of trailing decimal zeros
_modinv return inverse modulus
_modpow return modulus of power ($x ** $y) % $z
1 : result is exactly RESULT
0 : result was truncated to RESULT
undef : unknown whether result is exactly RESULT
+ _gcd(obj,obj) return Greatest Common Divisor of two objects
+
+The following functions are optional, and can be defined if the underlying lib
+has a fast way to do them. If undefined, Math::BigInt will use pure Perl (hence
+slow) fallback routines to emulate these:
+
+ _signed_or
+ _signed_and
+ _signed_xor
+
Input strings come in as unsigned but with prefix (i.e. as '123', '0xabc'
or '0b1101').
Return values are always references to objects, strings, or true/false for
comparisation routines.
-Exceptions are C<_lsft()> and C<_rsft()>, which return undef if they can not
-shift the argument. This is used to delegate shifting of bases different than
-the one you can support back to Math::BigInt, which will use some generic code
-to calculate the result.
-
=head1 WRAP YOUR OWN
If you want to port your own favourite c-lib for big numbers to the
in late 2000.
Seperated from BigInt and shaped API with the help of John Peacock.
Fixed, sped-up and enhanced by Tels http://bloodgate.com 2001-2003.
+Further streamlining (api_version 1) by Tels 2004.
=head1 SEE ALSO
projects / p5sagit/p5-mst-13.2.git / blobdiff