lib/Math/BigInt.pm

   1 package Math::BigInt;
   2
   3 #
   4 # "Mike had an infinite amount to do and a negative amount of time in which
   5 # to do it." - Before and After
   6 #
   7
   8 # The following hash values are used:
   9 #   value: unsigned int with actual value (as a Math::BigInt::Calc or similiar)
  10 #   sign : +,-,NaN,+inf,-inf
  11 #   _a   : accuracy
  12 #   _p   : precision
  13 #   _f   : flags, used by MBF to flag parts of a float as untouchable
  14
  15 # Remember not to take shortcuts ala $xs = $x->{value}; $CALC->foo($xs); since
  16 # underlying lib might change the reference!
  17
  18 my $class = "Math::BigInt";
  19 require 5.005;
  20
  21 $VERSION = '1.60';
  22 use Exporter;
  23 @ISA =       qw( Exporter );
  24 @EXPORT_OK = qw( objectify _swap bgcd blcm);
  25 use vars qw/$round_mode $accuracy $precision $div_scale $rnd_mode/;
  26 use vars qw/$upgrade $downgrade/;
  27 use strict;
  28
  29 # Inside overload, the first arg is always an object. If the original code had
  30 # it reversed (like $x = 2 * $y), then the third paramater indicates this
  31 # swapping. To make it work, we use a helper routine which not only reswaps the
  32 # params, but also makes a new object in this case. See _swap() for details,
  33 # especially the cases of operators with different classes.
  34
  35 # For overloaded ops with only one argument we simple use $_[0]->copy() to
  36 # preserve the argument.
  37
  38 # Thus inheritance of overload operators becomes possible and transparent for
  39 # our subclasses without the need to repeat the entire overload section there.
  40
  41 use overload
  42 '='     =>      sub { $_[0]->copy(); },
  43
  44 # '+' and '-' do not use _swap, since it is a triffle slower. If you want to
  45 # override _swap (if ever), then override overload of '+' and '-', too!
  46 # for sub it is a bit tricky to keep b: b-a => -a+b
  47 '-'     =>      sub { my $c = $_[0]->copy; $_[2] ?
  48                    $c->bneg()->badd($_[1]) :
  49                    $c->bsub( $_[1]) },
  50 '+'     =>      sub { $_[0]->copy()->badd($_[1]); },
  51
  52 # some shortcuts for speed (assumes that reversed order of arguments is routed
  53 # to normal '+' and we thus can always modify first arg. If this is changed,
  54 # this breaks and must be adjusted.)
  55 '+='    =>      sub { $_[0]->badd($_[1]); },
  56 '-='    =>      sub { $_[0]->bsub($_[1]); },
  57 '*='    =>      sub { $_[0]->bmul($_[1]); },
  58 '/='    =>      sub { scalar $_[0]->bdiv($_[1]); },
  59 '%='    =>      sub { $_[0]->bmod($_[1]); },
  60 '^='    =>      sub { $_[0]->bxor($_[1]); },
  61 '&='    =>      sub { $_[0]->band($_[1]); },
  62 '|='    =>      sub { $_[0]->bior($_[1]); },
  63 '**='   =>      sub { $_[0]->bpow($_[1]); },
  64
  65 # not supported by Perl yet
  66 '..'    =>      \&_pointpoint,
  67
  68 '<=>'   =>      sub { $_[2] ?
  69                       ref($_[0])->bcmp($_[1],$_[0]) :
  70                       $_[0]->bcmp($_[1])},
  71 'cmp'   =>      sub {
  72          $_[2] ?
  73                "$_[1]" cmp $_[0]->bstr() :
  74                $_[0]->bstr() cmp "$_[1]" },
  75
  76 'log'   =>      sub { $_[0]->copy()->blog(); },
  77 'int'   =>      sub { $_[0]->copy(); },
  78 'neg'   =>      sub { $_[0]->copy()->bneg(); },
  79 'abs'   =>      sub { $_[0]->copy()->babs(); },
  80 'sqrt'  =>      sub { $_[0]->copy()->bsqrt(); },
  81 '~'     =>      sub { $_[0]->copy()->bnot(); },
  82
  83 '*'     =>      sub { my @a = ref($_[0])->_swap(@_); $a[0]->bmul($a[1]); },
  84 '/'     =>      sub { my @a = ref($_[0])->_swap(@_);scalar $a[0]->bdiv($a[1]);},
  85 '%'     =>      sub { my @a = ref($_[0])->_swap(@_); $a[0]->bmod($a[1]); },
  86 '**'    =>      sub { my @a = ref($_[0])->_swap(@_); $a[0]->bpow($a[1]); },
  87 '<<'    =>      sub { my @a = ref($_[0])->_swap(@_); $a[0]->blsft($a[1]); },
  88 '>>'    =>      sub { my @a = ref($_[0])->_swap(@_); $a[0]->brsft($a[1]); },
  89
  90 '&'     =>      sub { my @a = ref($_[0])->_swap(@_); $a[0]->band($a[1]); },
  91 '|'     =>      sub { my @a = ref($_[0])->_swap(@_); $a[0]->bior($a[1]); },
  92 '^'     =>      sub { my @a = ref($_[0])->_swap(@_); $a[0]->bxor($a[1]); },
  93
  94 # can modify arg of ++ and --, so avoid a new-copy for speed, but don't
  95 # use $_[0]->__one(), it modifies $_[0] to be 1!
  96 '++'    =>      sub { $_[0]->binc() },
  97 '--'    =>      sub { $_[0]->bdec() },
  98
  99 # if overloaded, O(1) instead of O(N) and twice as fast for small numbers
 100 'bool'  =>      sub {
 101   # this kludge is needed for perl prior 5.6.0 since returning 0 here fails :-/
 102   # v5.6.1 dumps on that: return !$_[0]->is_zero() || undef;                :-(
 103   my $t = !$_[0]->is_zero();
 104   undef $t if $t == 0;
 105   $t;
 106   },
 107
 108 # the original qw() does not work with the TIESCALAR below, why?
 109 # Order of arguments unsignificant
 110 '""' => sub { $_[0]->bstr(); },
 111 '0+' => sub { $_[0]->numify(); }
 112 ;
 113
 114 ##############################################################################
 115 # global constants, flags and accessory
 116
 117 use constant MB_NEVER_ROUND => 0x0001;
 118
 119 my $NaNOK=1;                            # are NaNs ok?
 120 my $nan = 'NaN';                        # constants for easier life
 121
 122 my $CALC = 'Math::BigInt::Calc';        # module to do low level math
 123 my $IMPORT = 0;                         # did import() yet?
 124
 125 $round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'
 126 $accuracy   = undef;
 127 $precision  = undef;
 128 $div_scale  = 40;
 129
 130 $upgrade = undef;                       # default is no upgrade
 131 $downgrade = undef;                     # default is no downgrade
 132
 133 ##############################################################################
 134 # the old code had $rnd_mode, so we need to support it, too
 135
 136 $rnd_mode   = 'even';
 137 sub TIESCALAR  { my ($class) = @_; bless \$round_mode, $class; }
 138 sub FETCH      { return $round_mode; }
 139 sub STORE      { $rnd_mode = $_[0]->round_mode($_[1]); }
 140
 141 BEGIN { tie $rnd_mode, 'Math::BigInt'; }
 142
 143 ##############################################################################
 144
 145 sub round_mode
 146   {
 147   no strict 'refs';
 148   # make Class->round_mode() work
 149   my $self = shift;
 150   my $class = ref($self) || $self || __PACKAGE__;
 151   if (defined $_[0])
 152     {
 153     my $m = shift;
 154     die "Unknown round mode $m"
 155      if $m !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
 156     return ${"${class}::round_mode"} = $m;
 157     }
 158   return ${"${class}::round_mode"};
 159   }
 160
 161 sub upgrade
 162   {
 163   no strict 'refs';
 164   # make Class->upgrade() work
 165   my $self = shift;
 166   my $class = ref($self) || $self || __PACKAGE__;
 167   # need to set new value?
 168   if (@_ > 0)
 169     {
 170     my $u = shift;
 171     return ${"${class}::upgrade"} = $u;
 172     }
 173   return ${"${class}::upgrade"};
 174   }
 175
 176 sub downgrade
 177   {
 178   no strict 'refs';
 179   # make Class->downgrade() work
 180   my $self = shift;
 181   my $class = ref($self) || $self || __PACKAGE__;
 182   # need to set new value?
 183   if (@_ > 0)
 184     {
 185     my $u = shift;
 186     return ${"${class}::downgrade"} = $u;
 187     }
 188   return ${"${class}::downgrade"};
 189   }
 190
 191 sub div_scale
 192   {
 193   no strict 'refs';
 194   # make Class->round_mode() work
 195   my $self = shift;
 196   my $class = ref($self) || $self || __PACKAGE__;
 197   if (defined $_[0])
 198     {
 199     die ('div_scale must be greater than zero') if $_[0] < 0;
 200     ${"${class}::div_scale"} = shift;
 201     }
 202   return ${"${class}::div_scale"};
 203   }
 204
 205 sub accuracy
 206   {
 207   # $x->accuracy($a);           ref($x) $a
 208   # $x->accuracy();             ref($x)
 209   # Class->accuracy();          class
 210   # Class->accuracy($a);        class $a
 211
 212   my $x = shift;
 213   my $class = ref($x) || $x || __PACKAGE__;
 214
 215   no strict 'refs';
 216   # need to set new value?
 217   if (@_ > 0)
 218     {
 219     my $a = shift;
 220     die ('accuracy must not be zero') if defined $a && $a == 0;
 221     if (ref($x))
 222       {
 223       # $object->accuracy() or fallback to global
 224       $x->bround($a) if defined $a;
 225       $x->{_a} = $a;                    # set/overwrite, even if not rounded
 226       $x->{_p} = undef;                 # clear P
 227       }
 228     else
 229       {
 230       # set global
 231       ${"${class}::accuracy"} = $a;
 232       ${"${class}::precision"} = undef; # clear P
 233       }
 234     return $a;                          # shortcut
 235     }
 236
 237   my $r;
 238   # $object->accuracy() or fallback to global
 239   $r = $x->{_a} if ref($x);
 240   # but don't return global undef, when $x's accuracy is 0!
 241   $r = ${"${class}::accuracy"} if !defined $r;
 242   $r;
 243   }
 244
 245 sub precision
 246   {
 247   # $x->precision($p);          ref($x) $p
 248   # $x->precision();            ref($x)
 249   # Class->precision();         class
 250   # Class->precision($p);       class $p
 251
 252   my $x = shift;
 253   my $class = ref($x) || $x || __PACKAGE__;
 254
 255   no strict 'refs';
 256   # need to set new value?
 257   if (@_ > 0)
 258     {
 259     my $p = shift;
 260     if (ref($x))
 261       {
 262       # $object->precision() or fallback to global
 263       $x->bfround($p) if defined $p;
 264       $x->{_p} = $p;                    # set/overwrite, even if not rounded
 265       $x->{_a} = undef;                 # clear A
 266       }
 267     else
 268       {
 269       # set global
 270       ${"${class}::precision"} = $p;
 271       ${"${class}::accuracy"} = undef;  # clear A
 272       }
 273     return $p;                          # shortcut
 274     }
 275
 276   my $r;
 277   # $object->precision() or fallback to global
 278   $r = $x->{_p} if ref($x);
 279   # but don't return global undef, when $x's precision is 0!
 280   $r = ${"${class}::precision"} if !defined $r;
 281   $r;
 282   }
 283
 284 sub config
 285   {
 286   # return (later set?) configuration data as hash ref
 287   my $class = shift || 'Math::BigInt';
 288
 289   no strict 'refs';
 290   my $lib = $CALC;
 291   my $cfg = {
 292     lib => $lib,
 293     lib_version => ${"${lib}::VERSION"},
 294     class => $class,
 295     };
 296   foreach (
 297    qw/upgrade downgrade precision accuracy round_mode VERSION div_scale/)
 298     {
 299     $cfg->{lc($_)} = ${"${class}::$_"};
 300     };
 301   $cfg;
 302   }
 303
 304 sub _scale_a
 305   {
 306   # select accuracy parameter based on precedence,
 307   # used by bround() and bfround(), may return undef for scale (means no op)
 308   my ($x,$s,$m,$scale,$mode) = @_;
 309   $scale = $x->{_a} if !defined $scale;
 310   $scale = $s if (!defined $scale);
 311   $mode = $m if !defined $mode;
 312   return ($scale,$mode);
 313   }
 314
 315 sub _scale_p
 316   {
 317   # select precision parameter based on precedence,
 318   # used by bround() and bfround(), may return undef for scale (means no op)
 319   my ($x,$s,$m,$scale,$mode) = @_;
 320   $scale = $x->{_p} if !defined $scale;
 321   $scale = $s if (!defined $scale);
 322   $mode = $m if !defined $mode;
 323   return ($scale,$mode);
 324   }
 325
 326 ##############################################################################
 327 # constructors
 328
 329 sub copy
 330   {
 331   my ($c,$x);
 332   if (@_ > 1)
 333     {
 334     # if two arguments, the first one is the class to "swallow" subclasses
 335     ($c,$x) = @_;
 336     }
 337   else
 338     {
 339     $x = shift;
 340     $c = ref($x);
 341     }
 342   return unless ref($x); # only for objects
 343
 344   my $self = {}; bless $self,$c;
 345   my $r;
 346   foreach my $k (keys %$x)
 347     {
 348     if ($k eq 'value')
 349       {
 350       $self->{value} = $CALC->_copy($x->{value}); next;
 351       }
 352     if (!($r = ref($x->{$k})))
 353       {
 354       $self->{$k} = $x->{$k}; next;
 355       }
 356     if ($r eq 'SCALAR')
 357       {
 358       $self->{$k} = \${$x->{$k}};
 359       }
 360     elsif ($r eq 'ARRAY')
 361       {
 362       $self->{$k} = [ @{$x->{$k}} ];
 363       }
 364     elsif ($r eq 'HASH')
 365       {
 366       # only one level deep!
 367       foreach my $h (keys %{$x->{$k}})
 368         {
 369         $self->{$k}->{$h} = $x->{$k}->{$h};
 370         }
 371       }
 372     else # normal ref
 373       {
 374       my $xk = $x->{$k};
 375       if ($xk->can('copy'))
 376         {
 377         $self->{$k} = $xk->copy();
 378         }
 379       else
 380         {
 381         $self->{$k} = $xk->new($xk);
 382         }
 383       }
 384     }
 385   $self;
 386   }
 387
 388 sub new
 389   {
 390   # create a new BigInt object from a string or another BigInt object.
 391   # see hash keys documented at top
 392
 393   # the argument could be an object, so avoid ||, && etc on it, this would
 394   # cause costly overloaded code to be called. The only allowed ops are
 395   # ref() and defined.
 396
 397   my ($class,$wanted,$a,$p,$r) = @_;
 398
 399   # avoid numify-calls by not using || on $wanted!
 400   return $class->bzero($a,$p) if !defined $wanted;      # default to 0
 401   return $class->copy($wanted,$a,$p,$r)
 402    if ref($wanted) && $wanted->isa($class);             # MBI or subclass
 403
 404   $class->import() if $IMPORT == 0;             # make require work
 405
 406   my $self = bless {}, $class;
 407
 408   # shortcut for "normal" numbers
 409   if ((!ref $wanted) && ($wanted =~ /^([+-]?)[1-9][0-9]*$/))
 410     {
 411     $self->{sign} = $1 || '+';
 412     my $ref = \$wanted;
 413     if ($wanted =~ /^[+-]/)
 414      {
 415       # remove sign without touching wanted
 416       my $t = $wanted; $t =~ s/^[+-]//; $ref = \$t;
 417       }
 418     $self->{value} = $CALC->_new($ref);
 419     no strict 'refs';
 420     if ( (defined $a) || (defined $p)
 421         || (defined ${"${class}::precision"})
 422         || (defined ${"${class}::accuracy"})
 423        )
 424       {
 425       $self->round($a,$p,$r) unless (@_ == 4 && !defined $a && !defined $p);
 426       }
 427     return $self;
 428     }
 429
 430   # handle '+inf', '-inf' first
 431   if ($wanted =~ /^[+-]?inf$/)
 432     {
 433     $self->{value} = $CALC->_zero();
 434     $self->{sign} = $wanted; $self->{sign} = '+inf' if $self->{sign} eq 'inf';
 435     return $self;
 436     }
 437   # split str in m mantissa, e exponent, i integer, f fraction, v value, s sign
 438   my ($mis,$miv,$mfv,$es,$ev) = _split(\$wanted);
 439   if (!ref $mis)
 440     {
 441     die "$wanted is not a number initialized to $class" if !$NaNOK;
 442     #print "NaN 1\n";
 443     $self->{value} = $CALC->_zero();
 444     $self->{sign} = $nan;
 445     return $self;
 446     }
 447   if (!ref $miv)
 448     {
 449     # _from_hex or _from_bin
 450     $self->{value} = $mis->{value};
 451     $self->{sign} = $mis->{sign};
 452     return $self;       # throw away $mis
 453     }
 454   # make integer from mantissa by adjusting exp, then convert to bigint
 455   $self->{sign} = $$mis;                        # store sign
 456   $self->{value} = $CALC->_zero();              # for all the NaN cases
 457   my $e = int("$$es$$ev");                      # exponent (avoid recursion)
 458   if ($e > 0)
 459     {
 460     my $diff = $e - CORE::length($$mfv);
 461     if ($diff < 0)                              # Not integer
 462       {
 463       #print "NOI 1\n";
 464       return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
 465       $self->{sign} = $nan;
 466       }
 467     else                                        # diff >= 0
 468       {
 469       # adjust fraction and add it to value
 470       # print "diff > 0 $$miv\n";
 471       $$miv = $$miv . ($$mfv . '0' x $diff);
 472       }
 473     }
 474   else
 475     {
 476     if ($$mfv ne '')                            # e <= 0
 477       {
 478       # fraction and negative/zero E => NOI
 479       #print "NOI 2 \$\$mfv '$$mfv'\n";
 480       return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
 481       $self->{sign} = $nan;
 482       }
 483     elsif ($e < 0)
 484       {
 485       # xE-y, and empty mfv
 486       #print "xE-y\n";
 487       $e = abs($e);
 488       if ($$miv !~ s/0{$e}$//)          # can strip so many zero's?
 489         {
 490         #print "NOI 3\n";
 491         return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
 492         $self->{sign} = $nan;
 493         }
 494       }
 495     }
 496   $self->{sign} = '+' if $$miv eq '0';                  # normalize -0 => +0
 497   $self->{value} = $CALC->_new($miv) if $self->{sign} =~ /^[+-]$/;
 498   # if any of the globals is set, use them to round and store them inside $self
 499   # do not round for new($x,undef,undef) since that is used by MBF to signal
 500   # no rounding
 501   $self->round($a,$p,$r) unless @_ == 4 && !defined $a && !defined $p;
 502   $self;
 503   }
 504
 505 sub bnan
 506   {
 507   # create a bigint 'NaN', if given a BigInt, set it to 'NaN'
 508   my $self = shift;
 509   $self = $class if !defined $self;
 510   if (!ref($self))
 511     {
 512     my $c = $self; $self = {}; bless $self, $c;
 513     }
 514   $self->import() if $IMPORT == 0;              # make require work
 515   return if $self->modify('bnan');
 516   my $c = ref($self);
 517   if ($self->can('_bnan'))
 518     {
 519     # use subclass to initialize
 520     $self->_bnan();
 521     }
 522   else
 523     {
 524     # otherwise do our own thing
 525     $self->{value} = $CALC->_zero();
 526     }
 527   $self->{sign} = $nan;
 528   delete $self->{_a}; delete $self->{_p};       # rounding NaN is silly
 529   return $self;
 530   }
 531
 532 sub binf
 533   {
 534   # create a bigint '+-inf', if given a BigInt, set it to '+-inf'
 535   # the sign is either '+', or if given, used from there
 536   my $self = shift;
 537   my $sign = shift; $sign = '+' if !defined $sign || $sign !~ /^-(inf)?$/;
 538   $self = $class if !defined $self;
 539   if (!ref($self))
 540     {
 541     my $c = $self; $self = {}; bless $self, $c;
 542     }
 543   $self->import() if $IMPORT == 0;              # make require work
 544   return if $self->modify('binf');
 545   my $c = ref($self);
 546   if ($self->can('_binf'))
 547     {
 548     # use subclass to initialize
 549     $self->_binf();
 550     }
 551   else
 552     {
 553     # otherwise do our own thing
 554     $self->{value} = $CALC->_zero();
 555     }
 556   $sign = $sign . 'inf' if $sign !~ /inf$/;     # - => -inf
 557   $self->{sign} = $sign;
 558   ($self->{_a},$self->{_p}) = @_;               # take over requested rounding
 559   return $self;
 560   }
 561
 562 sub bzero
 563   {
 564   # create a bigint '+0', if given a BigInt, set it to 0
 565   my $self = shift;
 566   $self = $class if !defined $self;
 567
 568   if (!ref($self))
 569     {
 570     my $c = $self; $self = {}; bless $self, $c;
 571     }
 572   $self->import() if $IMPORT == 0;              # make require work
 573   return if $self->modify('bzero');
 574
 575   if ($self->can('_bzero'))
 576     {
 577     # use subclass to initialize
 578     $self->_bzero();
 579     }
 580   else
 581     {
 582     # otherwise do our own thing
 583     $self->{value} = $CALC->_zero();
 584     }
 585   $self->{sign} = '+';
 586   if (@_ > 0)
 587     {
 588     if (@_ > 3)
 589       {
 590       # call like: $x->bzero($a,$p,$r,$y);
 591       ($self,$self->{_a},$self->{_p}) = $self->_find_round_parameters(@_);
 592       }
 593     else
 594       {
 595       $self->{_a} = $_[0]
 596        if ( (!defined $self->{_a}) || (defined $_[0] && $_[0] > $self->{_a}));
 597       $self->{_p} = $_[1]
 598        if ( (!defined $self->{_p}) || (defined $_[1] && $_[1] > $self->{_p}));
 599       }
 600     }
 601   $self;
 602   }
 603
 604 sub bone
 605   {
 606   # create a bigint '+1' (or -1 if given sign '-'),
 607   # if given a BigInt, set it to +1 or -1, respecively
 608   my $self = shift;
 609   my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-';
 610   $self = $class if !defined $self;
 611
 612   if (!ref($self))
 613     {
 614     my $c = $self; $self = {}; bless $self, $c;
 615     }
 616   $self->import() if $IMPORT == 0;              # make require work
 617   return if $self->modify('bone');
 618
 619   if ($self->can('_bone'))
 620     {
 621     # use subclass to initialize
 622     $self->_bone();
 623     }
 624   else
 625     {
 626     # otherwise do our own thing
 627     $self->{value} = $CALC->_one();
 628     }
 629   $self->{sign} = $sign;
 630   if (@_ > 0)
 631     {
 632     if (@_ > 3)
 633       {
 634       # call like: $x->bone($sign,$a,$p,$r,$y);
 635       ($self,$self->{_a},$self->{_p}) = $self->_find_round_parameters(@_);
 636       }
 637     else
 638       {
 639       $self->{_a} = $_[0]
 640        if ( (!defined $self->{_a}) || (defined $_[0] && $_[0] > $self->{_a}));
 641       $self->{_p} = $_[1]
 642        if ( (!defined $self->{_p}) || (defined $_[1] && $_[1] > $self->{_p}));
 643       }
 644     }
 645   $self;
 646   }
 647
 648 ##############################################################################
 649 # string conversation
 650
 651 sub bsstr
 652   {
 653   # (ref to BFLOAT or num_str ) return num_str
 654   # Convert number from internal format to scientific string format.
 655   # internal format is always normalized (no leading zeros, "-0E0" => "+0E0")
 656   my $x = shift; $class = ref($x) || $x; $x = $class->new(shift) if !ref($x);
 657   # my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 658
 659   if ($x->{sign} !~ /^[+-]$/)
 660     {
 661     return $x->{sign} unless $x->{sign} eq '+inf';      # -inf, NaN
 662     return 'inf';                                       # +inf
 663     }
 664   my ($m,$e) = $x->parts();
 665   # e can only be positive
 666   my $sign = 'e+';
 667   # MBF: my $s = $e->{sign}; $s = '' if $s eq '-'; my $sep = 'e'.$s;
 668   return $m->bstr().$sign.$e->bstr();
 669   }
 670
 671 sub bstr
 672   {
 673   # make a string from bigint object
 674   my $x = shift; $class = ref($x) || $x; $x = $class->new(shift) if !ref($x);
 675   # my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 676
 677   if ($x->{sign} !~ /^[+-]$/)
 678     {
 679     return $x->{sign} unless $x->{sign} eq '+inf';      # -inf, NaN
 680     return 'inf';                                       # +inf
 681     }
 682   my $es = ''; $es = $x->{sign} if $x->{sign} eq '-';
 683   return $es.${$CALC->_str($x->{value})};
 684   }
 685
 686 sub numify
 687   {
 688   # Make a "normal" scalar from a BigInt object
 689   my $x = shift; $x = $class->new($x) unless ref $x;
 690   return $x->{sign} if $x->{sign} !~ /^[+-]$/;
 691   my $num = $CALC->_num($x->{value});
 692   return -$num if $x->{sign} eq '-';
 693   $num;
 694   }
 695
 696 ##############################################################################
 697 # public stuff (usually prefixed with "b")
 698
 699 sub sign
 700   {
 701   # return the sign of the number: +/-/-inf/+inf/NaN
 702   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 703
 704   $x->{sign};
 705   }
 706
 707 sub _find_round_parameters
 708   {
 709   # After any operation or when calling round(), the result is rounded by
 710   # regarding the A & P from arguments, local parameters, or globals.
 711
 712   # This procedure finds the round parameters, but it is for speed reasons
 713   # duplicated in round. Otherwise, it is tested by the testsuite and used
 714   # by fdiv().
 715
 716   my ($self,$a,$p,$r,@args) = @_;
 717   # $a accuracy, if given by caller
 718   # $p precision, if given by caller
 719   # $r round_mode, if given by caller
 720   # @args all 'other' arguments (0 for unary, 1 for binary ops)
 721
 722   # leave bigfloat parts alone
 723   return ($self) if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0;
 724
 725   my $c = ref($self);                           # find out class of argument(s)
 726   no strict 'refs';
 727
 728   # now pick $a or $p, but only if we have got "arguments"
 729   if (!defined $a)
 730     {
 731     foreach ($self,@args)
 732       {
 733       # take the defined one, or if both defined, the one that is smaller
 734       $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
 735       }
 736     }
 737   if (!defined $p)
 738     {
 739     # even if $a is defined, take $p, to signal error for both defined
 740     foreach ($self,@args)
 741       {
 742       # take the defined one, or if both defined, the one that is bigger
 743       # -2 > -3, and 3 > 2
 744       $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
 745       }
 746     }
 747   # if still none defined, use globals (#2)
 748   $a = ${"$c\::accuracy"} unless defined $a;
 749   $p = ${"$c\::precision"} unless defined $p;
 750
 751   # no rounding today?
 752   return ($self) unless defined $a || defined $p;               # early out
 753
 754   # set A and set P is an fatal error
 755   return ($self->bnan()) if defined $a && defined $p;
 756
 757   $r = ${"$c\::round_mode"} unless defined $r;
 758   die "Unknown round mode '$r'" if $r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
 759
 760   return ($self,$a,$p,$r);
 761   }
 762
 763 sub round
 764   {
 765   # Round $self according to given parameters, or given second argument's
 766   # parameters or global defaults
 767
 768   # for speed reasons, _find_round_parameters is embeded here:
 769
 770   my ($self,$a,$p,$r,@args) = @_;
 771   # $a accuracy, if given by caller
 772   # $p precision, if given by caller
 773   # $r round_mode, if given by caller
 774   # @args all 'other' arguments (0 for unary, 1 for binary ops)
 775
 776   # leave bigfloat parts alone
 777   return ($self) if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0;
 778
 779   my $c = ref($self);                           # find out class of argument(s)
 780   no strict 'refs';
 781
 782   # now pick $a or $p, but only if we have got "arguments"
 783   if (!defined $a)
 784     {
 785     foreach ($self,@args)
 786       {
 787       # take the defined one, or if both defined, the one that is smaller
 788       $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
 789       }
 790     }
 791   if (!defined $p)
 792     {
 793     # even if $a is defined, take $p, to signal error for both defined
 794     foreach ($self,@args)
 795       {
 796       # take the defined one, or if both defined, the one that is bigger
 797       # -2 > -3, and 3 > 2
 798       $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
 799       }
 800     }
 801   # if still none defined, use globals (#2)
 802   $a = ${"$c\::accuracy"} unless defined $a;
 803   $p = ${"$c\::precision"} unless defined $p;
 804
 805   # no rounding today?
 806   return $self unless defined $a || defined $p;         # early out
 807
 808   # set A and set P is an fatal error
 809   return $self->bnan() if defined $a && defined $p;
 810
 811   $r = ${"$c\::round_mode"} unless defined $r;
 812   die "Unknown round mode '$r'" if $r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
 813
 814   # now round, by calling either fround or ffround:
 815   if (defined $a)
 816     {
 817     $self->bround($a,$r) if !defined $self->{_a} || $self->{_a} >= $a;
 818     }
 819   else # both can't be undefined due to early out
 820     {
 821     $self->bfround($p,$r) if !defined $self->{_p} || $self->{_p} <= $p;
 822     }
 823   $self->bnorm();                       # after round, normalize
 824   }
 825
 826 sub bnorm
 827   {
 828   # (numstr or BINT) return BINT
 829   # Normalize number -- no-op here
 830   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 831   $x;
 832   }
 833
 834 sub babs
 835   {
 836   # (BINT or num_str) return BINT
 837   # make number absolute, or return absolute BINT from string
 838   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 839
 840   return $x if $x->modify('babs');
 841   # post-normalized abs for internal use (does nothing for NaN)
 842   $x->{sign} =~ s/^-/+/;
 843   $x;
 844   }
 845
 846 sub bneg
 847   {
 848   # (BINT or num_str) return BINT
 849   # negate number or make a negated number from string
 850   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 851
 852   return $x if $x->modify('bneg');
 853
 854   # for +0 dont negate (to have always normalized)
 855   $x->{sign} =~ tr/+-/-+/ if !$x->is_zero();    # does nothing for NaN
 856   $x;
 857   }
 858
 859 sub bcmp
 860   {
 861   # Compares 2 values.  Returns one of undef, <0, =0, >0. (suitable for sort)
 862   # (BINT or num_str, BINT or num_str) return cond_code
 863
 864   # set up parameters
 865   my ($self,$x,$y) = (ref($_[0]),@_);
 866
 867   # objectify is costly, so avoid it
 868   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
 869     {
 870     ($self,$x,$y) = objectify(2,@_);
 871     }
 872
 873   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
 874     {
 875     # handle +-inf and NaN
 876     return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
 877     return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
 878     return +1 if $x->{sign} eq '+inf';
 879     return -1 if $x->{sign} eq '-inf';
 880     return -1 if $y->{sign} eq '+inf';
 881     return +1;
 882     }
 883   # check sign for speed first
 884   return 1 if $x->{sign} eq '+' && $y->{sign} eq '-';   # does also 0 <=> -y
 885   return -1 if $x->{sign} eq '-' && $y->{sign} eq '+';  # does also -x <=> 0
 886
 887   # have same sign, so compare absolute values. Don't make tests for zero here
 888   # because it's actually slower than testin in Calc (especially w/ Pari et al)
 889
 890   # post-normalized compare for internal use (honors signs)
 891   if ($x->{sign} eq '+')
 892     {
 893     # $x and $y both > 0
 894     return $CALC->_acmp($x->{value},$y->{value});
 895     }
 896
 897   # $x && $y both < 0
 898   $CALC->_acmp($y->{value},$x->{value});        # swaped (lib returns 0,1,-1)
 899   }
 900
 901 sub bacmp
 902   {
 903   # Compares 2 values, ignoring their signs.
 904   # Returns one of undef, <0, =0, >0. (suitable for sort)
 905   # (BINT, BINT) return cond_code
 906
 907   # set up parameters
 908   my ($self,$x,$y) = (ref($_[0]),@_);
 909   # objectify is costly, so avoid it
 910   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
 911     {
 912     ($self,$x,$y) = objectify(2,@_);
 913     }
 914
 915   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
 916     {
 917     # handle +-inf and NaN
 918     return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
 919     return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
 920     return +1;  # inf is always bigger
 921     }
 922   $CALC->_acmp($x->{value},$y->{value});        # lib does only 0,1,-1
 923   }
 924
 925 sub badd
 926   {
 927   # add second arg (BINT or string) to first (BINT) (modifies first)
 928   # return result as BINT
 929
 930   # set up parameters
 931   my ($self,$x,$y,@r) = (ref($_[0]),@_);
 932   # objectify is costly, so avoid it
 933   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
 934     {
 935     ($self,$x,$y,@r) = objectify(2,@_);
 936     }
 937
 938   return $x if $x->modify('badd');
 939   return $upgrade->badd($x,$y,@r) if defined $upgrade &&
 940     ((!$x->isa($self)) || (!$y->isa($self)));
 941
 942   $r[3] = $y;                           # no push!
 943   # inf and NaN handling
 944   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
 945     {
 946     # NaN first
 947     return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
 948     # inf handling
 949     if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
 950       {
 951       # +inf++inf or -inf+-inf => same, rest is NaN
 952       return $x if $x->{sign} eq $y->{sign};
 953       return $x->bnan();
 954       }
 955     # +-inf + something => +inf
 956     # something +-inf => +-inf
 957     $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/;
 958     return $x;
 959     }
 960
 961   my ($sx, $sy) = ( $x->{sign}, $y->{sign} ); # get signs
 962
 963   if ($sx eq $sy)
 964     {
 965     $x->{value} = $CALC->_add($x->{value},$y->{value}); # same sign, abs add
 966     $x->{sign} = $sx;
 967     }
 968   else
 969     {
 970     my $a = $CALC->_acmp ($y->{value},$x->{value});     # absolute compare
 971     if ($a > 0)
 972       {
 973       #print "swapped sub (a=$a)\n";
 974       $x->{value} = $CALC->_sub($y->{value},$x->{value},1); # abs sub w/ swap
 975       $x->{sign} = $sy;
 976       }
 977     elsif ($a == 0)
 978       {
 979       # speedup, if equal, set result to 0
 980       #print "equal sub, result = 0\n";
 981       $x->{value} = $CALC->_zero();
 982       $x->{sign} = '+';
 983       }
 984     else # a < 0
 985       {
 986       #print "unswapped sub (a=$a)\n";
 987       $x->{value} = $CALC->_sub($x->{value}, $y->{value}); # abs sub
 988       $x->{sign} = $sx;
 989       }
 990     }
 991   $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
 992   $x;
 993   }
 994
 995 sub bsub
 996   {
 997   # (BINT or num_str, BINT or num_str) return num_str
 998   # subtract second arg from first, modify first
 999
1000   # set up parameters
1001   my ($self,$x,$y,@r) = (ref($_[0]),@_);
1002   # objectify is costly, so avoid it
1003   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1004     {
1005     ($self,$x,$y,@r) = objectify(2,@_);
1006     }
1007
1008   return $x if $x->modify('bsub');
1009
1010 # upgrade done by badd():
1011 #  return $upgrade->badd($x,$y,@r) if defined $upgrade &&
1012 #   ((!$x->isa($self)) || (!$y->isa($self)));
1013
1014   if ($y->is_zero())
1015     {
1016     $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
1017     return $x;
1018     }
1019
1020   $y->{sign} =~ tr/+\-/-+/;     # does nothing for NaN
1021   $x->badd($y,@r);              # badd does not leave internal zeros
1022   $y->{sign} =~ tr/+\-/-+/;     # refix $y (does nothing for NaN)
1023   $x;                           # already rounded by badd() or no round necc.
1024   }
1025
1026 sub binc
1027   {
1028   # increment arg by one
1029   my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1030   return $x if $x->modify('binc');
1031
1032   if ($x->{sign} eq '+')
1033     {
1034     $x->{value} = $CALC->_inc($x->{value});
1035     $x->round($a,$p,$r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
1036     return $x;
1037     }
1038   elsif ($x->{sign} eq '-')
1039     {
1040     $x->{value} = $CALC->_dec($x->{value});
1041     $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0
1042     $x->round($a,$p,$r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
1043     return $x;
1044     }
1045   # inf, nan handling etc
1046   $x->badd($self->__one(),$a,$p,$r);            # badd does round
1047   }
1048
1049 sub bdec
1050   {
1051   # decrement arg by one
1052   my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1053   return $x if $x->modify('bdec');
1054
1055   my $zero = $CALC->_is_zero($x->{value}) && $x->{sign} eq '+';
1056   # <= 0
1057   if (($x->{sign} eq '-') || $zero)
1058     {
1059     $x->{value} = $CALC->_inc($x->{value});
1060     $x->{sign} = '-' if $zero;                  # 0 => 1 => -1
1061     $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0
1062     $x->round($a,$p,$r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
1063     return $x;
1064     }
1065   # > 0
1066   elsif ($x->{sign} eq '+')
1067     {
1068     $x->{value} = $CALC->_dec($x->{value});
1069     $x->round($a,$p,$r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
1070     return $x;
1071     }
1072   # inf, nan handling etc
1073   $x->badd($self->__one('-'),$a,$p,$r);                 # badd does round
1074   }
1075
1076 sub blog
1077   {
1078   # not implemented yet
1079   my ($self,$x,$base,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1080
1081   return $upgrade->blog($x,$base,$a,$p,$r) if defined $upgrade;
1082
1083   return $x->bnan();
1084   }
1085
1086 sub blcm
1087   {
1088   # (BINT or num_str, BINT or num_str) return BINT
1089   # does not modify arguments, but returns new object
1090   # Lowest Common Multiplicator
1091
1092   my $y = shift; my ($x);
1093   if (ref($y))
1094     {
1095     $x = $y->copy();
1096     }
1097   else
1098     {
1099     $x = $class->new($y);
1100     }
1101   while (@_) { $x = __lcm($x,shift); }
1102   $x;
1103   }
1104
1105 sub bgcd
1106   {
1107   # (BINT or num_str, BINT or num_str) return BINT
1108   # does not modify arguments, but returns new object
1109   # GCD -- Euclids algorithm, variant C (Knuth Vol 3, pg 341 ff)
1110
1111   my $y = shift;
1112   $y = __PACKAGE__->new($y) if !ref($y);
1113   my $self = ref($y);
1114   my $x = $y->copy();           # keep arguments
1115   if ($CALC->can('_gcd'))
1116     {
1117     while (@_)
1118       {
1119       $y = shift; $y = $self->new($y) if !ref($y);
1120       next if $y->is_zero();
1121       return $x->bnan() if $y->{sign} !~ /^[+-]$/;      # y NaN?
1122       $x->{value} = $CALC->_gcd($x->{value},$y->{value}); last if $x->is_one();
1123       }
1124     }
1125   else
1126     {
1127     while (@_)
1128       {
1129       $y = shift; $y = $self->new($y) if !ref($y);
1130       $x = __gcd($x,$y->copy()); last if $x->is_one();  # _gcd handles NaN
1131       }
1132     }
1133   $x->babs();
1134   }
1135
1136 sub bnot
1137   {
1138   # (num_str or BINT) return BINT
1139   # represent ~x as twos-complement number
1140   # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1141   my ($self,$x,$a,$p,$r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
1142
1143   return $x if $x->modify('bnot');
1144   $x->bneg()->bdec();                   # bdec already does round
1145   }
1146
1147 # is_foo test routines
1148
1149 sub is_zero
1150   {
1151   # return true if arg (BINT or num_str) is zero (array '+', '0')
1152   # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1153   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1154
1155   return 0 if $x->{sign} !~ /^\+$/;                     # -, NaN & +-inf aren't
1156   $CALC->_is_zero($x->{value});
1157   }
1158
1159 sub is_nan
1160   {
1161   # return true if arg (BINT or num_str) is NaN
1162   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
1163
1164   return 1 if $x->{sign} eq $nan;
1165   0;
1166   }
1167
1168 sub is_inf
1169   {
1170   # return true if arg (BINT or num_str) is +-inf
1171   my ($self,$x,$sign) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1172
1173   $sign = '' if !defined $sign;
1174   return 1 if $sign eq $x->{sign};              # match ("+inf" eq "+inf")
1175   return 0 if $sign !~ /^([+-]|)$/;
1176
1177   if ($sign eq '')
1178     {
1179     return 1 if ($x->{sign} =~ /^[+-]inf$/);
1180     return 0;
1181     }
1182   $sign = quotemeta($sign.'inf');
1183   return 1 if ($x->{sign} =~ /^$sign$/);
1184   0;
1185   }
1186
1187 sub is_one
1188   {
1189   # return true if arg (BINT or num_str) is +1
1190   # or -1 if sign is given
1191   # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1192   my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
1193
1194   $sign = '' if !defined $sign; $sign = '+' if $sign ne '-';
1195
1196   return 0 if $x->{sign} ne $sign;      # -1 != +1, NaN, +-inf aren't either
1197   $CALC->_is_one($x->{value});
1198   }
1199
1200 sub is_odd
1201   {
1202   # return true when arg (BINT or num_str) is odd, false for even
1203   # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1204   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1205
1206   return 0 if $x->{sign} !~ /^[+-]$/;                   # NaN & +-inf aren't
1207   $CALC->_is_odd($x->{value});
1208   }
1209
1210 sub is_even
1211   {
1212   # return true when arg (BINT or num_str) is even, false for odd
1213   # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1214   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1215
1216   return 0 if $x->{sign} !~ /^[+-]$/;                   # NaN & +-inf aren't
1217   $CALC->_is_even($x->{value});
1218   }
1219
1220 sub is_positive
1221   {
1222   # return true when arg (BINT or num_str) is positive (>= 0)
1223   # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1224   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1225
1226   return 1 if $x->{sign} =~ /^\+/;
1227   0;
1228   }
1229
1230 sub is_negative
1231   {
1232   # return true when arg (BINT or num_str) is negative (< 0)
1233   # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1234   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1235
1236   return 1 if ($x->{sign} =~ /^-/);
1237   0;
1238   }
1239
1240 sub is_int
1241   {
1242   # return true when arg (BINT or num_str) is an integer
1243   # always true for BigInt, but different for Floats
1244   # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1245   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1246
1247   $x->{sign} =~ /^[+-]$/ ? 1 : 0;               # inf/-inf/NaN aren't
1248   }
1249
1250 ###############################################################################
1251
1252 sub bmul
1253   {
1254   # multiply two numbers -- stolen from Knuth Vol 2 pg 233
1255   # (BINT or num_str, BINT or num_str) return BINT
1256
1257   # set up parameters
1258   my ($self,$x,$y,@r) = (ref($_[0]),@_);
1259   # objectify is costly, so avoid it
1260   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1261     {
1262     ($self,$x,$y,@r) = objectify(2,@_);
1263     }
1264
1265   return $x if $x->modify('bmul');
1266
1267   return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
1268
1269   # inf handling
1270   if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
1271     {
1272     return $x->bnan() if $x->is_zero() || $y->is_zero();
1273     # result will always be +-inf:
1274     # +inf * +/+inf => +inf, -inf * -/-inf => +inf
1275     # +inf * -/-inf => -inf, -inf * +/+inf => -inf
1276     return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
1277     return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
1278     return $x->binf('-');
1279     }
1280
1281   return $upgrade->bmul($x,$y,@r)
1282    if defined $upgrade && $y->isa($upgrade);
1283
1284   $r[3] = $y;                           # no push here
1285
1286   $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => +
1287
1288   $x->{value} = $CALC->_mul($x->{value},$y->{value});   # do actual math
1289   $x->{sign} = '+' if $CALC->_is_zero($x->{value});     # no -0
1290
1291   $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
1292   $x;
1293   }
1294
1295 sub _div_inf
1296   {
1297   # helper function that handles +-inf cases for bdiv()/bmod() to reuse code
1298   my ($self,$x,$y) = @_;
1299
1300   # NaN if x == NaN or y == NaN or x==y==0
1301   return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan()
1302    if (($x->is_nan() || $y->is_nan())   ||
1303        ($x->is_zero() && $y->is_zero()));
1304
1305   # +-inf / +-inf == NaN, reminder also NaN
1306   if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
1307     {
1308     return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan();
1309     }
1310   # x / +-inf => 0, remainder x (works even if x == 0)
1311   if ($y->{sign} =~ /^[+-]inf$/)
1312     {
1313     my $t = $x->copy();         # bzero clobbers up $x
1314     return wantarray ? ($x->bzero(),$t) : $x->bzero()
1315     }
1316
1317   # 5 / 0 => +inf, -6 / 0 => -inf
1318   # +inf / 0 = inf, inf,  and -inf / 0 => -inf, -inf
1319   # exception:   -8 / 0 has remainder -8, not 8
1320   # exception: -inf / 0 has remainder -inf, not inf
1321   if ($y->is_zero())
1322     {
1323     # +-inf / 0 => special case for -inf
1324     return wantarray ?  ($x,$x->copy()) : $x if $x->is_inf();
1325     if (!$x->is_zero() && !$x->is_inf())
1326       {
1327       my $t = $x->copy();               # binf clobbers up $x
1328       return wantarray ?
1329        ($x->binf($x->{sign}),$t) : $x->binf($x->{sign})
1330       }
1331     }
1332
1333   # last case: +-inf / ordinary number
1334   my $sign = '+inf';
1335   $sign = '-inf' if substr($x->{sign},0,1) ne $y->{sign};
1336   $x->{sign} = $sign;
1337   return wantarray ? ($x,$self->bzero()) : $x;
1338   }
1339
1340 sub bdiv
1341   {
1342   # (dividend: BINT or num_str, divisor: BINT or num_str) return
1343   # (BINT,BINT) (quo,rem) or BINT (only rem)
1344
1345   # set up parameters
1346   my ($self,$x,$y,@r) = (ref($_[0]),@_);
1347   # objectify is costly, so avoid it
1348   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1349     {
1350     ($self,$x,$y,@r) = objectify(2,@_);
1351     }
1352
1353   return $x if $x->modify('bdiv');
1354
1355   return $self->_div_inf($x,$y)
1356    if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
1357
1358   return $upgrade->bdiv($upgrade->new($x),$y,@r)
1359    if defined $upgrade && !$y->isa($self);
1360
1361   $r[3] = $y;                                   # no push!
1362
1363   # 0 / something
1364   return
1365    wantarray ? ($x->round(@r),$self->bzero(@r)):$x->round(@r) if $x->is_zero();
1366
1367   # Is $x in the interval [0, $y) (aka $x <= $y) ?
1368   my $cmp = $CALC->_acmp($x->{value},$y->{value});
1369   if (($cmp < 0) and (($x->{sign} eq $y->{sign}) or !wantarray))
1370     {
1371     return $upgrade->bdiv($upgrade->new($x),$upgrade->new($y),@r)
1372      if defined $upgrade;
1373
1374     return $x->bzero()->round(@r) unless wantarray;
1375     my $t = $x->copy();      # make copy first, because $x->bzero() clobbers $x
1376     return ($x->bzero()->round(@r),$t);
1377     }
1378   elsif ($cmp == 0)
1379     {
1380     # shortcut, both are the same, so set to +/- 1
1381     $x->__one( ($x->{sign} ne $y->{sign} ? '-' : '+') );
1382     return $x unless wantarray;
1383     return ($x->round(@r),$self->bzero(@r));
1384     }
1385   return $upgrade->bdiv($upgrade->new($x),$upgrade->new($y),@r)
1386    if defined $upgrade;
1387
1388   # calc new sign and in case $y == +/- 1, return $x
1389   my $xsign = $x->{sign};                               # keep
1390   $x->{sign} = ($x->{sign} ne $y->{sign} ? '-' : '+');
1391   # check for / +-1 (cant use $y->is_one due to '-'
1392   if ($CALC->_is_one($y->{value}))
1393     {
1394     return wantarray ? ($x->round(@r),$self->bzero(@r)) : $x->round(@r);
1395     }
1396
1397   if (wantarray)
1398     {
1399     my $rem = $self->bzero();
1400     ($x->{value},$rem->{value}) = $CALC->_div($x->{value},$y->{value});
1401     $x->{sign} = '+' if $CALC->_is_zero($x->{value});
1402     $rem->{_a} = $x->{_a};
1403     $rem->{_p} = $x->{_p};
1404     $x->round(@r);
1405     if (! $CALC->_is_zero($rem->{value}))
1406       {
1407       $rem->{sign} = $y->{sign};
1408       $rem = $y-$rem if $xsign ne $y->{sign};   # one of them '-'
1409       }
1410     else
1411       {
1412       $rem->{sign} = '+';                       # dont leave -0
1413       }
1414     return ($x,$rem->round(@r));
1415     }
1416
1417   $x->{value} = $CALC->_div($x->{value},$y->{value});
1418   $x->{sign} = '+' if $CALC->_is_zero($x->{value});
1419
1420   $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
1421   $x;
1422   }
1423
1424 ###############################################################################
1425 # modulus functions
1426
1427 sub bmod
1428   {
1429   # modulus (or remainder)
1430   # (BINT or num_str, BINT or num_str) return BINT
1431
1432   # set up parameters
1433   my ($self,$x,$y,@r) = (ref($_[0]),@_);
1434   # objectify is costly, so avoid it
1435   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1436     {
1437     ($self,$x,$y,@r) = objectify(2,@_);
1438     }
1439
1440   return $x if $x->modify('bmod');
1441   $r[3] = $y;                                   # no push!
1442   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero())
1443     {
1444     my ($d,$r) = $self->_div_inf($x,$y);
1445     $x->{sign} = $r->{sign};
1446     $x->{value} = $r->{value};
1447     return $x->round(@r);
1448     }
1449
1450   if ($CALC->can('_mod'))
1451     {
1452     # calc new sign and in case $y == +/- 1, return $x
1453     $x->{value} = $CALC->_mod($x->{value},$y->{value});
1454     if (!$CALC->_is_zero($x->{value}))
1455       {
1456       my $xsign = $x->{sign};
1457       $x->{sign} = $y->{sign};
1458       if ($xsign ne $y->{sign})
1459         {
1460         my $t = $CALC->_copy($x->{value});              # copy $x
1461         $x->{value} = $CALC->_copy($y->{value});        # copy $y to $x
1462         $x->{value} = $CALC->_sub($y->{value},$t,1);    # $y-$x
1463         }
1464       }
1465     else
1466       {
1467       $x->{sign} = '+';                         # dont leave -0
1468       }
1469     $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
1470     return $x;
1471     }
1472   my ($t,$rem) = $self->bdiv($x->copy(),$y,@r); # slow way (also rounds)
1473   # modify in place
1474   foreach (qw/value sign _a _p/)
1475     {
1476     $x->{$_} = $rem->{$_};
1477     }
1478   $x;
1479   }
1480
1481 sub bmodinv
1482   {
1483   # modular inverse.  given a number which is (hopefully) relatively
1484   # prime to the modulus, calculate its inverse using Euclid's
1485   # alogrithm.  if the number is not relatively prime to the modulus
1486   # (i.e. their gcd is not one) then NaN is returned.
1487
1488   # set up parameters
1489   my ($self,$x,$y,@r) = (ref($_[0]),@_);
1490   # objectify is costly, so avoid it
1491   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1492     {
1493     ($self,$x,$y,@r) = objectify(2,@_);
1494     }
1495
1496   return $x if $x->modify('bmodinv');
1497
1498   return $x->bnan()
1499         if ($y->{sign} ne '+'                           # -, NaN, +inf, -inf
1500          || $x->is_zero()                               # or num == 0
1501          || $x->{sign} !~ /^[+-]$/                      # or num NaN, inf, -inf
1502         );
1503
1504   # put least residue into $x if $x was negative, and thus make it positive
1505   $x->bmod($y) if $x->{sign} eq '-';
1506
1507   if ($CALC->can('_modinv'))
1508     {
1509     $x->{value} = $CALC->_modinv($x->{value},$y->{value});
1510     $x->bnan() if !defined $x->{value} ;            # in case there was none
1511     return $x;
1512     }
1513
1514   my ($u, $u1) = ($self->bzero(), $self->bone());
1515   my ($a, $b) = ($y->copy(), $x->copy());
1516
1517   # first step need always be done since $num (and thus $b) is never 0
1518   # Note that the loop is aligned so that the check occurs between #2 and #1
1519   # thus saving us one step #2 at the loop end. Typical loop count is 1. Even
1520   # a case with 28 loops still gains about 3% with this layout.
1521   my $q;
1522   ($a, $q, $b) = ($b, $a->bdiv($b));                    # step #1
1523   # Euclid's Algorithm
1524   while (!$b->is_zero())
1525     {
1526     ($u, $u1) = ($u1, $u->bsub($u1->copy()->bmul($q))); # step #2
1527     ($a, $q, $b) = ($b, $a->bdiv($b));                  # step #1 again
1528     }
1529
1530   # if the gcd is not 1, then return NaN!  It would be pointless to
1531   # have called bgcd to check this first, because we would then be performing
1532   # the same Euclidean Algorithm *twice*
1533   return $x->bnan() unless $a->is_one();
1534
1535   $u1->bmod($y);
1536   $x->{value} = $u1->{value};
1537   $x->{sign} = $u1->{sign};
1538   $x;
1539   }
1540
1541 sub bmodpow
1542   {
1543   # takes a very large number to a very large exponent in a given very
1544   # large modulus, quickly, thanks to binary exponentation.  supports
1545   # negative exponents.
1546   my ($self,$num,$exp,$mod,@r) = objectify(3,@_);
1547
1548   return $num if $num->modify('bmodpow');
1549
1550   # check modulus for valid values
1551   return $num->bnan() if ($mod->{sign} ne '+'           # NaN, - , -inf, +inf
1552                        || $mod->is_zero());
1553
1554   # check exponent for valid values
1555   if ($exp->{sign} =~ /\w/)
1556     {
1557     # i.e., if it's NaN, +inf, or -inf...
1558     return $num->bnan();
1559     }
1560
1561   $num->bmodinv ($mod) if ($exp->{sign} eq '-');
1562
1563   # check num for valid values (also NaN if there was no inverse but $exp < 0)
1564   return $num->bnan() if $num->{sign} !~ /^[+-]$/;
1565
1566   if ($CALC->can('_modpow'))
1567     {
1568     # $mod is positive, sign on $exp is ignored, result also positive
1569     $num->{value} = $CALC->_modpow($num->{value},$exp->{value},$mod->{value});
1570     return $num;
1571     }
1572
1573   # in the trivial case,
1574   return $num->bzero(@r) if $mod->is_one();
1575   return $num->bone('+',@r) if $num->is_zero() or $num->is_one();
1576
1577   # $num->bmod($mod);           # if $x is large, make it smaller first
1578   my $acc = $num->copy();       # but this is not really faster...
1579
1580   $num->bone(); # keep ref to $num
1581
1582   my $expbin = $exp->as_bin(); $expbin =~ s/^[-]?0b//; # ignore sign and prefix
1583   my $len = length($expbin);
1584   while (--$len >= 0)
1585     {
1586     if( substr($expbin,$len,1) eq '1')
1587       {
1588       $num->bmul($acc)->bmod($mod);
1589       }
1590     $acc->bmul($acc)->bmod($mod);
1591     }
1592
1593   $num;
1594   }
1595
1596 ###############################################################################
1597
1598 sub bfac
1599   {
1600   # (BINT or num_str, BINT or num_str) return BINT
1601   # compute factorial numbers
1602   # modifies first argument
1603   my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1604
1605   return $x if $x->modify('bfac');
1606
1607   return $x->bnan() if $x->{sign} ne '+';       # inf, NnN, <0 etc => NaN
1608   return $x->bone('+',@r) if $x->is_zero() || $x->is_one();     # 0 or 1 => 1
1609
1610   if ($CALC->can('_fac'))
1611     {
1612     $x->{value} = $CALC->_fac($x->{value});
1613     return $x->round(@r);
1614     }
1615
1616   my $n = $x->copy();
1617   $x->bone();
1618   # seems we need not to temp. clear A/P of $x since the result is the same
1619   my $f = $self->new(2);
1620   while ($f->bacmp($n) < 0)
1621     {
1622     $x->bmul($f); $f->binc();
1623     }
1624   $x->bmul($f,@r);                      # last step and also round
1625   }
1626
1627 sub bpow
1628   {
1629   # (BINT or num_str, BINT or num_str) return BINT
1630   # compute power of two numbers -- stolen from Knuth Vol 2 pg 233
1631   # modifies first argument
1632
1633   # set up parameters
1634   my ($self,$x,$y,@r) = (ref($_[0]),@_);
1635   # objectify is costly, so avoid it
1636   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1637     {
1638     ($self,$x,$y,@r) = objectify(2,@_);
1639     }
1640
1641   return $x if $x->modify('bpow');
1642
1643   return $upgrade->bpow($upgrade->new($x),$y,@r)
1644    if defined $upgrade && !$y->isa($self);
1645
1646   $r[3] = $y;                                   # no push!
1647   return $x if $x->{sign} =~ /^[+-]inf$/;       # -inf/+inf ** x
1648   return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
1649   return $x->bone('+',@r) if $y->is_zero();
1650   return $x->round(@r) if $x->is_one() || $y->is_one();
1651   if ($x->{sign} eq '-' && $CALC->_is_one($x->{value}))
1652     {
1653     # if $x == -1 and odd/even y => +1/-1
1654     return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r);
1655     # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1;
1656     }
1657   # 1 ** -y => 1 / (1 ** |y|)
1658   # so do test for negative $y after above's clause
1659   return $x->bnan() if $y->{sign} eq '-';
1660   return $x->round(@r) if $x->is_zero();  # 0**y => 0 (if not y <= 0)
1661
1662   if ($CALC->can('_pow'))
1663     {
1664     $x->{value} = $CALC->_pow($x->{value},$y->{value});
1665     $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
1666     return $x;
1667     }
1668
1669 # based on the assumption that shifting in base 10 is fast, and that mul
1670 # works faster if numbers are small: we count trailing zeros (this step is
1671 # O(1)..O(N), but in case of O(N) we save much more time due to this),
1672 # stripping them out of the multiplication, and add $count * $y zeros
1673 # afterwards like this:
1674 # 300 ** 3 == 300*300*300 == 3*3*3 . '0' x 2 * 3 == 27 . '0' x 6
1675 # creates deep recursion since brsft/blsft use bpow sometimes.
1676 #  my $zeros = $x->_trailing_zeros();
1677 #  if ($zeros > 0)
1678 #    {
1679 #    $x->brsft($zeros,10);      # remove zeros
1680 #    $x->bpow($y);              # recursion (will not branch into here again)
1681 #    $zeros = $y * $zeros;      # real number of zeros to add
1682 #    $x->blsft($zeros,10);
1683 #    return $x->round(@r);
1684 #    }
1685
1686   my $pow2 = $self->__one();
1687   my $y_bin = $y->as_bin(); $y_bin =~ s/^0b//;
1688   my $len = length($y_bin);
1689   while (--$len > 0)
1690     {
1691     $pow2->bmul($x) if substr($y_bin,$len,1) eq '1';    # is odd?
1692     $x->bmul($x);
1693     }
1694   $x->bmul($pow2);
1695   $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
1696   $x;
1697   }
1698
1699 sub blsft
1700   {
1701   # (BINT or num_str, BINT or num_str) return BINT
1702   # compute x << y, base n, y >= 0
1703
1704   # set up parameters
1705   my ($self,$x,$y,$n,@r) = (ref($_[0]),@_);
1706   # objectify is costly, so avoid it
1707   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1708     {
1709     ($self,$x,$y,$n,@r) = objectify(2,@_);
1710     }
1711
1712   return $x if $x->modify('blsft');
1713   return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
1714   return $x->round(@r) if $y->is_zero();
1715
1716   $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
1717
1718   my $t; $t = $CALC->_lsft($x->{value},$y->{value},$n) if $CALC->can('_lsft');
1719   if (defined $t)
1720     {
1721     $x->{value} = $t; return $x->round(@r);
1722     }
1723   # fallback
1724   return $x->bmul( $self->bpow($n, $y, @r), @r );
1725   }
1726
1727 sub brsft
1728   {
1729   # (BINT or num_str, BINT or num_str) return BINT
1730   # compute x >> y, base n, y >= 0
1731
1732   # set up parameters
1733   my ($self,$x,$y,$n,@r) = (ref($_[0]),@_);
1734   # objectify is costly, so avoid it
1735   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1736     {
1737     ($self,$x,$y,$n,@r) = objectify(2,@_);
1738     }
1739
1740   return $x if $x->modify('brsft');
1741   return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
1742   return $x->round(@r) if $y->is_zero();
1743   return $x->bzero(@r) if $x->is_zero();                # 0 => 0
1744
1745   $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
1746
1747    # this only works for negative numbers when shifting in base 2
1748   if (($x->{sign} eq '-') && ($n == 2))
1749     {
1750     return $x->round(@r) if $x->is_one('-');    # -1 => -1
1751     if (!$y->is_one())
1752       {
1753       # although this is O(N*N) in calc (as_bin!) it is O(N) in Pari et al
1754       # but perhaps there is a better emulation for two's complement shift...
1755       # if $y != 1, we must simulate it by doing:
1756       # convert to bin, flip all bits, shift, and be done
1757       $x->binc();                       # -3 => -2
1758       my $bin = $x->as_bin();
1759       $bin =~ s/^-0b//;                 # strip '-0b' prefix
1760       $bin =~ tr/10/01/;                # flip bits
1761       # now shift
1762       if (CORE::length($bin) <= $y)
1763         {
1764         $bin = '0';                     # shifting to far right creates -1
1765                                         # 0, because later increment makes
1766                                         # that 1, attached '-' makes it '-1'
1767                                         # because -1 >> x == -1 !
1768         }
1769       else
1770         {
1771         $bin =~ s/.{$y}$//;             # cut off at the right side
1772         $bin = '1' . $bin;              # extend left side by one dummy '1'
1773         $bin =~ tr/10/01/;              # flip bits back
1774         }
1775       my $res = $self->new('0b'.$bin);  # add prefix and convert back
1776       $res->binc();                     # remember to increment
1777       $x->{value} = $res->{value};      # take over value
1778       return $x->round(@r);             # we are done now, magic, isn't?
1779       }
1780     $x->bdec();                         # n == 2, but $y == 1: this fixes it
1781     }
1782
1783   my $t; $t = $CALC->_rsft($x->{value},$y->{value},$n) if $CALC->can('_rsft');
1784   if (defined $t)
1785     {
1786     $x->{value} = $t;
1787     return $x->round(@r);
1788     }
1789   # fallback
1790   $x->bdiv($self->bpow($n,$y, @r), @r);
1791   $x;
1792   }
1793
1794 sub band
1795   {
1796   #(BINT or num_str, BINT or num_str) return BINT
1797   # compute x & y
1798
1799   # set up parameters
1800   my ($self,$x,$y,@r) = (ref($_[0]),@_);
1801   # objectify is costly, so avoid it
1802   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1803     {
1804     ($self,$x,$y,@r) = objectify(2,@_);
1805     }
1806
1807   return $x if $x->modify('band');
1808
1809   $r[3] = $y;                           # no push!
1810   local $Math::BigInt::upgrade = undef;
1811
1812   return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
1813   return $x->bzero(@r) if $y->is_zero() || $x->is_zero();
1814
1815   my $sign = 0;                                 # sign of result
1816   $sign = 1 if ($x->{sign} eq '-') && ($y->{sign} eq '-');
1817   my $sx = 1; $sx = -1 if $x->{sign} eq '-';
1818   my $sy = 1; $sy = -1 if $y->{sign} eq '-';
1819
1820   if ($CALC->can('_and') && $sx == 1 && $sy == 1)
1821     {
1822     $x->{value} = $CALC->_and($x->{value},$y->{value});
1823     return $x->round(@r);
1824     }
1825
1826   my $m = $self->bone(); my ($xr,$yr);
1827   my $x10000 = $self->new (0x1000);
1828   my $y1 = copy(ref($x),$y);                    # make copy
1829   $y1->babs();                                  # and positive
1830   my $x1 = $x->copy()->babs(); $x->bzero();     # modify x in place!
1831   use integer;                                  # need this for negative bools
1832   while (!$x1->is_zero() && !$y1->is_zero())
1833     {
1834     ($x1, $xr) = bdiv($x1, $x10000);
1835     ($y1, $yr) = bdiv($y1, $x10000);
1836     # make both op's numbers!
1837     $x->badd( bmul( $class->new(
1838        abs($sx*int($xr->numify()) & $sy*int($yr->numify()))),
1839       $m));
1840     $m->bmul($x10000);
1841     }
1842   $x->bneg() if $sign;
1843   $x->round(@r);
1844   }
1845
1846 sub bior
1847   {
1848   #(BINT or num_str, BINT or num_str) return BINT
1849   # compute x | y
1850
1851   # set up parameters
1852   my ($self,$x,$y,@r) = (ref($_[0]),@_);
1853   # objectify is costly, so avoid it
1854   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1855     {
1856     ($self,$x,$y,@r) = objectify(2,@_);
1857     }
1858
1859   return $x if $x->modify('bior');
1860   $r[3] = $y;                           # no push!
1861
1862   local $Math::BigInt::upgrade = undef;
1863
1864   return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
1865   return $x->round(@r) if $y->is_zero();
1866
1867   my $sign = 0;                                 # sign of result
1868   $sign = 1 if ($x->{sign} eq '-') || ($y->{sign} eq '-');
1869   my $sx = 1; $sx = -1 if $x->{sign} eq '-';
1870   my $sy = 1; $sy = -1 if $y->{sign} eq '-';
1871
1872   # don't use lib for negative values
1873   if ($CALC->can('_or') && $sx == 1 && $sy == 1)
1874     {
1875     $x->{value} = $CALC->_or($x->{value},$y->{value});
1876     return $x->round(@r);
1877     }
1878
1879   my $m = $self->bone(); my ($xr,$yr);
1880   my $x10000 = $self->new(0x10000);
1881   my $y1 = copy(ref($x),$y);                    # make copy
1882   $y1->babs();                                  # and positive
1883   my $x1 = $x->copy()->babs(); $x->bzero();     # modify x in place!
1884   use integer;                                  # need this for negative bools
1885   while (!$x1->is_zero() || !$y1->is_zero())
1886     {
1887     ($x1, $xr) = bdiv($x1,$x10000);
1888     ($y1, $yr) = bdiv($y1,$x10000);
1889     # make both op's numbers!
1890     $x->badd( bmul( $class->new(
1891        abs($sx*int($xr->numify()) | $sy*int($yr->numify()))),
1892       $m));
1893     $m->bmul($x10000);
1894     }
1895   $x->bneg() if $sign;
1896   $x->round(@r);
1897   }
1898
1899 sub bxor
1900   {
1901   #(BINT or num_str, BINT or num_str) return BINT
1902   # compute x ^ y
1903
1904   # set up parameters
1905   my ($self,$x,$y,@r) = (ref($_[0]),@_);
1906   # objectify is costly, so avoid it
1907   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1908     {
1909     ($self,$x,$y,@r) = objectify(2,@_);
1910     }
1911
1912   return $x if $x->modify('bxor');
1913   $r[3] = $y;                           # no push!
1914
1915   local $Math::BigInt::upgrade = undef;
1916
1917   return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
1918   return $x->round(@r) if $y->is_zero();
1919
1920   my $sign = 0;                                 # sign of result
1921   $sign = 1 if $x->{sign} ne $y->{sign};
1922   my $sx = 1; $sx = -1 if $x->{sign} eq '-';
1923   my $sy = 1; $sy = -1 if $y->{sign} eq '-';
1924
1925   # don't use lib for negative values
1926   if ($CALC->can('_xor') && $sx == 1 && $sy == 1)
1927     {
1928     $x->{value} = $CALC->_xor($x->{value},$y->{value});
1929     return $x->round(@r);
1930     }
1931
1932   my $m = $self->bone(); my ($xr,$yr);
1933   my $x10000 = $self->new(0x10000);
1934   my $y1 = copy(ref($x),$y);                    # make copy
1935   $y1->babs();                                  # and positive
1936   my $x1 = $x->copy()->babs(); $x->bzero();     # modify x in place!
1937   use integer;                                  # need this for negative bools
1938   while (!$x1->is_zero() || !$y1->is_zero())
1939     {
1940     ($x1, $xr) = bdiv($x1, $x10000);
1941     ($y1, $yr) = bdiv($y1, $x10000);
1942     # make both op's numbers!
1943     $x->badd( bmul( $class->new(
1944        abs($sx*int($xr->numify()) ^ $sy*int($yr->numify()))),
1945       $m));
1946     $m->bmul($x10000);
1947     }
1948   $x->bneg() if $sign;
1949   $x->round(@r);
1950   }
1951
1952 sub length
1953   {
1954   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
1955
1956   my $e = $CALC->_len($x->{value});
1957   return wantarray ? ($e,0) : $e;
1958   }
1959
1960 sub digit
1961   {
1962   # return the nth decimal digit, negative values count backward, 0 is right
1963   my ($self,$x,$n) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1964
1965   $CALC->_digit($x->{value},$n||0);
1966   }
1967
1968 sub _trailing_zeros
1969   {
1970   # return the amount of trailing zeros in $x
1971   my $x = shift;
1972   $x = $class->new($x) unless ref $x;
1973
1974   return 0 if $x->is_zero() || $x->is_odd() || $x->{sign} !~ /^[+-]$/;
1975
1976   return $CALC->_zeros($x->{value}) if $CALC->can('_zeros');
1977
1978   # if not: since we do not know underlying internal representation:
1979   my $es = "$x"; $es =~ /([0]*)$/;
1980   return 0 if !defined $1;      # no zeros
1981   CORE::length("$1");           # as string, not as +0!
1982   }
1983
1984 sub bsqrt
1985   {
1986   my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1987
1988   return $x if $x->modify('bsqrt');
1989
1990   return $x->bnan() if $x->{sign} ne '+';       # -x or inf or NaN => NaN
1991   return $x->bzero(@r) if $x->is_zero();                        # 0 => 0
1992   return $x->round(@r) if $x->is_one();                 # 1 => 1
1993
1994   return $upgrade->bsqrt($x,@r) if defined $upgrade;
1995
1996   if ($CALC->can('_sqrt'))
1997     {
1998     $x->{value} = $CALC->_sqrt($x->{value});
1999     return $x->round(@r);
2000     }
2001
2002   return $x->bone('+',@r) if $x < 4;                            # 2,3 => 1
2003   my $y = $x->copy();
2004   my $l = int($x->length()/2);
2005
2006   $x->bone();                                   # keep ref($x), but modify it
2007   $x->blsft($l,10);
2008
2009   my $last = $self->bzero();
2010   my $two = $self->new(2);
2011   my $lastlast = $x+$two;
2012   while ($last != $x && $lastlast != $x)
2013     {
2014     $lastlast = $last; $last = $x;
2015     $x += $y / $x;
2016     $x /= $two;
2017     }
2018   $x-- if $x * $x > $y;                         # overshot?
2019   $x->round(@r);
2020   }
2021
2022 sub exponent
2023   {
2024   # return a copy of the exponent (here always 0, NaN or 1 for $m == 0)
2025   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
2026
2027   if ($x->{sign} !~ /^[+-]$/)
2028     {
2029     my $s = $x->{sign}; $s =~ s/^[+-]//;
2030     return $self->new($s);              # -inf,+inf => inf
2031     }
2032   my $e = $class->bzero();
2033   return $e->binc() if $x->is_zero();
2034   $e += $x->_trailing_zeros();
2035   $e;
2036   }
2037
2038 sub mantissa
2039   {
2040   # return the mantissa (compatible to Math::BigFloat, e.g. reduced)
2041   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
2042
2043   if ($x->{sign} !~ /^[+-]$/)
2044     {
2045     return $self->new($x->{sign});              # keep + or - sign
2046     }
2047   my $m = $x->copy();
2048   # that's inefficient
2049   my $zeros = $m->_trailing_zeros();
2050   $m->brsft($zeros,10) if $zeros != 0;
2051   $m;
2052   }
2053
2054 sub parts
2055   {
2056   # return a copy of both the exponent and the mantissa
2057   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
2058
2059   return ($x->mantissa(),$x->exponent());
2060   }
2061
2062 ##############################################################################
2063 # rounding functions
2064
2065 sub bfround
2066   {
2067   # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
2068   # $n == 0 || $n == 1 => round to integer
2069   my $x = shift; $x = $class->new($x) unless ref $x;
2070   my ($scale,$mode) = $x->_scale_p($x->precision(),$x->round_mode(),@_);
2071   return $x if !defined $scale;         # no-op
2072   return $x if $x->modify('bfround');
2073
2074   # no-op for BigInts if $n <= 0
2075   if ($scale <= 0)
2076     {
2077     $x->{_a} = undef;                           # clear an eventual set A
2078     $x->{_p} = $scale; return $x;
2079     }
2080
2081   $x->bround( $x->length()-$scale, $mode);
2082   $x->{_a} = undef;                             # bround sets {_a}
2083   $x->{_p} = $scale;                            # so correct it
2084   $x;
2085   }
2086
2087 sub _scan_for_nonzero
2088   {
2089   my $x = shift;
2090   my $pad = shift;
2091   my $xs = shift;
2092
2093   my $len = $x->length();
2094   return 0 if $len == 1;                # '5' is trailed by invisible zeros
2095   my $follow = $pad - 1;
2096   return 0 if $follow > $len || $follow < 1;
2097
2098   # since we do not know underlying represention of $x, use decimal string
2099   #my $r = substr ($$xs,-$follow);
2100   my $r = substr ("$x",-$follow);
2101   return 1 if $r =~ /[^0]/;
2102   0;
2103   }
2104
2105 sub fround
2106   {
2107   # to make life easier for switch between MBF and MBI (autoload fxxx()
2108   # like MBF does for bxxx()?)
2109   my $x = shift;
2110   return $x->bround(@_);
2111   }
2112
2113 sub bround
2114   {
2115   # accuracy: +$n preserve $n digits from left,
2116   #           -$n preserve $n digits from right (f.i. for 0.1234 style in MBF)
2117   # no-op for $n == 0
2118   # and overwrite the rest with 0's, return normalized number
2119   # do not return $x->bnorm(), but $x
2120
2121   my $x = shift; $x = $class->new($x) unless ref $x;
2122   my ($scale,$mode) = $x->_scale_a($x->accuracy(),$x->round_mode(),@_);
2123   return $x if !defined $scale;                 # no-op
2124   return $x if $x->modify('bround');
2125
2126   if ($x->is_zero() || $scale == 0)
2127     {
2128     $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2
2129     return $x;
2130     }
2131   return $x if $x->{sign} !~ /^[+-]$/;          # inf, NaN
2132
2133   # we have fewer digits than we want to scale to
2134   my $len = $x->length();
2135   # scale < 0, but > -len (not >=!)
2136   if (($scale < 0 && $scale < -$len-1) || ($scale >= $len))
2137     {
2138     $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2
2139     return $x;
2140     }
2141
2142   # count of 0's to pad, from left (+) or right (-): 9 - +6 => 3, or |-6| => 6
2143   my ($pad,$digit_round,$digit_after);
2144   $pad = $len - $scale;
2145   $pad = abs($scale-1) if $scale < 0;
2146
2147   # do not use digit(), it is costly for binary => decimal
2148
2149   my $xs = $CALC->_str($x->{value});
2150   my $pl = -$pad-1;
2151
2152   # pad:   123: 0 => -1, at 1 => -2, at 2 => -3, at 3 => -4
2153   # pad+1: 123: 0 => 0,  at 1 => -1, at 2 => -2, at 3 => -3
2154   $digit_round = '0'; $digit_round = substr($$xs,$pl,1) if $pad <= $len;
2155   $pl++; $pl ++ if $pad >= $len;
2156   $digit_after = '0'; $digit_after = substr($$xs,$pl,1) if $pad > 0;
2157
2158   # in case of 01234 we round down, for 6789 up, and only in case 5 we look
2159   # closer at the remaining digits of the original $x, remember decision
2160   my $round_up = 1;                                     # default round up
2161   $round_up -- if
2162     ($mode eq 'trunc')                          ||      # trunc by round down
2163     ($digit_after =~ /[01234]/)                 ||      # round down anyway,
2164                                                         # 6789 => round up
2165     ($digit_after eq '5')                       &&      # not 5000...0000
2166     ($x->_scan_for_nonzero($pad,$xs) == 0)              &&
2167     (
2168      ($mode eq 'even') && ($digit_round =~ /[24680]/) ||
2169      ($mode eq 'odd')  && ($digit_round =~ /[13579]/) ||
2170      ($mode eq '+inf') && ($x->{sign} eq '-')   ||
2171      ($mode eq '-inf') && ($x->{sign} eq '+')   ||
2172      ($mode eq 'zero')          # round down if zero, sign adjusted below
2173     );
2174   my $put_back = 0;                                     # not yet modified
2175
2176   if (($pad > 0) && ($pad <= $len))
2177     {
2178     substr($$xs,-$pad,$pad) = '0' x $pad;
2179     $put_back = 1;
2180     }
2181   elsif ($pad > $len)
2182     {
2183     $x->bzero();                                        # round to '0'
2184     }
2185
2186   if ($round_up)                                        # what gave test above?
2187     {
2188     $put_back = 1;
2189     $pad = $len, $$xs = '0'x$pad if $scale < 0;         # tlr: whack 0.51=>1.0
2190
2191     # we modify directly the string variant instead of creating a number and
2192     # adding it, since that is faster (we already have the string)
2193     my $c = 0; $pad ++;                         # for $pad == $len case
2194     while ($pad <= $len)
2195       {
2196       $c = substr($$xs,-$pad,1) + 1; $c = '0' if $c eq '10';
2197       substr($$xs,-$pad,1) = $c; $pad++;
2198       last if $c != 0;                          # no overflow => early out
2199       }
2200     $$xs = '1'.$$xs if $c == 0;
2201
2202     }
2203   $x->{value} = $CALC->_new($xs) if $put_back == 1;     # put back in if needed
2204
2205   $x->{_a} = $scale if $scale >= 0;
2206   if ($scale < 0)
2207     {
2208     $x->{_a} = $len+$scale;
2209     $x->{_a} = 0 if $scale < -$len;
2210     }
2211   $x;
2212   }
2213
2214 sub bfloor
2215   {
2216   # return integer less or equal then number, since it is already integer,
2217   # always returns $self
2218   my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
2219
2220   $x->round(@r);
2221   }
2222
2223 sub bceil
2224   {
2225   # return integer greater or equal then number, since it is already integer,
2226   # always returns $self
2227   my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
2228
2229   $x->round(@r);
2230   }
2231
2232 ##############################################################################
2233 # private stuff (internal use only)
2234
2235 sub __one
2236   {
2237   # internal speedup, set argument to 1, or create a +/- 1
2238   my $self = shift;
2239   my $x = $self->bone(); # $x->{value} = $CALC->_one();
2240   $x->{sign} = shift || '+';
2241   $x;
2242   }
2243
2244 sub _swap
2245   {
2246   # Overload will swap params if first one is no object ref so that the first
2247   # one is always an object ref. In this case, third param is true.
2248   # This routine is to overcome the effect of scalar,$object creating an object
2249   # of the class of this package, instead of the second param $object. This
2250   # happens inside overload, when the overload section of this package is
2251   # inherited by sub classes.
2252   # For overload cases (and this is used only there), we need to preserve the
2253   # args, hence the copy().
2254   # You can override this method in a subclass, the overload section will call
2255   # $object->_swap() to make sure it arrives at the proper subclass, with some
2256   # exceptions like '+' and '-'. To make '+' and '-' work, you also need to
2257   # specify your own overload for them.
2258
2259   # object, (object|scalar) => preserve first and make copy
2260   # scalar, object          => swapped, re-swap and create new from first
2261   #                            (using class of second object, not $class!!)
2262   my $self = shift;                     # for override in subclass
2263   if ($_[2])
2264     {
2265     my $c = ref ($_[0]) || $class;      # fallback $class should not happen
2266     return ( $c->new($_[1]), $_[0] );
2267     }
2268   return ( $_[0]->copy(), $_[1] );
2269   }
2270
2271 sub objectify
2272   {
2273   # check for strings, if yes, return objects instead
2274
2275   # the first argument is number of args objectify() should look at it will
2276   # return $count+1 elements, the first will be a classname. This is because
2277   # overloaded '""' calls bstr($object,undef,undef) and this would result in
2278   # useless objects beeing created and thrown away. So we cannot simple loop
2279   # over @_. If the given count is 0, all arguments will be used.
2280
2281   # If the second arg is a ref, use it as class.
2282   # If not, try to use it as classname, unless undef, then use $class
2283   # (aka Math::BigInt). The latter shouldn't happen,though.
2284
2285   # caller:                        gives us:
2286   # $x->badd(1);                => ref x, scalar y
2287   # Class->badd(1,2);           => classname x (scalar), scalar x, scalar y
2288   # Class->badd( Class->(1),2); => classname x (scalar), ref x, scalar y
2289   # Math::BigInt::badd(1,2);    => scalar x, scalar y
2290   # In the last case we check number of arguments to turn it silently into
2291   # $class,1,2. (We can not take '1' as class ;o)
2292   # badd($class,1) is not supported (it should, eventually, try to add undef)
2293   # currently it tries 'Math::BigInt' + 1, which will not work.
2294
2295   # some shortcut for the common cases
2296   # $x->unary_op();
2297   return (ref($_[1]),$_[1]) if (@_ == 2) && ($_[0]||0 == 1) && ref($_[1]);
2298
2299   my $count = abs(shift || 0);
2300
2301   my (@a,$k,$d);                # resulting array, temp, and downgrade
2302   if (ref $_[0])
2303     {
2304     # okay, got object as first
2305     $a[0] = ref $_[0];
2306     }
2307   else
2308     {
2309     # nope, got 1,2 (Class->xxx(1) => Class,1 and not supported)
2310     $a[0] = $class;
2311     $a[0] = shift if $_[0] =~ /^[A-Z].*::/;     # classname as first?
2312     }
2313
2314   no strict 'refs';
2315   # disable downgrading, because Math::BigFLoat->foo('1.0','2.0') needs floats
2316   if (defined ${"$a[0]::downgrade"})
2317     {
2318     $d = ${"$a[0]::downgrade"};
2319     ${"$a[0]::downgrade"} = undef;
2320     }
2321
2322   my $up = ${"$a[0]::upgrade"};
2323   # print "Now in objectify, my class is today $a[0]\n";
2324   if ($count == 0)
2325     {
2326     while (@_)
2327       {
2328       $k = shift;
2329       if (!ref($k))
2330         {
2331         $k = $a[0]->new($k);
2332         }
2333       elsif (!defined $up && ref($k) ne $a[0])
2334         {
2335         # foreign object, try to convert to integer
2336         $k->can('as_number') ?  $k = $k->as_number() : $k = $a[0]->new($k);
2337         }
2338       push @a,$k;
2339       }
2340     }
2341   else
2342     {
2343     while ($count > 0)
2344       {
2345       $count--;
2346       $k = shift;
2347       if (!ref($k))
2348         {
2349         $k = $a[0]->new($k);
2350         }
2351       elsif (!defined $up && ref($k) ne $a[0])
2352         {
2353         # foreign object, try to convert to integer
2354         $k->can('as_number') ?  $k = $k->as_number() : $k = $a[0]->new($k);
2355         }
2356       push @a,$k;
2357       }
2358     push @a,@_;         # return other params, too
2359     }
2360   die "$class objectify needs list context" unless wantarray;
2361   ${"$a[0]::downgrade"} = $d;
2362   @a;
2363   }
2364
2365 sub import
2366   {
2367   my $self = shift;
2368
2369   $IMPORT++;
2370   my @a; my $l = scalar @_;
2371   for ( my $i = 0; $i < $l ; $i++ )
2372     {
2373     if ($_[$i] eq ':constant')
2374       {
2375       # this causes overlord er load to step in
2376       overload::constant integer => sub { $self->new(shift) };
2377       overload::constant binary => sub { $self->new(shift) };
2378       }
2379     elsif ($_[$i] eq 'upgrade')
2380       {
2381       # this causes upgrading
2382       $upgrade = $_[$i+1];              # or undef to disable
2383       $i++;
2384       }
2385     elsif ($_[$i] =~ /^lib$/i)
2386       {
2387       # this causes a different low lib to take care...
2388       $CALC = $_[$i+1] || '';
2389       $i++;
2390       }
2391     else
2392       {
2393       push @a, $_[$i];
2394       }
2395     }
2396   # any non :constant stuff is handled by our parent, Exporter
2397   # even if @_ is empty, to give it a chance
2398   $self->SUPER::import(@a);                     # need it for subclasses
2399   $self->export_to_level(1,$self,@a);           # need it for MBF
2400
2401   # try to load core math lib
2402   my @c = split /\s*,\s*/,$CALC;
2403   push @c,'Calc';                               # if all fail, try this
2404   $CALC = '';                                   # signal error
2405   foreach my $lib (@c)
2406     {
2407     next if ($lib || '') eq '';
2408     $lib = 'Math::BigInt::'.$lib if $lib !~ /^Math::BigInt/i;
2409     $lib =~ s/\.pm$//;
2410     if ($] < 5.006)
2411       {
2412       # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
2413       # used in the same script, or eval inside import().
2414       my @parts = split /::/, $lib;             # Math::BigInt => Math BigInt
2415       my $file = pop @parts; $file .= '.pm';    # BigInt => BigInt.pm
2416       require File::Spec;
2417       $file = File::Spec->catfile (@parts, $file);
2418       eval { require "$file"; $lib->import( @c ); }
2419       }
2420     else
2421       {
2422       eval "use $lib qw/@c/;";
2423       }
2424     $CALC = $lib, last if $@ eq '';     # no error in loading lib?
2425     }
2426   die "Couldn't load any math lib, not even the default" if $CALC eq '';
2427   }
2428
2429 sub __from_hex
2430   {
2431   # convert a (ref to) big hex string to BigInt, return undef for error
2432   my $hs = shift;
2433
2434   my $x = Math::BigInt->bzero();
2435
2436   # strip underscores
2437   $$hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g;
2438   $$hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g;
2439
2440   return $x->bnan() if $$hs !~ /^[\-\+]?0x[0-9A-Fa-f]+$/;
2441
2442   my $sign = '+'; $sign = '-' if ($$hs =~ /^-/);
2443
2444   $$hs =~ s/^[+-]//;                    # strip sign
2445   if ($CALC->can('_from_hex'))
2446     {
2447     $x->{value} = $CALC->_from_hex($hs);
2448     }
2449   else
2450     {
2451     # fallback to pure perl
2452     my $mul = Math::BigInt->bzero(); $mul++;
2453     my $x65536 = Math::BigInt->new(65536);
2454     my $len = CORE::length($$hs)-2;
2455     $len = int($len/4);                 # 4-digit parts, w/o '0x'
2456     my $val; my $i = -4;
2457     while ($len >= 0)
2458       {
2459       $val = substr($$hs,$i,4);
2460       $val =~ s/^[+-]?0x// if $len == 0;        # for last part only because
2461       $val = hex($val);                         # hex does not like wrong chars
2462       $i -= 4; $len --;
2463       $x += $mul * $val if $val != 0;
2464       $mul *= $x65536 if $len >= 0;             # skip last mul
2465       }
2466     }
2467   $x->{sign} = $sign unless $CALC->_is_zero($x->{value});       # no '-0'
2468   $x;
2469   }
2470
2471 sub __from_bin
2472   {
2473   # convert a (ref to) big binary string to BigInt, return undef for error
2474   my $bs = shift;
2475
2476   my $x = Math::BigInt->bzero();
2477   # strip underscores
2478   $$bs =~ s/([01])_([01])/$1$2/g;
2479   $$bs =~ s/([01])_([01])/$1$2/g;
2480   return $x->bnan() if $$bs !~ /^[+-]?0b[01]+$/;
2481
2482   my $sign = '+'; $sign = '-' if ($$bs =~ /^\-/);
2483   $$bs =~ s/^[+-]//;                            # strip sign
2484   if ($CALC->can('_from_bin'))
2485     {
2486     $x->{value} = $CALC->_from_bin($bs);
2487     }
2488   else
2489     {
2490     my $mul = Math::BigInt->bzero(); $mul++;
2491     my $x256 = Math::BigInt->new(256);
2492     my $len = CORE::length($$bs)-2;
2493     $len = int($len/8);                         # 8-digit parts, w/o '0b'
2494     my $val; my $i = -8;
2495     while ($len >= 0)
2496       {
2497       $val = substr($$bs,$i,8);
2498       $val =~ s/^[+-]?0b// if $len == 0;        # for last part only
2499       #$val = oct('0b'.$val);   # does not work on Perl prior to 5.6.0
2500       # slower:
2501       # $val = ('0' x (8-CORE::length($val))).$val if CORE::length($val) < 8;
2502       $val = ord(pack('B8',substr('00000000'.$val,-8,8)));
2503       $i -= 8; $len --;
2504       $x += $mul * $val if $val != 0;
2505       $mul *= $x256 if $len >= 0;               # skip last mul
2506       }
2507     }
2508   $x->{sign} = $sign unless $CALC->_is_zero($x->{value});       # no '-0'
2509   $x;
2510   }
2511
2512 sub _split
2513   {
2514   # (ref to num_str) return num_str
2515   # internal, take apart a string and return the pieces
2516   # strip leading/trailing whitespace, leading zeros, underscore and reject
2517   # invalid input
2518   my $x = shift;
2519
2520   # strip white space at front, also extranous leading zeros
2521   $$x =~ s/^\s*([-]?)0*([0-9])/$1$2/g;  # will not strip '  .2'
2522   $$x =~ s/^\s+//;                      # but this will
2523   $$x =~ s/\s+$//g;                     # strip white space at end
2524
2525   # shortcut, if nothing to split, return early
2526   if ($$x =~ /^[+-]?\d+$/)
2527     {
2528     $$x =~ s/^([+-])0*([0-9])/$2/; my $sign = $1 || '+';
2529     return (\$sign, $x, \'', \'', \0);
2530     }
2531
2532   # invalid starting char?
2533   return if $$x !~ /^[+-]?(\.?[0-9]|0b[0-1]|0x[0-9a-fA-F])/;
2534
2535   return __from_hex($x) if $$x =~ /^[\-\+]?0x/; # hex string
2536   return __from_bin($x) if $$x =~ /^[\-\+]?0b/; # binary string
2537
2538   # strip underscores between digits
2539   $$x =~ s/(\d)_(\d)/$1$2/g;
2540   $$x =~ s/(\d)_(\d)/$1$2/g;            # do twice for 1_2_3
2541
2542   # some possible inputs:
2543   # 2.1234 # 0.12        # 1          # 1E1 # 2.134E1 # 434E-10 # 1.02009E-2
2544   # .2     # 1_2_3.4_5_6 # 1.4E1_2_3  # 1e3 # +.2
2545
2546   return if $$x =~ /[Ee].*[Ee]/;        # more than one E => error
2547
2548   my ($m,$e) = split /[Ee]/,$$x;
2549   $e = '0' if !defined $e || $e eq "";
2550   # sign,value for exponent,mantint,mantfrac
2551   my ($es,$ev,$mis,$miv,$mfv);
2552   # valid exponent?
2553   if ($e =~ /^([+-]?)0*(\d+)$/) # strip leading zeros
2554     {
2555     $es = $1; $ev = $2;
2556     # valid mantissa?
2557     return if $m eq '.' || $m eq '';
2558     my ($mi,$mf,$last) = split /\./,$m;
2559     return if defined $last;            # last defined => 1.2.3 or others
2560     $mi = '0' if !defined $mi;
2561     $mi .= '0' if $mi =~ /^[\-\+]?$/;
2562     $mf = '0' if !defined $mf || $mf eq '';
2563     if ($mi =~ /^([+-]?)0*(\d+)$/) # strip leading zeros
2564       {
2565       $mis = $1||'+'; $miv = $2;
2566       return unless ($mf =~ /^(\d*?)0*$/);      # strip trailing zeros
2567       $mfv = $1;
2568       return (\$mis,\$miv,\$mfv,\$es,\$ev);
2569       }
2570     }
2571   return; # NaN, not a number
2572   }
2573
2574 sub as_number
2575   {
2576   # an object might be asked to return itself as bigint on certain overloaded
2577   # operations, this does exactly this, so that sub classes can simple inherit
2578   # it or override with their own integer conversion routine
2579   my $self = shift;
2580
2581   $self->copy();
2582   }
2583
2584 sub as_hex
2585   {
2586   # return as hex string, with prefixed 0x
2587   my $x = shift; $x = $class->new($x) if !ref($x);
2588
2589   return $x->bstr() if $x->{sign} !~ /^[+-]$/;  # inf, nan etc
2590   return '0x0' if $x->is_zero();
2591
2592   my $es = ''; my $s = '';
2593   $s = $x->{sign} if $x->{sign} eq '-';
2594   if ($CALC->can('_as_hex'))
2595     {
2596     $es = ${$CALC->_as_hex($x->{value})};
2597     }
2598   else
2599     {
2600     my $x1 = $x->copy()->babs(); my ($xr,$x10000,$h);
2601     if ($] >= 5.006)
2602       {
2603       $x10000 = Math::BigInt->new (0x10000); $h = 'h4';
2604       }
2605     else
2606       {
2607       $x10000 = Math::BigInt->new (0x1000); $h = 'h3';
2608       }
2609     while (!$x1->is_zero())
2610       {
2611       ($x1, $xr) = bdiv($x1,$x10000);
2612       $es .= unpack($h,pack('v',$xr->numify()));
2613       }
2614     $es = reverse $es;
2615     $es =~ s/^[0]+//;   # strip leading zeros
2616     $s .= '0x';
2617     }
2618   $s . $es;
2619   }
2620
2621 sub as_bin
2622   {
2623   # return as binary string, with prefixed 0b
2624   my $x = shift; $x = $class->new($x) if !ref($x);
2625
2626   return $x->bstr() if $x->{sign} !~ /^[+-]$/;  # inf, nan etc
2627   return '0b0' if $x->is_zero();
2628
2629   my $es = ''; my $s = '';
2630   $s = $x->{sign} if $x->{sign} eq '-';
2631   if ($CALC->can('_as_bin'))
2632     {
2633     $es = ${$CALC->_as_bin($x->{value})};
2634     }
2635   else
2636     {
2637     my $x1 = $x->copy()->babs(); my ($xr,$x10000,$b);
2638     if ($] >= 5.006)
2639       {
2640       $x10000 = Math::BigInt->new (0x10000); $b = 'b16';
2641       }
2642     else
2643       {
2644       $x10000 = Math::BigInt->new (0x1000); $b = 'b12';
2645       }
2646     while (!$x1->is_zero())
2647       {
2648       ($x1, $xr) = bdiv($x1,$x10000);
2649       $es .= unpack($b,pack('v',$xr->numify()));
2650       }
2651     $es = reverse $es;
2652     $es =~ s/^[0]+//;   # strip leading zeros
2653     $s .= '0b';
2654     }
2655   $s . $es;
2656   }
2657
2658 ##############################################################################
2659 # internal calculation routines (others are in Math::BigInt::Calc etc)
2660
2661 sub __lcm
2662   {
2663   # (BINT or num_str, BINT or num_str) return BINT
2664   # does modify first argument
2665   # LCM
2666
2667   my $x = shift; my $ty = shift;
2668   return $x->bnan() if ($x->{sign} eq $nan) || ($ty->{sign} eq $nan);
2669   return $x * $ty / bgcd($x,$ty);
2670   }
2671
2672 sub __gcd
2673   {
2674   # (BINT or num_str, BINT or num_str) return BINT
2675   # does modify both arguments
2676   # GCD -- Euclids algorithm E, Knuth Vol 2 pg 296
2677   my ($x,$ty) = @_;
2678
2679   return $x->bnan() if $x->{sign} !~ /^[+-]$/ || $ty->{sign} !~ /^[+-]$/;
2680
2681   while (!$ty->is_zero())
2682     {
2683     ($x, $ty) = ($ty,bmod($x,$ty));
2684     }
2685   $x;
2686   }
2687
2688 ###############################################################################
2689 # this method return 0 if the object can be modified, or 1 for not
2690 # We use a fast use constant statement here, to avoid costly calls. Subclasses
2691 # may override it with special code (f.i. Math::BigInt::Constant does so)
2692
2693 sub modify () { 0; }
2694
2695 1;
2696 __END__
2697
2698 =head1 NAME
2699
2700 Math::BigInt - Arbitrary size integer math package
2701
2702 =head1 SYNOPSIS
2703
2704   use Math::BigInt;
2705
2706   # Number creation
2707   $x = Math::BigInt->new($str);         # defaults to 0
2708   $nan  = Math::BigInt->bnan();         # create a NotANumber
2709   $zero = Math::BigInt->bzero();        # create a +0
2710   $inf = Math::BigInt->binf();          # create a +inf
2711   $inf = Math::BigInt->binf('-');       # create a -inf
2712   $one = Math::BigInt->bone();          # create a +1
2713   $one = Math::BigInt->bone('-');       # create a -1
2714
2715   # Testing
2716   $x->is_zero();                # true if arg is +0
2717   $x->is_nan();                 # true if arg is NaN
2718   $x->is_one();                 # true if arg is +1
2719   $x->is_one('-');              # true if arg is -1
2720   $x->is_odd();                 # true if odd, false for even
2721   $x->is_even();                # true if even, false for odd
2722   $x->is_positive();            # true if >= 0
2723   $x->is_negative();            # true if <  0
2724   $x->is_inf(sign);             # true if +inf, or -inf (sign is default '+')
2725   $x->is_int();                 # true if $x is an integer (not a float)
2726
2727   $x->bcmp($y);                 # compare numbers (undef,<0,=0,>0)
2728   $x->bacmp($y);                # compare absolutely (undef,<0,=0,>0)
2729   $x->sign();                   # return the sign, either +,- or NaN
2730   $x->digit($n);                # return the nth digit, counting from right
2731   $x->digit(-$n);               # return the nth digit, counting from left
2732
2733   # The following all modify their first argument:
2734
2735   # set
2736   $x->bzero();                  # set $x to 0
2737   $x->bnan();                   # set $x to NaN
2738   $x->bone();                   # set $x to +1
2739   $x->bone('-');                # set $x to -1
2740   $x->binf();                   # set $x to inf
2741   $x->binf('-');                # set $x to -inf
2742
2743   $x->bneg();                   # negation
2744   $x->babs();                   # absolute value
2745   $x->bnorm();                  # normalize (no-op)
2746   $x->bnot();                   # two's complement (bit wise not)
2747   $x->binc();                   # increment x by 1
2748   $x->bdec();                   # decrement x by 1
2749
2750   $x->badd($y);                 # addition (add $y to $x)
2751   $x->bsub($y);                 # subtraction (subtract $y from $x)
2752   $x->bmul($y);                 # multiplication (multiply $x by $y)
2753   $x->bdiv($y);                 # divide, set $x to quotient
2754                                 # return (quo,rem) or quo if scalar
2755
2756   $x->bmod($y);                 # modulus (x % y)
2757   $x->bmodpow($exp,$mod);       # modular exponentation (($num**$exp) % $mod))
2758   $x->bmodinv($mod);            # the inverse of $x in the given modulus $mod
2759
2760   $x->bpow($y);                 # power of arguments (x ** y)
2761   $x->blsft($y);                # left shift
2762   $x->brsft($y);                # right shift
2763   $x->blsft($y,$n);             # left shift, by base $n (like 10)
2764   $x->brsft($y,$n);             # right shift, by base $n (like 10)
2765
2766   $x->band($y);                 # bitwise and
2767   $x->bior($y);                 # bitwise inclusive or
2768   $x->bxor($y);                 # bitwise exclusive or
2769   $x->bnot();                   # bitwise not (two's complement)
2770
2771   $x->bsqrt();                  # calculate square-root
2772   $x->bfac();                   # factorial of $x (1*2*3*4*..$x)
2773
2774   $x->round($A,$P,$round_mode); # round to accuracy or precision using mode $r
2775   $x->bround($N);               # accuracy: preserve $N digits
2776   $x->bfround($N);              # round to $Nth digit, no-op for BigInts
2777
2778   # The following do not modify their arguments in BigInt, but do in BigFloat:
2779   $x->bfloor();                 # return integer less or equal than $x
2780   $x->bceil();                  # return integer greater or equal than $x
2781
2782   # The following do not modify their arguments:
2783
2784   bgcd(@values);                # greatest common divisor (no OO style)
2785   blcm(@values);                # lowest common multiplicator (no OO style)
2786
2787   $x->length();                 # return number of digits in number
2788   ($x,$f) = $x->length();       # length of number and length of fraction part,
2789                                 # latter is always 0 digits long for BigInt's
2790
2791   $x->exponent();               # return exponent as BigInt
2792   $x->mantissa();               # return (signed) mantissa as BigInt
2793   $x->parts();                  # return (mantissa,exponent) as BigInt
2794   $x->copy();                   # make a true copy of $x (unlike $y = $x;)
2795   $x->as_number();              # return as BigInt (in BigInt: same as copy())
2796
2797   # conversation to string
2798   $x->bstr();                   # normalized string
2799   $x->bsstr();                  # normalized string in scientific notation
2800   $x->as_hex();                 # as signed hexadecimal string with prefixed 0x
2801   $x->as_bin();                 # as signed binary string with prefixed 0b
2802
2803   Math::BigInt->config();       # return hash containing configuration/version
2804
2805   # precision and accuracy (see section about rounding for more)
2806   $x->precision();              # return P of $x (or global, if P of $x undef)
2807   $x->precision($n);            # set P of $x to $n
2808   $x->accuracy();               # return A of $x (or global, if A of $x undef)
2809   $x->accuracy($n);             # set P $x to $n
2810
2811   Math::BigInt->precision();    # get/set global P for all BigInt objects
2812   Math::BigInt->accuracy();     # get/set global A for all BigInt objects
2813
2814 =head1 DESCRIPTION
2815
2816 All operators (inlcuding basic math operations) are overloaded if you
2817 declare your big integers as
2818
2819   $i = new Math::BigInt '123_456_789_123_456_789';
2820
2821 Operations with overloaded operators preserve the arguments which is
2822 exactly what you expect.
2823
2824 =over 2
2825
2826 =item Canonical notation
2827
2828 Big integer values are strings of the form C</^[+-]\d+$/> with leading
2829 zeros suppressed.
2830
2831    '-0'                            canonical value '-0', normalized '0'
2832    '   -123_123_123'               canonical value '-123123123'
2833    '1_23_456_7890'                 canonical value '1234567890'
2834
2835 =item Input
2836
2837 Input values to these routines may be either Math::BigInt objects or
2838 strings of the form C</^\s*[+-]?[\d]+\.?[\d]*E?[+-]?[\d]*$/>.
2839
2840 You can include one underscore between any two digits.
2841
2842 This means integer values like 1.01E2 or even 1000E-2 are also accepted.
2843 Non integer values result in NaN.
2844
2845 Math::BigInt::new() defaults to 0, while Math::BigInt::new('') results
2846 in 'NaN'.
2847
2848 bnorm() on a BigInt object is now effectively a no-op, since the numbers
2849 are always stored in normalized form. On a string, it creates a BigInt
2850 object.
2851
2852 =item Output
2853
2854 Output values are BigInt objects (normalized), except for bstr(), which
2855 returns a string in normalized form.
2856 Some routines (C<is_odd()>, C<is_even()>, C<is_zero()>, C<is_one()>,
2857 C<is_nan()>) return true or false, while others (C<bcmp()>, C<bacmp()>)
2858 return either undef, <0, 0 or >0 and are suited for sort.
2859
2860 =back
2861
2862 =head1 METHODS
2863
2864 Each of the methods below accepts three additional parameters. These arguments
2865 $A, $P and $R are accuracy, precision and round_mode. Please see more in the
2866 section about ACCURACY and ROUNDIND.
2867
2868 =head2 config
2869
2870         use Data::Dumper;
2871
2872         print Dumper ( Math::BigInt->config() );
2873
2874 Returns a hash containing the configuration, e.g. the version number, lib
2875 loaded etc.
2876
2877 =head2 accuracy
2878
2879         $x->accuracy(5);                # local for $x
2880         $class->accuracy(5);            # global for all members of $class
2881
2882 Set or get the global or local accuracy, aka how many significant digits the
2883 results have. Please see the section about L<ACCURACY AND PRECISION> for
2884 further details.
2885
2886 Value must be greater than zero. Pass an undef value to disable it:
2887
2888         $x->accuracy(undef);
2889         Math::BigInt->accuracy(undef);
2890
2891 Returns the current accuracy. For C<$x->accuracy()> it will return either the
2892 local accuracy, or if not defined, the global. This means the return value
2893 represents the accuracy that will be in effect for $x:
2894
2895         $y = Math::BigInt->new(1234567);        # unrounded
2896         print Math::BigInt->accuracy(4),"\n";   # set 4, print 4
2897         $x = Math::BigInt->new(123456);         # will be automatically rounded
2898         print "$x $y\n";                        # '123500 1234567'
2899         print $x->accuracy(),"\n";              # will be 4
2900         print $y->accuracy(),"\n";              # also 4, since global is 4
2901         print Math::BigInt->accuracy(5),"\n";   # set to 5, print 5
2902         print $x->accuracy(),"\n";              # still 4
2903         print $y->accuracy(),"\n";              # 5, since global is 5
2904
2905 =head2 brsft
2906
2907         $x->brsft($y,$n);
2908
2909 Shifts $x right by $y in base $n. Default is base 2, used are usually 10 and
2910 2, but others work, too.
2911
2912 Right shifting usually amounts to dividing $x by $n ** $y and truncating the
2913 result:
2914
2915
2916         $x = Math::BigInt->new(10);
2917         $x->brsft(1);                   # same as $x >> 1: 5
2918         $x = Math::BigInt->new(1234);
2919         $x->brsft(2,10);                # result 12
2920
2921 There is one exception, and that is base 2 with negative $x:
2922
2923
2924         $x = Math::BigInt->new(-5);
2925         print $x->brsft(1);
2926
2927 This will print -3, not -2 (as it would if you divide -5 by 2 and truncate the
2928 result).
2929
2930 =head2 new
2931
2932         $x = Math::BigInt->new($str,$A,$P,$R);
2933
2934 Creates a new BigInt object from a string or another BigInt object. The
2935 input is accepted as decimal, hex (with leading '0x') or binary (with leading
2936 '0b').
2937
2938 =head2 bnan
2939
2940         $x = Math::BigInt->bnan();
2941
2942 Creates a new BigInt object representing NaN (Not A Number).
2943 If used on an object, it will set it to NaN:
2944
2945         $x->bnan();
2946
2947 =head2 bzero
2948
2949         $x = Math::BigInt->bzero();
2950
2951 Creates a new BigInt object representing zero.
2952 If used on an object, it will set it to zero:
2953
2954         $x->bzero();
2955
2956 =head2 binf
2957
2958         $x = Math::BigInt->binf($sign);
2959
2960 Creates a new BigInt object representing infinity. The optional argument is
2961 either '-' or '+', indicating whether you want infinity or minus infinity.
2962 If used on an object, it will set it to infinity:
2963
2964         $x->binf();
2965         $x->binf('-');
2966
2967 =head2 bone
2968
2969         $x = Math::BigInt->binf($sign);
2970
2971 Creates a new BigInt object representing one. The optional argument is
2972 either '-' or '+', indicating whether you want one or minus one.
2973 If used on an object, it will set it to one:
2974
2975         $x->bone();             # +1
2976         $x->bone('-');          # -1
2977
2978 =head2 is_one()/is_zero()/is_nan()/is_inf()
2979
2980
2981         $x->is_zero();                  # true if arg is +0
2982         $x->is_nan();                   # true if arg is NaN
2983         $x->is_one();                   # true if arg is +1
2984         $x->is_one('-');                # true if arg is -1
2985         $x->is_inf();                   # true if +inf
2986         $x->is_inf('-');                # true if -inf (sign is default '+')
2987
2988 These methods all test the BigInt for beeing one specific value and return
2989 true or false depending on the input. These are faster than doing something
2990 like:
2991
2992         if ($x == 0)
2993
2994 =head2 is_positive()/is_negative()
2995
2996         $x->is_positive();              # true if >= 0
2997         $x->is_negative();              # true if <  0
2998
2999 The methods return true if the argument is positive or negative, respectively.
3000 C<NaN> is neither positive nor negative, while C<+inf> counts as positive, and
3001 C<-inf> is negative. A C<zero> is positive.
3002
3003 These methods are only testing the sign, and not the value.
3004
3005 =head2 is_odd()/is_even()/is_int()
3006
3007         $x->is_odd();                   # true if odd, false for even
3008         $x->is_even();                  # true if even, false for odd
3009         $x->is_int();                   # true if $x is an integer
3010
3011 The return true when the argument satisfies the condition. C<NaN>, C<+inf>,
3012 C<-inf> are not integers and are neither odd nor even.
3013
3014 =head2 bcmp
3015
3016         $x->bcmp($y);
3017
3018 Compares $x with $y and takes the sign into account.
3019 Returns -1, 0, 1 or undef.
3020
3021 =head2 bacmp
3022
3023         $x->bacmp($y);
3024
3025 Compares $x with $y while ignoring their. Returns -1, 0, 1 or undef.
3026
3027 =head2 sign
3028
3029         $x->sign();
3030
3031 Return the sign, of $x, meaning either C<+>, C<->, C<-inf>, C<+inf> or NaN.
3032
3033 =head2 bcmp
3034
3035   $x->digit($n);                # return the nth digit, counting from right
3036
3037 =head2 bneg
3038
3039         $x->bneg();
3040
3041 Negate the number, e.g. change the sign between '+' and '-', or between '+inf'
3042 and '-inf', respectively. Does nothing for NaN or zero.
3043
3044 =head2 babs
3045
3046         $x->babs();
3047
3048 Set the number to it's absolute value, e.g. change the sign from '-' to '+'
3049 and from '-inf' to '+inf', respectively. Does nothing for NaN or positive
3050 numbers.
3051
3052 =head2 bnorm
3053
3054   $x->bnorm();                  # normalize (no-op)
3055
3056 =head2 bnot
3057
3058   $x->bnot();                   # two's complement (bit wise not)
3059
3060 =head2 binc
3061
3062   $x->binc();                   # increment x by 1
3063
3064 =head2 bdec
3065
3066   $x->bdec();                   # decrement x by 1
3067
3068 =head2 badd
3069
3070   $x->badd($y);                 # addition (add $y to $x)
3071
3072 =head2 bsub
3073
3074   $x->bsub($y);                 # subtraction (subtract $y from $x)
3075
3076 =head2 bmul
3077
3078   $x->bmul($y);                 # multiplication (multiply $x by $y)
3079
3080 =head2 bdiv
3081
3082   $x->bdiv($y);                 # divide, set $x to quotient
3083                                 # return (quo,rem) or quo if scalar
3084
3085 =head2 bmod
3086
3087   $x->bmod($y);                 # modulus (x % y)
3088
3089 =head2 bmodinv
3090
3091   $num->bmodinv($mod);          # modular inverse
3092
3093 Returns the inverse of C<$num> in the given modulus C<$mod>.  'C<NaN>' is
3094 returned unless C<$num> is relatively prime to C<$mod>, i.e. unless
3095 C<bgcd($num, $mod)==1>.
3096
3097 =head2 bmodpow
3098
3099   $num->bmodpow($exp,$mod);     # modular exponentation ($num**$exp % $mod)
3100
3101 Returns the value of C<$num> taken to the power C<$exp> in the modulus
3102 C<$mod> using binary exponentation.  C<bmodpow> is far superior to
3103 writing
3104
3105   $num ** $exp % $mod
3106
3107 because C<bmodpow> is much faster--it reduces internal variables into
3108 the modulus whenever possible, so it operates on smaller numbers.
3109
3110 C<bmodpow> also supports negative exponents.
3111
3112   bmodpow($num, -1, $mod)
3113
3114 is exactly equivalent to
3115
3116   bmodinv($num, $mod)
3117
3118 =head2 bpow
3119
3120   $x->bpow($y);                 # power of arguments (x ** y)
3121
3122 =head2 blsft
3123
3124   $x->blsft($y);                # left shift
3125   $x->blsft($y,$n);             # left shift, by base $n (like 10)
3126
3127 =head2 brsft
3128
3129   $x->brsft($y);                # right shift
3130   $x->brsft($y,$n);             # right shift, by base $n (like 10)
3131
3132 =head2 band
3133
3134   $x->band($y);                 # bitwise and
3135
3136 =head2 bior
3137
3138   $x->bior($y);                 # bitwise inclusive or
3139
3140 =head2 bxor
3141
3142   $x->bxor($y);                 # bitwise exclusive or
3143
3144 =head2 bnot
3145
3146   $x->bnot();                   # bitwise not (two's complement)
3147
3148 =head2 bsqrt
3149
3150   $x->bsqrt();                  # calculate square-root
3151
3152 =head2 bfac
3153
3154   $x->bfac();                   # factorial of $x (1*2*3*4*..$x)
3155
3156 =head2 round
3157
3158   $x->round($A,$P,$round_mode); # round to accuracy or precision using mode $r
3159
3160 =head2 bround
3161
3162   $x->bround($N);               # accuracy: preserve $N digits
3163
3164 =head2 bfround
3165
3166   $x->bfround($N);              # round to $Nth digit, no-op for BigInts
3167
3168 =head2 bfloor
3169
3170         $x->bfloor();
3171
3172 Set $x to the integer less or equal than $x. This is a no-op in BigInt, but
3173 does change $x in BigFloat.
3174
3175 =head2 bceil
3176
3177         $x->bceil();
3178
3179 Set $x to the integer greater or equal than $x. This is a no-op in BigInt, but
3180 does change $x in BigFloat.
3181
3182 =head2 bgcd
3183
3184   bgcd(@values);                # greatest common divisor (no OO style)
3185
3186 =head2 blcm
3187
3188   blcm(@values);                # lowest common multiplicator (no OO style)
3189
3190 head2 length
3191
3192         $x->length();
3193         ($xl,$fl) = $x->length();
3194
3195 Returns the number of digits in the decimal representation of the number.
3196 In list context, returns the length of the integer and fraction part. For
3197 BigInt's, the length of the fraction part will always be 0.
3198
3199 =head2 exponent
3200
3201         $x->exponent();
3202
3203 Return the exponent of $x as BigInt.
3204
3205 =head2 mantissa
3206
3207         $x->mantissa();
3208
3209 Return the signed mantissa of $x as BigInt.
3210
3211 =head2 parts
3212
3213   $x->parts();                  # return (mantissa,exponent) as BigInt
3214
3215 =head2 copy
3216
3217   $x->copy();                   # make a true copy of $x (unlike $y = $x;)
3218
3219 =head2 as_number
3220
3221   $x->as_number();              # return as BigInt (in BigInt: same as copy())
3222
3223 =head2 bsrt
3224
3225   $x->bstr();                   # normalized string
3226
3227 =head2 bsstr
3228
3229   $x->bsstr();                  # normalized string in scientific notation
3230
3231 =head2 as_hex
3232
3233   $x->as_hex();                 # as signed hexadecimal string with prefixed 0x
3234
3235 =head2 as_bin
3236
3237   $x->as_bin();                 # as signed binary string with prefixed 0b
3238
3239 =head1 ACCURACY and PRECISION
3240
3241 Since version v1.33, Math::BigInt and Math::BigFloat have full support for
3242 accuracy and precision based rounding, both automatically after every
3243 operation as well as manually.
3244
3245 This section describes the accuracy/precision handling in Math::Big* as it
3246 used to be and as it is now, complete with an explanation of all terms and
3247 abbreviations.
3248
3249 Not yet implemented things (but with correct description) are marked with '!',
3250 things that need to be answered are marked with '?'.
3251
3252 In the next paragraph follows a short description of terms used here (because
3253 these may differ from terms used by others people or documentation).
3254
3255 During the rest of this document, the shortcuts A (for accuracy), P (for
3256 precision), F (fallback) and R (rounding mode) will be used.
3257
3258 =head2 Precision P
3259
3260 A fixed number of digits before (positive) or after (negative)
3261 the decimal point. For example, 123.45 has a precision of -2. 0 means an
3262 integer like 123 (or 120). A precision of 2 means two digits to the left
3263 of the decimal point are zero, so 123 with P = 1 becomes 120. Note that
3264 numbers with zeros before the decimal point may have different precisions,
3265 because 1200 can have p = 0, 1 or 2 (depending on what the inital value
3266 was). It could also have p < 0, when the digits after the decimal point
3267 are zero.
3268
3269 The string output (of floating point numbers) will be padded with zeros:
3270
3271         Initial value   P       A       Result          String
3272         ------------------------------------------------------------
3273         1234.01         -3              1000            1000
3274         1234            -2              1200            1200
3275         1234.5          -1              1230            1230
3276         1234.001        1               1234            1234.0
3277         1234.01         0               1234            1234
3278         1234.01         2               1234.01         1234.01
3279         1234.01         5               1234.01         1234.01000
3280
3281 For BigInts, no padding occurs.
3282
3283 =head2 Accuracy A
3284
3285 Number of significant digits. Leading zeros are not counted. A
3286 number may have an accuracy greater than the non-zero digits
3287 when there are zeros in it or trailing zeros. For example, 123.456 has
3288 A of 6, 10203 has 5, 123.0506 has 7, 123.450000 has 8 and 0.000123 has 3.
3289
3290 The string output (of floating point numbers) will be padded with zeros:
3291
3292         Initial value   P       A       Result          String
3293         ------------------------------------------------------------
3294         1234.01                 3       1230            1230
3295         1234.01                 6       1234.01         1234.01
3296         1234.1                  8       1234.1          1234.1000
3297
3298 For BigInts, no padding occurs.
3299
3300 =head2 Fallback F
3301
3302 When both A and P are undefined, this is used as a fallback accuracy when
3303 dividing numbers.
3304
3305 =head2 Rounding mode R
3306
3307 When rounding a number, different 'styles' or 'kinds'
3308 of rounding are possible. (Note that random rounding, as in
3309 Math::Round, is not implemented.)
3310
3311 =over 2
3312
3313 =item 'trunc'
3314
3315 truncation invariably removes all digits following the
3316 rounding place, replacing them with zeros. Thus, 987.65 rounded
3317 to tens (P=1) becomes 980, and rounded to the fourth sigdig
3318 becomes 987.6 (A=4). 123.456 rounded to the second place after the
3319 decimal point (P=-2) becomes 123.46.
3320
3321 All other implemented styles of rounding attempt to round to the
3322 "nearest digit." If the digit D immediately to the right of the
3323 rounding place (skipping the decimal point) is greater than 5, the
3324 number is incremented at the rounding place (possibly causing a
3325 cascade of incrementation): e.g. when rounding to units, 0.9 rounds
3326 to 1, and -19.9 rounds to -20. If D < 5, the number is similarly
3327 truncated at the rounding place: e.g. when rounding to units, 0.4
3328 rounds to 0, and -19.4 rounds to -19.
3329
3330 However the results of other styles of rounding differ if the
3331 digit immediately to the right of the rounding place (skipping the
3332 decimal point) is 5 and if there are no digits, or no digits other
3333 than 0, after that 5. In such cases:
3334
3335 =item 'even'
3336
3337 rounds the digit at the rounding place to 0, 2, 4, 6, or 8
3338 if it is not already. E.g., when rounding to the first sigdig, 0.45
3339 becomes 0.4, -0.55 becomes -0.6, but 0.4501 becomes 0.5.
3340
3341 =item 'odd'
3342
3343 rounds the digit at the rounding place to 1, 3, 5, 7, or 9 if
3344 it is not already. E.g., when rounding to the first sigdig, 0.45
3345 becomes 0.5, -0.55 becomes -0.5, but 0.5501 becomes 0.6.
3346
3347 =item '+inf'
3348
3349 round to plus infinity, i.e. always round up. E.g., when
3350 rounding to the first sigdig, 0.45 becomes 0.5, -0.55 becomes -0.5,
3351 and 0.4501 also becomes 0.5.
3352
3353 =item '-inf'
3354
3355 round to minus infinity, i.e. always round down. E.g., when
3356 rounding to the first sigdig, 0.45 becomes 0.4, -0.55 becomes -0.6,
3357 but 0.4501 becomes 0.5.
3358
3359 =item 'zero'
3360
3361 round to zero, i.e. positive numbers down, negative ones up.
3362 E.g., when rounding to the first sigdig, 0.45 becomes 0.4, -0.55
3363 becomes -0.5, but 0.4501 becomes 0.5.
3364
3365 =back
3366
3367 The handling of A & P in MBI/MBF (the old core code shipped with Perl
3368 versions <= 5.7.2) is like this:
3369
3370 =over 2
3371
3372 =item Precision
3373
3374   * ffround($p) is able to round to $p number of digits after the decimal
3375     point
3376   * otherwise P is unused
3377
3378 =item Accuracy (significant digits)
3379
3380   * fround($a) rounds to $a significant digits
3381   * only fdiv() and fsqrt() take A as (optional) paramater
3382     + other operations simply create the same number (fneg etc), or more (fmul)
3383       of digits
3384     + rounding/truncating is only done when explicitly calling one of fround
3385       or ffround, and never for BigInt (not implemented)
3386   * fsqrt() simply hands its accuracy argument over to fdiv.
3387   * the documentation and the comment in the code indicate two different ways
3388     on how fdiv() determines the maximum number of digits it should calculate,
3389     and the actual code does yet another thing
3390     POD:
3391       max($Math::BigFloat::div_scale,length(dividend)+length(divisor))
3392     Comment:
3393       result has at most max(scale, length(dividend), length(divisor)) digits
3394     Actual code:
3395       scale = max(scale, length(dividend)-1,length(divisor)-1);
3396       scale += length(divisior) - length(dividend);
3397     So for lx = 3, ly = 9, scale = 10, scale will actually be 16 (10+9-3).
3398     Actually, the 'difference' added to the scale is calculated from the
3399     number of "significant digits" in dividend and divisor, which is derived
3400     by looking at the length of the mantissa. Which is wrong, since it includes
3401     the + sign (oups) and actually gets 2 for '+100' and 4 for '+101'. Oups
3402     again. Thus 124/3 with div_scale=1 will get you '41.3' based on the strange
3403     assumption that 124 has 3 significant digits, while 120/7 will get you
3404     '17', not '17.1' since 120 is thought to have 2 significant digits.
3405     The rounding after the division then uses the remainder and $y to determine
3406     wether it must round up or down.
3407  ?  I have no idea which is the right way. That's why I used a slightly more
3408  ?  simple scheme and tweaked the few failing testcases to match it.
3409
3410 =back
3411
3412 This is how it works now:
3413
3414 =over 2
3415
3416 =item Setting/Accessing
3417
3418   * You can set the A global via Math::BigInt->accuracy() or
3419     Math::BigFloat->accuracy() or whatever class you are using.
3420   * You can also set P globally by using Math::SomeClass->precision() likewise.
3421   * Globals are classwide, and not inherited by subclasses.
3422   * to undefine A, use Math::SomeCLass->accuracy(undef);
3423   * to undefine P, use Math::SomeClass->precision(undef);
3424   * Setting Math::SomeClass->accuracy() clears automatically
3425     Math::SomeClass->precision(), and vice versa.
3426   * To be valid, A must be > 0, P can have any value.
3427   * If P is negative, this means round to the P'th place to the right of the
3428     decimal point; positive values mean to the left of the decimal point.
3429     P of 0 means round to integer.
3430   * to find out the current global A, take Math::SomeClass->accuracy()
3431   * to find out the current global P, take Math::SomeClass->precision()
3432   * use $x->accuracy() respective $x->precision() for the local setting of $x.
3433   * Please note that $x->accuracy() respecive $x->precision() fall back to the
3434     defined globals, when $x's A or P is not set.
3435
3436 =item Creating numbers
3437
3438   * When you create a number, you can give it's desired A or P via:
3439     $x = Math::BigInt->new($number,$A,$P);
3440   * Only one of A or P can be defined, otherwise the result is NaN
3441   * If no A or P is give ($x = Math::BigInt->new($number) form), then the
3442     globals (if set) will be used. Thus changing the global defaults later on
3443     will not change the A or P of previously created numbers (i.e., A and P of
3444     $x will be what was in effect when $x was created)
3445   * If given undef for A and P, B<no> rounding will occur, and the globals will
3446     B<not> be used. This is used by subclasses to create numbers without
3447     suffering rounding in the parent. Thus a subclass is able to have it's own
3448     globals enforced upon creation of a number by using
3449     $x = Math::BigInt->new($number,undef,undef):
3450
3451         use Math::Bigint::SomeSubclass;
3452         use Math::BigInt;
3453
3454         Math::BigInt->accuracy(2);
3455         Math::BigInt::SomeSubClass->accuracy(3);
3456         $x = Math::BigInt::SomeSubClass->new(1234);
3457
3458     $x is now 1230, and not 1200. A subclass might choose to implement
3459     this otherwise, e.g. falling back to the parent's A and P.
3460
3461 =item Usage
3462
3463   * If A or P are enabled/defined, they are used to round the result of each
3464     operation according to the rules below
3465   * Negative P is ignored in Math::BigInt, since BigInts never have digits
3466     after the decimal point
3467   * Math::BigFloat uses Math::BigInts internally, but setting A or P inside
3468     Math::BigInt as globals should not tamper with the parts of a BigFloat.
3469     Thus a flag is used to mark all Math::BigFloat numbers as 'never round'
3470
3471 =item Precedence
3472
3473   * It only makes sense that a number has only one of A or P at a time.
3474     Since you can set/get both A and P, there is a rule that will practically
3475     enforce only A or P to be in effect at a time, even if both are set.
3476     This is called precedence.
3477   * If two objects are involved in an operation, and one of them has A in
3478     effect, and the other P, this results in an error (NaN).
3479   * A takes precendence over P (Hint: A comes before P). If A is defined, it
3480     is used, otherwise P is used. If neither of them is defined, nothing is
3481     used, i.e. the result will have as many digits as it can (with an
3482     exception for fdiv/fsqrt) and will not be rounded.
3483   * There is another setting for fdiv() (and thus for fsqrt()). If neither of
3484     A or P is defined, fdiv() will use a fallback (F) of $div_scale digits.
3485     If either the dividend's or the divisor's mantissa has more digits than
3486     the value of F, the higher value will be used instead of F.
3487     This is to limit the digits (A) of the result (just consider what would
3488     happen with unlimited A and P in the case of 1/3 :-)
3489   * fdiv will calculate (at least) 4 more digits than required (determined by
3490     A, P or F), and, if F is not used, round the result
3491     (this will still fail in the case of a result like 0.12345000000001 with A
3492     or P of 5, but this can not be helped - or can it?)
3493   * Thus you can have the math done by on Math::Big* class in three modes:
3494     + never round (this is the default):
3495       This is done by setting A and P to undef. No math operation
3496       will round the result, with fdiv() and fsqrt() as exceptions to guard
3497       against overflows. You must explicitely call bround(), bfround() or
3498       round() (the latter with parameters).
3499       Note: Once you have rounded a number, the settings will 'stick' on it
3500       and 'infect' all other numbers engaged in math operations with it, since
3501       local settings have the highest precedence. So, to get SaferRound[tm],
3502       use a copy() before rounding like this:
3503
3504         $x = Math::BigFloat->new(12.34);
3505         $y = Math::BigFloat->new(98.76);
3506         $z = $x * $y;                           # 1218.6984
3507         print $x->copy()->fround(3);            # 12.3 (but A is now 3!)
3508         $z = $x * $y;                           # still 1218.6984, without
3509                                                 # copy would have been 1210!
3510
3511     + round after each op:
3512       After each single operation (except for testing like is_zero()), the
3513       method round() is called and the result is rounded appropriately. By
3514       setting proper values for A and P, you can have all-the-same-A or
3515       all-the-same-P modes. For example, Math::Currency might set A to undef,
3516       and P to -2, globally.
3517
3518  ?Maybe an extra option that forbids local A & P settings would be in order,
3519  ?so that intermediate rounding does not 'poison' further math?
3520
3521 =item Overriding globals
3522
3523   * you will be able to give A, P and R as an argument to all the calculation
3524     routines; the second parameter is A, the third one is P, and the fourth is
3525     R (shift right by one for binary operations like badd). P is used only if
3526     the first parameter (A) is undefined. These three parameters override the
3527     globals in the order detailed as follows, i.e. the first defined value
3528     wins:
3529     (local: per object, global: global default, parameter: argument to sub)
3530       + parameter A
3531       + parameter P
3532       + local A (if defined on both of the operands: smaller one is taken)
3533       + local P (if defined on both of the operands: bigger one is taken)
3534       + global A
3535       + global P
3536       + global F
3537   * fsqrt() will hand its arguments to fdiv(), as it used to, only now for two
3538     arguments (A and P) instead of one
3539
3540 =item Local settings
3541
3542   * You can set A and P locally by using $x->accuracy() and $x->precision()
3543     and thus force different A and P for different objects/numbers.
3544   * Setting A or P this way immediately rounds $x to the new value.
3545   * $x->accuracy() clears $x->precision(), and vice versa.
3546
3547 =item Rounding
3548
3549   * the rounding routines will use the respective global or local settings.
3550     fround()/bround() is for accuracy rounding, while ffround()/bfround()
3551     is for precision
3552   * the two rounding functions take as the second parameter one of the
3553     following rounding modes (R):
3554     'even', 'odd', '+inf', '-inf', 'zero', 'trunc'
3555   * you can set and get the global R by using Math::SomeClass->round_mode()
3556     or by setting $Math::SomeClass::round_mode
3557   * after each operation, $result->round() is called, and the result may
3558     eventually be rounded (that is, if A or P were set either locally,
3559     globally or as parameter to the operation)
3560   * to manually round a number, call $x->round($A,$P,$round_mode);
3561     this will round the number by using the appropriate rounding function
3562     and then normalize it.
3563   * rounding modifies the local settings of the number:
3564
3565         $x = Math::BigFloat->new(123.456);
3566         $x->accuracy(5);
3567         $x->bround(4);
3568
3569     Here 4 takes precedence over 5, so 123.5 is the result and $x->accuracy()
3570     will be 4 from now on.
3571
3572 =item Default values
3573
3574   * R: 'even'
3575   * F: 40
3576   * A: undef
3577   * P: undef
3578
3579 =item Remarks
3580
3581   * The defaults are set up so that the new code gives the same results as
3582     the old code (except in a few cases on fdiv):
3583     + Both A and P are undefined and thus will not be used for rounding
3584       after each operation.
3585     + round() is thus a no-op, unless given extra parameters A and P
3586
3587 =back
3588
3589 =head1 INTERNALS
3590
3591 The actual numbers are stored as unsigned big integers (with seperate sign).
3592 You should neither care about nor depend on the internal representation; it
3593 might change without notice. Use only method calls like C<< $x->sign(); >>
3594 instead relying on the internal hash keys like in C<< $x->{sign}; >>.
3595
3596 =head2 MATH LIBRARY
3597
3598 Math with the numbers is done (by default) by a module called
3599 Math::BigInt::Calc. This is equivalent to saying:
3600
3601         use Math::BigInt lib => 'Calc';
3602
3603 You can change this by using:
3604
3605         use Math::BigInt lib => 'BitVect';
3606
3607 The following would first try to find Math::BigInt::Foo, then
3608 Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
3609
3610         use Math::BigInt lib => 'Foo,Math::BigInt::Bar';
3611
3612 Calc.pm uses as internal format an array of elements of some decimal base
3613 (usually 1e5 or 1e7) with the least significant digit first, while BitVect.pm
3614 uses a bit vector of base 2, most significant bit first. Other modules might
3615 use even different means of representing the numbers. See the respective
3616 module documentation for further details.
3617
3618 =head2 SIGN
3619
3620 The sign is either '+', '-', 'NaN', '+inf' or '-inf' and stored seperately.
3621
3622 A sign of 'NaN' is used to represent the result when input arguments are not
3623 numbers or as a result of 0/0. '+inf' and '-inf' represent plus respectively
3624 minus infinity. You will get '+inf' when dividing a positive number by 0, and
3625 '-inf' when dividing any negative number by 0.
3626
3627 =head2 mantissa(), exponent() and parts()
3628
3629 C<mantissa()> and C<exponent()> return the said parts of the BigInt such
3630 that:
3631
3632         $m = $x->mantissa();
3633         $e = $x->exponent();
3634         $y = $m * ( 10 ** $e );
3635         print "ok\n" if $x == $y;
3636
3637 C<< ($m,$e) = $x->parts() >> is just a shortcut that gives you both of them
3638 in one go. Both the returned mantissa and exponent have a sign.
3639
3640 Currently, for BigInts C<$e> will be always 0, except for NaN, +inf and -inf,
3641 where it will be NaN; and for $x == 0, where it will be 1
3642 (to be compatible with Math::BigFloat's internal representation of a zero as
3643 C<0E1>).
3644
3645 C<$m> will always be a copy of the original number. The relation between $e
3646 and $m might change in the future, but will always be equivalent in a
3647 numerical sense, e.g. $m might get minimized.
3648
3649 =head1 EXAMPLES
3650
3651   use Math::BigInt;
3652
3653   sub bint { Math::BigInt->new(shift); }
3654
3655   $x = Math::BigInt->bstr("1234")       # string "1234"
3656   $x = "$x";                            # same as bstr()
3657   $x = Math::BigInt->bneg("1234");      # Bigint "-1234"
3658   $x = Math::BigInt->babs("-12345");    # Bigint "12345"
3659   $x = Math::BigInt->bnorm("-0 00");    # BigInt "0"
3660   $x = bint(1) + bint(2);               # BigInt "3"
3661   $x = bint(1) + "2";                   # ditto (auto-BigIntify of "2")
3662   $x = bint(1);                         # BigInt "1"
3663   $x = $x + 5 / 2;                      # BigInt "3"
3664   $x = $x ** 3;                         # BigInt "27"
3665   $x *= 2;                              # BigInt "54"
3666   $x = Math::BigInt->new(0);            # BigInt "0"
3667   $x--;                                 # BigInt "-1"
3668   $x = Math::BigInt->badd(4,5)          # BigInt "9"
3669   print $x->bsstr();                    # 9e+0
3670
3671 Examples for rounding:
3672
3673   use Math::BigFloat;
3674   use Test;
3675
3676   $x = Math::BigFloat->new(123.4567);
3677   $y = Math::BigFloat->new(123.456789);
3678   Math::BigFloat->accuracy(4);          # no more A than 4
3679
3680   ok ($x->copy()->fround(),123.4);      # even rounding
3681   print $x->copy()->fround(),"\n";      # 123.4
3682   Math::BigFloat->round_mode('odd');    # round to odd
3683   print $x->copy()->fround(),"\n";      # 123.5
3684   Math::BigFloat->accuracy(5);          # no more A than 5
3685   Math::BigFloat->round_mode('odd');    # round to odd
3686   print $x->copy()->fround(),"\n";      # 123.46
3687   $y = $x->copy()->fround(4),"\n";      # A = 4: 123.4
3688   print "$y, ",$y->accuracy(),"\n";     # 123.4, 4
3689
3690   Math::BigFloat->accuracy(undef);      # A not important now
3691   Math::BigFloat->precision(2);         # P important
3692   print $x->copy()->bnorm(),"\n";       # 123.46
3693   print $x->copy()->fround(),"\n";      # 123.46
3694
3695 Examples for converting:
3696
3697   my $x = Math::BigInt->new('0b1'.'01' x 123);
3698   print "bin: ",$x->as_bin()," hex:",$x->as_hex()," dec: ",$x,"\n";
3699
3700 =head1 Autocreating constants
3701
3702 After C<use Math::BigInt ':constant'> all the B<integer> decimal, hexadecimal
3703 and binary constants in the given scope are converted to C<Math::BigInt>.
3704 This conversion happens at compile time.
3705
3706 In particular,
3707
3708   perl -MMath::BigInt=:constant -e 'print 2**100,"\n"'
3709
3710 prints the integer value of C<2**100>. Note that without conversion of
3711 constants the expression 2**100 will be calculated as perl scalar.
3712
3713 Please note that strings and floating point constants are not affected,
3714 so that
3715
3716         use Math::BigInt qw/:constant/;
3717
3718         $x = 1234567890123456789012345678901234567890
3719                 + 123456789123456789;
3720         $y = '1234567890123456789012345678901234567890'
3721                 + '123456789123456789';
3722
3723 do not work. You need an explicit Math::BigInt->new() around one of the
3724 operands. You should also quote large constants to protect loss of precision:
3725
3726         use Math::Bigint;
3727
3728         $x = Math::BigInt->new('1234567889123456789123456789123456789');
3729
3730 Without the quotes Perl would convert the large number to a floating point
3731 constant at compile time and then hand the result to BigInt, which results in
3732 an truncated result or a NaN.
3733
3734 This also applies to integers that look like floating point constants:
3735
3736         use Math::BigInt ':constant';
3737
3738         print ref(123e2),"\n";
3739         print ref(123.2e2),"\n";
3740
3741 will print nothing but newlines. Use either L<bignum> or L<Math::BigFloat>
3742 to get this to work.
3743
3744 =head1 PERFORMANCE
3745
3746 Using the form $x += $y; etc over $x = $x + $y is faster, since a copy of $x
3747 must be made in the second case. For long numbers, the copy can eat up to 20%
3748 of the work (in the case of addition/subtraction, less for
3749 multiplication/division). If $y is very small compared to $x, the form
3750 $x += $y is MUCH faster than $x = $x + $y since making the copy of $x takes
3751 more time then the actual addition.
3752
3753 With a technique called copy-on-write, the cost of copying with overload could
3754 be minimized or even completely avoided. A test implementation of COW did show
3755 performance gains for overloaded math, but introduced a performance loss due
3756 to a constant overhead for all other operatons.
3757
3758 The rewritten version of this module is slower on certain operations, like
3759 new(), bstr() and numify(). The reason are that it does now more work and
3760 handles more cases. The time spent in these operations is usually gained in
3761 the other operations so that programs on the average should get faster. If
3762 they don't, please contect the author.
3763
3764 Some operations may be slower for small numbers, but are significantly faster
3765 for big numbers. Other operations are now constant (O(1), like bneg(), babs()
3766 etc), instead of O(N) and thus nearly always take much less time. These
3767 optimizations were done on purpose.
3768
3769 If you find the Calc module to slow, try to install any of the replacement
3770 modules and see if they help you.
3771
3772 =head2 Alternative math libraries
3773
3774 You can use an alternative library to drive Math::BigInt via:
3775
3776         use Math::BigInt lib => 'Module';
3777
3778 See L<MATH LIBRARY> for more information.
3779
3780 For more benchmark results see L<http://bloodgate.com/perl/benchmarks.html>.
3781
3782 =head2 SUBCLASSING
3783
3784 =head1 Subclassing Math::BigInt
3785
3786 The basic design of Math::BigInt allows simple subclasses with very little
3787 work, as long as a few simple rules are followed:
3788
3789 =over 2
3790
3791 =item *
3792
3793 The public API must remain consistent, i.e. if a sub-class is overloading
3794 addition, the sub-class must use the same name, in this case badd(). The
3795 reason for this is that Math::BigInt is optimized to call the object methods
3796 directly.
3797
3798 =item *
3799
3800 The private object hash keys like C<$x->{sign}> may not be changed, but
3801 additional keys can be added, like C<$x->{_custom}>.
3802
3803 =item *
3804
3805 Accessor functions are available for all existing object hash keys and should
3806 be used instead of directly accessing the internal hash keys. The reason for
3807 this is that Math::BigInt itself has a pluggable interface which permits it
3808 to support different storage methods.
3809
3810 =back
3811
3812 More complex sub-classes may have to replicate more of the logic internal of
3813 Math::BigInt if they need to change more basic behaviors. A subclass that
3814 needs to merely change the output only needs to overload C<bstr()>.
3815
3816 All other object methods and overloaded functions can be directly inherited
3817 from the parent class.
3818
3819 At the very minimum, any subclass will need to provide it's own C<new()> and can
3820 store additional hash keys in the object. There are also some package globals
3821 that must be defined, e.g.:
3822
3823   # Globals
3824   $accuracy = undef;
3825   $precision = -2;       # round to 2 decimal places
3826   $round_mode = 'even';
3827   $div_scale = 40;
3828
3829 Additionally, you might want to provide the following two globals to allow
3830 auto-upgrading and auto-downgrading to work correctly:
3831
3832   $upgrade = undef;
3833   $downgrade = undef;
3834
3835 This allows Math::BigInt to correctly retrieve package globals from the
3836 subclass, like C<$SubClass::precision>.  See t/Math/BigInt/Subclass.pm or
3837 t/Math/BigFloat/SubClass.pm completely functional subclass examples.
3838
3839 Don't forget to
3840
3841         use overload;
3842
3843 in your subclass to automatically inherit the overloading from the parent. If
3844 you like, you can change part of the overloading, look at Math::String for an
3845 example.
3846
3847 =head1 UPGRADING
3848
3849 When used like this:
3850
3851         use Math::BigInt upgrade => 'Foo::Bar';
3852
3853 certain operations will 'upgrade' their calculation and thus the result to
3854 the class Foo::Bar. Usually this is used in conjunction with Math::BigFloat:
3855
3856         use Math::BigInt upgrade => 'Math::BigFloat';
3857
3858 As a shortcut, you can use the module C<bignum>:
3859
3860         use bignum;
3861
3862 Also good for oneliners:
3863
3864         perl -Mbignum -le 'print 2 ** 255'
3865
3866 This makes it possible to mix arguments of different classes (as in 2.5 + 2)
3867 as well es preserve accuracy (as in sqrt(3)).
3868
3869 Beware: This feature is not fully implemented yet.
3870
3871 =head2 Auto-upgrade
3872
3873 The following methods upgrade themselves unconditionally; that is if upgrade
3874 is in effect, they will always hand up their work:
3875
3876 =over 2
3877
3878 =item bsqrt()
3879
3880 =item div()
3881
3882 =item blog()
3883
3884 =back
3885
3886 Beware: This list is not complete.
3887
3888 All other methods upgrade themselves only when one (or all) of their
3889 arguments are of the class mentioned in $upgrade (This might change in later
3890 versions to a more sophisticated scheme):
3891
3892 =head1 BUGS
3893
3894 =over 2
3895
3896 =item Out of Memory!
3897
3898 Under Perl prior to 5.6.0 having an C<use Math::BigInt ':constant';> and
3899 C<eval()> in your code will crash with "Out of memory". This is probably an
3900 overload/exporter bug. You can workaround by not having C<eval()>
3901 and ':constant' at the same time or upgrade your Perl to a newer version.
3902
3903 =item Fails to load Calc on Perl prior 5.6.0
3904
3905 Since eval(' use ...') can not be used in conjunction with ':constant', BigInt
3906 will fall back to eval { require ... } when loading the math lib on Perls
3907 prior to 5.6.0. This simple replaces '::' with '/' and thus might fail on
3908 filesystems using a different seperator.
3909
3910 =back
3911
3912 =head1 CAVEATS
3913
3914 Some things might not work as you expect them. Below is documented what is
3915 known to be troublesome:
3916
3917 =over 1
3918
3919 =item stringify, bstr(), bsstr() and 'cmp'
3920
3921 Both stringify and bstr() now drop the leading '+'. The old code would return
3922 '+3', the new returns '3'. This is to be consistent with Perl and to make
3923 cmp (especially with overloading) to work as you expect. It also solves
3924 problems with Test.pm, it's ok() uses 'eq' internally.
3925
3926 Mark said, when asked about to drop the '+' altogether, or make only cmp work:
3927
3928         I agree (with the first alternative), don't add the '+' on positive
3929         numbers.  It's not as important anymore with the new internal
3930         form for numbers.  It made doing things like abs and neg easier,
3931         but those have to be done differently now anyway.
3932
3933 So, the following examples will now work all as expected:
3934
3935         use Test;
3936         BEGIN { plan tests => 1 }
3937         use Math::BigInt;
3938
3939         my $x = new Math::BigInt 3*3;
3940         my $y = new Math::BigInt 3*3;
3941
3942         ok ($x,3*3);
3943         print "$x eq 9" if $x eq $y;
3944         print "$x eq 9" if $x eq '9';
3945         print "$x eq 9" if $x eq 3*3;
3946
3947 Additionally, the following still works:
3948
3949         print "$x == 9" if $x == $y;
3950         print "$x == 9" if $x == 9;
3951         print "$x == 9" if $x == 3*3;
3952
3953 There is now a C<bsstr()> method to get the string in scientific notation aka
3954 C<1e+2> instead of C<100>. Be advised that overloaded 'eq' always uses bstr()
3955 for comparisation, but Perl will represent some numbers as 100 and others
3956 as 1e+308. If in doubt, convert both arguments to Math::BigInt before doing eq:
3957
3958         use Test;
3959         BEGIN { plan tests => 3 }
3960         use Math::BigInt;
3961
3962         $x = Math::BigInt->new('1e56'); $y = 1e56;
3963         ok ($x,$y);                     # will fail
3964         ok ($x->bsstr(),$y);            # okay
3965         $y = Math::BigInt->new($y);
3966         ok ($x,$y);                     # okay
3967
3968 Alternatively, simple use <=> for comparisations, that will get it always
3969 right. There is not yet a way to get a number automatically represented as
3970 a string that matches exactly the way Perl represents it.
3971
3972 =item int()
3973
3974 C<int()> will return (at least for Perl v5.7.1 and up) another BigInt, not a
3975 Perl scalar:
3976
3977         $x = Math::BigInt->new(123);
3978         $y = int($x);                           # BigInt 123
3979         $x = Math::BigFloat->new(123.45);
3980         $y = int($x);                           # BigInt 123
3981
3982 In all Perl versions you can use C<as_number()> for the same effect:
3983
3984         $x = Math::BigFloat->new(123.45);
3985         $y = $x->as_number();                   # BigInt 123
3986
3987 This also works for other subclasses, like Math::String.
3988
3989 It is yet unlcear whether overloaded int() should return a scalar or a BigInt.
3990
3991 =item length
3992
3993 The following will probably not do what you expect:
3994
3995         $c = Math::BigInt->new(123);
3996         print $c->length(),"\n";                # prints 30
3997
3998 It prints both the number of digits in the number and in the fraction part
3999 since print calls C<length()> in list context. Use something like:
4000
4001         print scalar $c->length(),"\n";         # prints 3
4002
4003 =item bdiv
4004
4005 The following will probably not do what you expect:
4006
4007         print $c->bdiv(10000),"\n";
4008
4009 It prints both quotient and remainder since print calls C<bdiv()> in list
4010 context. Also, C<bdiv()> will modify $c, so be carefull. You probably want
4011 to use
4012
4013         print $c / 10000,"\n";
4014         print scalar $c->bdiv(10000),"\n";  # or if you want to modify $c
4015
4016 instead.
4017
4018 The quotient is always the greatest integer less than or equal to the
4019 real-valued quotient of the two operands, and the remainder (when it is
4020 nonzero) always has the same sign as the second operand; so, for
4021 example,
4022
4023           1 / 4  => ( 0, 1)
4024           1 / -4 => (-1,-3)
4025          -3 / 4  => (-1, 1)
4026          -3 / -4 => ( 0,-3)
4027         -11 / 2  => (-5,1)
4028          11 /-2  => (-5,-1)
4029
4030 As a consequence, the behavior of the operator % agrees with the
4031 behavior of Perl's built-in % operator (as documented in the perlop
4032 manpage), and the equation
4033
4034         $x == ($x / $y) * $y + ($x % $y)
4035
4036 holds true for any $x and $y, which justifies calling the two return
4037 values of bdiv() the quotient and remainder. The only exception to this rule
4038 are when $y == 0 and $x is negative, then the remainder will also be
4039 negative. See below under "infinity handling" for the reasoning behing this.
4040
4041 Perl's 'use integer;' changes the behaviour of % and / for scalars, but will
4042 not change BigInt's way to do things. This is because under 'use integer' Perl
4043 will do what the underlying C thinks is right and this is different for each
4044 system. If you need BigInt's behaving exactly like Perl's 'use integer', bug
4045 the author to implement it ;)
4046
4047 =item infinity handling
4048
4049 Here are some examples that explain the reasons why certain results occur while
4050 handling infinity:
4051
4052 The following table shows the result of the division and the remainder, so that
4053 the equation above holds true. Some "ordinary" cases are strewn in to show more
4054 clearly the reasoning:
4055
4056         A /  B  =   C,     R so that C *    B +    R =    A
4057      =========================================================
4058         5 /   8 =   0,     5         0 *    8 +    5 =    5
4059         0 /   8 =   0,     0         0 *    8 +    0 =    0
4060         0 / inf =   0,     0         0 *  inf +    0 =    0
4061         0 /-inf =   0,     0         0 * -inf +    0 =    0
4062         5 / inf =   0,     5         0 *  inf +    5 =    5
4063         5 /-inf =   0,     5         0 * -inf +    5 =    5
4064         -5/ inf =   0,    -5         0 *  inf +   -5 =   -5
4065         -5/-inf =   0,    -5         0 * -inf +   -5 =   -5
4066        inf/   5 =  inf,    0       inf *    5 +    0 =  inf
4067       -inf/   5 = -inf,    0      -inf *    5 +    0 = -inf
4068        inf/  -5 = -inf,    0      -inf *   -5 +    0 =  inf
4069       -inf/  -5 =  inf,    0       inf *   -5 +    0 = -inf
4070          5/   5 =    1,    0         1 *    5 +    0 =    5
4071         -5/  -5 =    1,    0         1 *   -5 +    0 =   -5
4072        inf/ inf =    1,    0         1 *  inf +    0 =  inf
4073       -inf/-inf =    1,    0         1 * -inf +    0 = -inf
4074        inf/-inf =   -1,    0        -1 * -inf +    0 =  inf
4075       -inf/ inf =   -1,    0         1 * -inf +    0 = -inf
4076          8/   0 =  inf,    8       inf *    0 +    8 =    8
4077        inf/   0 =  inf,  inf       inf *    0 +  inf =  inf
4078          0/   0 =  NaN
4079
4080 These cases below violate the "remainder has the sign of the second of the two
4081 arguments", since they wouldn't match up otherwise.
4082
4083         A /  B  =   C,     R so that C *    B +    R =    A
4084      ========================================================
4085       -inf/   0 = -inf, -inf      -inf *    0 +  inf = -inf
4086         -8/   0 = -inf,   -8      -inf *    0 +    8 = -8
4087
4088 =item Modifying and =
4089
4090 Beware of:
4091
4092         $x = Math::BigFloat->new(5);
4093         $y = $x;
4094
4095 It will not do what you think, e.g. making a copy of $x. Instead it just makes
4096 a second reference to the B<same> object and stores it in $y. Thus anything
4097 that modifies $x (except overloaded operators) will modify $y, and vice versa.
4098 Or in other words, C<=> is only safe if you modify your BigInts only via
4099 overloaded math. As soon as you use a method call it breaks:
4100
4101         $x->bmul(2);
4102         print "$x, $y\n";       # prints '10, 10'
4103
4104 If you want a true copy of $x, use:
4105
4106         $y = $x->copy();
4107
4108 You can also chain the calls like this, this will make first a copy and then
4109 multiply it by 2:
4110
4111         $y = $x->copy()->bmul(2);
4112
4113 See also the documentation for overload.pm regarding C<=>.
4114
4115 =item bpow
4116
4117 C<bpow()> (and the rounding functions) now modifies the first argument and
4118 returns it, unlike the old code which left it alone and only returned the
4119 result. This is to be consistent with C<badd()> etc. The first three will
4120 modify $x, the last one won't:
4121
4122         print bpow($x,$i),"\n";         # modify $x
4123         print $x->bpow($i),"\n";        # ditto
4124         print $x **= $i,"\n";           # the same
4125         print $x ** $i,"\n";            # leave $x alone
4126
4127 The form C<$x **= $y> is faster than C<$x = $x ** $y;>, though.
4128
4129 =item Overloading -$x
4130
4131 The following:
4132
4133         $x = -$x;
4134
4135 is slower than
4136
4137         $x->bneg();
4138
4139 since overload calls C<sub($x,0,1);> instead of C<neg($x)>. The first variant
4140 needs to preserve $x since it does not know that it later will get overwritten.
4141 This makes a copy of $x and takes O(N), but $x->bneg() is O(1).
4142
4143 With Copy-On-Write, this issue would be gone, but C-o-W is not implemented
4144 since it is slower for all other things.
4145
4146 =item Mixing different object types
4147
4148 In Perl you will get a floating point value if you do one of the following:
4149
4150         $float = 5.0 + 2;
4151         $float = 2 + 5.0;
4152         $float = 5 / 2;
4153
4154 With overloaded math, only the first two variants will result in a BigFloat:
4155
4156         use Math::BigInt;
4157         use Math::BigFloat;
4158
4159         $mbf = Math::BigFloat->new(5);
4160         $mbi2 = Math::BigInteger->new(5);
4161         $mbi = Math::BigInteger->new(2);
4162
4163                                         # what actually gets called:
4164         $float = $mbf + $mbi;           # $mbf->badd()
4165         $float = $mbf / $mbi;           # $mbf->bdiv()
4166         $integer = $mbi + $mbf;         # $mbi->badd()
4167         $integer = $mbi2 / $mbi;        # $mbi2->bdiv()
4168         $integer = $mbi2 / $mbf;        # $mbi2->bdiv()
4169
4170 This is because math with overloaded operators follows the first (dominating)
4171 operand, and the operation of that is called and returns thus the result. So,
4172 Math::BigInt::bdiv() will always return a Math::BigInt, regardless whether
4173 the result should be a Math::BigFloat or the second operant is one.
4174
4175 To get a Math::BigFloat you either need to call the operation manually,
4176 make sure the operands are already of the proper type or casted to that type
4177 via Math::BigFloat->new():
4178
4179         $float = Math::BigFloat->new($mbi2) / $mbi;     # = 2.5
4180
4181 Beware of simple "casting" the entire expression, this would only convert
4182 the already computed result:
4183
4184         $float = Math::BigFloat->new($mbi2 / $mbi);     # = 2.0 thus wrong!
4185
4186 Beware also of the order of more complicated expressions like:
4187
4188         $integer = ($mbi2 + $mbi) / $mbf;               # int / float => int
4189         $integer = $mbi2 / Math::BigFloat->new($mbi);   # ditto
4190
4191 If in doubt, break the expression into simpler terms, or cast all operands
4192 to the desired resulting type.
4193
4194 Scalar values are a bit different, since:
4195
4196         $float = 2 + $mbf;
4197         $float = $mbf + 2;
4198
4199 will both result in the proper type due to the way the overloaded math works.
4200
4201 This section also applies to other overloaded math packages, like Math::String.
4202
4203 One solution to you problem might be L<autoupgrading|upgrading>.
4204
4205 =item bsqrt()
4206
4207 C<bsqrt()> works only good if the result is a big integer, e.g. the square
4208 root of 144 is 12, but from 12 the square root is 3, regardless of rounding
4209 mode.
4210
4211 If you want a better approximation of the square root, then use:
4212
4213         $x = Math::BigFloat->new(12);
4214         Math::BigFloat->precision(0);
4215         Math::BigFloat->round_mode('even');
4216         print $x->copy->bsqrt(),"\n";           # 4
4217
4218         Math::BigFloat->precision(2);
4219         print $x->bsqrt(),"\n";                 # 3.46
4220         print $x->bsqrt(3),"\n";                # 3.464
4221
4222 =item brsft()
4223
4224 For negative numbers in base see also L<brsft|brsft>.
4225
4226 =back
4227
4228 =head1 LICENSE
4229
4230 This program is free software; you may redistribute it and/or modify it under
4231 the same terms as Perl itself.
4232
4233 =head1 SEE ALSO
4234
4235 L<Math::BigFloat> and L<Math::Big> as well as L<Math::BigInt::BitVect>,
4236 L<Math::BigInt::Pari> and  L<Math::BigInt::GMP>.
4237
4238 The package at
4239 L<http://search.cpan.org/search?mode=module&query=Math%3A%3ABigInt> contains
4240 more documentation including a full version history, testcases, empty
4241 subclass files and benchmarks.
4242
4243 =head1 AUTHORS
4244
4245 Original code by Mark Biggar, overloaded interface by Ilya Zakharevich.
4246 Completely rewritten by Tels http://bloodgate.com in late 2000, 2001.
4247
4248 =cut