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