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.42';
  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                       ref($_[0])->bcmp($_[1],$_[0]) :
  73                       ref($_[0])->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->is_odd() || $x->{sign} !~ /^[+-]$/;
1228   return 0 if $x->is_zero() || $x->{sign} !~ /^[+-]$/;
1229
1230   return $CALC->_zeros($x->{value}) if $CALC->can('_zeros');
1231
1232   # if not: since we do not know underlying internal representation:
1233   my $es = "$x"; $es =~ /([0]*)$/;
1234
1235   return 0 if !defined $1;      # no zeros
1236   return CORE::length("$1");    # as string, not as +0!
1237   }
1238
1239 sub bsqrt
1240   {
1241   my ($self,$x) = objectify(1,@_);
1242
1243   return $x->bnan() if $x->{sign} =~ /\-|$nan/; # -x or NaN => NaN
1244   return $x->bzero() if $x->is_zero();          # 0 => 0
1245   return $x if $x == 1;                         # 1 => 1
1246
1247   my $y = $x->copy();                           # give us one more digit accur.
1248   my $l = int($x->length()/2);
1249
1250   $x->bzero();
1251   $x->binc();           # keep ref($x), but modify it
1252   $x *= 10 ** $l;
1253
1254   # print "x: $y guess $x\n";
1255
1256   my $last = $self->bzero();
1257   while ($last != $x)
1258     {
1259     $last = $x;
1260     $x += $y / $x;
1261     $x /= 2;
1262     }
1263   return $x;
1264   }
1265
1266 sub exponent
1267   {
1268   # return a copy of the exponent (here always 0, NaN or 1 for $m == 0)
1269   my ($self,$x) = objectify(1,@_);
1270
1271   return bnan() if $x->is_nan();
1272   my $e = $class->bzero();
1273   return $e->binc() if $x->is_zero();
1274   $e += $x->_trailing_zeros();
1275   return $e;
1276   }
1277
1278 sub mantissa
1279   {
1280   # return a copy of the mantissa (here always $self)
1281   my ($self,$x) = objectify(1,@_);
1282
1283   return bnan() if $x->is_nan();
1284   my $m = $x->copy();
1285   # that's inefficient
1286   my $zeros = $m->_trailing_zeros();
1287   $m /= 10 ** $zeros if $zeros != 0;
1288   return $m;
1289   }
1290
1291 sub parts
1292   {
1293   # return a copy of both the exponent and the mantissa (here 0 and self)
1294   my $self = shift;
1295   $self = $class->new($self) unless ref $self;
1296
1297   return ($self->mantissa(),$self->exponent());
1298   }
1299
1300 ##############################################################################
1301 # rounding functions
1302
1303 sub bfround
1304   {
1305   # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
1306   # $n == 0 => round to integer
1307   my $x = shift; $x = $class->new($x) unless ref $x;
1308   my ($scale,$mode) = $x->_scale_p($precision,$rnd_mode,@_);
1309   return $x if !defined $scale;         # no-op
1310
1311   # no-op for BigInts if $n <= 0
1312   return $x if $scale <= 0;
1313
1314   $x->bround( $x->length()-$scale, $mode);
1315   }
1316
1317 sub _scan_for_nonzero
1318   {
1319   my $x = shift;
1320   my $pad = shift;
1321   my $xs = shift;
1322
1323   my $len = $x->length();
1324   return 0 if $len == 1;                # '5' is trailed by invisible zeros
1325   my $follow = $pad - 1;
1326   return 0 if $follow > $len || $follow < 1;
1327   #print "checking $x $r\n";
1328
1329   # since we do not know underlying represention of $x, use decimal string
1330   #my $r = substr ($$xs,-$follow);
1331   my $r = substr ("$x",-$follow);
1332   return 1 if $r =~ /[^0]/; return 0;
1333   }
1334
1335 sub fround
1336   {
1337   # to make life easier for switch between MBF and MBI (autoload fxxx()
1338   # like MBF does for bxxx()?)
1339   my $x = shift;
1340   return $x->bround(@_);
1341   }
1342
1343 sub bround
1344   {
1345   # accuracy: +$n preserve $n digits from left,
1346   #           -$n preserve $n digits from right (f.i. for 0.1234 style in MBF)
1347   # no-op for $n == 0
1348   # and overwrite the rest with 0's, return normalized number
1349   # do not return $x->bnorm(), but $x
1350   my $x = shift; $x = $class->new($x) unless ref $x;
1351   my ($scale,$mode) = $x->_scale_a($accuracy,$rnd_mode,@_);
1352   return $x if !defined $scale;         # no-op
1353
1354   # print "MBI round: $x to $scale $mode\n";
1355   # -scale means what? tom? hullo? -$scale needed by MBF round, but what for?
1356   return $x if $x->{sign} !~ /^[+-]$/ || $x->is_zero() || $scale == 0;
1357
1358   # we have fewer digits than we want to scale to
1359   my $len = $x->length();
1360   # print "$len $scale\n";
1361   return $x if $len < abs($scale);
1362
1363   # count of 0's to pad, from left (+) or right (-): 9 - +6 => 3, or |-6| => 6
1364   my ($pad,$digit_round,$digit_after);
1365   $pad = $len - $scale;
1366   $pad = abs($scale)+1 if $scale < 0;
1367   # do not use digit(), it is costly for binary => decimal
1368   #$digit_round = '0'; $digit_round = $x->digit($pad) if $pad < $len;
1369   #$digit_after = '0'; $digit_after = $x->digit($pad-1) if $pad > 0;
1370   my $xs = $CALC->_str($x->{value});
1371   my $pl = -$pad-1;
1372   # pad:   123: 0 => -1, at 1 => -2, at 2 => -3, at 3 => -4
1373   # pad+1: 123: 0 => 0,  at 1 => -1, at 2 => -2, at 3 => -3
1374   $digit_round = '0'; $digit_round = substr($$xs,$pl,1) if $pad <= $len;
1375   $pl++; $pl ++ if $pad >= $len;
1376   $digit_after = '0'; $digit_after = substr($$xs,$pl,1)
1377    if $pad > 0;
1378
1379   #my $d_round = '0'; $d_round = $x->digit($pad) if $pad < $len;
1380   #my $d_after = '0'; $d_after = $x->digit($pad-1) if $pad > 0;
1381   # print "$pad $pl $$xs $digit_round:$d_round $digit_after:$d_after\n";
1382
1383   # in case of 01234 we round down, for 6789 up, and only in case 5 we look
1384   # closer at the remaining digits of the original $x, remember decision
1385   my $round_up = 1;                                     # default round up
1386   $round_up -- if
1387     ($mode eq 'trunc')                          ||      # trunc by round down
1388     ($digit_after =~ /[01234]/)                 ||      # round down anyway,
1389                                                         # 6789 => round up
1390     ($digit_after eq '5')                       &&      # not 5000...0000
1391     ($x->_scan_for_nonzero($pad,$xs) == 0)              &&
1392     (
1393      ($mode eq 'even') && ($digit_round =~ /[24680]/) ||
1394      ($mode eq 'odd')  && ($digit_round =~ /[13579]/) ||
1395      ($mode eq '+inf') && ($x->{sign} eq '-')   ||
1396      ($mode eq '-inf') && ($x->{sign} eq '+')   ||
1397      ($mode eq 'zero')          # round down if zero, sign adjusted below
1398     );
1399   # allow rounding one place left of mantissa
1400   #print "$pad $len $scale\n";
1401   # this is triggering warnings, and buggy for $scale < 0
1402   #if (-$scale != $len)
1403     {
1404     # old code, depend on internal representation
1405     # split mantissa at $pad and then pad with zeros
1406     #my $s5 = int($pad / 5);
1407     #my $i = 0;
1408     #while ($i < $s5)
1409     #  {
1410     #  $x->{value}->[$i++] = 0;                         # replace with 5 x 0
1411     #  }
1412     #$x->{value}->[$s5] = '00000'.$x->{value}->[$s5];   # pad with 0
1413     #my $rem = $pad % 5;                                # so much left over
1414     #if ($rem > 0)
1415     #  {
1416     #  #print "remainder $rem\n";
1417     ##  #print "elem      $x->{value}->[$s5]\n";
1418     #  substr($x->{value}->[$s5],-$rem,$rem) = '0' x $rem;      # stamp w/ '0'
1419     #  }
1420     #$x->{value}->[$s5] = int ($x->{value}->[$s5]);     # str '05' => int '5'
1421     #print ${$CALC->_str($pad->{value})}," $len\n";
1422     if (($pad > 0) && ($pad <= $len))
1423       {
1424       substr($$xs,-$pad,$pad) = '0' x $pad;
1425       $x->{value} = $CALC->_new($xs);                   # put back in
1426       }
1427     elsif ($pad > $len)
1428       {
1429       $x->bzero();                                      # round to '0'
1430       }
1431     # print "res $pad $len $x $$xs\n";
1432     }
1433   # move this later on after the inc of the string
1434   #$x->{value} = $CALC->_new($xs);                      # put back in
1435   if ($round_up)                                        # what gave test above?
1436     {
1437     $pad = $len if $scale < 0;                          # tlr: whack 0.51=>1.0
1438     # modify $x in place, undef, undef to avoid rounding
1439     # str creation much faster than 10 ** something
1440     $x->badd( Math::BigInt->new($x->{sign}.'1'.'0'x$pad) );
1441     # increment string in place, to avoid dec=>hex for the '1000...000'
1442     # $xs ...blah foo
1443     }
1444   # to here:
1445   #$x->{value} = $CALC->_new($xs);                      # put back in
1446   $x;
1447   }
1448
1449 sub bfloor
1450   {
1451   # return integer less or equal then number, since it is already integer,
1452   # always returns $self
1453   my ($self,$x,$a,$p,$r) = objectify(1,@_);
1454
1455   # not needed: return $x if $x->modify('bfloor');
1456
1457   return $x->round($a,$p,$r);
1458   }
1459
1460 sub bceil
1461   {
1462   # return integer greater or equal then number, since it is already integer,
1463   # always returns $self
1464   my ($self,$x,$a,$p,$r) = objectify(1,@_);
1465
1466   # not needed: return $x if $x->modify('bceil');
1467
1468   return $x->round($a,$p,$r);
1469   }
1470
1471 ##############################################################################
1472 # private stuff (internal use only)
1473
1474 sub __one
1475   {
1476   # internal speedup, set argument to 1, or create a +/- 1
1477   my $self = shift;
1478   my $x = $self->bzero(); $x->{value} = $CALC->_one();
1479   $x->{sign} = shift || '+';
1480   return $x;
1481   }
1482
1483 sub _swap
1484   {
1485   # Overload will swap params if first one is no object ref so that the first
1486   # one is always an object ref. In this case, third param is true.
1487   # This routine is to overcome the effect of scalar,$object creating an object
1488   # of the class of this package, instead of the second param $object. This
1489   # happens inside overload, when the overload section of this package is
1490   # inherited by sub classes.
1491   # For overload cases (and this is used only there), we need to preserve the
1492   # args, hence the copy().
1493   # You can override this method in a subclass, the overload section will call
1494   # $object->_swap() to make sure it arrives at the proper subclass, with some
1495   # exceptions like '+' and '-'.
1496
1497   # object, (object|scalar) => preserve first and make copy
1498   # scalar, object          => swapped, re-swap and create new from first
1499   #                            (using class of second object, not $class!!)
1500   my $self = shift;                     # for override in subclass
1501   #print "swap $self 0:$_[0] 1:$_[1] 2:$_[2]\n";
1502   if ($_[2])
1503     {
1504     my $c = ref ($_[0]) || $class;      # fallback $class should not happen
1505     return ( $c->new($_[1]), $_[0] );
1506     }
1507   return ( $_[0]->copy(), $_[1] );
1508   }
1509
1510 sub objectify
1511   {
1512   # check for strings, if yes, return objects instead
1513
1514   # the first argument is number of args objectify() should look at it will
1515   # return $count+1 elements, the first will be a classname. This is because
1516   # overloaded '""' calls bstr($object,undef,undef) and this would result in
1517   # useless objects beeing created and thrown away. So we cannot simple loop
1518   # over @_. If the given count is 0, all arguments will be used.
1519
1520   # If the second arg is a ref, use it as class.
1521   # If not, try to use it as classname, unless undef, then use $class
1522   # (aka Math::BigInt). The latter shouldn't happen,though.
1523
1524   # caller:                        gives us:
1525   # $x->badd(1);                => ref x, scalar y
1526   # Class->badd(1,2);           => classname x (scalar), scalar x, scalar y
1527   # Class->badd( Class->(1),2); => classname x (scalar), ref x, scalar y
1528   # Math::BigInt::badd(1,2);    => scalar x, scalar y
1529   # In the last case we check number of arguments to turn it silently into
1530   # $class,1,2. (We can not take '1' as class ;o)
1531   # badd($class,1) is not supported (it should, eventually, try to add undef)
1532   # currently it tries 'Math::BigInt' + 1, which will not work.
1533
1534   my $count = abs(shift || 0);
1535
1536   #print caller(),"\n";
1537
1538   my @a;                        # resulting array
1539   if (ref $_[0])
1540     {
1541     # okay, got object as first
1542     $a[0] = ref $_[0];
1543     }
1544   else
1545     {
1546     # nope, got 1,2 (Class->xxx(1) => Class,1 and not supported)
1547     $a[0] = $class;
1548     #print "@_\n"; sleep(1);
1549     $a[0] = shift if $_[0] =~ /^[A-Z].*::/;     # classname as first?
1550     }
1551   #print caller(),"\n";
1552   # print "Now in objectify, my class is today $a[0]\n";
1553   my $k;
1554   if ($count == 0)
1555     {
1556     while (@_)
1557       {
1558       $k = shift;
1559       if (!ref($k))
1560         {
1561         $k = $a[0]->new($k);
1562         }
1563       elsif (ref($k) ne $a[0])
1564         {
1565         # foreign object, try to convert to integer
1566         $k->can('as_number') ?  $k = $k->as_number() : $k = $a[0]->new($k);
1567         }
1568       push @a,$k;
1569       }
1570     }
1571   else
1572     {
1573     while ($count > 0)
1574       {
1575       #print "$count\n";
1576       $count--;
1577       $k = shift;
1578       if (!ref($k))
1579         {
1580         $k = $a[0]->new($k);
1581         }
1582       elsif (ref($k) ne $a[0])
1583         {
1584         # foreign object, try to convert to integer
1585         $k->can('as_number') ?  $k = $k->as_number() : $k = $a[0]->new($k);
1586         }
1587       push @a,$k;
1588       }
1589     push @a,@_;         # return other params, too
1590     }
1591   #my $i = 0;
1592   #foreach (@a)
1593   #  {
1594   #  print "o $i $a[0]\n" if $i == 0;
1595   #  print "o $i ",ref($_),"\n" if $i != 0; $i++;
1596   #  }
1597   #print "objectify done: would return ",scalar @a," values\n";
1598   #print caller(1),"\n" unless wantarray;
1599   die "$class objectify needs list context" unless wantarray;
1600   @a;
1601   }
1602
1603 sub import
1604   {
1605   my $self = shift;
1606   #print "import $self @_\n";
1607   my @a = @_; my $l = scalar @_; my $j = 0;
1608   for ( my $i = 0; $i < $l ; $i++,$j++ )
1609     {
1610     if ($_[$i] eq ':constant')
1611       {
1612       # this causes overlord er load to step in
1613       overload::constant integer => sub { $self->new(shift) };
1614       splice @a, $j, 1; $j --;
1615       }
1616     elsif ($_[$i] =~ /^lib$/i)
1617       {
1618       # this causes a different low lib to take care...
1619       $CALC = $_[$i+1] || $CALC;
1620       my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..."
1621       splice @a, $j, $s; $j -= $s;
1622       }
1623     }
1624   # any non :constant stuff is handled by our parent, Exporter
1625   # even if @_ is empty, to give it a chance
1626   #$self->SUPER::import(@a);                    # does not work
1627   $self->export_to_level(1,$self,@a);           # need this instead
1628
1629   # try to load core math lib
1630   my @c = split /\s*,\s*/,$CALC;
1631   push @c,'Calc';                               # if all fail, try this
1632   foreach my $lib (@c)
1633     {
1634     $lib = 'Math::BigInt::'.$lib if $lib !~ /^Math::BigInt/i;
1635     $lib =~ s/\.pm$//;
1636     if ($] < 5.6)
1637       {
1638       # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
1639       # used in the same script, or eval inside import().
1640       (my $mod = $lib . '.pm') =~ s!::!/!g;
1641       # require does not automatically :: => /, so portability problems arise
1642       eval { require $mod; $lib->import( @c ); }
1643       }
1644     else
1645       {
1646       eval "use $lib @c;";
1647       }
1648     $CALC = $lib, last if $@ eq '';     # no error in loading lib?
1649     }
1650   }
1651
1652 sub __from_hex
1653   {
1654   # convert a (ref to) big hex string to BigInt, return undef for error
1655   my $hs = shift;
1656
1657   my $x = Math::BigInt->bzero();
1658   return $x->bnan() if $$hs !~ /^[\-\+]?0x[0-9A-Fa-f]+$/;
1659
1660   my $sign = '+'; $sign = '-' if ($$hs =~ /^-/);
1661
1662   $$hs =~ s/^[+-]//;                    # strip sign
1663   if ($CALC->can('_from_hex'))
1664     {
1665     $x->{value} = $CALC->_from_hex($hs);
1666     }
1667   else
1668     {
1669     # fallback to pure perl
1670     my $mul = Math::BigInt->bzero(); $mul++;
1671     my $x65536 = Math::BigInt->new(65536);
1672     my $len = CORE::length($$hs)-2;
1673     $len = int($len/4);                 # 4-digit parts, w/o '0x'
1674     my $val; my $i = -4;
1675     while ($len >= 0)
1676       {
1677       $val = substr($$hs,$i,4);
1678       $val =~ s/^[+-]?0x// if $len == 0;        # for last part only because
1679       $val = hex($val);                         # hex does not like wrong chars
1680       # print "$val ",substr($$hs,$i,4),"\n";
1681       $i -= 4; $len --;
1682       $x += $mul * $val if $val != 0;
1683       $mul *= $x65536 if $len >= 0;             # skip last mul
1684       }
1685     }
1686   $x->{sign} = $sign if !$x->is_zero();         # no '-0'
1687   return $x;
1688   }
1689
1690 sub __from_bin
1691   {
1692   # convert a (ref to) big binary string to BigInt, return undef for error
1693   my $bs = shift;
1694
1695   my $x = Math::BigInt->bzero();
1696   return $x->bnan() if $$bs !~ /^[+-]?0b[01]+$/;
1697
1698   my $mul = Math::BigInt->bzero(); $mul++;
1699   my $x256 = Math::BigInt->new(256);
1700
1701   my $sign = '+'; $sign = '-' if ($$bs =~ /^\-/);
1702   $$bs =~ s/^[+-]//;                            # strip sign
1703   if ($CALC->can('_from_bin'))
1704     {
1705     $x->{value} = $CALC->_from_bin($bs);
1706     }
1707   else
1708     {
1709     my $len = CORE::length($$bs)-2;
1710     $len = int($len/8);                         # 8-digit parts, w/o '0b'
1711     my $val; my $i = -8;
1712     while ($len >= 0)
1713       {
1714       $val = substr($$bs,$i,8);
1715       $val =~ s/^[+-]?0b// if $len == 0;        # for last part only
1716       #$val = oct('0b'.$val);   # does not work on Perl prior to 5.6.0
1717       $val = ('0' x (8-CORE::length($val))).$val if CORE::length($val) < 8;
1718       $val = ord(pack('B8',$val));
1719       # print "$val ",substr($$bs,$i,16),"\n";
1720       $i -= 8; $len --;
1721       $x += $mul * $val if $val != 0;
1722       $mul *= $x256 if $len >= 0;               # skip last mul
1723       }
1724     }
1725   $x->{sign} = $sign if !$x->is_zero();
1726   return $x;
1727   }
1728
1729 sub _split
1730   {
1731   # (ref to num_str) return num_str
1732   # internal, take apart a string and return the pieces
1733   # strip leading/trailing whitespace, leading zeros, underscore, reject
1734   # invalid input
1735   my $x = shift;
1736
1737   # strip white space at front, also extranous leading zeros
1738   $$x =~ s/^\s*([-]?)0*([0-9])/$1$2/g;  # will not strip '  .2'
1739   $$x =~ s/^\s+//;                      # but this will
1740   $$x =~ s/\s+$//g;                     # strip white space at end
1741
1742   # shortcut, if nothing to split, return early
1743   if ($$x =~ /^[+-]?\d+$/)
1744     {
1745     $$x =~ s/^([+-])0*([0-9])/$2/; my $sign = $1 || '+';
1746     return (\$sign, $x, \'', \'', \0);
1747     }
1748
1749   # invalid starting char?
1750   return if $$x !~ /^[+-]?(\.?[0-9]|0b[0-1]|0x[0-9a-fA-F])/;
1751
1752   $$x =~ s/(\d)_(\d)/$1$2/g;            # strip underscores between digits
1753   $$x =~ s/(\d)_(\d)/$1$2/g;            # do twice for 1_2_3
1754
1755   return __from_hex($x) if $$x =~ /^[\-\+]?0x/; # hex string
1756   return __from_bin($x) if $$x =~ /^[\-\+]?0b/; # binary string
1757
1758   # some possible inputs:
1759   # 2.1234 # 0.12        # 1          # 1E1 # 2.134E1 # 434E-10 # 1.02009E-2
1760   # .2     # 1_2_3.4_5_6 # 1.4E1_2_3  # 1e3 # +.2
1761
1762   #print "input: '$$x' ";
1763   my ($m,$e) = split /[Ee]/,$$x;
1764   $e = '0' if !defined $e || $e eq "";
1765   # print "m '$m' e '$e'\n";
1766   # sign,value for exponent,mantint,mantfrac
1767   my ($es,$ev,$mis,$miv,$mfv);
1768   # valid exponent?
1769   if ($e =~ /^([+-]?)0*(\d+)$/) # strip leading zeros
1770     {
1771     $es = $1; $ev = $2;
1772     #print "'$m' '$e' e: $es $ev ";
1773     # valid mantissa?
1774     return if $m eq '.' || $m eq '';
1775     my ($mi,$mf) = split /\./,$m;
1776     $mi = '0' if !defined $mi;
1777     $mi .= '0' if $mi =~ /^[\-\+]?$/;
1778     $mf = '0' if !defined $mf || $mf eq '';
1779     if ($mi =~ /^([+-]?)0*(\d+)$/) # strip leading zeros
1780       {
1781       $mis = $1||'+'; $miv = $2;
1782       # print "$mis $miv";
1783       # valid, existing fraction part of mantissa?
1784       return unless ($mf =~ /^(\d*?)0*$/);      # strip trailing zeros
1785       $mfv = $1;
1786       #print " split: $mis $miv . $mfv E $es $ev\n";
1787       return (\$mis,\$miv,\$mfv,\$es,\$ev);
1788       }
1789     }
1790   return; # NaN, not a number
1791   }
1792
1793 sub as_number
1794   {
1795   # an object might be asked to return itself as bigint on certain overloaded
1796   # operations, this does exactly this, so that sub classes can simple inherit
1797   # it or override with their own integer conversion routine
1798   my $self = shift;
1799
1800   $self->copy();
1801   }
1802
1803 sub as_hex
1804   {
1805   # return as hex string, with prefixed 0x
1806   my $x = shift; $x = $class->new($x) if !ref($x);
1807
1808   return $x->bstr() if $x->{sign} !~ /^[+-]$/;  # inf, nan etc
1809   return '0x0' if $x->is_zero();
1810
1811   my $es = ''; my $s = '';
1812   $s = $x->{sign} if $x->{sign} eq '-';
1813   $s .= '0x';
1814   if ($CALC->can('_as_hex'))
1815     {
1816     $es = $CALC->_as_hex($x->{value});
1817     }
1818   else
1819     {
1820     my $x1 = $x->copy()->babs(); my $xr;
1821     my $x100 = Math::BigInt->new (0x100);
1822     while (!$x1->is_zero())
1823       {
1824       ($x1, $xr) = bdiv($x1,$x100);
1825       $es .= unpack('h2',pack('C',$xr->numify()));
1826       }
1827     $es = reverse $es;
1828     $es =~ s/^[0]+//;   # strip leading zeros
1829     }
1830   $s . $es;
1831   }
1832
1833 sub as_bin
1834   {
1835   # return as binary string, with prefixed 0b
1836   my $x = shift; $x = $class->new($x) if !ref($x);
1837
1838   return $x->bstr() if $x->{sign} !~ /^[+-]$/;  # inf, nan etc
1839   return '0b0' if $x->is_zero();
1840
1841   my $es = ''; my $s = '';
1842   $s = $x->{sign} if $x->{sign} eq '-';
1843   $s .= '0b';
1844   if ($CALC->can('_as_bin'))
1845     {
1846     $es = $CALC->_as_bin($x->{value});
1847     }
1848   else
1849     {
1850     my $x1 = $x->copy()->babs(); my $xr;
1851     my $x100 = Math::BigInt->new (0x100);
1852     while (!$x1->is_zero())
1853       {
1854       ($x1, $xr) = bdiv($x1,$x100);
1855       $es .= unpack('b8',pack('C',$xr->numify()));
1856       }
1857     $es = reverse $es;
1858     $es =~ s/^[0]+//;   # strip leading zeros
1859     }
1860   $s . $es;
1861   }
1862
1863 ##############################################################################
1864 # internal calculation routines (others are in Math::BigInt::Calc etc)
1865
1866 sub cmp
1867   {
1868   # post-normalized compare for internal use (honors signs)
1869   # input:  ref to value, ref to value, sign, sign
1870   # output: <0, 0, >0
1871   my ($cx,$cy,$sx,$sy) = @_;
1872
1873   if ($sx eq '+')
1874     {
1875     return 1 if $sy eq '-'; # 0 check handled above
1876     return $CALC->_acmp($cx,$cy);
1877     }
1878   else
1879     {
1880     # $sx eq '-'
1881     return -1 if $sy eq '+';
1882     return $CALC->_acmp($cy,$cx);
1883     }
1884   0; # equal
1885   }
1886
1887 sub _lcm
1888   {
1889   # (BINT or num_str, BINT or num_str) return BINT
1890   # does modify first argument
1891   # LCM
1892
1893   my $x = shift; my $ty = shift;
1894   return $x->bnan() if ($x->{sign} eq $nan) || ($ty->{sign} eq $nan);
1895   return $x * $ty / bgcd($x,$ty);
1896   }
1897
1898 sub __gcd
1899   {
1900   # (BINT or num_str, BINT or num_str) return BINT
1901   # does modify first arg
1902   # GCD -- Euclids algorithm E, Knuth Vol 2 pg 296
1903
1904   my $x = shift; my $ty = $class->new(shift); # preserve y, but make class
1905   return $x->bnan() if $x->{sign} !~ /^[+-]$/ || $ty->{sign} !~ /^[+-]$/;
1906
1907   while (!$ty->is_zero())
1908     {
1909     ($x, $ty) = ($ty,bmod($x,$ty));
1910     }
1911   $x;
1912   }
1913
1914 ###############################################################################
1915 # this method return 0 if the object can be modified, or 1 for not
1916 # We use a fast use constant statement here, to avoid costly calls. Subclasses
1917 # may override it with special code (f.i. Math::BigInt::Constant does so)
1918
1919 sub modify () { 0; }
1920
1921 1;
1922 __END__
1923
1924 =head1 NAME
1925
1926 Math::BigInt - Arbitrary size integer math package
1927
1928 =head1 SYNOPSIS
1929
1930   use Math::BigInt;
1931
1932   # Number creation
1933   $x = Math::BigInt->new($str);         # defaults to 0
1934   $nan  = Math::BigInt->bnan();         # create a NotANumber
1935   $zero = Math::BigInt->bzero();        # create a +0
1936   $inf = Math::BigInt->binf();          # create a +inf
1937   $inf = Math::BigInt->binf('-');       # create a -inf
1938   $one = Math::BigInt->bone();          # create a +1
1939   $one = Math::BigInt->bone('-');       # create a -1
1940
1941   # Testing
1942   $x->is_zero();                # true if arg is +0
1943   $x->is_nan();                 # true if arg is NaN
1944   $x->is_one();                 # true if arg is +1
1945   $x->is_one('-');              # true if arg is -1
1946   $x->is_odd();                 # true if odd, false for even
1947   $x->is_even();                # true if even, false for odd
1948   $x->is_positive();            # true if >= 0
1949   $x->is_negative();            # true if <  0
1950   $x->is_inf(sign);             # true if +inf, or -inf (sign is default '+')
1951
1952   $x->bcmp($y);                 # compare numbers (undef,<0,=0,>0)
1953   $x->bacmp($y);                # compare absolutely (undef,<0,=0,>0)
1954   $x->sign();                   # return the sign, either +,- or NaN
1955   $x->digit($n);                # return the nth digit, counting from right
1956   $x->digit(-$n);               # return the nth digit, counting from left
1957
1958   # The following all modify their first argument:
1959
1960   # set
1961   $x->bzero();                  # set $x to 0
1962   $x->bnan();                   # set $x to NaN
1963   $x->bone();                   # set $x to +1
1964   $x->bone('-');                # set $x to -1
1965
1966   $x->bneg();                   # negation
1967   $x->babs();                   # absolute value
1968   $x->bnorm();                  # normalize (no-op)
1969   $x->bnot();                   # two's complement (bit wise not)
1970   $x->binc();                   # increment x by 1
1971   $x->bdec();                   # decrement x by 1
1972
1973   $x->badd($y);                 # addition (add $y to $x)
1974   $x->bsub($y);                 # subtraction (subtract $y from $x)
1975   $x->bmul($y);                 # multiplication (multiply $x by $y)
1976   $x->bdiv($y);                 # divide, set $x to quotient
1977                                 # return (quo,rem) or quo if scalar
1978
1979   $x->bmod($y);                 # modulus (x % y)
1980   $x->bpow($y);                 # power of arguments (x ** y)
1981   $x->blsft($y);                # left shift
1982   $x->brsft($y);                # right shift
1983   $x->blsft($y,$n);             # left shift, by base $n (like 10)
1984   $x->brsft($y,$n);             # right shift, by base $n (like 10)
1985
1986   $x->band($y);                 # bitwise and
1987   $x->bior($y);                 # bitwise inclusive or
1988   $x->bxor($y);                 # bitwise exclusive or
1989   $x->bnot();                   # bitwise not (two's complement)
1990
1991   $x->bsqrt();                  # calculate square-root
1992
1993   $x->round($A,$P,$round_mode); # round to accuracy or precision using mode $r
1994   $x->bround($N);               # accuracy: preserve $N digits
1995   $x->bfround($N);              # round to $Nth digit, no-op for BigInts
1996
1997   # The following do not modify their arguments in BigInt, but do in BigFloat:
1998   $x->bfloor();                 # return integer less or equal than $x
1999   $x->bceil();                  # return integer greater or equal than $x
2000
2001   # The following do not modify their arguments:
2002
2003   bgcd(@values);                # greatest common divisor
2004   blcm(@values);                # lowest common multiplicator
2005
2006   $x->length();                 # return number of digits in number
2007   ($x,$f) = $x->length();       # length of number and length of fraction part,
2008                                 # latter is always 0 digits long for BigInt's
2009
2010   $x->exponent();               # return exponent as BigInt
2011   $x->mantissa();               # return mantissa as BigInt
2012   $x->parts();                  # return (mantissa,exponent) as BigInt
2013   $x->copy();                   # make a true copy of $x (unlike $y = $x;)
2014   $x->as_number();              # return as BigInt (in BigInt: same as copy())
2015
2016   # conversation to string
2017   $x->bstr();                   # normalized string
2018   $x->bsstr();                  # normalized string in scientific notation
2019   $x->as_hex();                 # as signed hexadecimal string with prefixed 0x
2020   $x->as_bin();                 # as signed binary string with prefixed 0b
2021
2022
2023 =head1 DESCRIPTION
2024
2025 All operators (inlcuding basic math operations) are overloaded if you
2026 declare your big integers as
2027
2028   $i = new Math::BigInt '123_456_789_123_456_789';
2029
2030 Operations with overloaded operators preserve the arguments which is
2031 exactly what you expect.
2032
2033 =over 2
2034
2035 =item Canonical notation
2036
2037 Big integer values are strings of the form C</^[+-]\d+$/> with leading
2038 zeros suppressed.
2039
2040    '-0'                            canonical value '-0', normalized '0'
2041    '   -123_123_123'               canonical value '-123123123'
2042    '1_23_456_7890'                 canonical value '1234567890'
2043
2044 =item Input
2045
2046 Input values to these routines may be either Math::BigInt objects or
2047 strings of the form C</^\s*[+-]?[\d]+\.?[\d]*E?[+-]?[\d]*$/>.
2048
2049 You can include one underscore between any two digits.
2050
2051 This means integer values like 1.01E2 or even 1000E-2 are also accepted.
2052 Non integer values result in NaN.
2053
2054 Math::BigInt::new() defaults to 0, while Math::BigInt::new('') results
2055 in 'NaN'.
2056
2057 bnorm() on a BigInt object is now effectively a no-op, since the numbers
2058 are always stored in normalized form. On a string, it creates a BigInt
2059 object.
2060
2061 =item Output
2062
2063 Output values are BigInt objects (normalized), except for bstr(), which
2064 returns a string in normalized form.
2065 Some routines (C<is_odd()>, C<is_even()>, C<is_zero()>, C<is_one()>,
2066 C<is_nan()>) return true or false, while others (C<bcmp()>, C<bacmp()>)
2067 return either undef, <0, 0 or >0 and are suited for sort.
2068
2069 =back
2070
2071 =head1 ACCURACY and PRECISION
2072
2073 Since version v1.33, Math::BigInt and Math::BigFloat have full support for
2074 accuracy and precision based rounding, both automatically after every
2075 operation as well as manually.
2076
2077 This section describes the accuracy/precision handling in Math::Big* as it
2078 used to be and as it is now, complete with an explanation of all terms and
2079 abbreviations.
2080
2081 Not yet implemented things (but with correct description) are marked with '!',
2082 things that need to be answered are marked with '?'.
2083
2084 In the next paragraph follows a short description of terms used here (because
2085 these may differ from terms used by others people or documentation).
2086
2087 During the rest of this document, the shortcuts A (for accuracy), P (for
2088 precision), F (fallback) and R (rounding mode) will be used.
2089
2090 =head2 Precision P
2091
2092 A fixed number of digits before (positive) or after (negative)
2093 the decimal point. For example, 123.45 has a precision of -2. 0 means an
2094 integer like 123 (or 120). A precision of 2 means two digits to the left
2095 of the decimal point are zero, so 123 with P = 1 becomes 120. Note that
2096 numbers with zeros before the decimal point may have different precisions,
2097 because 1200 can have p = 0, 1 or 2 (depending on what the inital value
2098 was). It could also have p < 0, when the digits after the decimal point
2099 are zero.
2100
2101 The string output (of floating point numbers) will be padded with zeros:
2102
2103         Initial value   P       A       Result          String
2104         ------------------------------------------------------------
2105         1234.01         -3              1000            1000
2106         1234            -2              1200            1200
2107         1234.5          -1              1230            1230
2108         1234.001        1               1234            1234.0
2109         1234.01         0               1234            1234
2110         1234.01         2               1234.01         1234.01
2111         1234.01         5               1234.01         1234.01000
2112
2113 For BigInts, no padding occurs.
2114
2115 =head2 Accuracy A
2116
2117 Number of significant digits. Leading zeros are not counted. A
2118 number may have an accuracy greater than the non-zero digits
2119 when there are zeros in it or trailing zeros. For example, 123.456 has
2120 A of 6, 10203 has 5, 123.0506 has 7, 123.450000 has 8 and 0.000123 has 3.
2121
2122 The string output (of floating point numbers) will be padded with zeros:
2123
2124         Initial value   P       A       Result          String
2125         ------------------------------------------------------------
2126         1234.01                 3       1230            1230
2127         1234.01                 6       1234.01         1234.01
2128         1234.1                  8       1234.1          1234.1000
2129
2130 For BigInts, no padding occurs.
2131
2132 =head2 Fallback F
2133
2134 When both A and P are undefined, this is used as a fallback accuracy when
2135 dividing numbers.
2136
2137 =head2 Rounding mode R
2138
2139 When rounding a number, different 'styles' or 'kinds'
2140 of rounding are possible. (Note that random rounding, as in
2141 Math::Round, is not implemented.)
2142
2143 =over 2
2144
2145 =item 'trunc'
2146
2147 truncation invariably removes all digits following the
2148 rounding place, replacing them with zeros. Thus, 987.65 rounded
2149 to tens (P=1) becomes 980, and rounded to the fourth sigdig
2150 becomes 987.6 (A=4). 123.456 rounded to the second place after the
2151 decimal point (P=-2) becomes 123.46.
2152
2153 All other implemented styles of rounding attempt to round to the
2154 "nearest digit." If the digit D immediately to the right of the
2155 rounding place (skipping the decimal point) is greater than 5, the
2156 number is incremented at the rounding place (possibly causing a
2157 cascade of incrementation): e.g. when rounding to units, 0.9 rounds
2158 to 1, and -19.9 rounds to -20. If D < 5, the number is similarly
2159 truncated at the rounding place: e.g. when rounding to units, 0.4
2160 rounds to 0, and -19.4 rounds to -19.
2161
2162 However the results of other styles of rounding differ if the
2163 digit immediately to the right of the rounding place (skipping the
2164 decimal point) is 5 and if there are no digits, or no digits other
2165 than 0, after that 5. In such cases:
2166
2167 =item 'even'
2168
2169 rounds the digit at the rounding place to 0, 2, 4, 6, or 8
2170 if it is not already. E.g., when rounding to the first sigdig, 0.45
2171 becomes 0.4, -0.55 becomes -0.6, but 0.4501 becomes 0.5.
2172
2173 =item 'odd'
2174
2175 rounds the digit at the rounding place to 1, 3, 5, 7, or 9 if
2176 it is not already. E.g., when rounding to the first sigdig, 0.45
2177 becomes 0.5, -0.55 becomes -0.5, but 0.5501 becomes 0.6.
2178
2179 =item '+inf'
2180
2181 round to plus infinity, i.e. always round up. E.g., when
2182 rounding to the first sigdig, 0.45 becomes 0.5, -0.55 becomes -0.5,
2183 and 0.4501 also becomes 0.5.
2184
2185 =item '-inf'
2186
2187 round to minus infinity, i.e. always round down. E.g., when
2188 rounding to the first sigdig, 0.45 becomes 0.4, -0.55 becomes -0.6,
2189 but 0.4501 becomes 0.5.
2190
2191 =item 'zero'
2192
2193 round to zero, i.e. positive numbers down, negative ones up.
2194 E.g., when rounding to the first sigdig, 0.45 becomes 0.4, -0.55
2195 becomes -0.5, but 0.4501 becomes 0.5.
2196
2197 =back
2198
2199 The handling of A & P in MBI/MBF (the old core code shipped with Perl
2200 versions <= 5.7.2) is like this:
2201
2202 =over 2
2203
2204 =item Precision
2205
2206   * ffround($p) is able to round to $p number of digits after the decimal
2207     point
2208   * otherwise P is unused
2209
2210 =item Accuracy (significant digits)
2211
2212   * fround($a) rounds to $a significant digits
2213   * only fdiv() and fsqrt() take A as (optional) paramater
2214     + other operations simply create the same number (fneg etc), or more (fmul)
2215       of digits
2216     + rounding/truncating is only done when explicitly calling one of fround
2217       or ffround, and never for BigInt (not implemented)
2218   * fsqrt() simply hands its accuracy argument over to fdiv.
2219   * the documentation and the comment in the code indicate two different ways
2220     on how fdiv() determines the maximum number of digits it should calculate,
2221     and the actual code does yet another thing
2222     POD:
2223       max($Math::BigFloat::div_scale,length(dividend)+length(divisor))
2224     Comment:
2225       result has at most max(scale, length(dividend), length(divisor)) digits
2226     Actual code:
2227       scale = max(scale, length(dividend)-1,length(divisor)-1);
2228       scale += length(divisior) - length(dividend);
2229     So for lx = 3, ly = 9, scale = 10, scale will actually be 16 (10+9-3).
2230     Actually, the 'difference' added to the scale is calculated from the
2231     number of "significant digits" in dividend and divisor, which is derived
2232     by looking at the length of the mantissa. Which is wrong, since it includes
2233     the + sign (oups) and actually gets 2 for '+100' and 4 for '+101'. Oups
2234     again. Thus 124/3 with div_scale=1 will get you '41.3' based on the strange
2235     assumption that 124 has 3 significant digits, while 120/7 will get you
2236     '17', not '17.1' since 120 is thought to have 2 significant digits.
2237     The rounding after the division then uses the reminder and $y to determine
2238     wether it must round up or down.
2239  ?  I have no idea which is the right way. That's why I used a slightly more
2240  ?  simple scheme and tweaked the few failing testcases to match it.
2241
2242 =back
2243
2244 This is how it works now:
2245
2246 =over 2
2247
2248 =item Setting/Accessing
2249
2250   * You can set the A global via $Math::BigInt::accuracy or
2251     $Math::BigFloat::accuracy or whatever class you are using.
2252   * You can also set P globally by using $Math::SomeClass::precision likewise.
2253   * Globals are classwide, and not inherited by subclasses.
2254   * to undefine A, use $Math::SomeCLass::accuracy = undef
2255   * to undefine P, use $Math::SomeClass::precision = undef
2256   * To be valid, A must be > 0, P can have any value.
2257   * If P is negative, this means round to the P'th place to the right of the
2258     decimal point; positive values mean to the left of the decimal point.
2259     P of 0 means round to integer.
2260   * to find out the current global A, take $Math::SomeClass::accuracy
2261   * use $x->accuracy() for the local setting of $x.
2262   * to find out the current global P, take $Math::SomeClass::precision
2263   * use $x->precision() for the local setting
2264
2265 =item Creating numbers
2266
2267  !* When you create a number, there should be a way to define its A & P
2268   * When a number without specific A or P is created, but the globals are
2269     defined, these should be used to round the number immediately and also
2270     stored locally with the number. Thus changing the global defaults later on
2271     will not change the A or P of previously created numbers (i.e., A and P of
2272     $x will be what was in effect when $x was created)
2273
2274 =item Usage
2275
2276   * If A or P are enabled/defined, they are used to round the result of each
2277     operation according to the rules below
2278   * Negative P is ignored in Math::BigInt, since BigInts never have digits
2279     after the decimal point
2280   * Math::BigFloat uses Math::BigInts internally, but setting A or P inside
2281     Math::BigInt as globals should not tamper with the parts of a BigFloat.
2282     Thus a flag is used to mark all Math::BigFloat numbers as 'never round'
2283
2284 =item Precedence
2285
2286   * It only makes sense that a number has only one of A or P at a time.
2287     Since you can set/get both A and P, there is a rule that will practically
2288     enforce only A or P to be in effect at a time, even if both are set.
2289     This is called precedence.
2290  !* If two objects are involved in an operation, and one of them has A in
2291  !  effect, and the other P, this should result in a warning or an error,
2292  !  probably in NaN.
2293   * A takes precendence over P (Hint: A comes before P). If A is defined, it
2294     is used, otherwise P is used. If neither of them is defined, nothing is
2295     used, i.e. the result will have as many digits as it can (with an
2296     exception for fdiv/fsqrt) and will not be rounded.
2297   * There is another setting for fdiv() (and thus for fsqrt()). If neither of
2298     A or P is defined, fdiv() will use a fallback (F) of $div_scale digits.
2299     If either the dividend's or the divisor's mantissa has more digits than
2300     the value of F, the higher value will be used instead of F.
2301     This is to limit the digits (A) of the result (just consider what would
2302     happen with unlimited A and P in the case of 1/3 :-)
2303   * fdiv will calculate 1 more digit than required (determined by
2304     A, P or F), and, if F is not used, round the result
2305     (this will still fail in the case of a result like 0.12345000000001 with A
2306     or P of 5, but this can not be helped - or can it?)
2307   * Thus you can have the math done by on Math::Big* class in three modes:
2308     + never round (this is the default):
2309       This is done by setting A and P to undef. No math operation
2310       will round the result, with fdiv() and fsqrt() as exceptions to guard
2311       against overflows. You must explicitely call bround(), bfround() or
2312       round() (the latter with parameters).
2313       Note: Once you have rounded a number, the settings will 'stick' on it
2314       and 'infect' all other numbers engaged in math operations with it, since
2315       local settings have the highest precedence. So, to get SaferRound[tm],
2316       use a copy() before rounding like this:
2317
2318         $x = Math::BigFloat->new(12.34);
2319         $y = Math::BigFloat->new(98.76);
2320         $z = $x * $y;                           # 1218.6984
2321         print $x->copy()->fround(3);            # 12.3 (but A is now 3!)
2322         $z = $x * $y;                           # still 1218.6984, without
2323                                                 # copy would have been 1210!
2324
2325     + round after each op:
2326       After each single operation (except for testing like is_zero()), the
2327       method round() is called and the result is rounded appropriately. By
2328       setting proper values for A and P, you can have all-the-same-A or
2329       all-the-same-P modes. For example, Math::Currency might set A to undef,
2330       and P to -2, globally.
2331
2332  ?Maybe an extra option that forbids local A & P settings would be in order,
2333  ?so that intermediate rounding does not 'poison' further math?
2334
2335 =item Overriding globals
2336
2337   * you will be able to give A, P and R as an argument to all the calculation
2338     routines; the second parameter is A, the third one is P, and the fourth is
2339     R (shift place by one for binary operations like add). P is used only if
2340     the first parameter (A) is undefined. These three parameters override the
2341     globals in the order detailed as follows, i.e. the first defined value
2342     wins:
2343     (local: per object, global: global default, parameter: argument to sub)
2344       + parameter A
2345       + parameter P
2346       + local A (if defined on both of the operands: smaller one is taken)
2347       + local P (if defined on both of the operands: smaller one is taken)
2348       + global A
2349       + global P
2350       + global F
2351   * fsqrt() will hand its arguments to fdiv(), as it used to, only now for two
2352     arguments (A and P) instead of one
2353
2354 =item Local settings
2355
2356   * You can set A and P locally by using $x->accuracy() and $x->precision()
2357     and thus force different A and P for different objects/numbers.
2358   * Setting A or P this way immediately rounds $x to the new value.
2359
2360 =item Rounding
2361
2362   * the rounding routines will use the respective global or local settings.
2363     fround()/bround() is for accuracy rounding, while ffround()/bfround()
2364     is for precision
2365   * the two rounding functions take as the second parameter one of the
2366     following rounding modes (R):
2367     'even', 'odd', '+inf', '-inf', 'zero', 'trunc'
2368   * you can set and get the global R by using Math::SomeClass->round_mode()
2369     or by setting $Math::SomeClass::rnd_mode
2370   * after each operation, $result->round() is called, and the result may
2371     eventually be rounded (that is, if A or P were set either locally,
2372     globally or as parameter to the operation)
2373   * to manually round a number, call $x->round($A,$P,$rnd_mode);
2374     this will round the number by using the appropriate rounding function
2375     and then normalize it.
2376   * rounding modifies the local settings of the number:
2377
2378         $x = Math::BigFloat->new(123.456);
2379         $x->accuracy(5);
2380         $x->bround(4);
2381
2382     Here 4 takes precedence over 5, so 123.5 is the result and $x->accuracy()
2383     will be 4 from now on.
2384
2385 =item Default values
2386
2387   * R: 'even'
2388   * F: 40
2389   * A: undef
2390   * P: undef
2391
2392 =item Remarks
2393
2394   * The defaults are set up so that the new code gives the same results as
2395     the old code (except in a few cases on fdiv):
2396     + Both A and P are undefined and thus will not be used for rounding
2397       after each operation.
2398     + round() is thus a no-op, unless given extra parameters A and P
2399
2400 =back
2401
2402 =head1 INTERNALS
2403
2404 The actual numbers are stored as unsigned big integers (with seperate sign).
2405 You should neither care about nor depend on the internal representation; it
2406 might change without notice. Use only method calls like C<< $x->sign(); >>
2407 instead relying on the internal hash keys like in C<< $x->{sign}; >>.
2408
2409 =head2 MATH LIBRARY
2410
2411 Math with the numbers is done (by default) by a module called
2412 Math::BigInt::Calc. This is equivalent to saying:
2413
2414         use Math::BigInt lib => 'Calc';
2415
2416 You can change this by using:
2417
2418         use Math::BigInt lib => 'BitVect';
2419
2420 The following would first try to find Math::BigInt::Foo, then
2421 Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
2422
2423         use Math::BigInt lib => 'Foo,Math::BigInt::Bar';
2424
2425 Calc.pm uses as internal format an array of elements of some decimal base
2426 (usually 1e5, but this might change to 1e7) with the least significant digit
2427 first, while BitVect.pm uses a bit vector of base 2, most significant bit
2428 first. Other modules might use even different means of representing the
2429 numbers. See the respective module documentation for further details.
2430
2431 =head2 SIGN
2432
2433 The sign is either '+', '-', 'NaN', '+inf' or '-inf' and stored seperately.
2434
2435 A sign of 'NaN' is used to represent the result when input arguments are not
2436 numbers or as a result of 0/0. '+inf' and '-inf' represent plus respectively
2437 minus infinity. You will get '+inf' when dividing a positive number by 0, and
2438 '-inf' when dividing any negative number by 0.
2439
2440 =head2 mantissa(), exponent() and parts()
2441
2442 C<mantissa()> and C<exponent()> return the said parts of the BigInt such
2443 that:
2444
2445         $m = $x->mantissa();
2446         $e = $x->exponent();
2447         $y = $m * ( 10 ** $e );
2448         print "ok\n" if $x == $y;
2449
2450 C<< ($m,$e) = $x->parts() >> is just a shortcut that gives you both of them
2451 in one go. Both the returned mantissa and exponent have a sign.
2452
2453 Currently, for BigInts C<$e> will be always 0, except for NaN, +inf and -inf,
2454 where it will be NaN; and for $x == 0, where it will be 1
2455 (to be compatible with Math::BigFloat's internal representation of a zero as
2456 C<0E1>).
2457
2458 C<$m> will always be a copy of the original number. The relation between $e
2459 and $m might change in the future, but will always be equivalent in a
2460 numerical sense, e.g. $m might get minimized.
2461
2462 =head1 EXAMPLES
2463
2464   use Math::BigInt qw(bstr);
2465
2466   sub bint { Math::BigInt->new(shift); }
2467
2468   $x = bstr("1234")                     # string "1234"
2469   $x = "$x";                            # same as bstr()
2470   $x = bneg("1234")                     # Bigint "-1234"
2471   $x = Math::BigInt->bneg("1234");      # Bigint "-1234"
2472   $x = Math::BigInt->babs("-12345");    # Bigint "12345"
2473   $x = Math::BigInt->bnorm("-0 00");    # BigInt "0"
2474   $x = bint(1) + bint(2);               # BigInt "3"
2475   $x = bint(1) + "2";                   # ditto (auto-BigIntify of "2")
2476   $x = bint(1);                         # BigInt "1"
2477   $x = $x + 5 / 2;                      # BigInt "3"
2478   $x = $x ** 3;                         # BigInt "27"
2479   $x *= 2;                              # BigInt "54"
2480   $x = new Math::BigInt;                # BigInt "0"
2481   $x--;                                 # BigInt "-1"
2482   $x = Math::BigInt->badd(4,5)          # BigInt "9"
2483   $x = Math::BigInt::badd(4,5)          # BigInt "9"
2484   print $x->bsstr();                    # 9e+0
2485
2486 Examples for rounding:
2487
2488   use Math::BigFloat;
2489   use Test;
2490
2491   $x = Math::BigFloat->new(123.4567);
2492   $y = Math::BigFloat->new(123.456789);
2493   $Math::BigFloat::accuracy = 4;        # no more A than 4
2494
2495   ok ($x->copy()->fround(),123.4);      # even rounding
2496   print $x->copy()->fround(),"\n";      # 123.4
2497   Math::BigFloat->round_mode('odd');    # round to odd
2498   print $x->copy()->fround(),"\n";      # 123.5
2499   $Math::BigFloat::accuracy = 5;        # no more A than 5
2500   Math::BigFloat->round_mode('odd');    # round to odd
2501   print $x->copy()->fround(),"\n";      # 123.46
2502   $y = $x->copy()->fround(4),"\n";      # A = 4: 123.4
2503   print "$y, ",$y->accuracy(),"\n";     # 123.4, 4
2504
2505   $Math::BigFloat::accuracy = undef;    # A not important
2506   $Math::BigFloat::precision = 2;       # P important
2507   print $x->copy()->bnorm(),"\n";       # 123.46
2508   print $x->copy()->fround(),"\n";      # 123.46
2509
2510 Examples for converting:
2511
2512   my $x = Math::BigInt->new('0b1'.'01' x 123);
2513   print "bin: ",$x->as_bin()," hex:",$x->as_hex()," dec: ",$x,"\n";
2514
2515 =head1 Autocreating constants
2516
2517 After C<use Math::BigInt ':constant'> all the B<integer> decimal constants
2518 in the given scope are converted to C<Math::BigInt>. This conversion
2519 happens at compile time.
2520
2521 In particular,
2522
2523   perl -MMath::BigInt=:constant -e 'print 2**100,"\n"'
2524
2525 prints the integer value of C<2**100>.  Note that without conversion of
2526 constants the expression 2**100 will be calculated as perl scalar.
2527
2528 Please note that strings and floating point constants are not affected,
2529 so that
2530
2531         use Math::BigInt qw/:constant/;
2532
2533         $x = 1234567890123456789012345678901234567890
2534                 + 123456789123456789;
2535         $y = '1234567890123456789012345678901234567890'
2536                 + '123456789123456789';
2537
2538 do not work. You need an explicit Math::BigInt->new() around one of the
2539 operands.
2540
2541 =head1 PERFORMANCE
2542
2543 Using the form $x += $y; etc over $x = $x + $y is faster, since a copy of $x
2544 must be made in the second case. For long numbers, the copy can eat up to 20%
2545 of the work (in the case of addition/subtraction, less for
2546 multiplication/division). If $y is very small compared to $x, the form
2547 $x += $y is MUCH faster than $x = $x + $y since making the copy of $x takes
2548 more time then the actual addition.
2549
2550 With a technique called copy-on-write, the cost of copying with overload could
2551 be minimized or even completely avoided. This is currently not implemented.
2552
2553 The new version of this module is slower on new(), bstr() and numify(). Some
2554 operations may be slower for small numbers, but are significantly faster for
2555 big numbers. Other operations are now constant (O(1), like bneg(), babs()
2556 etc), instead of O(N) and thus nearly always take much less time.
2557
2558 If you find the Calc module to slow, try to install any of the replacement
2559 modules and see if they help you.
2560
2561 =head2 Alternative math libraries
2562
2563 You can use an alternative library to drive Math::BigInt via:
2564
2565         use Math::BigInt lib => 'Module';
2566
2567 The default is called Math::BigInt::Calc and is a pure-perl implementation
2568 that consists mainly of the standard routine present in earlier versions of
2569 Math::BigInt.
2570
2571 There are also Math::BigInt::Scalar (primarily for testing) and
2572 Math::BigInt::BitVect; as well as Math::BigInt::Pari and likely others.
2573 All these can be found via L<http://search.cpan.org/>:
2574
2575         use Math::BigInt lib => 'BitVect';
2576
2577         my $x = Math::BigInt->new(2);
2578         print $x ** (1024*1024);
2579
2580 For more benchmark results see http://bloodgate.com/perl/benchmarks.html
2581
2582 =head1 BUGS
2583
2584 =over 2
2585
2586 =item Out of Memory!
2587
2588 Under Perl prior to 5.6.0 having an C<use Math::BigInt ':constant';> and
2589 C<eval()> in your code will crash with "Out of memory". This is probably an
2590 overload/exporter bug. You can workaround by not having C<eval()>
2591 and ':constant' at the same time or upgrade your Perl to a newer version.
2592
2593 =item Fails to load Calc on Perl prior 5.6.0
2594
2595 Since eval(' use ...') can not be used in conjunction with ':constant', BigInt
2596 will fall back to eval { require ... } when loading the math lib on Perls
2597 prior to 5.6.0. This simple replaces '::' with '/' and thus might fail on
2598 filesystems using a different seperator.
2599
2600 =back
2601
2602 =head1 CAVEATS
2603
2604 Some things might not work as you expect them. Below is documented what is
2605 known to be troublesome:
2606
2607 =over 1
2608
2609 =item stringify, bstr(), bsstr() and 'cmp'
2610
2611 Both stringify and bstr() now drop the leading '+'. The old code would return
2612 '+3', the new returns '3'. This is to be consistent with Perl and to make
2613 cmp (especially with overloading) to work as you expect. It also solves
2614 problems with Test.pm, it's ok() uses 'eq' internally.
2615
2616 Mark said, when asked about to drop the '+' altogether, or make only cmp work:
2617
2618         I agree (with the first alternative), don't add the '+' on positive
2619         numbers.  It's not as important anymore with the new internal
2620         form for numbers.  It made doing things like abs and neg easier,
2621         but those have to be done differently now anyway.
2622
2623 So, the following examples will now work all as expected:
2624
2625         use Test;
2626         BEGIN { plan tests => 1 }
2627         use Math::BigInt;
2628
2629         my $x = new Math::BigInt 3*3;
2630         my $y = new Math::BigInt 3*3;
2631
2632         ok ($x,3*3);
2633         print "$x eq 9" if $x eq $y;
2634         print "$x eq 9" if $x eq '9';
2635         print "$x eq 9" if $x eq 3*3;
2636
2637 Additionally, the following still works:
2638
2639         print "$x == 9" if $x == $y;
2640         print "$x == 9" if $x == 9;
2641         print "$x == 9" if $x == 3*3;
2642
2643 There is now a C<bsstr()> method to get the string in scientific notation aka
2644 C<1e+2> instead of C<100>. Be advised that overloaded 'eq' always uses bstr()
2645 for comparisation, but Perl will represent some numbers as 100 and others
2646 as 1e+308. If in doubt, convert both arguments to Math::BigInt before doing eq:
2647
2648         use Test;
2649         BEGIN { plan tests => 3 }
2650         use Math::BigInt;
2651
2652         $x = Math::BigInt->new('1e56'); $y = 1e56;
2653         ok ($x,$y);                     # will fail
2654         ok ($x->bsstr(),$y);            # okay
2655         $y = Math::BigInt->new($y);
2656         ok ($x,$y);                     # okay
2657
2658 There is not yet a way to get a number automatically represented in exactly
2659 the way Perl represents it.
2660
2661 =item int()
2662
2663 C<int()> will return (at least for Perl v5.7.1 and up) another BigInt, not a
2664 Perl scalar:
2665
2666         $x = Math::BigInt->new(123);
2667         $y = int($x);                           # BigInt 123
2668         $x = Math::BigFloat->new(123.45);
2669         $y = int($x);                           # BigInt 123
2670
2671 In all Perl versions you can use C<as_number()> for the same effect:
2672
2673         $x = Math::BigFloat->new(123.45);
2674         $y = $x->as_number();                   # BigInt 123
2675
2676 This also works for other subclasses, like Math::String.
2677
2678 It is yet unlcear whether overloaded int() should return a scalar or a BigInt.
2679
2680 =item bdiv
2681
2682 The following will probably not do what you expect:
2683
2684         $c = Math::BigInt->new(123);
2685         print $c->length(),"\n";                # prints 30
2686
2687 It prints both the number of digits in the number and in the fraction part
2688 since print calls C<length()> in list context. Use something like:
2689
2690         print scalar $c->length(),"\n";         # prints 3
2691
2692 =item bdiv
2693
2694 The following will probably not do what you expect:
2695
2696         print $c->bdiv(10000),"\n";
2697
2698 It prints both quotient and reminder since print calls C<bdiv()> in list
2699 context. Also, C<bdiv()> will modify $c, so be carefull. You probably want
2700 to use
2701
2702         print $c / 10000,"\n";
2703         print scalar $c->bdiv(10000),"\n";  # or if you want to modify $c
2704
2705 instead.
2706
2707 The quotient is always the greatest integer less than or equal to the
2708 real-valued quotient of the two operands, and the remainder (when it is
2709 nonzero) always has the same sign as the second operand; so, for
2710 example,
2711
2712          1 / 4  => ( 0, 1)
2713          1 / -4 => (-1,-3)
2714         -3 / 4  => (-1, 1)
2715         -3 / -4 => ( 0,-3)
2716
2717 As a consequence, the behavior of the operator % agrees with the
2718 behavior of Perl's built-in % operator (as documented in the perlop
2719 manpage), and the equation
2720
2721         $x == ($x / $y) * $y + ($x % $y)
2722
2723 holds true for any $x and $y, which justifies calling the two return
2724 values of bdiv() the quotient and remainder.
2725
2726 Perl's 'use integer;' changes the behaviour of % and / for scalars, but will
2727 not change BigInt's way to do things. This is because under 'use integer' Perl
2728 will do what the underlying C thinks is right and this is different for each
2729 system. If you need BigInt's behaving exactly like Perl's 'use integer', bug
2730 the author to implement it ;)
2731
2732 =item Modifying and =
2733
2734 Beware of:
2735
2736         $x = Math::BigFloat->new(5);
2737         $y = $x;
2738
2739 It will not do what you think, e.g. making a copy of $x. Instead it just makes
2740 a second reference to the B<same> object and stores it in $y. Thus anything
2741 that modifies $x (except overloaded operators) will modify $y, and vice versa.
2742 Or in other words, C<=> is only safe if you modify your BigInts only via
2743 overloaded math. As soon as you use a method call it breaks:
2744
2745         $x->bmul(2);
2746         print "$x, $y\n";       # prints '10, 10'
2747
2748 If you want a true copy of $x, use:
2749
2750         $y = $x->copy();
2751
2752 You can also chain the calls like this, this will make first a copy and then
2753 multiply it by 2:
2754
2755         $y = $x->copy()->bmul(2);
2756
2757 See also the documentation for overload.pm regarding C<=>.
2758
2759 =item bpow
2760
2761 C<bpow()> (and the rounding functions) now modifies the first argument and
2762 returns it, unlike the old code which left it alone and only returned the
2763 result. This is to be consistent with C<badd()> etc. The first three will
2764 modify $x, the last one won't:
2765
2766         print bpow($x,$i),"\n";         # modify $x
2767         print $x->bpow($i),"\n";        # ditto
2768         print $x **= $i,"\n";           # the same
2769         print $x ** $i,"\n";            # leave $x alone
2770
2771 The form C<$x **= $y> is faster than C<$x = $x ** $y;>, though.
2772
2773 =item Overloading -$x
2774
2775 The following:
2776
2777         $x = -$x;
2778
2779 is slower than
2780
2781         $x->bneg();
2782
2783 since overload calls C<sub($x,0,1);> instead of C<neg($x)>. The first variant
2784 needs to preserve $x since it does not know that it later will get overwritten.
2785 This makes a copy of $x and takes O(N), but $x->bneg() is O(1).
2786
2787 With Copy-On-Write, this issue will be gone. Stay tuned...
2788
2789 =item Mixing different object types
2790
2791 In Perl you will get a floating point value if you do one of the following:
2792
2793         $float = 5.0 + 2;
2794         $float = 2 + 5.0;
2795         $float = 5 / 2;
2796
2797 With overloaded math, only the first two variants will result in a BigFloat:
2798
2799         use Math::BigInt;
2800         use Math::BigFloat;
2801
2802         $mbf = Math::BigFloat->new(5);
2803         $mbi2 = Math::BigInteger->new(5);
2804         $mbi = Math::BigInteger->new(2);
2805
2806                                         # what actually gets called:
2807         $float = $mbf + $mbi;           # $mbf->badd()
2808         $float = $mbf / $mbi;           # $mbf->bdiv()
2809         $integer = $mbi + $mbf;         # $mbi->badd()
2810         $integer = $mbi2 / $mbi;        # $mbi2->bdiv()
2811         $integer = $mbi2 / $mbf;        # $mbi2->bdiv()
2812
2813 This is because math with overloaded operators follows the first (dominating)
2814 operand, this one's operation is called and returns thus the result. So,
2815 Math::BigInt::bdiv() will always return a Math::BigInt, regardless whether
2816 the result should be a Math::BigFloat or the second operant is one.
2817
2818 To get a Math::BigFloat you either need to call the operation manually,
2819 make sure the operands are already of the proper type or casted to that type
2820 via Math::BigFloat->new():
2821
2822         $float = Math::BigFloat->new($mbi2) / $mbi;     # = 2.5
2823
2824 Beware of simple "casting" the entire expression, this would only convert
2825 the already computed result:
2826
2827         $float = Math::BigFloat->new($mbi2 / $mbi);     # = 2.0 thus wrong!
2828
2829 Beware also of the order of more complicated expressions like:
2830
2831         $integer = ($mbi2 + $mbi) / $mbf;               # int / float => int
2832         $integer = $mbi2 / Math::BigFloat->new($mbi);   # ditto
2833
2834 If in doubt, break the expression into simpler terms, or cast all operands
2835 to the desired resulting type.
2836
2837 Scalar values are a bit different, since:
2838
2839         $float = 2 + $mbf;
2840         $float = $mbf + 2;
2841
2842 will both result in the proper type due to the way the overloaded math works.
2843
2844 This section also applies to other overloaded math packages, like Math::String.
2845
2846 =item bsqrt()
2847
2848 C<bsqrt()> works only good if the result is an big integer, e.g. the square
2849 root of 144 is 12, but from 12 the square root is 3, regardless of rounding
2850 mode.
2851
2852 If you want a better approximation of the square root, then use:
2853
2854         $x = Math::BigFloat->new(12);
2855         $Math::BigFloat::precision = 0;
2856         Math::BigFloat->round_mode('even');
2857         print $x->copy->bsqrt(),"\n";           # 4
2858
2859         $Math::BigFloat::precision = 2;
2860         print $x->bsqrt(),"\n";                 # 3.46
2861         print $x->bsqrt(3),"\n";                # 3.464
2862
2863 =back
2864
2865 =head1 LICENSE
2866
2867 This program is free software; you may redistribute it and/or modify it under
2868 the same terms as Perl itself.
2869
2870 =head1 SEE ALSO
2871
2872 L<Math::BigFloat> and L<Math::Big>.
2873
2874 L<Math::BigInt::BitVect> and L<Math::BigInt::Pari>.
2875
2876 =head1 AUTHORS
2877
2878 Original code by Mark Biggar, overloaded interface by Ilya Zakharevich.
2879 Completely rewritten by Tels http://bloodgate.com in late 2000, 2001.
2880
2881 =cut