lib/Math/BigInt.pm

   1 #!/usr/bin/perl -w
   2
   3 # Qs: what exactly happens on numify of HUGE numbers? overflow?
   4 #     $a = -$a is much slower (making copy of $a) than $a->bneg(), hm!?
   5 #     (copy_on_write will help there, but that is not yet implemented)
   6
   7 # The following hash values are used:
   8 #   value: unsigned int with actual value (as a Math::BigInt::Calc or similiar)
   9 #   sign : +,-,NaN,+inf,-inf
  10 #   _a   : accuracy
  11 #   _p   : precision
  12 #   _f   : flags, used by MBF to flag parts of a float as untouchable
  13 #   _cow : copy on write: number of objects that share the data (NRY)
  14
  15 # Remember not to take shortcuts ala $xs = $x->{value}; $CALC->foo($xs); since
  16 # underlying lib might change the reference!
  17
  18 package Math::BigInt;
  19 my $class = "Math::BigInt";
  20 require 5.005;
  21
  22 $VERSION = '1.41';
  23 use Exporter;
  24 @ISA =       qw( Exporter );
  25 @EXPORT_OK = qw( bneg babs bcmp badd bmul bdiv bmod bnorm bsub
  26                  bgcd blcm
  27                  bround
  28                  blsft brsft band bior bxor bnot bpow bnan bzero
  29                  bacmp bstr bsstr binc bdec binf bfloor bceil
  30                  is_odd is_even is_zero is_one is_nan is_inf sign
  31                  is_positive is_negative
  32                  length as_number
  33                  objectify _swap
  34                );
  35 #@EXPORT = qw( );
  36 use vars qw/$rnd_mode $accuracy $precision $div_scale/;
  37 use strict;
  38
  39 # Inside overload, the first arg is always an object. If the original code had
  40 # it reversed (like $x = 2 * $y), then the third paramater indicates this
  41 # swapping. To make it work, we use a helper routine which not only reswaps the
  42 # params, but also makes a new object in this case. See _swap() for details,
  43 # especially the cases of operators with different classes.
  44
  45 # For overloaded ops with only one argument we simple use $_[0]->copy() to
  46 # preserve the argument.
  47
  48 # Thus inheritance of overload operators becomes possible and transparent for
  49 # our subclasses without the need to repeat the entire overload section there.
  50
  51 use overload
  52 '='     =>      sub { $_[0]->copy(); },
  53
  54 # '+' and '-' do not use _swap, since it is a triffle slower. If you want to
  55 # override _swap (if ever), then override overload of '+' and '-', too!
  56 # for sub it is a bit tricky to keep b: b-a => -a+b
  57 '-'     =>      sub { my $c = $_[0]->copy; $_[2] ?
  58                    $c->bneg()->badd($_[1]) :
  59                    $c->bsub( $_[1]) },
  60 '+'     =>      sub { $_[0]->copy()->badd($_[1]); },
  61
  62 # some shortcuts for speed (assumes that reversed order of arguments is routed
  63 # to normal '+' and we thus can always modify first arg. If this is changed,
  64 # this breaks and must be adjusted.)
  65 '+='    =>      sub { $_[0]->badd($_[1]); },
  66 '-='    =>      sub { $_[0]->bsub($_[1]); },
  67 '*='    =>      sub { $_[0]->bmul($_[1]); },
  68 '/='    =>      sub { scalar $_[0]->bdiv($_[1]); },
  69 '**='   =>      sub { $_[0]->bpow($_[1]); },
  70
  71 '<=>'   =>      sub { $_[2] ?
  72                       $class->bcmp($_[1],$_[0]) :
  73                       $class->bcmp($_[0],$_[1])},
  74 'cmp'   =>      sub {
  75          $_[2] ?
  76                $_[1] cmp $_[0]->bstr() :
  77                $_[0]->bstr() cmp $_[1] },
  78
  79 'int'   =>      sub { $_[0]->copy(); },
  80 'neg'   =>      sub { $_[0]->copy()->bneg(); },
  81 'abs'   =>      sub { $_[0]->copy()->babs(); },
  82 '~'     =>      sub { $_[0]->copy()->bnot(); },
  83
  84 '*'     =>      sub { my @a = ref($_[0])->_swap(@_); $a[0]->bmul($a[1]); },
  85 '/'     =>      sub { my @a = ref($_[0])->_swap(@_);scalar $a[0]->bdiv($a[1]);},
  86 '%'     =>      sub { my @a = ref($_[0])->_swap(@_); $a[0]->bmod($a[1]); },
  87 '**'    =>      sub { my @a = ref($_[0])->_swap(@_); $a[0]->bpow($a[1]); },
  88 '<<'    =>      sub { my @a = ref($_[0])->_swap(@_); $a[0]->blsft($a[1]); },
  89 '>>'    =>      sub { my @a = ref($_[0])->_swap(@_); $a[0]->brsft($a[1]); },
  90
  91 '&'     =>      sub { my @a = ref($_[0])->_swap(@_); $a[0]->band($a[1]); },
  92 '|'     =>      sub { my @a = ref($_[0])->_swap(@_); $a[0]->bior($a[1]); },
  93 '^'     =>      sub { my @a = ref($_[0])->_swap(@_); $a[0]->bxor($a[1]); },
  94
  95 # can modify arg of ++ and --, so avoid a new-copy for speed, but don't
  96 # use $_[0]->__one(), it modifies $_[0] to be 1!
  97 '++'    =>      sub { $_[0]->binc() },
  98 '--'    =>      sub { $_[0]->bdec() },
  99
 100 # if overloaded, O(1) instead of O(N) and twice as fast for small numbers
 101 'bool'  =>      sub {
 102   # this kludge is needed for perl prior 5.6.0 since returning 0 here fails :-/
 103   # v5.6.1 dumps on that: return !$_[0]->is_zero() || undef;                :-(
 104   my $t = !$_[0]->is_zero();
 105   undef $t if $t == 0;
 106   return $t;
 107   },
 108
 109 qw(
 110 ""      bstr
 111 0+      numify),                # Order of arguments unsignificant
 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 sub _core_lib () { return $CALC; }      # for test suite
 124
 125 # Rounding modes, one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'
 126 $rnd_mode = 'even';
 127 $accuracy = undef;
 128 $precision = undef;
 129 $div_scale = 40;
 130
 131 sub round_mode
 132   {
 133   # make Class->round_mode() work
 134   my $self = shift || $class;
 135   # shift @_ if defined $_[0] && $_[0] eq $class;
 136   if (defined $_[0])
 137     {
 138     my $m = shift;
 139     die "Unknown round mode $m"
 140      if $m !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
 141     $rnd_mode = $m; return;
 142     }
 143   return $rnd_mode;
 144   }
 145
 146 sub accuracy
 147   {
 148   # $x->accuracy($a);           ref($x) a
 149   # $x->accuracy();             ref($x);
 150   # Class::accuracy();          # not supported
 151   #print "MBI @_ ($class)\n";
 152   my $x = shift;
 153
 154   die ("accuracy() needs reference to object as first parameter.")
 155    if !ref $x;
 156
 157   if (@_ > 0)
 158     {
 159     $x->{_a} = shift;
 160     $x->round() if defined $x->{_a};
 161     }
 162   return $x->{_a};
 163   }
 164
 165 sub precision
 166   {
 167   my $x = shift;
 168
 169   die ("precision() needs reference to object as first parameter.")
 170    if !ref $x;
 171
 172   if (@_ > 0)
 173     {
 174     $x->{_p} = shift;
 175     $x->round() if defined $x->{_p};
 176     }
 177   return $x->{_p};
 178   }
 179
 180 sub _scale_a
 181   {
 182   # select accuracy parameter based on precedence,
 183   # used by bround() and bfround(), may return undef for scale (means no op)
 184   my ($x,$s,$m,$scale,$mode) = @_;
 185   $scale = $x->{_a} if !defined $scale;
 186   $scale = $s if (!defined $scale);
 187   $mode = $m if !defined $mode;
 188   return ($scale,$mode);
 189   }
 190
 191 sub _scale_p
 192   {
 193   # select precision parameter based on precedence,
 194   # used by bround() and bfround(), may return undef for scale (means no op)
 195   my ($x,$s,$m,$scale,$mode) = @_;
 196   $scale = $x->{_p} if !defined $scale;
 197   $scale = $s if (!defined $scale);
 198   $mode = $m if !defined $mode;
 199   return ($scale,$mode);
 200   }
 201
 202 ##############################################################################
 203 # constructors
 204
 205 sub copy
 206   {
 207   my ($c,$x);
 208   if (@_ > 1)
 209     {
 210     # if two arguments, the first one is the class to "swallow" subclasses
 211     ($c,$x) = @_;
 212     }
 213   else
 214     {
 215     $x = shift;
 216     $c = ref($x);
 217     }
 218   return unless ref($x); # only for objects
 219
 220   my $self = {}; bless $self,$c;
 221   foreach my $k (keys %$x)
 222     {
 223     if ($k eq 'value')
 224       {
 225       $self->{$k} = $CALC->_copy($x->{$k});
 226       }
 227     elsif (ref($x->{$k}) eq 'SCALAR')
 228       {
 229       $self->{$k} = \${$x->{$k}};
 230       }
 231     elsif (ref($x->{$k}) eq 'ARRAY')
 232       {
 233       $self->{$k} = [ @{$x->{$k}} ];
 234       }
 235     elsif (ref($x->{$k}) eq 'HASH')
 236       {
 237       # only one level deep!
 238       foreach my $h (keys %{$x->{$k}})
 239         {
 240         $self->{$k}->{$h} = $x->{$k}->{$h};
 241         }
 242       }
 243     elsif (ref($x->{$k}))
 244       {
 245       my $c = ref($x->{$k});
 246       $self->{$k} = $c->new($x->{$k}); # no copy() due to deep rec
 247       }
 248     else
 249       {
 250       $self->{$k} = $x->{$k};
 251       }
 252     }
 253   $self;
 254   }
 255
 256 sub new
 257   {
 258   # create a new BigInt object from a string or another BigInt object.
 259   # see hash keys documented at top
 260
 261   # the argument could be an object, so avoid ||, && etc on it, this would
 262   # cause costly overloaded code to be called. The only allowed ops are
 263   # ref() and defined.
 264
 265   my $class = shift;
 266
 267   my $wanted = shift; # avoid numify call by not using || here
 268   return $class->bzero() if !defined $wanted;   # default to 0
 269   return $class->copy($wanted) if ref($wanted);
 270
 271   my $self = {}; bless $self, $class;
 272   # handle '+inf', '-inf' first
 273   if ($wanted =~ /^[+-]inf$/)
 274     {
 275     $self->{value} = $CALC->_zero();
 276     $self->{sign} = $wanted;
 277     return $self;
 278     }
 279   # split str in m mantissa, e exponent, i integer, f fraction, v value, s sign
 280   my ($mis,$miv,$mfv,$es,$ev) = _split(\$wanted);
 281   if (!ref $mis)
 282     {
 283     die "$wanted is not a number initialized to $class" if !$NaNOK;
 284     #print "NaN 1\n";
 285     $self->{value} = $CALC->_zero();
 286     $self->{sign} = $nan;
 287     return $self;
 288     }
 289   if (!ref $miv)
 290     {
 291     # _from_hex or _from_bin
 292     $self->{value} = $mis->{value};
 293     $self->{sign} = $mis->{sign};
 294     return $self;       # throw away $mis
 295     }
 296   # make integer from mantissa by adjusting exp, then convert to bigint
 297   $self->{sign} = $$mis;                        # store sign
 298   $self->{value} = $CALC->_zero();              # for all the NaN cases
 299   my $e = int("$$es$$ev");                      # exponent (avoid recursion)
 300   if ($e > 0)
 301     {
 302     my $diff = $e - CORE::length($$mfv);
 303     if ($diff < 0)                              # Not integer
 304       {
 305       #print "NOI 1\n";
 306       $self->{sign} = $nan;
 307       }
 308     else                                        # diff >= 0
 309       {
 310       # adjust fraction and add it to value
 311       # print "diff > 0 $$miv\n";
 312       $$miv = $$miv . ($$mfv . '0' x $diff);
 313       }
 314     }
 315   else
 316     {
 317     if ($$mfv ne '')                            # e <= 0
 318       {
 319       # fraction and negative/zero E => NOI
 320       #print "NOI 2 \$\$mfv '$$mfv'\n";
 321       $self->{sign} = $nan;
 322       }
 323     elsif ($e < 0)
 324       {
 325       # xE-y, and empty mfv
 326       #print "xE-y\n";
 327       $e = abs($e);
 328       if ($$miv !~ s/0{$e}$//)          # can strip so many zero's?
 329         {
 330         #print "NOI 3\n";
 331         $self->{sign} = $nan;
 332         }
 333       }
 334     }
 335   $self->{sign} = '+' if $$miv eq '0';                  # normalize -0 => +0
 336   $self->{value} = $CALC->_new($miv) if $self->{sign} =~ /^[+-]$/;
 337   #print "$wanted => $self->{sign}\n";
 338   # if any of the globals is set, use them to round and store them inside $self
 339   $self->round($accuracy,$precision,$rnd_mode)
 340    if defined $accuracy || defined $precision;
 341   return $self;
 342   }
 343
 344 sub bnan
 345   {
 346   # create a bigint 'NaN', if given a BigInt, set it to 'NaN'
 347   my $self = shift;
 348   $self = $class if !defined $self;
 349   if (!ref($self))
 350     {
 351     my $c = $self; $self = {}; bless $self, $c;
 352     }
 353   return if $self->modify('bnan');
 354   $self->{value} = $CALC->_zero();
 355   $self->{sign} = $nan;
 356   return $self;
 357   }
 358
 359 sub binf
 360   {
 361   # create a bigint '+-inf', if given a BigInt, set it to '+-inf'
 362   # the sign is either '+', or if given, used from there
 363   my $self = shift;
 364   my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-';
 365   $self = $class if !defined $self;
 366   if (!ref($self))
 367     {
 368     my $c = $self; $self = {}; bless $self, $c;
 369     }
 370   return if $self->modify('binf');
 371   $self->{value} = $CALC->_zero();
 372   $self->{sign} = $sign.'inf';
 373   return $self;
 374   }
 375
 376 sub bzero
 377   {
 378   # create a bigint '+0', if given a BigInt, set it to 0
 379   my $self = shift;
 380   $self = $class if !defined $self;
 381
 382   if (!ref($self))
 383     {
 384     my $c = $self; $self = {}; bless $self, $c;
 385     }
 386   return if $self->modify('bzero');
 387   $self->{value} = $CALC->_zero();
 388   $self->{sign} = '+';
 389   #print "result: $self\n";
 390   return $self;
 391   }
 392
 393 sub bone
 394   {
 395   # create a bigint '+1' (or -1 if given sign '-'),
 396   # if given a BigInt, set it to +1 or -1, respecively
 397   my $self = shift;
 398   my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-';
 399   $self = $class if !defined $self;
 400   #print "bone $self\n";
 401
 402   if (!ref($self))
 403     {
 404     my $c = $self; $self = {}; bless $self, $c;
 405     }
 406   return if $self->modify('bone');
 407   $self->{value} = $CALC->_one();
 408   $self->{sign} = $sign;
 409   #print "result: $self\n";
 410   return $self;
 411   }
 412
 413 ##############################################################################
 414 # string conversation
 415
 416 sub bsstr
 417   {
 418   # (ref to BFLOAT or num_str ) return num_str
 419   # Convert number from internal format to scientific string format.
 420   # internal format is always normalized (no leading zeros, "-0E0" => "+0E0")
 421   my ($self,$x) = objectify(1,@_);
 422
 423   if ($x->{sign} !~ /^[+-]$/)
 424     {
 425     return $x->{sign} unless $x->{sign} eq '+inf';      # -inf, NaN
 426     return 'inf';                                       # +inf
 427     }
 428   my ($m,$e) = $x->parts();
 429   # e can only be positive
 430   my $sign = 'e+';
 431   # MBF: my $s = $e->{sign}; $s = '' if $s eq '-'; my $sep = 'e'.$s;
 432   return $m->bstr().$sign.$e->bstr();
 433   }
 434
 435 sub bstr
 436   {
 437   # make a string from bigint object
 438   my $x = shift; $x = $class->new($x) unless ref $x;
 439   if ($x->{sign} !~ /^[+-]$/)
 440     {
 441     return $x->{sign} unless $x->{sign} eq '+inf';      # -inf, NaN
 442     return 'inf';                                       # +inf
 443     }
 444   my $es = ''; $es = $x->{sign} if $x->{sign} eq '-';
 445   return $es.${$CALC->_str($x->{value})};
 446   }
 447
 448 sub numify
 449   {
 450   # Make a number from a BigInt object
 451   my $x = shift; $x = $class->new($x) unless ref $x;
 452   return $x->{sign} if $x->{sign} !~ /^[+-]$/;
 453   my $num = $CALC->_num($x->{value});
 454   return -$num if $x->{sign} eq '-';
 455   return $num;
 456   }
 457
 458 ##############################################################################
 459 # public stuff (usually prefixed with "b")
 460
 461 sub sign
 462   {
 463   # return the sign of the number: +/-/NaN
 464   my ($self,$x) = objectify(1,@_);
 465   return $x->{sign};
 466   }
 467
 468 sub round
 469   {
 470   # After any operation or when calling round(), the result is rounded by
 471   # regarding the A & P from arguments, local parameters, or globals.
 472   # The result's A or P are set by the rounding, but not inspected beforehand
 473   # (aka only the arguments enter into it). This works because the given
 474   # 'first' argument is both the result and true first argument with unchanged
 475   # A and P settings.
 476   # This does not yet handle $x with A, and $y with P (which should be an
 477   # error).
 478   my $self = shift;
 479   my $a    = shift;     # accuracy, if given by caller
 480   my $p    = shift;     # precision, if given by caller
 481   my $r    = shift;     # round_mode, if given by caller
 482   my @args = @_;        # all 'other' arguments (0 for unary, 1 for binary ops)
 483
 484   $self = new($self) unless ref($self);         # if not object, make one
 485   my $c = ref($args[0]);                        # find out class of argument
 486   unshift @args,$self;                          # add 'first' argument
 487
 488   # leave bigfloat parts alone
 489   return $self if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0;
 490
 491   no strict 'refs';
 492   my $z = "$c\::accuracy"; my $aa = $$z; my $ap = undef;
 493   if (!defined $aa)
 494     {
 495     $z = "$c\::precision"; $ap = $$z;
 496     }
 497
 498   # now pick $a or $p, but only if we have got "arguments"
 499   if ((!defined $a) && (!defined $p) && (@args > 0))
 500     {
 501     foreach (@args)
 502       {
 503       # take the defined one, or if both defined, the one that is smaller
 504       $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
 505       }
 506     if (!defined $a)            # if it still is not defined, take p
 507       {
 508       foreach (@args)
 509         {
 510         # take the defined one, or if both defined, the one that is smaller
 511         $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} < $p);
 512         }
 513       # if none defined, use globals (#2)
 514       if (!defined $p)
 515         {
 516         $a = $aa; $p = $ap; # save the check: if !defined $a;
 517         }
 518       } # endif !$a
 519     } # endif !$a || !$P && args > 0
 520   # for clearity, this is not merged at place (#2)
 521   # now round, by calling fround or ffround:
 522   if (defined $a)
 523     {
 524     $self->{_a} = $a; $self->bround($a,$r);
 525     }
 526   elsif (defined $p)
 527     {
 528     $self->{_p} = $p; $self->bfround($p,$r);
 529     }
 530   return $self->bnorm();
 531   }
 532
 533 sub bnorm
 534   {
 535   # (num_str or BINT) return BINT
 536   # Normalize number -- no-op here
 537   return $_[0];
 538   }
 539
 540 sub babs
 541   {
 542   # (BINT or num_str) return BINT
 543   # make number absolute, or return absolute BINT from string
 544   my $x = shift; $x = $class->new($x) unless ref $x;
 545   return $x if $x->modify('babs');
 546   # post-normalized abs for internal use (does nothing for NaN)
 547   $x->{sign} =~ s/^-/+/;
 548   $x;
 549   }
 550
 551 sub bneg
 552   {
 553   # (BINT or num_str) return BINT
 554   # negate number or make a negated number from string
 555   my $x = shift; $x = $class->new($x) unless ref $x;
 556   return $x if $x->modify('bneg');
 557   # for +0 dont negate (to have always normalized)
 558   return $x if $x->is_zero();
 559   $x->{sign} =~ tr/+\-/-+/; # does nothing for NaN
 560   $x;
 561   }
 562
 563 sub bcmp
 564   {
 565   # Compares 2 values.  Returns one of undef, <0, =0, >0. (suitable for sort)
 566   # (BINT or num_str, BINT or num_str) return cond_code
 567   my ($self,$x,$y) = objectify(2,@_);
 568
 569   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
 570     {
 571     # handle +-inf and NaN
 572     return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
 573     return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
 574     return +1 if $x->{sign} eq '+inf';
 575     return -1 if $x->{sign} eq '-inf';
 576     return -1 if $y->{sign} eq '+inf';
 577     return +1 if $y->{sign} eq '-inf';
 578     }
 579   # check sign for speed first
 580   return 1 if $x->{sign} eq '+' && $y->{sign} eq '-';   # does also 0 <=> -y
 581   return -1 if $x->{sign} eq '-' && $y->{sign} eq '+';  # does also -x <=> 0
 582
 583   # shortcut
 584   my $xz = $x->is_zero();
 585   my $yz = $y->is_zero();
 586   return 0 if $xz && $yz;                               # 0 <=> 0
 587   return -1 if $xz && $y->{sign} eq '+';                # 0 <=> +y
 588   return 1 if $yz && $x->{sign} eq '+';                 # +x <=> 0
 589   # normal compare now
 590   &cmp($x->{value},$y->{value},$x->{sign},$y->{sign}) <=> 0;
 591   }
 592
 593 sub bacmp
 594   {
 595   # Compares 2 values, ignoring their signs.
 596   # Returns one of undef, <0, =0, >0. (suitable for sort)
 597   # (BINT, BINT) return cond_code
 598   my ($self,$x,$y) = objectify(2,@_);
 599
 600   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
 601     {
 602     # handle +-inf and NaN
 603     return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
 604     return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
 605     return +1;  # inf is always bigger
 606     }
 607   $CALC->_acmp($x->{value},$y->{value}) <=> 0;
 608   }
 609
 610 sub badd
 611   {
 612   # add second arg (BINT or string) to first (BINT) (modifies first)
 613   # return result as BINT
 614   my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
 615
 616   return $x if $x->modify('badd');
 617
 618   # inf and NaN handling
 619   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
 620     {
 621     # NaN first
 622     return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
 623     # inf handline
 624    if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
 625       {
 626       # + and + => +, - and - => -, + and - => 0, - and + => 0
 627       return $x->bzero() if $x->{sign} ne $y->{sign};
 628       return $x;
 629       }
 630     # +-inf + something => +inf
 631     # something +-inf => +-inf
 632     $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/;
 633     return $x;
 634     }
 635
 636   my @bn = ($a,$p,$r,$y);                       # make array for round calls
 637   # speed: no add for 0+y or x+0
 638   return $x->round(@bn) if $y->is_zero();                       # x+0
 639   if ($x->is_zero())                                            # 0+y
 640     {
 641     # make copy, clobbering up x
 642     $x->{value} = $CALC->_copy($y->{value});
 643     $x->{sign} = $y->{sign} || $nan;
 644     return $x->round(@bn);
 645     }
 646
 647   my ($sx, $sy) = ( $x->{sign}, $y->{sign} ); # get signs
 648
 649   if ($sx eq $sy)
 650     {
 651     $x->{value} = $CALC->_add($x->{value},$y->{value}); # same sign, abs add
 652     $x->{sign} = $sx;
 653     }
 654   else
 655     {
 656     my $a = $CALC->_acmp ($y->{value},$x->{value});     # absolute compare
 657     if ($a > 0)
 658       {
 659       #print "swapped sub (a=$a)\n";
 660       $x->{value} = $CALC->_sub($y->{value},$x->{value},1); # abs sub w/ swap
 661       $x->{sign} = $sy;
 662       }
 663     elsif ($a == 0)
 664       {
 665       # speedup, if equal, set result to 0
 666       #print "equal sub, result = 0\n";
 667       $x->{value} = $CALC->_zero();
 668       $x->{sign} = '+';
 669       }
 670     else # a < 0
 671       {
 672       #print "unswapped sub (a=$a)\n";
 673       $x->{value} = $CALC->_sub($x->{value}, $y->{value}); # abs sub
 674       $x->{sign} = $sx;
 675       }
 676     }
 677   return $x->round(@bn);
 678   }
 679
 680 sub bsub
 681   {
 682   # (BINT or num_str, BINT or num_str) return num_str
 683   # subtract second arg from first, modify first
 684   my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
 685
 686   return $x if $x->modify('bsub');
 687   $x->badd($y->bneg()); # badd does not leave internal zeros
 688   $y->bneg();           # refix y, assumes no one reads $y in between
 689   return $x->round($a,$p,$r,$y);
 690   }
 691
 692 sub binc
 693   {
 694   # increment arg by one
 695   my ($self,$x,$a,$p,$r) = objectify(1,@_);
 696   # my $x = shift; $x = $class->new($x) unless ref $x; my $self = ref($x);
 697   return $x if $x->modify('binc');
 698   $x->badd($self->__one())->round($a,$p,$r);
 699   }
 700
 701 sub bdec
 702   {
 703   # decrement arg by one
 704   my ($self,$x,$a,$p,$r) = objectify(1,@_);
 705   return $x if $x->modify('bdec');
 706   $x->badd($self->__one('-'))->round($a,$p,$r);
 707   }
 708
 709 sub blcm
 710   {
 711   # (BINT or num_str, BINT or num_str) return BINT
 712   # does not modify arguments, but returns new object
 713   # Lowest Common Multiplicator
 714
 715   my $y = shift; my ($x);
 716   if (ref($y))
 717     {
 718     $x = $y->copy();
 719     }
 720   else
 721     {
 722     $x = $class->new($y);
 723     }
 724   while (@_) { $x = _lcm($x,shift); }
 725   $x;
 726   }
 727
 728 sub bgcd
 729   {
 730   # (BINT or num_str, BINT or num_str) return BINT
 731   # does not modify arguments, but returns new object
 732   # GCD -- Euclids algorithm, variant C (Knuth Vol 3, pg 341 ff)
 733
 734   my $y = shift; my ($x);
 735   if (ref($y))
 736     {
 737     $x = $y->copy();
 738     }
 739   else
 740     {
 741     $x = $class->new($y);
 742     }
 743
 744   if ($CALC->can('_gcd'))
 745     {
 746     while (@_)
 747       {
 748       $y = shift; $y = $class->new($y) if !ref($y);
 749       next if $y->is_zero();
 750       return $x->bnan() if $y->{sign} !~ /^[+-]$/;      # y NaN?
 751       $x->{value} = $CALC->_gcd($x->{value},$y->{value}); last if $x->is_one();
 752       }
 753     }
 754   else
 755     {
 756     while (@_)
 757       {
 758       $x = __gcd($x,shift); last if $x->is_one();       # _gcd handles NaN
 759       }
 760     }
 761   $x->babs();
 762   }
 763
 764 sub bmod
 765   {
 766   # modulus
 767   # (BINT or num_str, BINT or num_str) return BINT
 768   my ($self,$x,$y) = objectify(2,@_);
 769
 770   return $x if $x->modify('bmod');
 771   (&bdiv($self,$x,$y))[1];
 772   }
 773
 774 sub bnot
 775   {
 776   # (num_str or BINT) return BINT
 777   # represent ~x as twos-complement number
 778   my ($self,$x) = objectify(1,@_);
 779   return $x if $x->modify('bnot');
 780   $x->bneg(); $x->bdec(); # was: bsub(-1,$x);, time it someday
 781   $x;
 782   }
 783
 784 sub is_zero
 785   {
 786   # return true if arg (BINT or num_str) is zero (array '+', '0')
 787   #my ($self,$x) = objectify(1,@_);
 788   my $x = shift; $x = $class->new($x) unless ref $x;
 789
 790   return 0 if $x->{sign} !~ /^\+$/;                     # -, NaN & +-inf aren't
 791   $CALC->_is_zero($x->{value});
 792   #return $CALC->_is_zero($x->{value});
 793   }
 794
 795 sub is_nan
 796   {
 797   # return true if arg (BINT or num_str) is NaN
 798   #my ($self,$x) = objectify(1,@_);
 799   my $x = shift; $x = $class->new($x) unless ref $x;
 800   return ($x->{sign} eq $nan);
 801   }
 802
 803 sub is_inf
 804   {
 805   # return true if arg (BINT or num_str) is +-inf
 806   #my ($self,$x) = objectify(1,@_);
 807   my $x = shift; $x = $class->new($x) unless ref $x;
 808   my $sign = shift || '';
 809
 810   return $x->{sign} =~ /^[+-]inf$/ if $sign eq '';
 811   return $x->{sign} =~ /^[$sign]inf$/;
 812   }
 813
 814 sub is_one
 815   {
 816   # return true if arg (BINT or num_str) is +1
 817   # or -1 if sign is given
 818   #my ($self,$x) = objectify(1,@_);
 819   my $x = shift; $x = $class->new($x) unless ref $x;
 820   my $sign = shift || ''; $sign = '+' if $sign ne '-';
 821
 822   return 0 if $x->{sign} ne $sign;
 823   return $CALC->_is_one($x->{value});
 824   }
 825
 826 sub is_odd
 827   {
 828   # return true when arg (BINT or num_str) is odd, false for even
 829   my $x = shift; $x = $class->new($x) unless ref $x;
 830   #my ($self,$x) = objectify(1,@_);
 831
 832   return 0 if $x->{sign} !~ /^[+-]$/;                   # NaN & +-inf aren't
 833   return $CALC->_is_odd($x->{value});
 834   }
 835
 836 sub is_even
 837   {
 838   # return true when arg (BINT or num_str) is even, false for odd
 839   my $x = shift; $x = $class->new($x) unless ref $x;
 840   #my ($self,$x) = objectify(1,@_);
 841
 842   return 0 if $x->{sign} !~ /^[+-]$/;                   # NaN & +-inf aren't
 843   return $CALC->_is_even($x->{value});
 844   }
 845
 846 sub is_positive
 847   {
 848   # return true when arg (BINT or num_str) is positive (>= 0)
 849   my $x = shift; $x = $class->new($x) unless ref $x;
 850   return ($x->{sign} =~ /^\+/);
 851   }
 852
 853 sub is_negative
 854   {
 855   # return true when arg (BINT or num_str) is negative (< 0)
 856   my $x = shift; $x = $class->new($x) unless ref $x;
 857   return ($x->{sign} =~ /^-/);
 858   }
 859
 860 ###############################################################################
 861
 862 sub bmul
 863   {
 864   # multiply two numbers -- stolen from Knuth Vol 2 pg 233
 865   # (BINT or num_str, BINT or num_str) return BINT
 866   my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
 867
 868   return $x if $x->modify('bmul');
 869   return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
 870   # handle result = 0
 871   return $x if $x->is_zero();
 872   return $x->bzero() if $y->is_zero();
 873   # inf handling
 874   if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
 875     {
 876     # result will always be +-inf:
 877     # +inf * +/+inf => +inf, -inf * -/-inf => +inf
 878     # +inf * -/-inf => -inf, -inf * +/+inf => -inf
 879     return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
 880     return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
 881     return $x->binf('-');
 882     }
 883
 884   $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => +
 885   $x->{value} = $CALC->_mul($x->{value},$y->{value});  # do actual math
 886   return $x->round($a,$p,$r,$y);
 887   }
 888
 889 sub bdiv
 890   {
 891   # (dividend: BINT or num_str, divisor: BINT or num_str) return
 892   # (BINT,BINT) (quo,rem) or BINT (only rem)
 893   my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
 894
 895   return $x if $x->modify('bdiv');
 896
 897   # x / +-inf => 0, reminder x
 898   return wantarray ? ($x->bzero(),$x->copy()) : $x->bzero()
 899    if $y->{sign} =~ /^[+-]inf$/;
 900
 901   # NaN if x == NaN or y == NaN or x==y==0
 902   return wantarray ? ($x->bnan(),bnan()) : $x->bnan()
 903    if (($x->is_nan() || $y->is_nan()) ||
 904       ($x->is_zero() && $y->is_zero()));
 905
 906   # 5 / 0 => +inf, -6 / 0 => -inf
 907   return wantarray
 908    ? ($x->binf($x->{sign}),$self->bnan()) : $x->binf($x->{sign})
 909    if ($x->{sign} =~ /^[+-]$/ && $y->is_zero());
 910
 911   # old code: always NaN if /0
 912   #return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan()
 913   # if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/ || $y->is_zero());
 914
 915   # 0 / something
 916   return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
 917
 918   # Is $x in the interval [0, $y) ?
 919   my $cmp = $CALC->_acmp($x->{value},$y->{value});
 920   if (($cmp < 0) and ($x->{sign} eq $y->{sign}))
 921     {
 922     return $x->bzero() unless wantarray;
 923     my $t = $x->copy();      # make copy first, because $x->bzero() clobbers $x
 924     return ($x->bzero(),$t);
 925     }
 926   elsif ($cmp == 0)
 927     {
 928     # shortcut, both are the same, so set to +/- 1
 929     $x->__one( ($x->{sign} ne $y->{sign} ? '-' : '+') );
 930     return $x unless wantarray;
 931     return ($x,$self->bzero());
 932     }
 933
 934   # calc new sign and in case $y == +/- 1, return $x
 935   $x->{sign} = ($x->{sign} ne $y->{sign} ? '-' : '+');
 936   # check for / +-1 (cant use $y->is_one due to '-'
 937   if (($y == 1) || ($y == -1))  # slow!
 938   #if ((@{$y->{value}} == 1) && ($y->{value}->[0] == 1))
 939     {
 940     return wantarray ? ($x,$self->bzero()) : $x;
 941     }
 942
 943   # call div here
 944   my $rem = $self->bzero();
 945   $rem->{sign} = $y->{sign};
 946   #($x->{value},$rem->{value}) = div($x->{value},$y->{value});
 947   ($x->{value},$rem->{value}) = $CALC->_div($x->{value},$y->{value});
 948   # do not leave rest "-0";
 949   # $rem->{sign} = '+' if (@{$rem->{value}} == 1) && ($rem->{value}->[0] == 0);
 950   $rem->{sign} = '+' if $CALC->_is_zero($rem->{value});
 951   if (($x->{sign} eq '-') and (!$rem->is_zero()))
 952     {
 953     $x->bdec();
 954     }
 955   $x->round($a,$p,$r,$y);
 956   if (wantarray)
 957     {
 958     $rem->round($a,$p,$r,$x,$y);
 959     return ($x,$y-$rem) if $x->{sign} eq '-';   # was $x,$rem
 960     return ($x,$rem);
 961     }
 962   return $x;
 963   }
 964
 965 sub bpow
 966   {
 967   # (BINT or num_str, BINT or num_str) return BINT
 968   # compute power of two numbers -- stolen from Knuth Vol 2 pg 233
 969   # modifies first argument
 970   my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
 971
 972   return $x if $x->modify('bpow');
 973
 974   return $x if $x->{sign} =~ /^[+-]inf$/;       # -inf/+inf ** x
 975   return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
 976   return $x->__one() if $y->is_zero();
 977   return $x         if $x->is_one() || $y->is_one();
 978   #if ($x->{sign} eq '-' && @{$x->{value}} == 1 && $x->{value}->[0] == 1)
 979   if ($x->{sign} eq '-' && $CALC->_is_one($x->{value}))
 980     {
 981     # if $x == -1 and odd/even y => +1/-1
 982     return $y->is_odd() ? $x : $x->babs();
 983     # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1;
 984     }
 985   # 1 ** -y => 1 / (1 ** |y|)
 986   # so do test for negative $y after above's clause
 987   return $x->bnan() if $y->{sign} eq '-';
 988   return $x         if $x->is_zero();  # 0**y => 0 (if not y <= 0)
 989
 990   if ($CALC->can('_pow'))
 991     {
 992     $x->{value} = $CALC->_pow($x->{value},$y->{value});
 993     return $x->round($a,$p,$r);
 994     }
 995   # based on the assumption that shifting in base 10 is fast, and that mul
 996   # works faster if numbers are small: we count trailing zeros (this step is
 997   # O(1)..O(N), but in case of O(N) we save much more time due to this),
 998   # stripping them out of the multiplication, and add $count * $y zeros
 999   # afterwards like this:
1000   # 300 ** 3 == 300*300*300 == 3*3*3 . '0' x 2 * 3 == 27 . '0' x 6
1001   # creates deep recursion?
1002 #  my $zeros = $x->_trailing_zeros();
1003 #  if ($zeros > 0)
1004 #    {
1005 #    $x->brsft($zeros,10);      # remove zeros
1006 #    $x->bpow($y);              # recursion (will not branch into here again)
1007 #    $zeros = $y * $zeros;      # real number of zeros to add
1008 #    $x->blsft($zeros,10);
1009 #    return $x->round($a,$p,$r);
1010 #    }
1011
1012   my $pow2 = $self->__one();
1013   my $y1 = $class->new($y);
1014   my ($res);
1015   while (!$y1->is_one())
1016     {
1017     #print "bpow: p2: $pow2 x: $x y: $y1 r: $res\n";
1018     #print "len ",$x->length(),"\n";
1019     ($y1,$res)=&bdiv($y1,2);
1020     if (!$res->is_zero()) { &bmul($pow2,$x); }
1021     if (!$y1->is_zero())  { &bmul($x,$x); }
1022     #print "$x $y\n";
1023     }
1024   #print "bpow: e p2: $pow2 x: $x y: $y1 r: $res\n";
1025   &bmul($x,$pow2) if (!$pow2->is_one());
1026   #print "bpow: e p2: $pow2 x: $x y: $y1 r: $res\n";
1027   return $x->round($a,$p,$r);
1028   }
1029
1030 sub blsft
1031   {
1032   # (BINT or num_str, BINT or num_str) return BINT
1033   # compute x << y, base n, y >= 0
1034   my ($self,$x,$y,$n) = objectify(2,@_);
1035
1036   return $x if $x->modify('blsft');
1037   return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
1038
1039   $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
1040
1041   my $t = $CALC->_lsft($x->{value},$y->{value},$n) if $CALC->can('_lsft');
1042   if (defined $t)
1043     {
1044     $x->{value} = $t; return $x;
1045     }
1046   # fallback
1047   return $x->bmul( $self->bpow($n, $y) );
1048   }
1049
1050 sub brsft
1051   {
1052   # (BINT or num_str, BINT or num_str) return BINT
1053   # compute x >> y, base n, y >= 0
1054   my ($self,$x,$y,$n) = objectify(2,@_);
1055
1056   return $x if $x->modify('brsft');
1057   return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
1058
1059   $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
1060
1061   my $t = $CALC->_rsft($x->{value},$y->{value},$n) if $CALC->can('_rsft');
1062   if (defined $t)
1063     {
1064     $x->{value} = $t; return $x;
1065     }
1066   # fallback
1067   return scalar bdiv($x, $self->bpow($n, $y));
1068   }
1069
1070 sub band
1071   {
1072   #(BINT or num_str, BINT or num_str) return BINT
1073   # compute x & y
1074   my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
1075
1076   return $x if $x->modify('band');
1077
1078   return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
1079   return $x->bzero() if $y->is_zero();
1080
1081   my $sign = 0;                                 # sign of result
1082   $sign = 1 if ($x->{sign} eq '-') && ($y->{sign} eq '-');
1083   my $sx = 1; $sx = -1 if $x->{sign} eq '-';
1084   my $sy = 1; $sy = -1 if $y->{sign} eq '-';
1085
1086   if ($CALC->can('_and') && $sx == 1 && $sy == 1)
1087     {
1088     $x->{value} = $CALC->_and($x->{value},$y->{value});
1089     return $x->round($a,$p,$r);
1090     }
1091
1092   my $m = new Math::BigInt 1; my ($xr,$yr);
1093   my $x10000 = new Math::BigInt (0x1000);
1094   my $y1 = copy(ref($x),$y);                    # make copy
1095   $y1->babs();                                  # and positive
1096   my $x1 = $x->copy()->babs(); $x->bzero();     # modify x in place!
1097   use integer;                                  # need this for negative bools
1098   while (!$x1->is_zero() && !$y1->is_zero())
1099     {
1100     ($x1, $xr) = bdiv($x1, $x10000);
1101     ($y1, $yr) = bdiv($y1, $x10000);
1102     # make both op's numbers!
1103     $x->badd( bmul( $class->new(
1104        abs($sx*int($xr->numify()) & $sy*int($yr->numify()))),
1105       $m));
1106     $m->bmul($x10000);
1107     }
1108   $x->bneg() if $sign;
1109   return $x->round($a,$p,$r);
1110   }
1111
1112 sub bior
1113   {
1114   #(BINT or num_str, BINT or num_str) return BINT
1115   # compute x | y
1116   my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
1117
1118   return $x if $x->modify('bior');
1119
1120   return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
1121   return $x if $y->is_zero();
1122
1123   my $sign = 0;                                 # sign of result
1124   $sign = 1 if ($x->{sign} eq '-') || ($y->{sign} eq '-');
1125   my $sx = 1; $sx = -1 if $x->{sign} eq '-';
1126   my $sy = 1; $sy = -1 if $y->{sign} eq '-';
1127
1128   # don't use lib for negative values
1129   if ($CALC->can('_or') && $sx == 1 && $sy == 1)
1130     {
1131     $x->{value} = $CALC->_or($x->{value},$y->{value});
1132     return $x->round($a,$p,$r);
1133     }
1134
1135   my $m = new Math::BigInt 1; my ($xr,$yr);
1136   my $x10000 = new Math::BigInt (0x10000);
1137   my $y1 = copy(ref($x),$y);                    # make copy
1138   $y1->babs();                                  # and positive
1139   my $x1 = $x->copy()->babs(); $x->bzero();     # modify x in place!
1140   use integer;                                  # need this for negative bools
1141   while (!$x1->is_zero() || !$y1->is_zero())
1142     {
1143     ($x1, $xr) = bdiv($x1,$x10000);
1144     ($y1, $yr) = bdiv($y1,$x10000);
1145     # make both op's numbers!
1146     $x->badd( bmul( $class->new(
1147        abs($sx*int($xr->numify()) | $sy*int($yr->numify()))),
1148       $m));
1149 #    $x->badd( bmul( $class->new(int($xr->numify()) | int($yr->numify())), $m));
1150     $m->bmul($x10000);
1151     }
1152   $x->bneg() if $sign;
1153   return $x->round($a,$p,$r);
1154   }
1155
1156 sub bxor
1157   {
1158   #(BINT or num_str, BINT or num_str) return BINT
1159   # compute x ^ y
1160   my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
1161
1162   return $x if $x->modify('bxor');
1163
1164   return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
1165   return $x if $y->is_zero();
1166   return $x->bzero() if $x == $y; # shortcut
1167
1168   my $sign = 0;                                 # sign of result
1169   $sign = 1 if $x->{sign} ne $y->{sign};
1170   my $sx = 1; $sx = -1 if $x->{sign} eq '-';
1171   my $sy = 1; $sy = -1 if $y->{sign} eq '-';
1172
1173   # don't use lib for negative values
1174   if ($CALC->can('_xor') && $sx == 1 && $sy == 1)
1175     {
1176     $x->{value} = $CALC->_xor($x->{value},$y->{value});
1177     return $x->round($a,$p,$r);
1178     }
1179
1180   my $m = new Math::BigInt 1; my ($xr,$yr);
1181   my $x10000 = new Math::BigInt (0x10000);
1182   my $y1 = copy(ref($x),$y);                    # make copy
1183   $y1->babs();                                  # and positive
1184   my $x1 = $x->copy()->babs(); $x->bzero();     # modify x in place!
1185   use integer;                                  # need this for negative bools
1186   while (!$x1->is_zero() || !$y1->is_zero())
1187     {
1188     ($x1, $xr) = bdiv($x1, $x10000);
1189     ($y1, $yr) = bdiv($y1, $x10000);
1190     # make both op's numbers!
1191     $x->badd( bmul( $class->new(
1192        abs($sx*int($xr->numify()) ^ $sy*int($yr->numify()))),
1193       $m));
1194 #    $x->badd( bmul( $class->new(int($xr->numify()) ^ int($yr->numify())), $m));
1195     $m->bmul($x10000);
1196     }
1197   $x->bneg() if $sign;
1198   return $x->round($a,$p,$r);
1199   }
1200
1201 sub length
1202   {
1203   my ($self,$x) = objectify(1,@_);
1204
1205   my $e = $CALC->_len($x->{value});
1206   #  # fallback, since we do not know the underlying representation
1207   #my $es = "$x"; my $c = 0; $c = 1 if $es =~ /^[+-]/;  # if lib returns '+123'
1208   #my $e = CORE::length($es)-$c;
1209   return wantarray ? ($e,0) : $e;
1210   }
1211
1212 sub digit
1213   {
1214   # return the nth decimal digit, negative values count backward, 0 is right
1215   my $x = shift;
1216   my $n = shift || 0;
1217
1218   return $CALC->_digit($x->{value},$n);
1219   }
1220
1221 sub _trailing_zeros
1222   {
1223   # return the amount of trailing zeros in $x
1224   my $x = shift;
1225   $x = $class->new($x) unless ref $x;
1226
1227   return 0 if $x->is_zero() || $x->{sign} !~ /^[+-]$/;
1228
1229   return $CALC->_zeros($x->{value}) if $CALC->can('_zeros');
1230
1231   # if not: since we do not know underlying internal representation:
1232   my $es = "$x"; $es =~ /([0]*)$/;
1233
1234   return 0 if !defined $1;      # no zeros
1235   return CORE::length("$1");    # as string, not as +0!
1236   }
1237
1238 sub bsqrt
1239   {
1240   my ($self,$x) = objectify(1,@_);
1241
1242   return $x->bnan() if $x->{sign} =~ /\-|$nan/; # -x or NaN => NaN
1243   return $x->bzero() if $x->is_zero();          # 0 => 0
1244   return $x if $x == 1;                         # 1 => 1
1245
1246   my $y = $x->copy();                           # give us one more digit accur.
1247   my $l = int($x->length()/2);
1248
1249   $x->bzero();
1250   $x->binc();           # keep ref($x), but modify it
1251   $x *= 10 ** $l;
1252
1253   # print "x: $y guess $x\n";
1254
1255   my $last = $self->bzero();
1256   while ($last != $x)
1257     {
1258     $last = $x;
1259     $x += $y / $x;
1260     $x /= 2;
1261     }
1262   return $x;
1263   }
1264
1265 sub exponent
1266   {
1267   # return a copy of the exponent (here always 0, NaN or 1 for $m == 0)
1268   my ($self,$x) = objectify(1,@_);
1269
1270   return bnan() if $x->is_nan();
1271   my $e = $class->bzero();
1272   return $e->binc() if $x->is_zero();
1273   $e += $x->_trailing_zeros();
1274   return $e;
1275   }
1276
1277 sub mantissa
1278   {
1279   # return a copy of the mantissa (here always $self)
1280   my ($self,$x) = objectify(1,@_);
1281
1282   return bnan() if $x->is_nan();
1283   my $m = $x->copy();
1284   # that's inefficient
1285   my $zeros = $m->_trailing_zeros();
1286   $m /= 10 ** $zeros if $zeros != 0;
1287   return $m;
1288   }
1289
1290 sub parts
1291   {
1292   # return a copy of both the exponent and the mantissa (here 0 and self)
1293   my $self = shift;
1294   $self = $class->new($self) unless ref $self;
1295
1296   return ($self->mantissa(),$self->exponent());
1297   }
1298
1299 ##############################################################################
1300 # rounding functions
1301
1302 sub bfround
1303   {
1304   # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
1305   # $n == 0 => round to integer
1306   my $x = shift; $x = $class->new($x) unless ref $x;
1307   my ($scale,$mode) = $x->_scale_p($precision,$rnd_mode,@_);
1308   return $x if !defined $scale;         # no-op
1309
1310   # no-op for BigInts if $n <= 0
1311   return $x if $scale <= 0;
1312
1313   $x->bround( $x->length()-$scale, $mode);
1314   }
1315
1316 sub _scan_for_nonzero
1317   {
1318   my $x = shift;
1319   my $pad = shift;
1320   my $xs = shift;
1321
1322   my $len = $x->length();
1323   return 0 if $len == 1;                # '5' is trailed by invisible zeros
1324   my $follow = $pad - 1;
1325   return 0 if $follow > $len || $follow < 1;
1326   #print "checking $x $r\n";
1327
1328   # since we do not know underlying represention of $x, use decimal string
1329   #my $r = substr ($$xs,-$follow);
1330   my $r = substr ("$x",-$follow);
1331   return 1 if $r =~ /[^0]/; return 0;
1332   }
1333
1334 sub fround
1335   {
1336   # to make life easier for switch between MBF and MBI (autoload fxxx()
1337   # like MBF does for bxxx()?)
1338   my $x = shift;
1339   return $x->bround(@_);
1340   }
1341
1342 sub bround
1343   {
1344   # accuracy: +$n preserve $n digits from left,
1345   #           -$n preserve $n digits from right (f.i. for 0.1234 style in MBF)
1346   # no-op for $n == 0
1347   # and overwrite the rest with 0's, return normalized number
1348   # do not return $x->bnorm(), but $x
1349   my $x = shift; $x = $class->new($x) unless ref $x;
1350   my ($scale,$mode) = $x->_scale_a($accuracy,$rnd_mode,@_);
1351   return $x if !defined $scale;         # no-op
1352
1353   # print "MBI round: $x to $scale $mode\n";
1354   # -scale means what? tom? hullo? -$scale needed by MBF round, but what for?
1355   return $x if $x->{sign} !~ /^[+-]$/ || $x->is_zero() || $scale == 0;
1356
1357   # we have fewer digits than we want to scale to
1358   my $len = $x->length();
1359   # print "$len $scale\n";
1360   return $x if $len < abs($scale);
1361
1362   # count of 0's to pad, from left (+) or right (-): 9 - +6 => 3, or |-6| => 6
1363   my ($pad,$digit_round,$digit_after);
1364   $pad = $len - $scale;
1365   $pad = abs($scale)+1 if $scale < 0;
1366   # do not use digit(), it is costly for binary => decimal
1367   #$digit_round = '0'; $digit_round = $x->digit($pad) if $pad < $len;
1368   #$digit_after = '0'; $digit_after = $x->digit($pad-1) if $pad > 0;
1369   my $xs = $CALC->_str($x->{value});
1370   my $pl = -$pad-1;
1371   # pad:   123: 0 => -1, at 1 => -2, at 2 => -3, at 3 => -4
1372   # pad+1: 123: 0 => 0,  at 1 => -1, at 2 => -2, at 3 => -3
1373   $digit_round = '0'; $digit_round = substr($$xs,$pl,1) if $pad <= $len;
1374   $pl++; $pl ++ if $pad >= $len;
1375   $digit_after = '0'; $digit_after = substr($$xs,$pl,1)
1376    if $pad > 0;
1377
1378   #my $d_round = '0'; $d_round = $x->digit($pad) if $pad < $len;
1379   #my $d_after = '0'; $d_after = $x->digit($pad-1) if $pad > 0;
1380   # print "$pad $pl $$xs $digit_round:$d_round $digit_after:$d_after\n";
1381
1382   # in case of 01234 we round down, for 6789 up, and only in case 5 we look
1383   # closer at the remaining digits of the original $x, remember decision
1384   my $round_up = 1;                                     # default round up
1385   $round_up -- if
1386     ($mode eq 'trunc')                          ||      # trunc by round down
1387     ($digit_after =~ /[01234]/)                 ||      # round down anyway,
1388                                                         # 6789 => round up
1389     ($digit_after eq '5')                       &&      # not 5000...0000
1390     ($x->_scan_for_nonzero($pad,$xs) == 0)              &&
1391     (
1392      ($mode eq 'even') && ($digit_round =~ /[24680]/) ||
1393      ($mode eq 'odd')  && ($digit_round =~ /[13579]/) ||
1394      ($mode eq '+inf') && ($x->{sign} eq '-')   ||
1395      ($mode eq '-inf') && ($x->{sign} eq '+')   ||
1396      ($mode eq 'zero')          # round down if zero, sign adjusted below
1397     );
1398   # allow rounding one place left of mantissa
1399   #print "$pad $len $scale\n";
1400   # this is triggering warnings, and buggy for $scale < 0
1401   #if (-$scale != $len)
1402     {
1403     # old code, depend on internal representation
1404     # split mantissa at $pad and then pad with zeros
1405     #my $s5 = int($pad / 5);
1406     #my $i = 0;
1407     #while ($i < $s5)
1408     #  {
1409     #  $x->{value}->[$i++] = 0;                         # replace with 5 x 0
1410     #  }
1411     #$x->{value}->[$s5] = '00000'.$x->{value}->[$s5];   # pad with 0
1412     #my $rem = $pad % 5;                                # so much left over
1413     #if ($rem > 0)
1414     #  {
1415     #  #print "remainder $rem\n";
1416     ##  #print "elem      $x->{value}->[$s5]\n";
1417     #  substr($x->{value}->[$s5],-$rem,$rem) = '0' x $rem;      # stamp w/ '0'
1418     #  }
1419     #$x->{value}->[$s5] = int ($x->{value}->[$s5]);     # str '05' => int '5'
1420     #print ${$CALC->_str($pad->{value})}," $len\n";
1421     if (($pad > 0) && ($pad <= $len))
1422       {
1423       substr($$xs,-$pad,$pad) = '0' x $pad;
1424       $x->{value} = $CALC->_new($xs);                   # put back in
1425       }
1426     elsif ($pad > $len)
1427       {
1428       $x->bzero();                                      # round to '0'
1429       }
1430     # print "res $pad $len $x $$xs\n";
1431     }
1432   # move this later on after the inc of the string
1433   #$x->{value} = $CALC->_new($xs);                      # put back in
1434   if ($round_up)                                        # what gave test above?
1435     {
1436     $pad = $len if $scale < 0;                          # tlr: whack 0.51=>1.0
1437     # modify $x in place, undef, undef to avoid rounding
1438     # str creation much faster than 10 ** something
1439     $x->badd( Math::BigInt->new($x->{sign}.'1'.'0'x$pad) );
1440     # increment string in place, to avoid dec=>hex for the '1000...000'
1441     # $xs ...blah foo
1442     }
1443   # to here:
1444   #$x->{value} = $CALC->_new($xs);                      # put back in
1445   $x;
1446   }
1447
1448 sub bfloor
1449   {
1450   # return integer less or equal then number, since it is already integer,
1451   # always returns $self
1452   my ($self,$x,$a,$p,$r) = objectify(1,@_);
1453
1454   # not needed: return $x if $x->modify('bfloor');
1455
1456   return $x->round($a,$p,$r);
1457   }
1458
1459 sub bceil
1460   {
1461   # return integer greater or equal then number, since it is already integer,
1462   # always returns $self
1463   my ($self,$x,$a,$p,$r) = objectify(1,@_);
1464
1465   # not needed: return $x if $x->modify('bceil');
1466
1467   return $x->round($a,$p,$r);
1468   }
1469
1470 ##############################################################################
1471 # private stuff (internal use only)
1472
1473 sub __one
1474   {
1475   # internal speedup, set argument to 1, or create a +/- 1
1476   my $self = shift;
1477   my $x = $self->bzero(); $x->{value} = $CALC->_one();
1478   $x->{sign} = shift || '+';
1479   return $x;
1480   }
1481
1482 sub _swap
1483   {
1484   # Overload will swap params if first one is no object ref so that the first
1485   # one is always an object ref. In this case, third param is true.
1486   # This routine is to overcome the effect of scalar,$object creating an object
1487   # of the class of this package, instead of the second param $object. This
1488   # happens inside overload, when the overload section of this package is
1489   # inherited by sub classes.
1490   # For overload cases (and this is used only there), we need to preserve the
1491   # args, hence the copy().
1492   # You can override this method in a subclass, the overload section will call
1493   # $object->_swap() to make sure it arrives at the proper subclass, with some
1494   # exceptions like '+' and '-'.
1495
1496   # object, (object|scalar) => preserve first and make copy
1497   # scalar, object          => swapped, re-swap and create new from first
1498   #                            (using class of second object, not $class!!)
1499   my $self = shift;                     # for override in subclass
1500   #print "swap $self 0:$_[0] 1:$_[1] 2:$_[2]\n";
1501   if ($_[2])
1502     {
1503     my $c = ref ($_[0]) || $class;      # fallback $class should not happen
1504     return ( $c->new($_[1]), $_[0] );
1505     }
1506   return ( $_[0]->copy(), $_[1] );
1507   }
1508
1509 sub objectify
1510   {
1511   # check for strings, if yes, return objects instead
1512
1513   # the first argument is number of args objectify() should look at it will
1514   # return $count+1 elements, the first will be a classname. This is because
1515   # overloaded '""' calls bstr($object,undef,undef) and this would result in
1516   # useless objects beeing created and thrown away. So we cannot simple loop
1517   # over @_. If the given count is 0, all arguments will be used.
1518
1519   # If the second arg is a ref, use it as class.
1520   # If not, try to use it as classname, unless undef, then use $class
1521   # (aka Math::BigInt). The latter shouldn't happen,though.
1522
1523   # caller:                        gives us:
1524   # $x->badd(1);                => ref x, scalar y
1525   # Class->badd(1,2);           => classname x (scalar), scalar x, scalar y
1526   # Class->badd( Class->(1),2); => classname x (scalar), ref x, scalar y
1527   # Math::BigInt::badd(1,2);    => scalar x, scalar y
1528   # In the last case we check number of arguments to turn it silently into
1529   # $class,1,2. (We can not take '1' as class ;o)
1530   # badd($class,1) is not supported (it should, eventually, try to add undef)
1531   # currently it tries 'Math::BigInt' + 1, which will not work.
1532
1533   my $count = abs(shift || 0);
1534
1535   #print caller(),"\n";
1536
1537   my @a;                        # resulting array
1538   if (ref $_[0])
1539     {
1540     # okay, got object as first
1541     $a[0] = ref $_[0];
1542     }
1543   else
1544     {
1545     # nope, got 1,2 (Class->xxx(1) => Class,1 and not supported)
1546     $a[0] = $class;
1547     #print "@_\n"; sleep(1);
1548     $a[0] = shift if $_[0] =~ /^[A-Z].*::/;     # classname as first?
1549     }
1550   #print caller(),"\n";
1551   # print "Now in objectify, my class is today $a[0]\n";
1552   my $k;
1553   if ($count == 0)
1554     {
1555     while (@_)
1556       {
1557       $k = shift;
1558       if (!ref($k))
1559         {
1560         $k = $a[0]->new($k);
1561         }
1562       elsif (ref($k) ne $a[0])
1563         {
1564         # foreign object, try to convert to integer
1565         $k->can('as_number') ?  $k = $k->as_number() : $k = $a[0]->new($k);
1566         }
1567       push @a,$k;
1568       }
1569     }
1570   else
1571     {
1572     while ($count > 0)
1573       {
1574       #print "$count\n";
1575       $count--;
1576       $k = shift;
1577       if (!ref($k))
1578         {
1579         $k = $a[0]->new($k);
1580         }
1581       elsif (ref($k) ne $a[0])
1582         {
1583         # foreign object, try to convert to integer
1584         $k->can('as_number') ?  $k = $k->as_number() : $k = $a[0]->new($k);
1585         }
1586       push @a,$k;
1587       }
1588     push @a,@_;         # return other params, too
1589     }
1590   #my $i = 0;
1591   #foreach (@a)
1592   #  {
1593   #  print "o $i $a[0]\n" if $i == 0;
1594   #  print "o $i ",ref($_),"\n" if $i != 0; $i++;
1595   #  }
1596   #print "objectify done: would return ",scalar @a," values\n";
1597   #print caller(1),"\n" unless wantarray;
1598   die "$class objectify needs list context" unless wantarray;
1599   @a;
1600   }
1601
1602 sub import
1603   {
1604   my $self = shift;
1605   #print "import $self @_\n";
1606   my @a = @_; my $l = scalar @_; my $j = 0;
1607   for ( my $i = 0; $i < $l ; $i++,$j++ )
1608     {
1609     if ($_[$i] eq ':constant')
1610       {
1611       # this causes overlord er load to step in
1612       overload::constant integer => sub { $self->new(shift) };
1613       splice @a, $j, 1; $j --;
1614       }
1615     elsif ($_[$i] =~ /^lib$/i)
1616       {
1617       # this causes a different low lib to take care...
1618       $CALC = $_[$i+1] || $CALC;
1619       my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..."
1620       splice @a, $j, $s; $j -= $s;
1621       }
1622     }
1623   # any non :constant stuff is handled by our parent, Exporter
1624   # even if @_ is empty, to give it a chance
1625   #$self->SUPER::import(@a);                    # does not work
1626   $self->export_to_level(1,$self,@a);           # need this instead
1627
1628   # try to load core math lib
1629   my @c = split /\s*,\s*/,$CALC;
1630   push @c,'Calc';                               # if all fail, try this
1631   foreach my $lib (@c)
1632     {
1633     $lib = 'Math::BigInt::'.$lib if $lib !~ /^Math::BigInt/i;
1634     $lib =~ s/\.pm$//;
1635     if ($] < 5.6)
1636       {
1637       # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
1638       # used in the same script, or eval inside import().
1639       (my $mod = $lib . '.pm') =~ s!::!/!g;
1640       # require does not automatically :: => /, so portability problems arise
1641       eval { require $mod; $lib->import(); }
1642       }
1643     else
1644       {
1645       eval "use $lib;";
1646       }
1647     $CALC = $lib, last if $@ eq '';
1648     }
1649   }
1650
1651 sub __from_hex
1652   {
1653   # convert a (ref to) big hex string to BigInt, return undef for error
1654   my $hs = shift;
1655
1656   my $x = Math::BigInt->bzero();
1657   return $x->bnan() if $$hs !~ /^[\-\+]?0x[0-9A-Fa-f]+$/;
1658
1659   my $sign = '+'; $sign = '-' if ($$hs =~ /^-/);
1660
1661   $$hs =~ s/^[+-]//;                    # strip sign
1662   if ($CALC->can('_from_hex'))
1663     {
1664     $x->{value} = $CALC->_from_hex($hs);
1665     }
1666   else
1667     {
1668     # fallback to pure perl
1669     my $mul = Math::BigInt->bzero(); $mul++;
1670     my $x65536 = Math::BigInt->new(65536);
1671     my $len = CORE::length($$hs)-2;
1672     $len = int($len/4);                 # 4-digit parts, w/o '0x'
1673     my $val; my $i = -4;
1674     while ($len >= 0)
1675       {
1676       $val = substr($$hs,$i,4);
1677       $val =~ s/^[+-]?0x// if $len == 0;        # for last part only because
1678       $val = hex($val);                         # hex does not like wrong chars
1679       # print "$val ",substr($$hs,$i,4),"\n";
1680       $i -= 4; $len --;
1681       $x += $mul * $val if $val != 0;
1682       $mul *= $x65536 if $len >= 0;             # skip last mul
1683       }
1684     }
1685   $x->{sign} = $sign if !$x->is_zero();         # no '-0'
1686   return $x;
1687   }
1688
1689 sub __from_bin
1690   {
1691   # convert a (ref to) big binary string to BigInt, return undef for error
1692   my $bs = shift;
1693
1694   my $x = Math::BigInt->bzero();
1695   return $x->bnan() if $$bs !~ /^[+-]?0b[01]+$/;
1696
1697   my $mul = Math::BigInt->bzero(); $mul++;
1698   my $x256 = Math::BigInt->new(256);
1699
1700   my $sign = '+'; $sign = '-' if ($$bs =~ /^\-/);
1701   $$bs =~ s/^[+-]//;                            # strip sign
1702   if ($CALC->can('_from_bin'))
1703     {
1704     $x->{value} = $CALC->_from_bin($bs);
1705     }
1706   else
1707     {
1708     my $len = CORE::length($$bs)-2;
1709     $len = int($len/8);                         # 8-digit parts, w/o '0b'
1710     my $val; my $i = -8;
1711     while ($len >= 0)
1712       {
1713       $val = substr($$bs,$i,8);
1714       $val =~ s/^[+-]?0b// if $len == 0;        # for last part only
1715       #$val = oct('0b'.$val);   # does not work on Perl prior to 5.6.0
1716       $val = ('0' x (8-CORE::length($val))).$val if CORE::length($val) < 8;
1717       $val = ord(pack('B8',$val));
1718       # print "$val ",substr($$bs,$i,16),"\n";
1719       $i -= 8; $len --;
1720       $x += $mul * $val if $val != 0;
1721       $mul *= $x256 if $len >= 0;               # skip last mul
1722       }
1723     }
1724   $x->{sign} = $sign if !$x->is_zero();
1725   return $x;
1726   }
1727
1728 sub _split
1729   {
1730   # (ref to num_str) return num_str
1731   # internal, take apart a string and return the pieces
1732   # strip leading/trailing whitespace, leading zeros, underscore, reject
1733   # invalid input
1734   my $x = shift;
1735
1736   # strip white space at front, also extranous leading zeros
1737   $$x =~ s/^\s*([-]?)0*([0-9])/$1$2/g;  # will not strip '  .2'
1738   $$x =~ s/^\s+//;                      # but this will
1739   $$x =~ s/\s+$//g;                     # strip white space at end
1740
1741   # shortcut, if nothing to split, return early
1742   if ($$x =~ /^[+-]?\d+$/)
1743     {
1744     $$x =~ s/^([+-])0*([0-9])/$2/; my $sign = $1 || '+';
1745     return (\$sign, $x, \'', \'', \0);
1746     }
1747
1748   # invalid starting char?
1749   return if $$x !~ /^[+-]?(\.?[0-9]|0b[0-1]|0x[0-9a-fA-F])/;
1750
1751   $$x =~ s/(\d)_(\d)/$1$2/g;            # strip underscores between digits
1752   $$x =~ s/(\d)_(\d)/$1$2/g;            # do twice for 1_2_3
1753
1754   return __from_hex($x) if $$x =~ /^[\-\+]?0x/; # hex string
1755   return __from_bin($x) if $$x =~ /^[\-\+]?0b/; # binary string
1756
1757   # some possible inputs:
1758   # 2.1234 # 0.12        # 1          # 1E1 # 2.134E1 # 434E-10 # 1.02009E-2
1759   # .2     # 1_2_3.4_5_6 # 1.4E1_2_3  # 1e3 # +.2
1760
1761   #print "input: '$$x' ";
1762   my ($m,$e) = split /[Ee]/,$$x;
1763   $e = '0' if !defined $e || $e eq "";
1764   # print "m '$m' e '$e'\n";
1765   # sign,value for exponent,mantint,mantfrac
1766   my ($es,$ev,$mis,$miv,$mfv);
1767   # valid exponent?
1768   if ($e =~ /^([+-]?)0*(\d+)$/) # strip leading zeros
1769     {
1770     $es = $1; $ev = $2;
1771     #print "'$m' '$e' e: $es $ev ";
1772     # valid mantissa?
1773     return if $m eq '.' || $m eq '';
1774     my ($mi,$mf) = split /\./,$m;
1775     $mi = '0' if !defined $mi;
1776     $mi .= '0' if $mi =~ /^[\-\+]?$/;
1777     $mf = '0' if !defined $mf || $mf eq '';
1778     if ($mi =~ /^([+-]?)0*(\d+)$/) # strip leading zeros
1779       {
1780       $mis = $1||'+'; $miv = $2;
1781       # print "$mis $miv";
1782       # valid, existing fraction part of mantissa?
1783       return unless ($mf =~ /^(\d*?)0*$/);      # strip trailing zeros
1784       $mfv = $1;
1785       #print " split: $mis $miv . $mfv E $es $ev\n";
1786       return (\$mis,\$miv,\$mfv,\$es,\$ev);
1787       }
1788     }
1789   return; # NaN, not a number
1790   }
1791
1792 sub as_number
1793   {
1794   # an object might be asked to return itself as bigint on certain overloaded
1795   # operations, this does exactly this, so that sub classes can simple inherit
1796   # it or override with their own integer conversion routine
1797   my $self = shift;
1798
1799   $self->copy();
1800   }
1801
1802 ##############################################################################
1803 # internal calculation routines (others are in Math::BigInt::Calc etc)
1804
1805 sub cmp
1806   {
1807   # post-normalized compare for internal use (honors signs)
1808   # input:  ref to value, ref to value, sign, sign
1809   # output: <0, 0, >0
1810   my ($cx,$cy,$sx,$sy) = @_;
1811
1812   if ($sx eq '+')
1813     {
1814     return 1 if $sy eq '-'; # 0 check handled above
1815     return $CALC->_acmp($cx,$cy);
1816     }
1817   else
1818     {
1819     # $sx eq '-'
1820     return -1 if $sy eq '+';
1821     return $CALC->_acmp($cy,$cx);
1822     }
1823   0; # equal
1824   }
1825
1826 sub _lcm
1827   {
1828   # (BINT or num_str, BINT or num_str) return BINT
1829   # does modify first argument
1830   # LCM
1831
1832   my $x = shift; my $ty = shift;
1833   return $x->bnan() if ($x->{sign} eq $nan) || ($ty->{sign} eq $nan);
1834   return $x * $ty / bgcd($x,$ty);
1835   }
1836
1837 sub __gcd
1838   {
1839   # (BINT or num_str, BINT or num_str) return BINT
1840   # does modify first arg
1841   # GCD -- Euclids algorithm E, Knuth Vol 2 pg 296
1842
1843   my $x = shift; my $ty = $class->new(shift); # preserve y, but make class
1844   return $x->bnan() if $x->{sign} !~ /^[+-]$/ || $ty->{sign} !~ /^[+-]$/;
1845
1846   while (!$ty->is_zero())
1847     {
1848     ($x, $ty) = ($ty,bmod($x,$ty));
1849     }
1850   $x;
1851   }
1852
1853 ###############################################################################
1854 # this method return 0 if the object can be modified, or 1 for not
1855 # We use a fast use constant statement here, to avoid costly calls. Subclasses
1856 # may override it with special code (f.i. Math::BigInt::Constant does so)
1857
1858 sub modify () { 0; }
1859
1860 1;
1861 __END__
1862
1863 =head1 NAME
1864
1865 Math::BigInt - Arbitrary size integer math package
1866
1867 =head1 SYNOPSIS
1868
1869   use Math::BigInt;
1870
1871   # Number creation
1872   $x = Math::BigInt->new($str);         # defaults to 0
1873   $nan  = Math::BigInt->bnan();         # create a NotANumber
1874   $zero = Math::BigInt->bzero();        # create a +0
1875   $inf = Math::BigInt->binf();          # create a +inf
1876   $inf = Math::BigInt->binf('-');       # create a -inf
1877   $one = Math::BigInt->bone();          # create a +1
1878   $one = Math::BigInt->bone('-');       # create a -1
1879
1880   # Testing
1881   $x->is_zero();                # true if arg is +0
1882   $x->is_nan();                 # true if arg is NaN
1883   $x->is_one();                 # true if arg is +1
1884   $x->is_one('-');              # true if arg is -1
1885   $x->is_odd();                 # true if odd, false for even
1886   $x->is_even();                # true if even, false for odd
1887   $x->is_positive();            # true if >= 0
1888   $x->is_negative();            # true if <  0
1889   $x->is_inf(sign);             # true if +inf, or -inf (sign is default '+')
1890
1891   $x->bcmp($y);                 # compare numbers (undef,<0,=0,>0)
1892   $x->bacmp($y);                # compare absolutely (undef,<0,=0,>0)
1893   $x->sign();                   # return the sign, either +,- or NaN
1894   $x->digit($n);                # return the nth digit, counting from right
1895   $x->digit(-$n);               # return the nth digit, counting from left
1896
1897   # The following all modify their first argument:
1898
1899   # set
1900   $x->bzero();                  # set $x to 0
1901   $x->bnan();                   # set $x to NaN
1902   $x->bone();                   # set $x to +1
1903   $x->bone('-');                # set $x to -1
1904
1905   $x->bneg();                   # negation
1906   $x->babs();                   # absolute value
1907   $x->bnorm();                  # normalize (no-op)
1908   $x->bnot();                   # two's complement (bit wise not)
1909   $x->binc();                   # increment x by 1
1910   $x->bdec();                   # decrement x by 1
1911
1912   $x->badd($y);                 # addition (add $y to $x)
1913   $x->bsub($y);                 # subtraction (subtract $y from $x)
1914   $x->bmul($y);                 # multiplication (multiply $x by $y)
1915   $x->bdiv($y);                 # divide, set $x to quotient
1916                                 # return (quo,rem) or quo if scalar
1917
1918   $x->bmod($y);                 # modulus (x % y)
1919   $x->bpow($y);                 # power of arguments (x ** y)
1920   $x->blsft($y);                # left shift
1921   $x->brsft($y);                # right shift
1922   $x->blsft($y,$n);             # left shift, by base $n (like 10)
1923   $x->brsft($y,$n);             # right shift, by base $n (like 10)
1924
1925   $x->band($y);                 # bitwise and
1926   $x->bior($y);                 # bitwise inclusive or
1927   $x->bxor($y);                 # bitwise exclusive or
1928   $x->bnot();                   # bitwise not (two's complement)
1929
1930   $x->bsqrt();                  # calculate square-root
1931
1932   $x->round($A,$P,$round_mode); # round to accuracy or precision using mode $r
1933   $x->bround($N);               # accuracy: preserve $N digits
1934   $x->bfround($N);              # round to $Nth digit, no-op for BigInts
1935
1936   # The following do not modify their arguments in BigInt, but do in BigFloat:
1937   $x->bfloor();                 # return integer less or equal than $x
1938   $x->bceil();                  # return integer greater or equal than $x
1939
1940   # The following do not modify their arguments:
1941
1942   bgcd(@values);                # greatest common divisor
1943   blcm(@values);                # lowest common multiplicator
1944
1945   $x->bstr();                   # normalized string
1946   $x->bsstr();                  # normalized string in scientific notation
1947   $x->length();                 # return number of digits in number
1948   ($x,$f) = $x->length();       # length of number and length of fraction part
1949
1950   $x->exponent();               # return exponent as BigInt
1951   $x->mantissa();               # return mantissa as BigInt
1952   $x->parts();                  # return (mantissa,exponent) as BigInt
1953   $x->copy();                   # make a true copy of $x (unlike $y = $x;)
1954   $x->as_number();              # return as BigInt (in BigInt: same as copy())
1955
1956 =head1 DESCRIPTION
1957
1958 All operators (inlcuding basic math operations) are overloaded if you
1959 declare your big integers as
1960
1961   $i = new Math::BigInt '123_456_789_123_456_789';
1962
1963 Operations with overloaded operators preserve the arguments which is
1964 exactly what you expect.
1965
1966 =over 2
1967
1968 =item Canonical notation
1969
1970 Big integer values are strings of the form C</^[+-]\d+$/> with leading
1971 zeros suppressed.
1972
1973    '-0'                            canonical value '-0', normalized '0'
1974    '   -123_123_123'               canonical value '-123123123'
1975    '1_23_456_7890'                 canonical value '1234567890'
1976
1977 =item Input
1978
1979 Input values to these routines may be either Math::BigInt objects or
1980 strings of the form C</^\s*[+-]?[\d]+\.?[\d]*E?[+-]?[\d]*$/>.
1981
1982 You can include one underscore between any two digits.
1983
1984 This means integer values like 1.01E2 or even 1000E-2 are also accepted.
1985 Non integer values result in NaN.
1986
1987 Math::BigInt::new() defaults to 0, while Math::BigInt::new('') results
1988 in 'NaN'.
1989
1990 bnorm() on a BigInt object is now effectively a no-op, since the numbers
1991 are always stored in normalized form. On a string, it creates a BigInt
1992 object.
1993
1994 =item Output
1995
1996 Output values are BigInt objects (normalized), except for bstr(), which
1997 returns a string in normalized form.
1998 Some routines (C<is_odd()>, C<is_even()>, C<is_zero()>, C<is_one()>,
1999 C<is_nan()>) return true or false, while others (C<bcmp()>, C<bacmp()>)
2000 return either undef, <0, 0 or >0 and are suited for sort.
2001
2002 =back
2003
2004 =head1 ACCURACY and PRECISION
2005
2006 Since version v1.33, Math::BigInt and Math::BigFloat have full support for
2007 accuracy and precision based rounding, both automatically after every
2008 operation as well as manually.
2009
2010 This section describes the accuracy/precision handling in Math::Big* as it
2011 used to be and as it is now, complete with an explanation of all terms and
2012 abbreviations.
2013
2014 Not yet implemented things (but with correct description) are marked with '!',
2015 things that need to be answered are marked with '?'.
2016
2017 In the next paragraph follows a short description of terms used here (because
2018 these may differ from terms used by others people or documentation).
2019
2020 During the rest of this document, the shortcuts A (for accuracy), P (for
2021 precision), F (fallback) and R (rounding mode) will be used.
2022
2023 =head2 Precision P
2024
2025 A fixed number of digits before (positive) or after (negative)
2026 the decimal point. For example, 123.45 has a precision of -2. 0 means an
2027 integer like 123 (or 120). A precision of 2 means two digits to the left
2028 of the decimal point are zero, so 123 with P = 1 becomes 120. Note that
2029 numbers with zeros before the decimal point may have different precisions,
2030 because 1200 can have p = 0, 1 or 2 (depending on what the inital value
2031 was). It could also have p < 0, when the digits after the decimal point
2032 are zero.
2033
2034 The string output (of floating point numbers) will be padded with zeros:
2035
2036         Initial value   P       A       Result          String
2037         ------------------------------------------------------------
2038         1234.01         -3              1000            1000
2039         1234            -2              1200            1200
2040         1234.5          -1              1230            1230
2041         1234.001        1               1234            1234.0
2042         1234.01         0               1234            1234
2043         1234.01         2               1234.01         1234.01
2044         1234.01         5               1234.01         1234.01000
2045
2046 For BigInts, no padding occurs.
2047
2048 =head2 Accuracy A
2049
2050 Number of significant digits. Leading zeros are not counted. A
2051 number may have an accuracy greater than the non-zero digits
2052 when there are zeros in it or trailing zeros. For example, 123.456 has
2053 A of 6, 10203 has 5, 123.0506 has 7, 123.450000 has 8 and 0.000123 has 3.
2054
2055 The string output (of floating point numbers) will be padded with zeros:
2056
2057         Initial value   P       A       Result          String
2058         ------------------------------------------------------------
2059         1234.01                 3       1230            1230
2060         1234.01                 6       1234.01         1234.01
2061         1234.1                  8       1234.1          1234.1000
2062
2063 For BigInts, no padding occurs.
2064
2065 =head2 Fallback F
2066
2067 When both A and P are undefined, this is used as a fallback accuracy when
2068 dividing numbers.
2069
2070 =head2 Rounding mode R
2071
2072 When rounding a number, different 'styles' or 'kinds'
2073 of rounding are possible. (Note that random rounding, as in
2074 Math::Round, is not implemented.)
2075
2076 =over 2
2077
2078 =item 'trunc'
2079
2080 truncation invariably removes all digits following the
2081 rounding place, replacing them with zeros. Thus, 987.65 rounded
2082 to tens (P=1) becomes 980, and rounded to the fourth sigdig
2083 becomes 987.6 (A=4). 123.456 rounded to the second place after the
2084 decimal point (P=-2) becomes 123.46.
2085
2086 All other implemented styles of rounding attempt to round to the
2087 "nearest digit." If the digit D immediately to the right of the
2088 rounding place (skipping the decimal point) is greater than 5, the
2089 number is incremented at the rounding place (possibly causing a
2090 cascade of incrementation): e.g. when rounding to units, 0.9 rounds
2091 to 1, and -19.9 rounds to -20. If D < 5, the number is similarly
2092 truncated at the rounding place: e.g. when rounding to units, 0.4
2093 rounds to 0, and -19.4 rounds to -19.
2094
2095 However the results of other styles of rounding differ if the
2096 digit immediately to the right of the rounding place (skipping the
2097 decimal point) is 5 and if there are no digits, or no digits other
2098 than 0, after that 5. In such cases:
2099
2100 =item 'even'
2101
2102 rounds the digit at the rounding place to 0, 2, 4, 6, or 8
2103 if it is not already. E.g., when rounding to the first sigdig, 0.45
2104 becomes 0.4, -0.55 becomes -0.6, but 0.4501 becomes 0.5.
2105
2106 =item 'odd'
2107
2108 rounds the digit at the rounding place to 1, 3, 5, 7, or 9 if
2109 it is not already. E.g., when rounding to the first sigdig, 0.45
2110 becomes 0.5, -0.55 becomes -0.5, but 0.5501 becomes 0.6.
2111
2112 =item '+inf'
2113
2114 round to plus infinity, i.e. always round up. E.g., when
2115 rounding to the first sigdig, 0.45 becomes 0.5, -0.55 becomes -0.5,
2116 and 0.4501 also becomes 0.5.
2117
2118 =item '-inf'
2119
2120 round to minus infinity, i.e. always round down. E.g., when
2121 rounding to the first sigdig, 0.45 becomes 0.4, -0.55 becomes -0.6,
2122 but 0.4501 becomes 0.5.
2123
2124 =item 'zero'
2125
2126 round to zero, i.e. positive numbers down, negative ones up.
2127 E.g., when rounding to the first sigdig, 0.45 becomes 0.4, -0.55
2128 becomes -0.5, but 0.4501 becomes 0.5.
2129
2130 =back
2131
2132 The handling of A & P in MBI/MBF (the old core code shipped with Perl
2133 versions <= 5.7.2) is like this:
2134
2135 =over 2
2136
2137 =item Precision
2138
2139   * ffround($p) is able to round to $p number of digits after the decimal
2140     point
2141   * otherwise P is unused
2142
2143 =item Accuracy (significant digits)
2144
2145   * fround($a) rounds to $a significant digits
2146   * only fdiv() and fsqrt() take A as (optional) paramater
2147     + other operations simply create the same number (fneg etc), or more (fmul)
2148       of digits
2149     + rounding/truncating is only done when explicitly calling one of fround
2150       or ffround, and never for BigInt (not implemented)
2151   * fsqrt() simply hands its accuracy argument over to fdiv.
2152   * the documentation and the comment in the code indicate two different ways
2153     on how fdiv() determines the maximum number of digits it should calculate,
2154     and the actual code does yet another thing
2155     POD:
2156       max($Math::BigFloat::div_scale,length(dividend)+length(divisor))
2157     Comment:
2158       result has at most max(scale, length(dividend), length(divisor)) digits
2159     Actual code:
2160       scale = max(scale, length(dividend)-1,length(divisor)-1);
2161       scale += length(divisior) - length(dividend);
2162     So for lx = 3, ly = 9, scale = 10, scale will actually be 16 (10+9-3).
2163     Actually, the 'difference' added to the scale is calculated from the
2164     number of "significant digits" in dividend and divisor, which is derived
2165     by looking at the length of the mantissa. Which is wrong, since it includes
2166     the + sign (oups) and actually gets 2 for '+100' and 4 for '+101'. Oups
2167     again. Thus 124/3 with div_scale=1 will get you '41.3' based on the strange
2168     assumption that 124 has 3 significant digits, while 120/7 will get you
2169     '17', not '17.1' since 120 is thought to have 2 significant digits.
2170     The rounding after the division then uses the reminder and $y to determine
2171     wether it must round up or down.
2172  ?  I have no idea which is the right way. That's why I used a slightly more
2173  ?  simple scheme and tweaked the few failing testcases to match it.
2174
2175 =back
2176
2177 This is how it works now:
2178
2179 =over 2
2180
2181 =item Setting/Accessing
2182
2183   * You can set the A global via $Math::BigInt::accuracy or
2184     $Math::BigFloat::accuracy or whatever class you are using.
2185   * You can also set P globally by using $Math::SomeClass::precision likewise.
2186   * Globals are classwide, and not inherited by subclasses.
2187   * to undefine A, use $Math::SomeCLass::accuracy = undef
2188   * to undefine P, use $Math::SomeClass::precision = undef
2189   * To be valid, A must be > 0, P can have any value.
2190   * If P is negative, this means round to the P'th place to the right of the
2191     decimal point; positive values mean to the left of the decimal point.
2192     P of 0 means round to integer.
2193   * to find out the current global A, take $Math::SomeClass::accuracy
2194   * use $x->accuracy() for the local setting of $x.
2195   * to find out the current global P, take $Math::SomeClass::precision
2196   * use $x->precision() for the local setting
2197
2198 =item Creating numbers
2199
2200  !* When you create a number, there should be a way to define its A & P
2201   * When a number without specific A or P is created, but the globals are
2202     defined, these should be used to round the number immediately and also
2203     stored locally with the number. Thus changing the global defaults later on
2204     will not change the A or P of previously created numbers (i.e., A and P of
2205     $x will be what was in effect when $x was created)
2206
2207 =item Usage
2208
2209   * If A or P are enabled/defined, they are used to round the result of each
2210     operation according to the rules below
2211   * Negative P is ignored in Math::BigInt, since BigInts never have digits
2212     after the decimal point
2213   * Math::BigFloat uses Math::BigInts internally, but setting A or P inside
2214     Math::BigInt as globals should not tamper with the parts of a BigFloat.
2215     Thus a flag is used to mark all Math::BigFloat numbers as 'never round'
2216
2217 =item Precedence
2218
2219   * It only makes sense that a number has only one of A or P at a time.
2220     Since you can set/get both A and P, there is a rule that will practically
2221     enforce only A or P to be in effect at a time, even if both are set.
2222     This is called precedence.
2223  !* If two objects are involved in an operation, and one of them has A in
2224  !  effect, and the other P, this should result in a warning or an error,
2225  !  probably in NaN.
2226   * A takes precendence over P (Hint: A comes before P). If A is defined, it
2227     is used, otherwise P is used. If neither of them is defined, nothing is
2228     used, i.e. the result will have as many digits as it can (with an
2229     exception for fdiv/fsqrt) and will not be rounded.
2230   * There is another setting for fdiv() (and thus for fsqrt()). If neither of
2231     A or P is defined, fdiv() will use a fallback (F) of $div_scale digits.
2232     If either the dividend's or the divisor's mantissa has more digits than
2233     the value of F, the higher value will be used instead of F.
2234     This is to limit the digits (A) of the result (just consider what would
2235     happen with unlimited A and P in the case of 1/3 :-)
2236   * fdiv will calculate 1 more digit than required (determined by
2237     A, P or F), and, if F is not used, round the result
2238     (this will still fail in the case of a result like 0.12345000000001 with A
2239     or P of 5, but this can not be helped - or can it?)
2240   * Thus you can have the math done by on Math::Big* class in three modes:
2241     + never round (this is the default):
2242       This is done by setting A and P to undef. No math operation
2243       will round the result, with fdiv() and fsqrt() as exceptions to guard
2244       against overflows. You must explicitely call bround(), bfround() or
2245       round() (the latter with parameters).
2246       Note: Once you have rounded a number, the settings will 'stick' on it
2247       and 'infect' all other numbers engaged in math operations with it, since
2248       local settings have the highest precedence. So, to get SaferRound[tm],
2249       use a copy() before rounding like this:
2250
2251         $x = Math::BigFloat->new(12.34);
2252         $y = Math::BigFloat->new(98.76);
2253         $z = $x * $y;                           # 1218.6984
2254         print $x->copy()->fround(3);            # 12.3 (but A is now 3!)
2255         $z = $x * $y;                           # still 1218.6984, without
2256                                                 # copy would have been 1210!
2257
2258     + round after each op:
2259       After each single operation (except for testing like is_zero()), the
2260       method round() is called and the result is rounded appropriately. By
2261       setting proper values for A and P, you can have all-the-same-A or
2262       all-the-same-P modes. For example, Math::Currency might set A to undef,
2263       and P to -2, globally.
2264
2265  ?Maybe an extra option that forbids local A & P settings would be in order,
2266  ?so that intermediate rounding does not 'poison' further math?
2267
2268 =item Overriding globals
2269
2270   * you will be able to give A, P and R as an argument to all the calculation
2271     routines; the second parameter is A, the third one is P, and the fourth is
2272     R (shift place by one for binary operations like add). P is used only if
2273     the first parameter (A) is undefined. These three parameters override the
2274     globals in the order detailed as follows, i.e. the first defined value
2275     wins:
2276     (local: per object, global: global default, parameter: argument to sub)
2277       + parameter A
2278       + parameter P
2279       + local A (if defined on both of the operands: smaller one is taken)
2280       + local P (if defined on both of the operands: smaller one is taken)
2281       + global A
2282       + global P
2283       + global F
2284   * fsqrt() will hand its arguments to fdiv(), as it used to, only now for two
2285     arguments (A and P) instead of one
2286
2287 =item Local settings
2288
2289   * You can set A and P locally by using $x->accuracy() and $x->precision()
2290     and thus force different A and P for different objects/numbers.
2291   * Setting A or P this way immediately rounds $x to the new value.
2292
2293 =item Rounding
2294
2295   * the rounding routines will use the respective global or local settings.
2296     fround()/bround() is for accuracy rounding, while ffround()/bfround()
2297     is for precision
2298   * the two rounding functions take as the second parameter one of the
2299     following rounding modes (R):
2300     'even', 'odd', '+inf', '-inf', 'zero', 'trunc'
2301   * you can set and get the global R by using Math::SomeClass->round_mode()
2302     or by setting $Math::SomeClass::rnd_mode
2303   * after each operation, $result->round() is called, and the result may
2304     eventually be rounded (that is, if A or P were set either locally,
2305     globally or as parameter to the operation)
2306   * to manually round a number, call $x->round($A,$P,$rnd_mode);
2307     this will round the number by using the appropriate rounding function
2308     and then normalize it.
2309   * rounding modifies the local settings of the number:
2310
2311         $x = Math::BigFloat->new(123.456);
2312         $x->accuracy(5);
2313         $x->bround(4);
2314
2315     Here 4 takes precedence over 5, so 123.5 is the result and $x->accuracy()
2316     will be 4 from now on.
2317
2318 =item Default values
2319
2320   * R: 'even'
2321   * F: 40
2322   * A: undef
2323   * P: undef
2324
2325 =item Remarks
2326
2327   * The defaults are set up so that the new code gives the same results as
2328     the old code (except in a few cases on fdiv):
2329     + Both A and P are undefined and thus will not be used for rounding
2330       after each operation.
2331     + round() is thus a no-op, unless given extra parameters A and P
2332
2333 =back
2334
2335 =head1 INTERNALS
2336
2337 The actual numbers are stored as unsigned big integers (with seperate sign).
2338 You should neither care about nor depend on the internal representation; it
2339 might change without notice. Use only method calls like C<< $x->sign(); >>
2340 instead relying on the internal hash keys like in C<< $x->{sign}; >>.
2341
2342 =head2 MATH LIBRARY
2343
2344 Math with the numbers is done (by default) by a module called
2345 Math::BigInt::Calc. This is equivalent to saying:
2346
2347         use Math::BigInt lib => 'Calc';
2348
2349 You can change this by using:
2350
2351         use Math::BigInt lib => 'BitVect';
2352
2353 The following would first try to find Math::BigInt::Foo, then
2354 Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
2355
2356         use Math::BigInt lib => 'Foo,Math::BigInt::Bar';
2357
2358 Calc.pm uses as internal format an array of elements of some decimal base
2359 (usually 1e5, but this might change to 1e7) with the least significant digit
2360 first, while BitVect.pm uses a bit vector of base 2, most significant bit
2361 first. Other modules might use even different means of representing the
2362 numbers. See the respective module documentation for further details.
2363
2364 =head2 SIGN
2365
2366 The sign is either '+', '-', 'NaN', '+inf' or '-inf' and stored seperately.
2367
2368 A sign of 'NaN' is used to represent the result when input arguments are not
2369 numbers or as a result of 0/0. '+inf' and '-inf' represent plus respectively
2370 minus infinity. You will get '+inf' when dividing a positive number by 0, and
2371 '-inf' when dividing any negative number by 0.
2372
2373 =head2 mantissa(), exponent() and parts()
2374
2375 C<mantissa()> and C<exponent()> return the said parts of the BigInt such
2376 that:
2377
2378         $m = $x->mantissa();
2379         $e = $x->exponent();
2380         $y = $m * ( 10 ** $e );
2381         print "ok\n" if $x == $y;
2382
2383 C<< ($m,$e) = $x->parts() >> is just a shortcut that gives you both of them
2384 in one go. Both the returned mantissa and exponent have a sign.
2385
2386 Currently, for BigInts C<$e> will be always 0, except for NaN, +inf and -inf,
2387 where it will be NaN; and for $x == 0, where it will be 1
2388 (to be compatible with Math::BigFloat's internal representation of a zero as
2389 C<0E1>).
2390
2391 C<$m> will always be a copy of the original number. The relation between $e
2392 and $m might change in the future, but will always be equivalent in a
2393 numerical sense, e.g. $m might get minimized.
2394
2395 =head1 EXAMPLES
2396
2397   use Math::BigInt qw(bstr);
2398
2399   sub bint { Math::BigInt->new(shift); }
2400
2401   $x = bstr("1234")                     # string "1234"
2402   $x = "$x";                            # same as bstr()
2403   $x = bneg("1234")                     # Bigint "-1234"
2404   $x = Math::BigInt->bneg("1234");      # Bigint "-1234"
2405   $x = Math::BigInt->babs("-12345");    # Bigint "12345"
2406   $x = Math::BigInt->bnorm("-0 00");    # BigInt "0"
2407   $x = bint(1) + bint(2);               # BigInt "3"
2408   $x = bint(1) + "2";                   # ditto (auto-BigIntify of "2")
2409   $x = bint(1);                         # BigInt "1"
2410   $x = $x + 5 / 2;                      # BigInt "3"
2411   $x = $x ** 3;                         # BigInt "27"
2412   $x *= 2;                              # BigInt "54"
2413   $x = new Math::BigInt;                # BigInt "0"
2414   $x--;                                 # BigInt "-1"
2415   $x = Math::BigInt->badd(4,5)          # BigInt "9"
2416   $x = Math::BigInt::badd(4,5)          # BigInt "9"
2417   print $x->bsstr();                    # 9e+0
2418
2419 Examples for rounding:
2420
2421   use Math::BigFloat;
2422   use Test;
2423
2424   $x = Math::BigFloat->new(123.4567);
2425   $y = Math::BigFloat->new(123.456789);
2426   $Math::BigFloat::accuracy = 4;        # no more A than 4
2427
2428   ok ($x->copy()->fround(),123.4);      # even rounding
2429   print $x->copy()->fround(),"\n";      # 123.4
2430   Math::BigFloat->round_mode('odd');    # round to odd
2431   print $x->copy()->fround(),"\n";      # 123.5
2432   $Math::BigFloat::accuracy = 5;        # no more A than 5
2433   Math::BigFloat->round_mode('odd');    # round to odd
2434   print $x->copy()->fround(),"\n";      # 123.46
2435   $y = $x->copy()->fround(4),"\n";      # A = 4: 123.4
2436   print "$y, ",$y->accuracy(),"\n";     # 123.4, 4
2437
2438   $Math::BigFloat::accuracy = undef;    # A not important
2439   $Math::BigFloat::precision = 2;       # P important
2440   print $x->copy()->bnorm(),"\n";       # 123.46
2441   print $x->copy()->fround(),"\n";      # 123.46
2442
2443 =head1 Autocreating constants
2444
2445 After C<use Math::BigInt ':constant'> all the B<integer> decimal constants
2446 in the given scope are converted to C<Math::BigInt>. This conversion
2447 happens at compile time.
2448
2449 In particular,
2450
2451   perl -MMath::BigInt=:constant -e 'print 2**100,"\n"'
2452
2453 prints the integer value of C<2**100>.  Note that without conversion of
2454 constants the expression 2**100 will be calculated as perl scalar.
2455
2456 Please note that strings and floating point constants are not affected,
2457 so that
2458
2459         use Math::BigInt qw/:constant/;
2460
2461         $x = 1234567890123456789012345678901234567890
2462                 + 123456789123456789;
2463         $y = '1234567890123456789012345678901234567890'
2464                 + '123456789123456789';
2465
2466 do not work. You need an explicit Math::BigInt->new() around one of the
2467 operands.
2468
2469 =head1 PERFORMANCE
2470
2471 Using the form $x += $y; etc over $x = $x + $y is faster, since a copy of $x
2472 must be made in the second case. For long numbers, the copy can eat up to 20%
2473 of the work (in the case of addition/subtraction, less for
2474 multiplication/division). If $y is very small compared to $x, the form
2475 $x += $y is MUCH faster than $x = $x + $y since making the copy of $x takes
2476 more time then the actual addition.
2477
2478 With a technique called copy-on-write, the cost of copying with overload could
2479 be minimized or even completely avoided. This is currently not implemented.
2480
2481 The new version of this module is slower on new(), bstr() and numify(). Some
2482 operations may be slower for small numbers, but are significantly faster for
2483 big numbers. Other operations are now constant (O(1), like bneg(), babs()
2484 etc), instead of O(N) and thus nearly always take much less time.
2485
2486 If you find the Calc module to slow, try to install any of the replacement
2487 modules and see if they help you.
2488
2489 =head2 Alternative math libraries
2490
2491 You can use an alternative library to drive Math::BigInt via:
2492
2493         use Math::BigInt lib => 'Module';
2494
2495 The default is called Math::BigInt::Calc and is a pure-perl implementation
2496 that consists mainly of the standard routine present in earlier versions of
2497 Math::BigInt.
2498
2499 There are also Math::BigInt::Scalar (primarily for testing) and
2500 Math::BigInt::BitVect; as well as Math::BigInt::Pari and likely others.
2501 All these can be found via L<http://search.cpan.org/>:
2502
2503         use Math::BigInt lib => 'BitVect';
2504
2505         my $x = Math::BigInt->new(2);
2506         print $x ** (1024*1024);
2507
2508 For more benchmark results see http://bloodgate.com/perl/benchmarks.html
2509
2510 =head1 BUGS
2511
2512 =over 2
2513
2514 =item Out of Memory!
2515
2516 Under Perl prior to 5.6.0 having an C<use Math::BigInt ':constant';> and
2517 C<eval()> in your code will crash with "Out of memory". This is probably an
2518 overload/exporter bug. You can workaround by not having C<eval()>
2519 and ':constant' at the same time or upgrade your Perl to a newer version.
2520
2521 =item Fails to load Calc on Perl prior 5.6.0
2522
2523 Since eval(' use ...') can not be used in conjunction with ':constant', BigInt
2524 will fall back to eval { require ... } when loading the math lib on Perls
2525 prior to 5.6.0. This simple replaces '::' with '/' and thus might fail on
2526 filesystems using a different seperator.
2527
2528 =back
2529
2530 =head1 CAVEATS
2531
2532 Some things might not work as you expect them. Below is documented what is
2533 known to be troublesome:
2534
2535 =over 1
2536
2537 =item stringify, bstr(), bsstr() and 'cmp'
2538
2539 Both stringify and bstr() now drop the leading '+'. The old code would return
2540 '+3', the new returns '3'. This is to be consistent with Perl and to make
2541 cmp (especially with overloading) to work as you expect. It also solves
2542 problems with Test.pm, it's ok() uses 'eq' internally.
2543
2544 Mark said, when asked about to drop the '+' altogether, or make only cmp work:
2545
2546         I agree (with the first alternative), don't add the '+' on positive
2547         numbers.  It's not as important anymore with the new internal
2548         form for numbers.  It made doing things like abs and neg easier,
2549         but those have to be done differently now anyway.
2550
2551 So, the following examples will now work all as expected:
2552
2553         use Test;
2554         BEGIN { plan tests => 1 }
2555         use Math::BigInt;
2556
2557         my $x = new Math::BigInt 3*3;
2558         my $y = new Math::BigInt 3*3;
2559
2560         ok ($x,3*3);
2561         print "$x eq 9" if $x eq $y;
2562         print "$x eq 9" if $x eq '9';
2563         print "$x eq 9" if $x eq 3*3;
2564
2565 Additionally, the following still works:
2566
2567         print "$x == 9" if $x == $y;
2568         print "$x == 9" if $x == 9;
2569         print "$x == 9" if $x == 3*3;
2570
2571 There is now a C<bsstr()> method to get the string in scientific notation aka
2572 C<1e+2> instead of C<100>. Be advised that overloaded 'eq' always uses bstr()
2573 for comparisation, but Perl will represent some numbers as 100 and others
2574 as 1e+308. If in doubt, convert both arguments to Math::BigInt before doing eq:
2575
2576         use Test;
2577         BEGIN { plan tests => 3 }
2578         use Math::BigInt;
2579
2580         $x = Math::BigInt->new('1e56'); $y = 1e56;
2581         ok ($x,$y);                     # will fail
2582         ok ($x->bsstr(),$y);            # okay
2583         $y = Math::BigInt->new($y);
2584         ok ($x,$y);                     # okay
2585
2586 There is not yet a way to get a number automatically represented in exactly
2587 the way Perl represents it.
2588
2589 =item int()
2590
2591 C<int()> will return (at least for Perl v5.7.1 and up) another BigInt, not a
2592 Perl scalar:
2593
2594         $x = Math::BigInt->new(123);
2595         $y = int($x);                           # BigInt 123
2596         $x = Math::BigFloat->new(123.45);
2597         $y = int($x);                           # BigInt 123
2598
2599 In all Perl versions you can use C<as_number()> for the same effect:
2600
2601         $x = Math::BigFloat->new(123.45);
2602         $y = $x->as_number();                   # BigInt 123
2603
2604 This also works for other subclasses, like Math::String.
2605
2606 It is yet unlcear whether overloaded int() should return a scalar or a BigInt.
2607
2608 =item bdiv
2609
2610 The following will probably not do what you expect:
2611
2612         print $c->bdiv(10000),"\n";
2613
2614 It prints both quotient and reminder since print calls C<bdiv()> in list
2615 context. Also, C<bdiv()> will modify $c, so be carefull. You probably want
2616 to use
2617
2618         print $c / 10000,"\n";
2619         print scalar $c->bdiv(10000),"\n";  # or if you want to modify $c
2620
2621 instead.
2622
2623 The quotient is always the greatest integer less than or equal to the
2624 real-valued quotient of the two operands, and the remainder (when it is
2625 nonzero) always has the same sign as the second operand; so, for
2626 example,
2627
2628          1 / 4  => ( 0, 1)
2629          1 / -4 => (-1,-3)
2630         -3 / 4  => (-1, 1)
2631         -3 / -4 => ( 0,-3)
2632
2633 As a consequence, the behavior of the operator % agrees with the
2634 behavior of Perl's built-in % operator (as documented in the perlop
2635 manpage), and the equation
2636
2637         $x == ($x / $y) * $y + ($x % $y)
2638
2639 holds true for any $x and $y, which justifies calling the two return
2640 values of bdiv() the quotient and remainder.
2641
2642 Perl's 'use integer;' changes the behaviour of % and / for scalars, but will
2643 not change BigInt's way to do things. This is because under 'use integer' Perl
2644 will do what the underlying C thinks is right and this is different for each
2645 system. If you need BigInt's behaving exactly like Perl's 'use integer', bug
2646 the author to implement it ;)
2647
2648 =item Modifying and =
2649
2650 Beware of:
2651
2652         $x = Math::BigFloat->new(5);
2653         $y = $x;
2654
2655 It will not do what you think, e.g. making a copy of $x. Instead it just makes
2656 a second reference to the B<same> object and stores it in $y. Thus anything
2657 that modifies $x (except overloaded operators) will modify $y, and vice versa.
2658 Or in other words, C<=> is only safe if you modify your BigInts only via
2659 overloaded math. As soon as you use a method call it breaks:
2660
2661         $x->bmul(2);
2662         print "$x, $y\n";       # prints '10, 10'
2663
2664 If you want a true copy of $x, use:
2665
2666         $y = $x->copy();
2667
2668 You can also chain the calls like this, this will make first a copy and then
2669 multiply it by 2:
2670
2671         $y = $x->copy()->bmul(2);
2672
2673 See also the documentation for overload.pm regarding C<=>.
2674
2675 =item bpow
2676
2677 C<bpow()> (and the rounding functions) now modifies the first argument and
2678 returns it, unlike the old code which left it alone and only returned the
2679 result. This is to be consistent with C<badd()> etc. The first three will
2680 modify $x, the last one won't:
2681
2682         print bpow($x,$i),"\n";         # modify $x
2683         print $x->bpow($i),"\n";        # ditto
2684         print $x **= $i,"\n";           # the same
2685         print $x ** $i,"\n";            # leave $x alone
2686
2687 The form C<$x **= $y> is faster than C<$x = $x ** $y;>, though.
2688
2689 =item Overloading -$x
2690
2691 The following:
2692
2693         $x = -$x;
2694
2695 is slower than
2696
2697         $x->bneg();
2698
2699 since overload calls C<sub($x,0,1);> instead of C<neg($x)>. The first variant
2700 needs to preserve $x since it does not know that it later will get overwritten.
2701 This makes a copy of $x and takes O(N), but $x->bneg() is O(1).
2702
2703 With Copy-On-Write, this issue will be gone. Stay tuned...
2704
2705 =item Mixing different object types
2706
2707 In Perl you will get a floating point value if you do one of the following:
2708
2709         $float = 5.0 + 2;
2710         $float = 2 + 5.0;
2711         $float = 5 / 2;
2712
2713 With overloaded math, only the first two variants will result in a BigFloat:
2714
2715         use Math::BigInt;
2716         use Math::BigFloat;
2717
2718         $mbf = Math::BigFloat->new(5);
2719         $mbi2 = Math::BigInteger->new(5);
2720         $mbi = Math::BigInteger->new(2);
2721
2722                                         # what actually gets called:
2723         $float = $mbf + $mbi;           # $mbf->badd()
2724         $float = $mbf / $mbi;           # $mbf->bdiv()
2725         $integer = $mbi + $mbf;         # $mbi->badd()
2726         $integer = $mbi2 / $mbi;        # $mbi2->bdiv()
2727         $integer = $mbi2 / $mbf;        # $mbi2->bdiv()
2728
2729 This is because math with overloaded operators follows the first (dominating)
2730 operand, this one's operation is called and returns thus the result. So,
2731 Math::BigInt::bdiv() will always return a Math::BigInt, regardless whether
2732 the result should be a Math::BigFloat or the second operant is one.
2733
2734 To get a Math::BigFloat you either need to call the operation manually,
2735 make sure the operands are already of the proper type or casted to that type
2736 via Math::BigFloat->new():
2737
2738         $float = Math::BigFloat->new($mbi2) / $mbi;     # = 2.5
2739
2740 Beware of simple "casting" the entire expression, this would only convert
2741 the already computed result:
2742
2743         $float = Math::BigFloat->new($mbi2 / $mbi);     # = 2.0 thus wrong!
2744
2745 Beware also of the order of more complicated expressions like:
2746
2747         $integer = ($mbi2 + $mbi) / $mbf;               # int / float => int
2748         $integer = $mbi2 / Math::BigFloat->new($mbi);   # ditto
2749
2750 If in doubt, break the expression into simpler terms, or cast all operands
2751 to the desired resulting type.
2752
2753 Scalar values are a bit different, since:
2754
2755         $float = 2 + $mbf;
2756         $float = $mbf + 2;
2757
2758 will both result in the proper type due to the way the overloaded math works.
2759
2760 This section also applies to other overloaded math packages, like Math::String.
2761
2762 =item bsqrt()
2763
2764 C<bsqrt()> works only good if the result is an big integer, e.g. the square
2765 root of 144 is 12, but from 12 the square root is 3, regardless of rounding
2766 mode.
2767
2768 If you want a better approximation of the square root, then use:
2769
2770         $x = Math::BigFloat->new(12);
2771         $Math::BigFloat::precision = 0;
2772         Math::BigFloat->round_mode('even');
2773         print $x->copy->bsqrt(),"\n";           # 4
2774
2775         $Math::BigFloat::precision = 2;
2776         print $x->bsqrt(),"\n";                 # 3.46
2777         print $x->bsqrt(3),"\n";                # 3.464
2778
2779 =back
2780
2781 =head1 LICENSE
2782
2783 This program is free software; you may redistribute it and/or modify it under
2784 the same terms as Perl itself.
2785
2786 =head1 SEE ALSO
2787
2788 L<Math::BigFloat> and L<Math::Big>.
2789
2790 L<Math::BigInt::BitVect> and L<Math::BigInt::Pari>.
2791
2792 =head1 AUTHORS
2793
2794 Original code by Mark Biggar, overloaded interface by Ilya Zakharevich.
2795 Completely rewritten by Tels http://bloodgate.com in late 2000, 2001.
2796
2797 =cut