lib/Math/BigFloat.pm An arbitrary precision floating-point arithmetic package
lib/Math/BigFloat/Trace.pm bignum tracing
lib/Math/BigInt/Calc.pm Pure Perl module to support Math::BigInt
+lib/Math/BigInt/CalcEmu.pm Pure Perl module to support Math::BigInt
lib/Math/BigInt.pm An arbitrary precision integer arithmetic package
lib/Math/BigInt/t/bare_mbf.t Test MBF under Math::BigInt::BareCalc
lib/Math/BigInt/t/bare_mbi.t Test MBI under Math::BigInt::BareCalc
lib/Math/BigInt/t/bare_mif.t Rounding tests under BareCalc
+lib/Math/BigInt/t/alias.inc Support for BigInt tests
lib/Math/BigInt/t/bigfltpm.inc Shared tests for bigfltpm.t and sub_mbf.t
lib/Math/BigInt/t/bigfltpm.t See if BigFloat.pm works
lib/Math/BigInt/t/bigintc.t See if BigInt/Calc.pm works
lib/Math/BigInt/t/fallback.t Test Math::BigInt
lib/Math/BigInt/t/inf_nan.t Special tests for inf and NaN handling
lib/Math/BigInt/t/isa.t Test for Math::BigInt inheritance
+lib/Math/BigInt/t/mbf_ali.t Tests for BigFloat
lib/Math/BigInt/t/mbimbf.inc Actual BigInt/BigFloat accuracy, precision and fallback, round_mode tests
lib/Math/BigInt/t/mbimbf.t BigInt/BigFloat accuracy, precision and fallback, round_mode
+lib/Math/BigInt/t/mbi_ali.t Tests for BigInt
lib/Math/BigInt/t/mbi_rand.t Test Math::BigInt randomly
lib/Math/BigInt/Trace.pm bignum tracing
lib/Math/BigInt/t/req_mbf0.t test: require Math::BigFloat; ->bzero();
lib/Math/BigInt/t/req_mbfn.t test: require Math::BigFloat; ->new();
lib/Math/BigInt/t/req_mbfw.t require Math::BigFloat; import ( with => );
lib/Math/BigInt/t/require.t Test if require Math::BigInt works
+lib/Math/BigInt/t/sub_ali.t Tests for aliases in BigInt subclasses
lib/Math/BigInt/t/sub_mbf.t Empty subclass test of BigFloat
lib/Math/BigInt/t/sub_mbi.t Empty subclass test of BigInt
lib/Math/BigInt/t/sub_mif.t Test A & P with subclasses using mbimbf.inc
# _p: precision
# _f: flags, used to signal MBI not to touch our private parts
-$VERSION = '1.41';
+$VERSION = '1.42';
require 5.005;
use Exporter;
@ISA = qw(Exporter Math::BigInt);
use strict;
-use vars qw/$AUTOLOAD $accuracy $precision $div_scale $round_mode $rnd_mode/;
-use vars qw/$upgrade $downgrade/;
-# the following are internal and should never be accessed from the outside
-use vars qw/$_trap_nan $_trap_inf/;
+# $_trap_inf and $_trap_nan are internal and should never be accessed from the outside
+use vars qw/$AUTOLOAD $accuracy $precision $div_scale $round_mode $rnd_mode
+ $upgrade $downgrade $_trap_nan $_trap_inf/;
my $class = "Math::BigFloat";
use overload
# the following are private and not to be used from the outside:
-use constant MB_NEVER_ROUND => 0x0001;
+sub MB_NEVER_ROUND () { 0x0001; }
# are NaNs ok? (otherwise it dies when encountering an NaN) set w/ config()
$_trap_nan = 0;
return $self->bnorm();
}
#print "new string '$wanted'\n";
+
my ($mis,$miv,$mfv,$es,$ev) = Math::BigInt::_split(\$wanted);
if (!ref $mis)
{
# undef,undef to signal MBI that we don't need no bloody rounding
$self->{_e} = $MBI->new("$$es$$ev",undef,undef); # exponent
$self->{_m} = $MBI->new("$$miv$$mfv",undef,undef); # create mant.
- # print $self->{_e}, " ", $self->{_m},"\n";
+
+ # this is to prevent automatically rounding when MBI's globals are set
+ $self->{_m}->{_f} = MB_NEVER_ROUND;
+ $self->{_e}->{_f} = MB_NEVER_ROUND;
+
# 3.123E0 = 3123E-3, and 3.123E-2 => 3123E-5
- $self->{_e} -= CORE::length($$mfv) if CORE::length($$mfv) != 0;
+ $self->{_e}->bsub( $MBI->new(CORE::length($$mfv),undef,undef))
+ if CORE::length($$mfv) != 0;
$self->{sign} = $$mis;
+
+ #print "$$miv$$mfv $$es$$ev\n";
+
+ # we can only have trailing zeros on the mantissa of $$mfv eq ''
+ if (CORE::length($$mfv) == 0)
+ {
+ my $zeros = $self->{_m}->_trailing_zeros(); # correct for trailing zeros
+ if ($zeros != 0)
+ {
+ $self->{_m}->brsft($zeros,10); $self->{_e}->badd($MBI->new($zeros));
+ }
+ }
+# else
+# {
+ # for something like 0Ey, set y to 1, and -0 => +0
+ $self->{sign} = '+', $self->{_e}->bone() if $self->{_m}->is_zero();
+# }
+ return $self->round(@r) if !$downgrade;
}
# if downgrade, inf, NaN or integers go down
sub numify
{
# Make a number from a BigFloat object
- # simple return string and let Perl's atoi()/atof() handle the rest
- my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ # simple return a string and let Perl's atoi()/atof() handle the rest
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
$x->bsstr();
}
# public stuff (usually prefixed with "b")
# tels 2001-08-04
-# todo: this must be overwritten and return NaN for non-integer values
+# XXX TODO this must be overwritten and return NaN for non-integer values
# band(), bior(), bxor(), too
#sub bnot
# {
sub bcmp
{
# Compares 2 values. Returns one of undef, <0, =0, >0. (suitable for sort)
- # (BFLOAT or num_str, BFLOAT or num_str) return cond_code
# set up parameters
my ($self,$x,$y) = (ref($_[0]),@_);
{
# Compares 2 values, ignoring their signs.
# Returns one of undef, <0, =0, >0. (suitable for sort)
- # (BFLOAT or num_str, BFLOAT or num_str) return cond_code
# set up parameters
my ($self,$x,$y) = (ref($_[0]),@_);
($self,$x,$y,$a,$p,$r) = objectify(2,@_);
}
- # XXX TODO: remove?
if ($y->is_zero()) # still round for not adding zero
{
return $x->round($a,$p,$r);
sub binc
{
# increment arg by one
- my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
+ my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
if ($x->{_e}->sign() eq '-')
{
- return $x->badd($self->bone(),$a,$p,$r); # digits after dot
+ return $x->badd($self->bone(),@r); # digits after dot
}
- if (!$x->{_e}->is_zero())
+ if (!$x->{_e}->is_zero()) # _e == 0 for NaN, inf, -inf
{
+ # 1e2 => 100, so after the shift below _m has a '0' as last digit
$x->{_m}->blsft($x->{_e},10); # 1e2 => 100
- $x->{_e}->bzero();
+ $x->{_e}->bzero(); # normalize
+ # we know that the last digit of $x will be '1' or '9', depending on the
+ # sign
}
# now $x->{_e} == 0
if ($x->{sign} eq '+')
{
$x->{_m}->binc();
- return $x->bnorm()->bround($a,$p,$r);
+ return $x->bnorm()->bround(@r);
}
elsif ($x->{sign} eq '-')
{
$x->{_m}->bdec();
$x->{sign} = '+' if $x->{_m}->is_zero(); # -1 +1 => -0 => +0
- return $x->bnorm()->bround($a,$p,$r);
+ return $x->bnorm()->bround(@r);
}
# inf, nan handling etc
- $x->badd($self->bone(),$a,$p,$r); # does round
+ $x->badd($self->bone(),@r); # badd() does round
}
sub bdec
{
# decrement arg by one
- my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
+ my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
if ($x->{_e}->sign() eq '-')
{
- return $x->badd($self->bone('-'),$a,$p,$r); # digits after dot
+ return $x->badd($self->bone('-'),@r); # digits after dot
}
if (!$x->{_e}->is_zero())
$x->{_m}->binc();
$x->{sign} = '-' if $zero; # 0 => 1 => -1
$x->{sign} = '+' if $x->{_m}->is_zero(); # -1 +1 => -0 => +0
- return $x->bnorm()->round($a,$p,$r);
+ return $x->bnorm()->round(@r);
}
# > 0
elsif ($x->{sign} eq '+')
{
$x->{_m}->bdec();
- return $x->bnorm()->round($a,$p,$r);
+ return $x->bnorm()->round(@r);
}
# inf, nan handling etc
- $x->badd($self->bone('-'),$a,$p,$r); # does round
+ $x->badd($self->bone('-'),@r); # does round
}
sub DEBUG () { 0; }
$x = Math::BigFloat->new($x);
$self = ref($x);
}
- # first calculate the log to base e (using reduction by 10 (and probably 2))
- $self->_log_10($x,$scale);
-
- # and if a different base was requested, convert it
- if (defined $base)
+
+ my $done = 0;
+
+ # If the base is defined and an integer, try to calculate integer result
+ # first. This is very fast, and in case the real result was found, we can
+ # stop right here.
+ if (defined $base && $base->is_int() && $x->is_int())
+ {
+ my $int = $x->{_m}->copy();
+ $int->blsft($x->{_e},10) unless $x->{_e}->is_zero();
+ $int->blog($base->as_number());
+ # if ($exact)
+ if ($base->copy()->bpow($int) == $x)
+ {
+ # found result, return it
+ $x->{_m} = $int;
+ $x->{_e} = $MBI->bzero();
+ $x->bnorm();
+ $done = 1;
+ }
+ }
+
+ if ($done == 0)
{
- $base = Math::BigFloat->new($base) unless $base->isa('Math::BigFloat');
- # not ln, but some other base (don't modify $base)
- $x->bdiv( $base->copy()->blog(undef,$scale), $scale );
+ # first calculate the log to base e (using reduction by 10 (and probably 2))
+ $self->_log_10($x,$scale);
+
+ # and if a different base was requested, convert it
+ if (defined $base)
+ {
+ $base = Math::BigFloat->new($base) unless $base->isa('Math::BigFloat');
+ # not ln, but some other base (don't modify $base)
+ $x->bdiv( $base->copy()->blog(undef,$scale), $scale );
+ }
}
# shortcut to not run through _find_round_parameters again
{
# (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT
# compute factorial number, modifies first argument
- my ($self,$x,@r) = objectify(1,@_);
+ # set up parameters
+ my ($self,$x,@r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ ($self,$x,@r) = objectify(1,@_) if !ref($x);
+
+ return $x if $x->{sign} eq '+inf'; # inf => inf
return $x->bnan()
if (($x->{sign} ne '+') || # inf, NaN, <0 etc => NaN
($x->{_e}->{sign} ne '+')); # digits after dot?
# use BigInt's bfac() for faster calc
- if (! _is_zero_or_one($x->{_e}))
+ if (! $x->{_e}->is_zero())
{
- $x->{_m}->blsft($x->{_e},10); # unnorm
- $x->{_e}->bzero(); # norm again
+ $x->{_m}->blsft($x->{_e},10); # change 12e1 to 120e0
+ $x->{_e}->bzero();
}
- $x->{_m}->blsft($x->{_e},10); # un-norm m
- $x->{_e}->bzero(); # norm again
$x->{_m}->bfac(); # calculate factorial
$x->bnorm()->round(@r); # norm again and round result
}
sub DESTROY
{
- # going through AUTOLOAD for every DESTROY is costly, so avoid it by empty sub
+ # going through AUTOLOAD for every DESTROY is costly, avoid it by empty sub
}
sub AUTOLOAD
return $x if $x->{sign} !~ /^[+-]$/; # inf, nan etc
-# if (!$x->{_m}->is_odd())
-# {
- my $zeros = $x->{_m}->_trailing_zeros(); # correct for trailing zeros
- if ($zeros != 0)
- {
- $x->{_m}->brsft($zeros,10); $x->{_e}->badd($zeros);
- }
- # for something like 0Ey, set y to 1, and -0 => +0
+ my $zeros = $x->{_m}->_trailing_zeros(); # correct for trailing zeros
+ if ($zeros != 0)
+ {
+ my $z = $MBI->new($zeros,undef,undef);
+ $x->{_m}->brsft($z,10); $x->{_e}->badd($z);
+ }
+ else
+ {
+ # $x can only be 0Ey if there are no trailing zeros ('0' has 0 trailing
+ # zeros). So, for something like 0Ey, set y to 1, and -0 => +0
$x->{sign} = '+', $x->{_e}->bone() if $x->{_m}->is_zero();
-# }
+ }
+
# this is to prevent automatically rounding when MBI's globals are set
$x->{_m}->{_f} = MB_NEVER_ROUND;
$x->{_e}->{_f} = MB_NEVER_ROUND;
my $class = "Math::BigInt";
require 5.005;
-$VERSION = '1.67';
+$VERSION = '1.68';
use Exporter;
@ISA = qw( Exporter );
@EXPORT_OK = qw( objectify bgcd blcm);
-use vars qw/$round_mode $accuracy $precision $div_scale $rnd_mode/;
-use vars qw/$upgrade $downgrade/;
-# the following are internal and should never be accessed from the outside
-use vars qw/$_trap_nan $_trap_inf/;
+# _trap_inf and _trap_nan are internal and should never be accessed from the
+# outside
+use vars qw/$round_mode $accuracy $precision $div_scale $rnd_mode
+ $upgrade $downgrade $_trap_nan $_trap_inf/;
use strict;
# Inside overload, the first arg is always an object. If the original code had
"$_[1]" cmp $_[0]->bstr() :
$_[0]->bstr() cmp "$_[1]" },
-#'cos' => sub {
-# require Math::Big;
-# return Math::Big::cos($_[0], ref($_[0])->accuracy());
-# },
-
# make cos()/sin()/exp() "work" with BigInt's or subclasses
'cos' => sub { cos($_[0]->numify()) },
'sin' => sub { sin($_[0]->numify()) },
# these are internally, and not to be used from the outside
-use constant MB_NEVER_ROUND => 0x0001;
+sub MB_NEVER_ROUND () { 0x0001; }
$_trap_nan = 0; # are NaNs ok? set w/ config()
$_trap_inf = 0; # are infs ok? set w/ config()
my $IMPORT = 0; # was import() called yet?
# used to make require work
+my $EMU_LIB = 'Math/BigInt/CalcEmu.pm'; # emulate low-level math
+my $EMU = 'Math::BigInt::CalcEmu'; # emulate low-level math
+
##############################################################################
# the old code had $rnd_mode, so we need to support it, too
sub FETCH { return $round_mode; }
sub STORE { $rnd_mode = $_[0]->round_mode($_[1]); }
-BEGIN { tie $rnd_mode, 'Math::BigInt'; }
+BEGIN
+ {
+ # tie to enable $rnd_mode to work transparently
+ tie $rnd_mode, 'Math::BigInt';
+
+ # set up some handy alias names
+ *as_int = \&as_number;
+ *is_pos = \&is_positive;
+ *is_neg = \&is_negative;
+ }
##############################################################################
return 'inf'; # +inf
}
my ($m,$e) = $x->parts();
- my $sign = 'e+'; # e can only be positive
- return $m->bstr().$sign.$e->bstr();
+ #$m->bstr() . 'e+' . $e->bstr(); # e can only be positive in BigInt
+ # 'e+' because E can only be positive in BigInt
+ $m->bstr() . 'e+' . ${$CALC->_str($e->{value})};
}
sub bstr
return 'inf'; # +inf
}
my $es = ''; $es = $x->{sign} if $x->{sign} eq '-';
- return $es.${$CALC->_str($x->{value})};
+ $es.${$CALC->_str($x->{value})};
}
sub numify
sub sign
{
# return the sign of the number: +/-/-inf/+inf/NaN
- my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
$x->{sign};
}
$r = ${"$c\::round_mode"} unless defined $r;
if ($r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/)
{
-
+ require Carp; Carp::croak ("Unknown round mode '$r'");
}
# now round, by calling either fround or ffround:
{
# (numstr or BINT) return BINT
# Normalize number -- no-op here
- my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
$x;
}
}
# $x && $y both < 0
- $CALC->_acmp($y->{value},$x->{value}); # swaped (lib returns 0,1,-1)
+ $CALC->_acmp($y->{value},$x->{value}); # swaped acmp (lib returns 0,1,-1)
}
sub bacmp
return $x;
}
- my ($sx, $sy) = ( $x->{sign}, $y->{sign} ); # get signs
+ my ($sx, $sy) = ( $x->{sign}, $y->{sign} ); # get signs
if ($sx eq $sy)
{
$x->{value} = $CALC->_add($x->{value},$y->{value}); # same sign, abs add
- $x->{sign} = $sx;
}
else
{
else # a < 0
{
$x->{value} = $CALC->_sub($x->{value}, $y->{value}); # abs sub
- $x->{sign} = $sx;
}
}
$x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
sub bdec
{
# decrement arg by one
- my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
+ my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
return $x if $x->modify('bdec');
- my $zero = $CALC->_is_zero($x->{value}) && $x->{sign} eq '+';
- # <= 0
- if (($x->{sign} eq '-') || $zero)
+ if ($x->{sign} eq '-')
{
+ # < 0
$x->{value} = $CALC->_inc($x->{value});
- $x->{sign} = '-' if $zero; # 0 => 1 => -1
- $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0
- $x->round($a,$p,$r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
- return $x;
- }
- # > 0
- elsif ($x->{sign} eq '+')
+ }
+ else
{
- $x->{value} = $CALC->_dec($x->{value});
- $x->round($a,$p,$r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
- return $x;
+ return $x->badd($self->bone('-'),@r) unless $x->{sign} eq '+'; # inf/NaN
+ # >= 0
+ if ($CALC->_is_zero($x->{value}))
+ {
+ # == 0
+ $x->{value} = $CALC->_one(); $x->{sign} = '-'; # 0 => -1
+ }
+ else
+ {
+ # > 0
+ $x->{value} = $CALC->_dec($x->{value});
+ }
}
- # inf, nan handling etc
- $x->badd($self->bone('-'),$a,$p,$r); # badd does round
- }
+ $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+ $x;
+ }
sub blog
{
# objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
{
- ($self,$x,$base,@r) = objectify(2,@_);
+ ($self,$x,$base,@r) = objectify(2,$class,@_);
}
# inf, -inf, NaN, <0 => NaN
return $x->round(@r);
}
- return $x->bnan() if $x->is_zero() || $base->is_zero() || $base->is_one();
-
- my $acmp = $x->bacmp($base);
- return $x->bone('+',@r) if $acmp == 0;
- return $x->bzero(@r) if $acmp < 0 || $x->is_one();
-
- # blog($x,$base) ** $base + $y = $x
-
- # this trial multiplication is very fast, even for large counts (like for
- # 2 ** 1024, since this still requires only 1024 very fast steps
- # (multiplication of a large number by a very small number is very fast))
- # See Calc for an even faster algorightmn
- my $x_org = $x->copy(); # preserve orgx
- $x->bzero(); # keep ref to $x
- my $trial = $base->copy();
- while ($trial->bacmp($x_org) <= 0)
- {
- $trial->bmul($base); $x->binc();
- }
- $x->round(@r);
+ require $EMU_LIB;
+ __emu_blog($self,$x,$base,@r);
}
sub blcm
{
my $sign;
($x->{value},$sign) = $CALC->_modinv($x->{value},$y->{value});
- $x->bnan() if !defined $x->{value}; # in case no GCD found
- return $x if !defined $sign; # already real result
- $x->{sign} = $sign; # flip/flop see below
- $x->bmod($y); # calc real result
+ return $x->bnan() if !defined $x->{value}; # in case no GCD found
+ return $x if !defined $sign; # already real result
+ $x->{sign} = $sign; # flip/flop see below
+ $x->bmod($y); # calc real result
return $x;
}
- my ($u, $u1) = ($self->bzero(), $self->bone());
- my ($a, $b) = ($y->copy(), $x->copy());
-
- # first step need always be done since $num (and thus $b) is never 0
- # Note that the loop is aligned so that the check occurs between #2 and #1
- # thus saving us one step #2 at the loop end. Typical loop count is 1. Even
- # a case with 28 loops still gains about 3% with this layout.
- my $q;
- ($a, $q, $b) = ($b, $a->bdiv($b)); # step #1
- # Euclid's Algorithm (calculate GCD of ($a,$b) in $a and also calculate
- # two values in $u and $u1, we use only $u1 afterwards)
- my $sign = 1; # flip-flop
- while (!$b->is_zero()) # found GCD if $b == 0
- {
- # the original algorithm had:
- # ($u, $u1) = ($u1, $u->bsub($u1->copy()->bmul($q))); # step #2
- # The following creates exact the same sequence of numbers in $u1,
- # except for the sign ($u1 is now always positive). Since formerly
- # the sign of $u1 was alternating between '-' and '+', the $sign
- # flip-flop will take care of that, so that at the end of the loop
- # we have the real sign of $u1. Keeping numbers positive gains us
- # speed since badd() is faster than bsub() and makes it possible
- # to have the algorithmn in Calc for even more speed.
-
- ($u, $u1) = ($u1, $u->badd($u1->copy()->bmul($q))); # step #2
- $sign = - $sign; # flip sign
-
- ($a, $q, $b) = ($b, $a->bdiv($b)); # step #1 again
- }
- # If the gcd is not 1, then return NaN! It would be pointless to
- # have called bgcd to check this first, because we would then be
- # performing the same Euclidean Algorithm *twice*.
- return $x->bnan() unless $a->is_one();
-
- $u1->bneg() if $sign != 1; # need to flip?
-
- $u1->bmod($y); # calc result
- $x->{value} = $u1->{value}; # and copy over to $x
- $x->{sign} = $u1->{sign}; # to modify in place
- $x;
+ require $EMU_LIB;
+ __emu_bmodinv($self,$x,$y,@r);
}
sub bmodpow
return $num;
}
- # in the trivial case,
- return $num->bzero(@r) if $mod->is_one();
- return $num->bone('+',@r) if $num->is_zero() or $num->is_one();
-
- # $num->bmod($mod); # if $x is large, make it smaller first
- my $acc = $num->copy(); # but this is not really faster...
-
- $num->bone(); # keep ref to $num
-
- my $expbin = $exp->as_bin(); $expbin =~ s/^[-]?0b//; # ignore sign and prefix
- my $len = CORE::length($expbin);
- while (--$len >= 0)
- {
- $num->bmul($acc)->bmod($mod) if substr($expbin,$len,1) eq '1';
- $acc->bmul($acc)->bmod($mod);
- }
-
- $num;
+ require $EMU_LIB;
+ __emu_bmodpow($self,$num,$exp,$mod,@r);
}
###############################################################################
return $x if $x->modify('bfac');
- return $x->bnan() if $x->{sign} ne '+'; # inf, NnN, <0 etc => NaN
+ return $x if $x->{sign} eq '+inf'; # inf => inf
+ return $x->bnan() if $x->{sign} ne '+'; # NaN, <0 etc => NaN
if ($CAN{fac})
{
return $x->round(@r);
}
- return $x->bone('+',@r) if $x->is_zero() || $x->is_one(); # 0 or 1 => 1
-
- my $n = $x->copy();
- $x->bone();
- # seems we need not to temp. clear A/P of $x since the result is the same
- my $f = $self->new(2);
- while ($f->bacmp($n) < 0)
- {
- $x->bmul($f); $f->binc();
- }
- $x->bmul($f,@r); # last step and also round
+ require $EMU_LIB;
+ __emu_bfac($self,$x,@r);
}
sub bpow
$r[3] = $y; # no push!
return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x
return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
- return $x->bone('+',@r) if $y->is_zero();
- return $x->round(@r) if $x->is_one() || $y->is_one();
+
+ # cases 0 ** Y, X ** 0, X ** 1, 1 ** Y are handled by Calc or Emu
+
if ($x->{sign} eq '-' && $CALC->_is_one($x->{value}))
{
# if $x == -1 and odd/even y => +1/-1
}
# 1 ** -y => 1 / (1 ** |y|)
# so do test for negative $y after above's clause
- return $x->bnan() if $y->{sign} eq '-';
- return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0)
+ return $x->bnan() if $y->{sign} eq '-' && !$x->is_one();
if ($CAN{pow})
{
$x->{value} = $CALC->_pow($x->{value},$y->{value});
+ $x->{sign} = '+' if $CALC->_is_zero($y->{value});
$x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
return $x;
}
-# based on the assumption that shifting in base 10 is fast, and that mul
-# works faster if numbers are small: we count trailing zeros (this step is
-# O(1)..O(N), but in case of O(N) we save much more time due to this),
-# stripping them out of the multiplication, and add $count * $y zeros
-# afterwards like this:
-# 300 ** 3 == 300*300*300 == 3*3*3 . '0' x 2 * 3 == 27 . '0' x 6
-# creates deep recursion since brsft/blsft use bpow sometimes.
-# my $zeros = $x->_trailing_zeros();
-# if ($zeros > 0)
-# {
-# $x->brsft($zeros,10); # remove zeros
-# $x->bpow($y); # recursion (will not branch into here again)
-# $zeros = $y * $zeros; # real number of zeros to add
-# $x->blsft($zeros,10);
-# return $x->round(@r);
-# }
-
- my $pow2 = $self->bone();
- my $y_bin = $y->as_bin(); $y_bin =~ s/^0b//;
- my $len = CORE::length($y_bin);
- while (--$len > 0)
- {
- $pow2->bmul($x) if substr($y_bin,$len,1) eq '1'; # is odd?
- $x->bmul($x);
- }
- $x->bmul($pow2);
- $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
- $x;
+ require $EMU_LIB;
+ __emu_bpow($self,$x,$y,@r);
}
sub blsft
$x->{value} = $t; return $x->round(@r);
}
# fallback
- return $x->bmul( $self->bpow($n, $y, @r), @r );
+ $x->bmul( $self->bpow($n, $y, @r), @r );
}
sub brsft
$x->{value} = $res->{value}; # take over value
return $x->round(@r); # we are done now, magic, isn't?
}
+ # x < 0, n == 2, y == 1
$x->bdec(); # n == 2, but $y == 1: this fixes it
}
return $x if $x->modify('band');
$r[3] = $y; # no push!
- local $Math::BigInt::upgrade = undef;
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
- my $sx = 1; $sx = -1 if $x->{sign} eq '-';
- my $sy = 1; $sy = -1 if $y->{sign} eq '-';
+ my $sx = $x->{sign} eq '+' ? 1 : -1;
+ my $sy = $y->{sign} eq '+' ? 1 : -1;
if ($CAN{and} && $sx == 1 && $sy == 1)
{
$x->{value} = $CALC->_signed_and($x->{value},$y->{value},$sx,$sy);
return $x->round(@r);
}
-
- return $x->bzero(@r) if $y->is_zero() || $x->is_zero();
-
- my $sign = 0; # sign of result
- $sign = 1 if ($x->{sign} eq '-') && ($y->{sign} eq '-');
-
- my ($bx,$by);
-
- if ($sx == -1) # if x is negative
- {
- # two's complement: inc and flip all "bits" in $bx
- $bx = $x->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc
- $bx =~ s/-?0x//;
- $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- else
- {
- $bx = $x->as_hex(); # get binary representation
- $bx =~ s/-?0x//;
- $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- if ($sy == -1) # if y is negative
- {
- # two's complement: inc and flip all "bits" in $by
- $by = $y->copy()->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc
- $by =~ s/-?0x//;
- $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- else
- {
- $by = $y->as_hex(); # get binary representation
- $by =~ s/-?0x//;
- $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- # now we have bit-strings from X and Y, reverse them for padding
- $bx = reverse $bx;
- $by = reverse $by;
-
- # cut the longer string to the length of the shorter one (the result would
- # be 0 due to AND anyway)
- my $diff = CORE::length($bx) - CORE::length($by);
- if ($diff > 0)
- {
- $bx = substr($bx,0,CORE::length($by));
- }
- elsif ($diff < 0)
- {
- $by = substr($by,0,CORE::length($bx));
- }
-
- # and the strings together
- my $r = $bx & $by;
-
- # and reverse the result again
- $bx = reverse $r;
-
- # one of $x or $y was negative, so need to flip bits in the result
- # in both cases (one or two of them negative, or both positive) we need
- # to get the characters back.
- if ($sign == 1)
- {
- $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/;
- }
- else
- {
- $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/;
- }
-
- $bx = '0x' . $bx;
- if ($CAN{from_hex})
- {
- $x->{value} = $CALC->_from_hex( \$bx );
- }
- else
- {
- $r = $self->new($bx);
- $x->{value} = $r->{value};
- }
-
- # calculate sign of result
- $x->{sign} = '+';
- $x->{sign} = '-' if $sx == $sy && $sx == -1 && !$x->is_zero();
-
- $x->bdec() if $sign == 1;
-
- $x->round(@r);
+
+ require $EMU_LIB;
+ __emu_band($self,$x,$y,$sx,$sy,@r);
}
sub bior
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
- my $sx = 1; $sx = -1 if $x->{sign} eq '-';
- my $sy = 1; $sy = -1 if $y->{sign} eq '-';
+ my $sx = $x->{sign} eq '+' ? 1 : -1;
+ my $sy = $y->{sign} eq '+' ? 1 : -1;
# the sign of X follows the sign of X, e.g. sign of Y irrelevant for bior()
return $x->round(@r);
}
- # if lib can do negatvie values, so use it
+ # if lib can do negative values, let it handle this
if ($CAN{signed_or})
{
$x->{value} = $CALC->_signed_or($x->{value},$y->{value},$sx,$sy);
return $x->round(@r);
}
- return $x->round(@r) if $y->is_zero();
-
- my $sign = 0; # sign of result
- $sign = 1 if ($x->{sign} eq '-') || ($y->{sign} eq '-');
-
- my ($bx,$by);
-
- if ($sx == -1) # if x is negative
- {
- # two's complement: inc and flip all "bits" in $bx
- $bx = $x->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc
- $bx =~ s/-?0x//;
- $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- else
- {
- $bx = $x->as_hex(); # get binary representation
- $bx =~ s/-?0x//;
- $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- if ($sy == -1) # if y is negative
- {
- # two's complement: inc and flip all "bits" in $by
- $by = $y->copy()->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc
- $by =~ s/-?0x//;
- $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- else
- {
- $by = $y->as_hex(); # get binary representation
- $by =~ s/-?0x//;
- $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- # now we have bit-strings from X and Y, reverse them for padding
- $bx = reverse $bx;
- $by = reverse $by;
-
- # padd the shorter string
- my $xx = "\x00"; $xx = "\x0f" if $sx == -1;
- my $yy = "\x00"; $yy = "\x0f" if $sy == -1;
- my $diff = CORE::length($bx) - CORE::length($by);
- if ($diff > 0)
- {
- $by .= $yy x $diff;
- }
- elsif ($diff < 0)
- {
- $bx .= $xx x abs($diff);
- }
-
- # or the strings together
- my $r = $bx | $by;
-
- # and reverse the result again
- $bx = reverse $r;
-
- # one of $x or $y was negative, so need to flip bits in the result
- # in both cases (one or two of them negative, or both positive) we need
- # to get the characters back.
- if ($sign == 1)
- {
- $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/;
- }
- else
- {
- $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/;
- }
-
- $bx = '0x' . $bx;
- if ($CAN{from_hex})
- {
- $x->{value} = $CALC->_from_hex( \$bx );
- }
- else
- {
- $r = $self->new($bx);
- $x->{value} = $r->{value};
- }
-
- # if one of X or Y was negative, we need to decrement result
- $x->bdec() if $sign == 1;
-
- $x->round(@r);
+ require $EMU_LIB;
+ __emu_bior($self,$x,$y,$sx,$sy,@r);
}
sub bxor
return $x if $x->modify('bxor');
$r[3] = $y; # no push!
- local $Math::BigInt::upgrade = undef;
-
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
- my $sx = 1; $sx = -1 if $x->{sign} eq '-';
- my $sy = 1; $sy = -1 if $y->{sign} eq '-';
+ my $sx = $x->{sign} eq '+' ? 1 : -1;
+ my $sy = $y->{sign} eq '+' ? 1 : -1;
# don't use lib for negative values
if ($CAN{xor} && $sx == 1 && $sy == 1)
return $x->round(@r);
}
- # if lib can do negatvie values, so use it
+ # if lib can do negative values, let it handle this
if ($CAN{signed_xor})
{
$x->{value} = $CALC->_signed_xor($x->{value},$y->{value},$sx,$sy);
return $x->round(@r);
}
- return $x->round(@r) if $y->is_zero();
-
- my $sign = 0; # sign of result
- $sign = 1 if $x->{sign} ne $y->{sign};
-
- my ($bx,$by);
-
- if ($sx == -1) # if x is negative
- {
- # two's complement: inc and flip all "bits" in $bx
- $bx = $x->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc
- $bx =~ s/-?0x//;
- $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- else
- {
- $bx = $x->as_hex(); # get binary representation
- $bx =~ s/-?0x//;
- $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- if ($sy == -1) # if y is negative
- {
- # two's complement: inc and flip all "bits" in $by
- $by = $y->copy()->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc
- $by =~ s/-?0x//;
- $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- else
- {
- $by = $y->as_hex(); # get binary representation
- $by =~ s/-?0x//;
- $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- # now we have bit-strings from X and Y, reverse them for padding
- $bx = reverse $bx;
- $by = reverse $by;
-
- # padd the shorter string
- my $xx = "\x00"; $xx = "\x0f" if $sx == -1;
- my $yy = "\x00"; $yy = "\x0f" if $sy == -1;
- my $diff = CORE::length($bx) - CORE::length($by);
- if ($diff > 0)
- {
- $by .= $yy x $diff;
- }
- elsif ($diff < 0)
- {
- $bx .= $xx x abs($diff);
- }
-
- # xor the strings together
- my $r = $bx ^ $by;
-
- # and reverse the result again
- $bx = reverse $r;
-
- # one of $x or $y was negative, so need to flip bits in the result
- # in both cases (one or two of them negative, or both positive) we need
- # to get the characters back.
- if ($sign == 1)
- {
- $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/;
- }
- else
- {
- $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/;
- }
-
- $bx = '0x' . $bx;
- if ($CAN{from_hex})
- {
- $x->{value} = $CALC->_from_hex( \$bx );
- }
- else
- {
- $r = $self->new($bx);
- $x->{value} = $r->{value};
- }
-
- # calculate sign of result
- $x->{sign} = '+';
- $x->{sign} = '-' if $sx != $sy && !$x->is_zero();
-
- $x->bdec() if $sign == 1;
-
- $x->round(@r);
+ require $EMU_LIB;
+ __emu_bxor($self,$x,$y,$sx,$sy,@r);
}
sub length
{
- my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
my $e = $CALC->_len($x->{value});
wantarray ? ($e,0) : $e;
sub _trailing_zeros
{
- # return the amount of trailing zeros in $x
+ # return the amount of trailing zeros in $x (as scalar)
my $x = shift;
$x = $class->new($x) unless ref $x;
return $x->round(@r);
}
- # this is slow:
- return $x->round(@r) if $x->is_zero(); # 0,1 => 0,1
-
- return $x->bone('+',@r) if $x < 4; # 1,2,3 => 1
- my $y = $x->copy();
- my $l = int($x->length()/2);
-
- $x->bone(); # keep ref($x), but modify it
- $x->blsft($l,10) if $l != 0; # first guess: 1.('0' x (l/2))
-
- my $last = $self->bzero();
- my $two = $self->new(2);
- my $lastlast = $self->bzero();
- #my $lastlast = $x+$two;
- while ($last != $x && $lastlast != $x)
- {
- $lastlast = $last; $last = $x->copy();
- $x->badd($y / $x);
- $x->bdiv($two);
- }
- $x->bdec() if $x * $x > $y; # overshot?
- $x->round(@r);
+ require $EMU_LIB;
+ __emu_bsqrt($self,$x,@r);
}
sub broot
return $x->round(@r);
}
- return $x->bsqrt() if $y->bacmp(2) == 0; # 2 => square root
-
- # since we take at least a cubic root, and only 8 ** 1/3 >= 2 (==2):
- return $x->bone('+',@r) if $x < 8; # $x=2..7 => 1
-
- my $num = $x->numify();
-
- if ($num <= 1000000)
- {
- $x = $self->new( int($num ** (1 / $y->numify()) ));
- return $x->round(@r);
- }
-
- # 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)
- # See Calc.pm for more details
- my $b = $y->as_bin();
- if ($b =~ /0b1(0+)/)
- {
- my $count = CORE::length($1); # 0b100 => len('00') => 2
- my $cnt = $count; # counter for loop
- my $shift = $self->new(6);
- $x->blsft($shift); # add some zeros (even amount)
- while ($cnt-- > 0)
- {
- # 'inflate' $X by adding more zeros
- $x->blsft($shift);
- # calculate sqrt($x), $x is now a bit too big, again. In the next
- # round we make even bigger, again.
- $x->bsqrt($x);
- }
- # $x is still to big, so truncate result
- $x->brsft($shift);
- }
- else
- {
- # Should compute a guess of the result (by rule of thumb), then improve it
- # via Newton's method or something similiar.
- # XXX TODO
- warn ('broot() not fully implemented in BigInt.');
- }
- return $x->round(@r);
+ require $EMU_LIB;
+ __emu_broot($self,$x,$y,@r);
}
sub exponent
if ($x->{sign} !~ /^[+-]$/)
{
- my $s = $x->{sign}; $s =~ s/^[+-]//;
- return $self->new($s); # -inf,+inf => inf
+ my $s = $x->{sign}; $s =~ s/^[+-]//; # NaN, -inf,+inf => NaN or inf
+ return $self->new($s);
}
- my $e = $class->bzero();
- return $e->binc() if $x->is_zero();
- $e += $x->_trailing_zeros();
- $e;
+ return $self->bone() if $x->is_zero();
+
+ $self->new($x->_trailing_zeros());
}
sub mantissa
if ($x->{sign} !~ /^[+-]$/)
{
- return $self->new($x->{sign}); # keep + or - sign
+ # for NaN, +inf, -inf: keep the sign
+ return $self->new($x->{sign});
}
- my $m = $x->copy();
- # that's inefficient
+ my $m = $x->copy(); delete $m->{_p}; delete $m->{_a};
+ # that's a bit inefficient:
my $zeros = $m->_trailing_zeros();
$m->brsft($zeros,10) if $zeros != 0;
$m;
# precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
# $n == 0 || $n == 1 => round to integer
my $x = shift; $x = $class->new($x) unless ref $x;
+
my ($scale,$mode) = $x->_scale_p($x->precision(),$x->round_mode(),@_);
- return $x if !defined $scale; # no-op
- return $x if $x->modify('bfround');
+
+ return $x if !defined $scale || $x->modify('bfround'); # no-op
# no-op for BigInts if $n <= 0
- if ($scale <= 0)
- {
- $x->{_a} = undef; # clear an eventual set A
- $x->{_p} = $scale; return $x;
- }
+ $x->bround( $x->length()-$scale, $mode) if $scale > 0;
- $x->bround( $x->length()-$scale, $mode);
$x->{_a} = undef; # bround sets {_a}
$x->{_p} = $scale; # so correct it
$x;
sub _scan_for_nonzero
{
# internal, used by bround()
- my $x = shift;
- my $pad = shift;
- my $xs = shift;
+ my ($x,$pad,$xs) = @_;
my $len = $x->length();
return 0 if $len == 1; # '5' is trailed by invisible zeros
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
- my $es = ''; my $s = '';
+ my $s = '';
$s = $x->{sign} if $x->{sign} eq '-';
if ($CAN{as_hex})
{
- $es = ${$CALC->_as_hex($x->{value})};
+ return $s . ${$CALC->_as_hex($x->{value})};
}
- else
- {
- return '0x0' if $x->is_zero();
- my $x1 = $x->copy()->babs(); my ($xr,$x10000,$h);
- if ($] >= 5.006)
- {
- $x10000 = Math::BigInt->new (0x10000); $h = 'h4';
- }
- else
- {
- $x10000 = Math::BigInt->new (0x1000); $h = 'h3';
- }
- while (!$x1->is_zero())
- {
- ($x1, $xr) = bdiv($x1,$x10000);
- $es .= unpack($h,pack('v',$xr->numify()));
- }
- $es = reverse $es;
- $es =~ s/^[0]+//; # strip leading zeros
- $s .= '0x';
- }
- $s . $es;
+ require $EMU_LIB;
+ __emu_as_hex(ref($x),$x,$s);
}
sub as_bin
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
- my $es = ''; my $s = '';
- $s = $x->{sign} if $x->{sign} eq '-';
+ my $s = ''; $s = $x->{sign} if $x->{sign} eq '-';
if ($CAN{as_bin})
{
- $es = ${$CALC->_as_bin($x->{value})};
- }
- else
- {
- return '0b0' if $x->is_zero();
- my $x1 = $x->copy()->babs(); my ($xr,$x10000,$b);
- if ($] >= 5.006)
- {
- $x10000 = Math::BigInt->new (0x10000); $b = 'b16';
- }
- else
- {
- $x10000 = Math::BigInt->new (0x1000); $b = 'b12';
- }
- while (!$x1->is_zero())
- {
- ($x1, $xr) = bdiv($x1,$x10000);
- $es .= unpack($b,pack('v',$xr->numify()));
- }
- $es = reverse $es;
- $es =~ s/^[0]+//; # strip leading zeros
- $s .= '0b';
+ return $s . ${$CALC->_as_bin($x->{value})};
}
- $s . $es;
+
+ require $EMU_LIB;
+ __emu_as_bin(ref($x),$x,$s);
+
}
##############################################################################
my $sign = '+'; $sign = '-' if ($$hs =~ /^-/);
$$hs =~ s/^[+-]//; # strip sign
- if ($CAN{'_from_hex'})
+ if ($CAN{'from_hex'})
{
$x->{value} = $CALC->_from_hex($hs);
}
else
{
# fallback to pure perl
- my $mul = Math::BigInt->bzero(); $mul++;
+ my $mul = Math::BigInt->bone();
my $x65536 = Math::BigInt->new(65536);
- my $len = CORE::length($$hs)-2;
- $len = int($len/4); # 4-digit parts, w/o '0x'
+ my $len = CORE::length($$hs)-2; # minus 2 for 0x
+ $len = int($len/4); # 4-digit parts, w/o '0x'
my $val; my $i = -4;
while ($len >= 0)
{
my $sign = '+'; $sign = '-' if ($$bs =~ /^\-/);
$$bs =~ s/^[+-]//; # strip sign
- if ($CAN{'_from_bin'})
+ if ($CAN{'from_bin'})
{
$x->{value} = $CALC->_from_bin($bs);
}
else
{
- my $mul = Math::BigInt->bzero(); $mul++;
+ my $mul = Math::BigInt->bone();
my $x256 = Math::BigInt->new(256);
- my $len = CORE::length($$bs)-2;
+ my $len = CORE::length($$bs)-2; # minus 2 for 0b
$len = int($len/8); # 8-digit parts, w/o '0b'
my $val; my $i = -8;
while ($len >= 0)
###############################################################################
# this method return 0 if the object can be modified, or 1 for not
-# We use a fast use constant statement here, to avoid costly calls. Subclasses
+# We use a fast constant sub() here, to avoid costly calls. Subclasses
# may override it with special code (f.i. Math::BigInt::Constant does so)
sub modify () { 0; }
$x->is_one('-'); # if $x is -1
$x->is_odd(); # if $x is odd
$x->is_even(); # if $x is even
- $x->is_positive(); # if $x >= 0
- $x->is_negative(); # if $x < 0
+ $x->is_pos(); # if $x >= 0
+ $x->is_neg(); # if $x < 0
$x->is_inf(sign); # if $x is +inf, or -inf (sign is default '+')
$x->is_int(); # if $x is an integer (not a float)
$x->mantissa(); # return (signed) mantissa as BigInt
$x->parts(); # return (mantissa,exponent) as BigInt
$x->copy(); # make a true copy of $x (unlike $y = $x;)
- $x->as_number(); # return as BigInt (in BigInt: same as copy())
+ $x->as_int(); # return as BigInt (in BigInt: same as copy())
+ $x->numify(); # return as scalar (might overflow!)
# conversation to string (do not modify their argument)
$x->bstr(); # normalized string
$x->bsstr(); # normalized string in scientific notation
$x->as_hex(); # as signed hexadecimal string with prefixed 0x
$x->as_bin(); # as signed binary string with prefixed 0b
-
+
# precision and accuracy (see section about rounding for more)
$x->precision(); # return P of $x (or global, if P of $x undef)
if ($x == 0)
-=head2 is_positive()/is_negative()
+=head2 is_pos()/is_neg()
- $x->is_positive(); # true if >= 0
- $x->is_negative(); # true if < 0
+ $x->is_pos(); # true if >= 0
+ $x->is_neg(); # true if < 0
The methods return true if the argument is positive or negative, respectively.
C<NaN> is neither positive nor negative, while C<+inf> counts as positive, and
These methods are only testing the sign, and not the value.
+C<is_positive()> and C<is_negative()> are aliase to C<is_pos()> and
+C<is_neg()>, respectively. C<is_positive()> and C<is_negative()> were
+introduced in v1.36, while C<is_pos()> and C<is_neg()> were only introduced
+in v1.68.
+
=head2 is_odd()/is_even()/is_int()
$x->is_odd(); # true if odd, false for even
$x->copy(); # make a true copy of $x (unlike $y = $x;)
-=head2 as_number
+=head2 as_int
- $x->as_number(); # return as BigInt (in BigInt: same as copy())
+ $x->as_int();
+
+Returns $x as a BigInt (truncated towards zero). In BigInt this is the same as
+C<copy()>.
+
+C<as_number()> is an alias to this method. C<as_number> was introduced in
+v1.22, while C<as_int()> was only introduced in v1.68.
-=head2 bsrt
+=head2 bstr
+
+ $x->bstr();
- $x->bstr(); # return normalized string
+Returns a normalized string represantation of C<$x>.
=head2 bsstr
use strict;
# use warnings; # dont use warnings for older Perls
-require Exporter;
-use vars qw/@ISA $VERSION/;
-@ISA = qw(Exporter);
+use vars qw/$VERSION/;
-$VERSION = '0.37';
+$VERSION = '0.38';
# Package to store unsigned big integers in decimal and do math with them
# 1ex format. Assumes normalized value as input.
my $d = $_[1];
my $il = length($$d)-1;
+
+ # < BASE_LEN due len-1 above
+ return [ int($$d) ] 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)) ];
# ref to array, ref to array, return ref to array
my ($c,$cx,$cy) = @_;
+ if (scalar @$cy == 1 && $cy->[0] == 0)
+ {
+ splice (@$cx,1); $cx->[0] = 1; # y == 0 => x => 1
+ return $cx;
+ }
+ if ((scalar @$cx == 1 && $cx->[0] == 1) || # x == 1
+ (scalar @$cy == 1 && $cy->[0] == 1)) # or y == 1
+ {
+ return $cx;
+ }
+ if (scalar @$cx == 1 && $cx->[0] == 0)
+ {
+ splice (@$cx,1); $cx->[0] = 0; # 0 ** y => 0 (if not y <= 0)
+ return $cx;
+ }
+
my $pow2 = _one();
my $y_bin = ${_as_bin($c,$cy)}; $y_bin =~ s/^0b//;
return if (scalar @$x == 1 && $x->[0] == 0);
# BASE 0 or 1 => NaN
return if (scalar @$base == 1 && $base->[0] < 2);
- my $cmp = _acmp($c,$x,$base);
- # X == BASE => 1
+ my $cmp = _acmp($c,$x,$base); # X == BASE => 1
if ($cmp == 0)
{
splice (@$x,1); $x->[0] = 1;
my $x_org = _copy($c,$x); # preserve x
splice(@$x,1); $x->[0] = 1; # keep ref to $x
+ my $trial = _copy($c,$base);
+
+ # XXX TODO this only works if $base has only one element
+ if (scalar @$base == 1)
+ {
+ # compute int ( length_in_base_10(X) / ( log(base) / log(10) ) )
+ my $len = _len($c,$x_org);
+ my $res = int($len / (log($base->[0]) / log(10))) || 1; # avoid $res == 0
+
+ $x->[0] = $res;
+ $trial = _pow ($c, _copy($c, $base), $x);
+ my $a = _acmp($x,$trial,$x_org);
+ return ($x,1) if $a == 0;
+ # we now that $res is too small
+ if ($res < 0)
+ {
+ _mul($c,$trial,$base); _add($c, $x, [1]);
+ }
+ else
+ {
+ # or too big
+ _div($c,$trial,$base); _sub($c, $x, [1]);
+ }
+ # did we now get the right result?
+ $a = _acmp($x,$trial,$x_org);
+ return ($x,1) if $a == 0; # yes, exactly
+ # still too big
+ if ($a > 0)
+ {
+ _div($c,$trial,$base); _sub($c, $x, [1]);
+ }
+ }
+
# simple loop that increments $x by two in each step, possible overstepping
# the real result by one
- # use a loop that keeps $x as scalar as long as possible (this is faster)
- my $trial = _copy($c,$base); my $a;
+ my $a;
my $base_mul = _mul($c, _copy($c,$base), $base);
while (($a = _acmp($x,$trial,$x_org)) < 0)
_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
--- /dev/null
+package Math::BigInt;
+
+use 5.005;
+use strict;
+# use warnings; # dont use warnings for older Perls
+
+use vars qw/$VERSION/;
+
+$VERSION = '0.01';
+
+# See SYNOPSIS below.
+
+my $CALC_EMU;
+
+BEGIN
+ {
+ $CALC_EMU = Math::BigInt->config()->{'lib'};
+ }
+
+sub __emu_blog
+ {
+ my ($self,$x,$base,@r) = @_;
+
+ return $x->bnan() if $x->is_zero() || $base->is_zero() || $base->is_one();
+
+ my $acmp = $x->bacmp($base);
+ return $x->bone('+',@r) if $acmp == 0;
+ return $x->bzero(@r) if $acmp < 0 || $x->is_one();
+
+ # blog($x,$base) ** $base + $y = $x
+
+ # this trial multiplication is very fast, even for large counts (like for
+ # 2 ** 1024, since this still requires only 1024 very fast steps
+ # (multiplication of a large number by a very small number is very fast))
+ # See Calc for an even faster algorightmn
+ my $x_org = $x->copy(); # preserve orgx
+ $x->bzero(); # keep ref to $x
+ my $trial = $base->copy();
+ while ($trial->bacmp($x_org) <= 0)
+ {
+ $trial->bmul($base); $x->binc();
+ }
+ $x->round(@r);
+ }
+
+sub __emu_bmodinv
+ {
+ my ($self,$x,$y,@r) = @_;
+
+ my ($u, $u1) = ($self->bzero(), $self->bone());
+ my ($a, $b) = ($y->copy(), $x->copy());
+
+ # first step need always be done since $num (and thus $b) is never 0
+ # Note that the loop is aligned so that the check occurs between #2 and #1
+ # thus saving us one step #2 at the loop end. Typical loop count is 1. Even
+ # a case with 28 loops still gains about 3% with this layout.
+ my $q;
+ ($a, $q, $b) = ($b, $a->bdiv($b)); # step #1
+ # Euclid's Algorithm (calculate GCD of ($a,$b) in $a and also calculate
+ # two values in $u and $u1, we use only $u1 afterwards)
+ my $sign = 1; # flip-flop
+ while (!$b->is_zero()) # found GCD if $b == 0
+ {
+ # the original algorithm had:
+ # ($u, $u1) = ($u1, $u->bsub($u1->copy()->bmul($q))); # step #2
+ # The following creates exact the same sequence of numbers in $u1,
+ # except for the sign ($u1 is now always positive). Since formerly
+ # the sign of $u1 was alternating between '-' and '+', the $sign
+ # flip-flop will take care of that, so that at the end of the loop
+ # we have the real sign of $u1. Keeping numbers positive gains us
+ # speed since badd() is faster than bsub() and makes it possible
+ # to have the algorithmn in Calc for even more speed.
+
+ ($u, $u1) = ($u1, $u->badd($u1->copy()->bmul($q))); # step #2
+ $sign = - $sign; # flip sign
+
+ ($a, $q, $b) = ($b, $a->bdiv($b)); # step #1 again
+ }
+
+ # If the gcd is not 1, then return NaN! It would be pointless to have
+ # called bgcd to check this first, because we would then be performing
+ # the same Euclidean Algorithm *twice* in case the gcd is 1.
+ return $x->bnan() unless $a->is_one();
+
+ $u1->bneg() if $sign != 1; # need to flip?
+
+ $u1->bmod($y); # calc result
+ $x->{value} = $u1->{value}; # and copy over to $x
+ $x->{sign} = $u1->{sign}; # to modify in place
+ $x->round(@r);
+ }
+
+sub __emu_bmodpow
+ {
+ my ($self,$num,$exp,$mod,@r) = @_;
+
+ # in the trivial case,
+ return $num->bzero(@r) if $mod->is_one();
+ return $num->bone('+',@r) if $num->is_zero() or $num->is_one();
+
+ # $num->bmod($mod); # if $x is large, make it smaller first
+ my $acc = $num->copy(); # but this is not really faster...
+
+ $num->bone(); # keep ref to $num
+
+ my $expbin = $exp->as_bin(); $expbin =~ s/^[-]?0b//; # ignore sign and prefix
+ my $len = CORE::length($expbin);
+ while (--$len >= 0)
+ {
+ $num->bmul($acc)->bmod($mod) if substr($expbin,$len,1) eq '1';
+ $acc->bmul($acc)->bmod($mod);
+ }
+
+ $num->round(@r);
+ }
+
+sub __emu_bfac
+ {
+ my ($self,$x,@r) = @_;
+
+ return $x->bone('+',@r) if $x->is_zero() || $x->is_one(); # 0 or 1 => 1
+
+ my $n = $x->copy();
+ $x->bone();
+ # seems we need not to temp. clear A/P of $x since the result is the same
+ my $f = $self->new(2);
+ while ($f->bacmp($n) < 0)
+ {
+ $x->bmul($f); $f->binc();
+ }
+ $x->bmul($f,@r); # last step and also round result
+ }
+
+sub __emu_bpow
+ {
+ my ($self,$x,$y,@r) = @_;
+
+ return $x->bone('+',@r) if $y->is_zero();
+ return $x->round(@r) if $x->is_one() || $y->is_one();
+ return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0)
+
+ my $pow2 = $self->bone();
+ my $y_bin = $y->as_bin(); $y_bin =~ s/^0b//;
+ my $len = CORE::length($y_bin);
+ while (--$len > 0)
+ {
+ $pow2->bmul($x) if substr($y_bin,$len,1) eq '1'; # is odd?
+ $x->bmul($x);
+ }
+ $x->bmul($pow2);
+ $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+ $x;
+ }
+
+sub __emu_band
+ {
+ my ($self,$x,$y,$sx,$sy,@r) = @_;
+
+ return $x->bzero(@r) if $y->is_zero() || $x->is_zero();
+
+ my $sign = 0; # sign of result
+ $sign = 1 if $sx == -1 && $sy == -1;
+
+ my ($bx,$by);
+
+ if ($sx == -1) # if x is negative
+ {
+ # two's complement: inc and flip all "bits" in $bx
+ $bx = $x->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc
+ $bx =~ s/-?0x//;
+ $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
+ }
+ else
+ {
+ $bx = $x->as_hex(); # get binary representation
+ $bx =~ s/-?0x//;
+ $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
+ }
+ if ($sy == -1) # if y is negative
+ {
+ # two's complement: inc and flip all "bits" in $by
+ $by = $y->copy()->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc
+ $by =~ s/-?0x//;
+ $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
+ }
+ else
+ {
+ $by = $y->as_hex(); # get binary representation
+ $by =~ s/-?0x//;
+ $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
+ }
+ # now we have bit-strings from X and Y, reverse them for padding
+ $bx = reverse $bx;
+ $by = reverse $by;
+
+ # cut the longer string to the length of the shorter one (the result would
+ # be 0 due to AND anyway)
+ my $diff = CORE::length($bx) - CORE::length($by);
+ if ($diff > 0)
+ {
+ $bx = substr($bx,0,CORE::length($by));
+ }
+ elsif ($diff < 0)
+ {
+ $by = substr($by,0,CORE::length($bx));
+ }
+
+ # and the strings together
+ my $r = $bx & $by;
+
+ # and reverse the result again
+ $bx = reverse $r;
+
+ # one of $x or $y was negative, so need to flip bits in the result
+ # in both cases (one or two of them negative, or both positive) we need
+ # to get the characters back.
+ if ($sign == 1)
+ {
+ $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/;
+ }
+ else
+ {
+ $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/;
+ }
+
+ $bx = '0x' . $bx;
+ if ($CALC_EMU->can('_from_hex'))
+ {
+ $x->{value} = $CALC_EMU->_from_hex( \$bx );
+ }
+ else
+ {
+ $r = $self->new($bx);
+ $x->{value} = $r->{value};
+ }
+
+ # calculate sign of result
+ $x->{sign} = '+';
+ #$x->{sign} = '-' if $sx == $sy && $sx == -1 && !$x->is_zero();
+ $x->{sign} = '-' if $sign == 1 && !$x->is_zero();
+
+ $x->bdec() if $sign == 1;
+
+ $x->round(@r);
+ }
+
+sub __emu_bior
+ {
+ my ($self,$x,$y,$sx,$sy,@r) = @_;
+
+ return $x->round(@r) if $y->is_zero();
+
+ my $sign = 0; # sign of result
+ $sign = 1 if ($sx == -1) || ($sy == -1);
+
+ my ($bx,$by);
+
+ if ($sx == -1) # if x is negative
+ {
+ # two's complement: inc and flip all "bits" in $bx
+ $bx = $x->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc
+ $bx =~ s/-?0x//;
+ $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
+ }
+ else
+ {
+ $bx = $x->as_hex(); # get binary representation
+ $bx =~ s/-?0x//;
+ $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
+ }
+ if ($sy == -1) # if y is negative
+ {
+ # two's complement: inc and flip all "bits" in $by
+ $by = $y->copy()->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc
+ $by =~ s/-?0x//;
+ $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
+ }
+ else
+ {
+ $by = $y->as_hex(); # get binary representation
+ $by =~ s/-?0x//;
+ $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
+ }
+ # now we have bit-strings from X and Y, reverse them for padding
+ $bx = reverse $bx;
+ $by = reverse $by;
+
+ # padd the shorter string
+ my $xx = "\x00"; $xx = "\x0f" if $sx == -1;
+ my $yy = "\x00"; $yy = "\x0f" if $sy == -1;
+ my $diff = CORE::length($bx) - CORE::length($by);
+ if ($diff > 0)
+ {
+ $by .= $yy x $diff;
+ }
+ elsif ($diff < 0)
+ {
+ $bx .= $xx x abs($diff);
+ }
+
+ # or the strings together
+ my $r = $bx | $by;
+
+ # and reverse the result again
+ $bx = reverse $r;
+
+ # one of $x or $y was negative, so need to flip bits in the result
+ # in both cases (one or two of them negative, or both positive) we need
+ # to get the characters back.
+ if ($sign == 1)
+ {
+ $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/;
+ }
+ else
+ {
+ $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/;
+ }
+
+ $bx = '0x' . $bx;
+ if ($CALC_EMU->can('_from_hex'))
+ {
+ $x->{value} = $CALC_EMU->_from_hex( \$bx );
+ }
+ else
+ {
+ $r = $self->new($bx);
+ $x->{value} = $r->{value};
+ }
+
+ # if one of X or Y was negative, we need to decrement result
+ $x->bdec() if $sign == 1;
+
+ $x->round(@r);
+ }
+
+sub __emu_bxor
+ {
+ my ($self,$x,$y,$sx,$sy,@r) = @_;
+
+ return $x->round(@r) if $y->is_zero();
+
+ my $sign = 0; # sign of result
+ $sign = 1 if $x->{sign} ne $y->{sign};
+
+ my ($bx,$by);
+
+ if ($sx == -1) # if x is negative
+ {
+ # two's complement: inc and flip all "bits" in $bx
+ $bx = $x->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc
+ $bx =~ s/-?0x//;
+ $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
+ }
+ else
+ {
+ $bx = $x->as_hex(); # get binary representation
+ $bx =~ s/-?0x//;
+ $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
+ }
+ if ($sy == -1) # if y is negative
+ {
+ # two's complement: inc and flip all "bits" in $by
+ $by = $y->copy()->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc
+ $by =~ s/-?0x//;
+ $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
+ }
+ else
+ {
+ $by = $y->as_hex(); # get binary representation
+ $by =~ s/-?0x//;
+ $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
+ }
+ # now we have bit-strings from X and Y, reverse them for padding
+ $bx = reverse $bx;
+ $by = reverse $by;
+
+ # padd the shorter string
+ my $xx = "\x00"; $xx = "\x0f" if $sx == -1;
+ my $yy = "\x00"; $yy = "\x0f" if $sy == -1;
+ my $diff = CORE::length($bx) - CORE::length($by);
+ if ($diff > 0)
+ {
+ $by .= $yy x $diff;
+ }
+ elsif ($diff < 0)
+ {
+ $bx .= $xx x abs($diff);
+ }
+
+ # xor the strings together
+ my $r = $bx ^ $by;
+
+ # and reverse the result again
+ $bx = reverse $r;
+
+ # one of $x or $y was negative, so need to flip bits in the result
+ # in both cases (one or two of them negative, or both positive) we need
+ # to get the characters back.
+ if ($sign == 1)
+ {
+ $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/;
+ }
+ else
+ {
+ $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/;
+ }
+
+ $bx = '0x' . $bx;
+ if ($CALC_EMU->can('_from_hex'))
+ {
+ $x->{value} = $CALC_EMU->_from_hex( \$bx );
+ }
+ else
+ {
+ $r = $self->new($bx);
+ $x->{value} = $r->{value};
+ }
+
+ # calculate sign of result
+ $x->{sign} = '+';
+ $x->{sign} = '-' if $sx != $sy && !$x->is_zero();
+
+ $x->bdec() if $sign == 1;
+
+ $x->round(@r);
+ }
+
+sub __emu_bsqrt
+ {
+ my ($self,$x,@r) = @_;
+
+ # this is slow:
+ return $x->round(@r) if $x->is_zero(); # 0,1 => 0,1
+
+ return $x->bone('+',@r) if $x < 4; # 1,2,3 => 1
+ my $y = $x->copy();
+ my $l = int($x->length()/2);
+
+ $x->bone(); # keep ref($x), but modify it
+ $x->blsft($l,10) if $l != 0; # first guess: 1.('0' x (l/2))
+
+ my $last = $self->bzero();
+ my $two = $self->new(2);
+ my $lastlast = $self->bzero();
+ #my $lastlast = $x+$two;
+ while ($last != $x && $lastlast != $x)
+ {
+ $lastlast = $last; $last = $x->copy();
+ $x->badd($y / $x);
+ $x->bdiv($two);
+ }
+ $x->bdec() if $x * $x > $y; # overshot?
+ $x->round(@r);
+ }
+
+sub __emu_broot
+ {
+ my ($self,$x,$y,@r) = @_;
+
+ return $x->bsqrt() if $y->bacmp(2) == 0; # 2 => square root
+
+ # since we take at least a cubic root, and only 8 ** 1/3 >= 2 (==2):
+ return $x->bone('+',@r) if $x < 8; # $x=2..7 => 1
+
+ my $num = $x->numify();
+
+ if ($num <= 1000000)
+ {
+ $x = $self->new( int ( sprintf ("%.8f", $num ** (1 / $y->numify() ))));
+ return $x->round(@r);
+ }
+
+ # 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)
+ # See Calc.pm for more details
+ my $b = $y->as_bin();
+ if ($b =~ /0b1(0+)/)
+ {
+ my $count = CORE::length($1); # 0b100 => len('00') => 2
+ my $cnt = $count; # counter for loop
+ my $shift = $self->new(6);
+ $x->blsft($shift); # add some zeros (even amount)
+ while ($cnt-- > 0)
+ {
+ # 'inflate' $X by adding more zeros
+ $x->blsft($shift);
+ # calculate sqrt($x), $x is now a bit too big, again. In the next
+ # round we make even bigger, again.
+ $x->bsqrt($x);
+ }
+ # $x is still to big, so truncate result
+ $x->brsft($shift);
+ }
+ else
+ {
+ # Should compute a guess of the result (by rule of thumb), then improve it
+ # via Newton's method or something similiar.
+ # XXX TODO
+ warn ('broot() not fully implemented in BigInt.');
+ }
+ $x->round(@r);
+ }
+
+sub __emu_as_hex
+ {
+ my ($self,$x,$s) = @_;
+
+ return '0x0' if $x->is_zero();
+
+ my $x1 = $x->copy()->babs(); my ($xr,$x10000,$h,$es);
+ if ($] >= 5.006)
+ {
+ $x10000 = $self->new (0x10000); $h = 'h4';
+ }
+ else
+ {
+ $x10000 = $self->new (0x1000); $h = 'h3';
+ }
+ while (!$x1->is_zero())
+ {
+ ($x1, $xr) = bdiv($x1,$x10000);
+ $es .= unpack($h,pack('v',$xr->numify()));
+ }
+ $es = reverse $es;
+ $es =~ s/^[0]+//; # strip leading zeros
+ $s . '0x' . $es;
+ }
+
+sub __emu_as_bin
+ {
+ my ($self,$x,$s) = @_;
+
+ return '0b0' if $x->is_zero();
+
+ my $x1 = $x->copy()->babs(); my ($xr,$x10000,$b,$es);
+ if ($] >= 5.006)
+ {
+ $x10000 = $self->new (0x10000); $b = 'b16';
+ }
+ else
+ {
+ $x10000 = $self->new (0x1000); $b = 'b12';
+ }
+ while (!$x1->is_zero())
+ {
+ ($x1, $xr) = bdiv($x1,$x10000);
+ $es .= unpack($b,pack('v',$xr->numify()));
+ }
+ $es = reverse $es;
+ $es =~ s/^[0]+//; # strip leading zeros
+ $s . '0b' . $es;
+ }
+
+##############################################################################
+##############################################################################
+
+1;
+__END__
+
+=head1 NAME
+
+Math::BigInt::CalcEmu - Emulate low-level math with BigInt code
+
+=head1 SYNOPSIS
+
+Contains routines that emulate low-level math functions in BigInt, e.g.
+optional routines the low-level math package does not provide on it's own.
+
+Will be loaded on demand and automatically by BigInt.
+
+Stuff here is really low-priority to optimize,
+since it is far better to implement the operation in the low-level math
+libary directly, possible even using a call to the native lib.
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=head1 LICENSE
+
+This program is free software; you may redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 AUTHORS
+
+(c) Tels http://bloodgate.com 2003 - based on BigInt code by
+Tels from 2001-2003.
+
+=head1 SEE ALSO
+
+L<Math::BigInt>, L<Math::BigFloat>, L<Math::BigInt::BitVect>,
+L<Math::BigInt::GMP> and L<Math::BigInt::Pari>.
+
+=cut
--- /dev/null
+
+# alias subroutine testing, included by sub_ali.t and mbi_ali.t
+
+my $x = $CL->new(123);
+
+is ($x->is_pos(), 1, '123 is positive');
+is ($x->is_neg(), 0, '123 is not negative');
+is ($x->as_int(), 123, '123 is 123 as int');
+is (ref($x->as_int()), $CL, '123 is scalar as int');
+$x->bneg();
+is ($x->is_pos(), 0, '-123 is not positive');
+is ($x->is_neg(), 1, '-123 is negative');
&ffac
Nanfac:NaN
-1:NaN
-+inf:NaN
++inf:inf
-inf:NaN
0:1
1:1
BEGIN
{
- plan tests => 296;
+ plan tests => 300;
}
my ($BASE_LEN, $AND_BITS, $XOR_BITS, $OR_BITS, $BASE_LEN_SMALL, $MAX_VAL) =
ok (${$C->_str($C->_root($x,$n))},'3');
# _pow (and _root)
+$x = $C->_new(\"0"); $n = $C->_new(\"3"); # 0 ** y => 0
+ok (${$C->_str($C->_pow($x,$n))}, 0);
+$x = $C->_new(\"3"); $n = $C->_new(\"0"); # x ** 0 => 1
+ok (${$C->_str($C->_pow($x,$n))}, 1);
+$x = $C->_new(\"1"); $n = $C->_new(\"3"); # 1 ** y => 1
+ok (${$C->_str($C->_pow($x,$n))}, 1);
+$x = $C->_new(\"5"); $n = $C->_new(\"1"); # x ** 1 => x
+ok (${$C->_str($C->_pow($x,$n))}, 5);
+
$x = $C->_new(\"81"); $n = $C->_new(\"3"); # 81 ** 3 == 531441
ok (${$C->_str($C->_pow($x,$n))},81 ** 3);
&bfac
-1:NaN
NaNfac:NaN
-+inf:NaN
++inf:inf
-inf:NaN
0:1
1:1
--- /dev/null
+#!/usr/bin/perl -w
+
+# test that the new alias names work
+
+use Test::More;
+use strict;
+
+BEGIN
+ {
+ $| = 1;
+ # to locate the testing files
+ my $location = $0; $location =~ s/mbf_ali.t//i;
+ if ($ENV{PERL_CORE})
+ {
+ # testing with the core distribution
+ @INC = qw(../t/lib);
+ }
+ unshift @INC, qw(../lib);
+ if (-d 't')
+ {
+ chdir 't';
+ require File::Spec;
+ unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
+ }
+ else
+ {
+ unshift @INC, $location;
+ }
+ print "# INC = @INC\n";
+
+ plan tests => 6;
+ }
+
+use Math::BigFloat;
+
+use vars qw/$x $CL/;
+
+$CL = 'Math::BigFloat';
+
+require 'alias.inc';
+
+
--- /dev/null
+#!/usr/bin/perl -w
+
+# test that the new alias names work
+
+use Test::More;
+use strict;
+
+BEGIN
+ {
+ $| = 1;
+ # to locate the testing files
+ my $location = $0; $location =~ s/mbi_ali.t//i;
+ if ($ENV{PERL_CORE})
+ {
+ # testing with the core distribution
+ @INC = qw(../t/lib);
+ }
+ unshift @INC, qw(../lib);
+ if (-d 't')
+ {
+ chdir 't';
+ require File::Spec;
+ unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
+ }
+ else
+ {
+ unshift @INC, $location;
+ }
+ print "# INC = @INC\n";
+
+ plan tests => 6;
+ }
+
+use Math::BigInt;
+
+use vars qw/$x $CL/;
+
+$CL = 'Math::BigInt';
+
+require 'alias.inc';
+
+
--- /dev/null
+#!/usr/bin/perl -w
+
+# test that the new alias names work
+
+use Test::More;
+use strict;
+
+BEGIN
+ {
+ $| = 1;
+ # to locate the testing files
+ my $location = $0; $location =~ s/sub_ali.t//i;
+ if ($ENV{PERL_CORE})
+ {
+ # testing with the core distribution
+ @INC = qw(../t/lib);
+ }
+ unshift @INC, qw(../lib);
+ if (-d 't')
+ {
+ chdir 't';
+ require File::Spec;
+ unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
+ }
+ else
+ {
+ unshift @INC, $location;
+ }
+ print "# INC = @INC\n";
+
+ plan tests => 6;
+ }
+
+use Math::BigInt::Subclass;
+
+use vars qw/$CL $x/;
+$CL = 'Math::BigInt::Subclass';
+
+require 'alias.inc';
+
&bfac
-1:NaN
NaNfac:NaN
-+inf:NaN
++inf:inf
-inf:NaN
0:1
1:1
projects / p5sagit/p5-mst-13.2.git / commitdiff