home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 June / PCWorld_2005-06_cd.bin / software / vyzkuste / firewally / firewally.exe / framework-2.3.exe / BigFloat.pm < prev    next >
Text File  |  2003-11-07  |  84KB  |  2,742 lines

  1. package Math::BigFloat;
  2.  
  3. # Mike grinned. 'Two down, infinity to go' - Mike Nostrus in 'Before and After'
  4. #
  5.  
  6. # The following hash values are internally used:
  7. #   _e: exponent (BigInt)
  8. #   _m: mantissa (absolute BigInt)
  9. # sign: +,-,+inf,-inf, or "NaN" if not a number
  10. #   _a: accuracy
  11. #   _p: precision
  12. #   _f: flags, used to signal MBI not to touch our private parts
  13.  
  14. $VERSION = '1.40';
  15. require 5.005;
  16. use Exporter;
  17. @ISA =       qw(Exporter Math::BigInt);
  18.  
  19. use strict;
  20. use vars qw/$AUTOLOAD $accuracy $precision $div_scale $round_mode $rnd_mode/;
  21. use vars qw/$upgrade $downgrade/;
  22. # the following are internal and should never be accessed from the outside
  23. use vars qw/$_trap_nan $_trap_inf/;
  24. my $class = "Math::BigFloat";
  25.  
  26. use overload
  27. '<=>'    =>    sub { $_[2] ?
  28.                       ref($_[0])->bcmp($_[1],$_[0]) : 
  29.                       ref($_[0])->bcmp($_[0],$_[1])},
  30. 'int'    =>    sub { $_[0]->as_number() },        # 'trunc' to bigint
  31. ;
  32.  
  33. ##############################################################################
  34. # global constants, flags and assorted stuff
  35.  
  36. # the following are public, but their usage is not recommended. Use the
  37. # accessor methods instead.
  38.  
  39. # class constants, use Class->constant_name() to access
  40. $round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'
  41. $accuracy   = undef;
  42. $precision  = undef;
  43. $div_scale  = 40;
  44.  
  45. $upgrade = undef;
  46. $downgrade = undef;
  47. my $MBI = 'Math::BigInt'; # the package we are using for our private parts
  48.               # changable by use Math::BigFloat with => 'package'
  49.  
  50. # the following are private and not to be used from the outside:
  51.  
  52. use constant MB_NEVER_ROUND => 0x0001;
  53.  
  54. # are NaNs ok? (otherwise it dies when encountering an NaN) set w/ config()
  55. $_trap_nan = 0;
  56. # the same for infs
  57. $_trap_inf = 0;
  58.  
  59. # constant for easier life
  60. my $nan = 'NaN'; 
  61.  
  62. my $IMPORT = 0;                         # was import() called yet?
  63.                                         # used to make require work
  64.  
  65. # some digits of accuracy for blog(undef,10); which we use in blog() for speed
  66. my $LOG_10 = 
  67.  '2.3025850929940456840179914546843642076011014886287729760333279009675726097';
  68. my $LOG_10_A = length($LOG_10)-1;
  69. # ditto for log(2)
  70. my $LOG_2 = 
  71.  '0.6931471805599453094172321214581765680755001343602552541206800094933936220';
  72. my $LOG_2_A = length($LOG_2)-1;
  73.  
  74. ##############################################################################
  75. # the old code had $rnd_mode, so we need to support it, too
  76.  
  77. sub TIESCALAR   { my ($class) = @_; bless \$round_mode, $class; }
  78. sub FETCH       { return $round_mode; }
  79. sub STORE       { $rnd_mode = $_[0]->round_mode($_[1]); }
  80.  
  81. BEGIN
  82.   {
  83.   # when someone set's $rnd_mode, we catch this and check the value to see
  84.   # whether it is valid or not. 
  85.   $rnd_mode   = 'even'; tie $rnd_mode, 'Math::BigFloat'; 
  86.   }
  87.  
  88. ##############################################################################
  89.  
  90. # in case we call SUPER::->foo() and this wants to call modify()
  91. # sub modify () { 0; }
  92.  
  93. {
  94.   # valid method aliases for AUTOLOAD
  95.   my %methods = map { $_ => 1 }  
  96.    qw / fadd fsub fmul fdiv fround ffround fsqrt fmod fstr fsstr fpow fnorm
  97.         fint facmp fcmp fzero fnan finf finc fdec flog ffac
  98.     fceil ffloor frsft flsft fone flog froot
  99.       /;
  100.   # valid method's that can be hand-ed up (for AUTOLOAD)
  101.   my %hand_ups = map { $_ => 1 }  
  102.    qw / is_nan is_inf is_negative is_positive
  103.         accuracy precision div_scale round_mode fneg fabs fnot
  104.         objectify upgrade downgrade
  105.     bone binf bnan bzero
  106.       /;
  107.  
  108.   sub method_alias { return exists $methods{$_[0]||''}; } 
  109.   sub method_hand_up { return exists $hand_ups{$_[0]||''}; } 
  110. }
  111.  
  112. ##############################################################################
  113. # constructors
  114.  
  115. sub new 
  116.   {
  117.   # create a new BigFloat object from a string or another bigfloat object. 
  118.   # _e: exponent
  119.   # _m: mantissa
  120.   # sign  => sign (+/-), or "NaN"
  121.  
  122.   my ($class,$wanted,@r) = @_;
  123.  
  124.   # avoid numify-calls by not using || on $wanted!
  125.   return $class->bzero() if !defined $wanted;    # default to 0
  126.   return $wanted->copy() if UNIVERSAL::isa($wanted,'Math::BigFloat');
  127.  
  128.   $class->import() if $IMPORT == 0;             # make require work
  129.  
  130.   my $self = {}; bless $self, $class;
  131.   # shortcut for bigints and its subclasses
  132.   if ((ref($wanted)) && (ref($wanted) ne $class))
  133.     {
  134.     $self->{_m} = $wanted->as_number();        # get us a bigint copy
  135.     $self->{_e} = $MBI->bzero();
  136.     $self->{_m}->babs();
  137.     $self->{sign} = $wanted->sign();
  138.     return $self->bnorm();
  139.     }
  140.   # got string
  141.   # handle '+inf', '-inf' first
  142.   if ($wanted =~ /^[+-]?inf$/)
  143.     {
  144.     return $downgrade->new($wanted) if $downgrade;
  145.  
  146.     $self->{_e} = $MBI->bzero();
  147.     $self->{_m} = $MBI->bzero();
  148.     $self->{sign} = $wanted;
  149.     $self->{sign} = '+inf' if $self->{sign} eq 'inf';
  150.     return $self->bnorm();
  151.     }
  152.   #print "new string '$wanted'\n";
  153.   my ($mis,$miv,$mfv,$es,$ev) = Math::BigInt::_split(\$wanted);
  154.   if (!ref $mis)
  155.     {
  156.     if ($_trap_nan)
  157.       {
  158.       require Carp;
  159.       Carp::croak ("$wanted is not a number initialized to $class");
  160.       }
  161.     
  162.     return $downgrade->bnan() if $downgrade;
  163.     
  164.     $self->{_e} = $MBI->bzero();
  165.     $self->{_m} = $MBI->bzero();
  166.     $self->{sign} = $nan;
  167.     }
  168.   else
  169.     {
  170.     # make integer from mantissa by adjusting exp, then convert to bigint
  171.     # undef,undef to signal MBI that we don't need no bloody rounding
  172.     $self->{_e} = $MBI->new("$$es$$ev",undef,undef);    # exponent
  173.     $self->{_m} = $MBI->new("$$miv$$mfv",undef,undef);     # create mant.
  174.     # 3.123E0 = 3123E-3, and 3.123E-2 => 3123E-5
  175.     $self->{_e} -= CORE::length($$mfv) if CORE::length($$mfv) != 0;         
  176.     $self->{sign} = $$mis;
  177.     }
  178.   # if downgrade, inf, NaN or integers go down
  179.  
  180.   if ($downgrade && $self->{_e}->{sign} eq '+')
  181.     {
  182.     #print "downgrading $$miv$$mfv"."E$$es$$ev";
  183.     if ($self->{_e}->is_zero())
  184.       {
  185.       $self->{_m}->{sign} = $$mis;        # negative if wanted
  186.       return $downgrade->new($self->{_m});
  187.       }
  188.     return $downgrade->new("$$mis$$miv$$mfv"."E$$es$$ev");
  189.     }
  190.   #print "mbf new $self->{sign} $self->{_m} e $self->{_e} ",ref($self),"\n";
  191.   $self->bnorm()->round(@r);            # first normalize, then round
  192.   }
  193.  
  194. sub _bnan
  195.   {
  196.   # used by parent class bone() to initialize number to NaN
  197.   my $self = shift;
  198.   
  199.   if ($_trap_nan)
  200.     {
  201.     require Carp;
  202.     my $class = ref($self);
  203.     Carp::croak ("Tried to set $self to NaN in $class\::_bnan()");
  204.     }
  205.  
  206.   $IMPORT=1;                    # call our import only once
  207.   $self->{_m} = $MBI->bzero();
  208.   $self->{_e} = $MBI->bzero();
  209.   }
  210.  
  211. sub _binf
  212.   {
  213.   # used by parent class bone() to initialize number to +-inf
  214.   my $self = shift;
  215.   
  216.   if ($_trap_inf)
  217.     {
  218.     require Carp;
  219.     my $class = ref($self);
  220.     Carp::croak ("Tried to set $self to +-inf in $class\::_binf()");
  221.     }
  222.  
  223.   $IMPORT=1;                    # call our import only once
  224.   $self->{_m} = $MBI->bzero();
  225.   $self->{_e} = $MBI->bzero();
  226.   }
  227.  
  228. sub _bone
  229.   {
  230.   # used by parent class bone() to initialize number to 1
  231.   my $self = shift;
  232.   $IMPORT=1;                    # call our import only once
  233.   $self->{_m} = $MBI->bone();
  234.   $self->{_e} = $MBI->bzero();
  235.   }
  236.  
  237. sub _bzero
  238.   {
  239.   # used by parent class bone() to initialize number to 0
  240.   my $self = shift;
  241.   $IMPORT=1;                    # call our import only once
  242.   $self->{_m} = $MBI->bzero();
  243.   $self->{_e} = $MBI->bone();
  244.   }
  245.  
  246. sub isa
  247.   {
  248.   my ($self,$class) = @_;
  249.   return if $class =~ /^Math::BigInt/;        # we aren't one of these
  250.   UNIVERSAL::isa($self,$class);
  251.   }
  252.  
  253. sub config
  254.   {
  255.   # return (later set?) configuration data as hash ref
  256.   my $class = shift || 'Math::BigFloat';
  257.  
  258.   my $cfg = $class->SUPER::config(@_);
  259.  
  260.   # now we need only to override the ones that are different from our parent
  261.   $cfg->{class} = $class;
  262.   $cfg->{with} = $MBI;
  263.   $cfg;
  264.   }
  265.  
  266. ##############################################################################
  267. # string conversation
  268.  
  269. sub bstr 
  270.   {
  271.   # (ref to BFLOAT or num_str ) return num_str
  272.   # Convert number from internal format to (non-scientific) string format.
  273.   # internal format is always normalized (no leading zeros, "-0" => "+0")
  274.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  275.  
  276.   if ($x->{sign} !~ /^[+-]$/)
  277.     {
  278.     return $x->{sign} unless $x->{sign} eq '+inf';      # -inf, NaN
  279.     return 'inf';                                       # +inf
  280.     }
  281.  
  282.   my $es = '0'; my $len = 1; my $cad = 0; my $dot = '.';
  283.  
  284.   # $x is zero?
  285.   my $not_zero = !($x->{sign} eq '+' && $x->{_m}->is_zero());
  286.   if ($not_zero)
  287.     {
  288.     $es = $x->{_m}->bstr();
  289.     $len = CORE::length($es);
  290.     my $e = $x->{_e}->numify();    
  291.     if ($e < 0)
  292.       {
  293.       $dot = '';
  294.       # if _e is bigger than a scalar, the following will blow your memory
  295.       if ($e <= -$len)
  296.         {
  297.         #print "style: 0.xxxx\n";
  298.         my $r = abs($e) - $len;
  299.         $es = '0.'. ('0' x $r) . $es; $cad = -($len+$r);
  300.         }
  301.       else
  302.         {
  303.         #print "insert '.' at $e in '$es'\n";
  304.         substr($es,$e,0) = '.'; $cad = $x->{_e};
  305.         }
  306.       }
  307.     elsif ($e > 0)
  308.       {
  309.       # expand with zeros
  310.       $es .= '0' x $e; $len += $e; $cad = 0;
  311.       }
  312.     } # if not zero
  313.   $es = '-'.$es if $x->{sign} eq '-';
  314.   # if set accuracy or precision, pad with zeros on the right side
  315.   if ((defined $x->{_a}) && ($not_zero))
  316.     {
  317.     # 123400 => 6, 0.1234 => 4, 0.001234 => 4
  318.     my $zeros = $x->{_a} - $cad;        # cad == 0 => 12340
  319.     $zeros = $x->{_a} - $len if $cad != $len;
  320.     $es .= $dot.'0' x $zeros if $zeros > 0;
  321.     }
  322.   elsif ((($x->{_p} || 0) < 0))
  323.     {
  324.     # 123400 => 6, 0.1234 => 4, 0.001234 => 6
  325.     my $zeros = -$x->{_p} + $cad;
  326.     $es .= $dot.'0' x $zeros if $zeros > 0;
  327.     }
  328.   $es;
  329.   }
  330.  
  331. sub bsstr
  332.   {
  333.   # (ref to BFLOAT or num_str ) return num_str
  334.   # Convert number from internal format to scientific string format.
  335.   # internal format is always normalized (no leading zeros, "-0E0" => "+0E0")
  336.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  337.   #my $x = shift; my $class = ref($x) || $x;
  338.   #$x = $class->new(shift) unless ref($x);
  339.  
  340.   if ($x->{sign} !~ /^[+-]$/)
  341.     {
  342.     return $x->{sign} unless $x->{sign} eq '+inf';      # -inf, NaN
  343.     return 'inf';                                       # +inf
  344.     }
  345.   my $esign = $x->{_e}->{sign}; $esign = '' if $esign eq '-';
  346.   my $sep = 'e'.$esign;
  347.   my $sign = $x->{sign}; $sign = '' if $sign eq '+';
  348.   $sign . $x->{_m}->bstr() . $sep . $x->{_e}->bstr();
  349.   }
  350.     
  351. sub numify 
  352.   {
  353.   # Make a number from a BigFloat object
  354.   # simple return string and let Perl's atoi()/atof() handle the rest
  355.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  356.   $x->bsstr(); 
  357.   }
  358.  
  359. ##############################################################################
  360. # public stuff (usually prefixed with "b")
  361.  
  362. # tels 2001-08-04 
  363. # todo: this must be overwritten and return NaN for non-integer values
  364. # band(), bior(), bxor(), too
  365. #sub bnot
  366. #  {
  367. #  $class->SUPER::bnot($class,@_);
  368. #  }
  369.  
  370. sub bcmp 
  371.   {
  372.   # Compares 2 values.  Returns one of undef, <0, =0, >0. (suitable for sort)
  373.   # (BFLOAT or num_str, BFLOAT or num_str) return cond_code
  374.  
  375.   # set up parameters
  376.   my ($self,$x,$y) = (ref($_[0]),@_);
  377.   # objectify is costly, so avoid it
  378.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  379.     {
  380.     ($self,$x,$y) = objectify(2,@_);
  381.     }
  382.  
  383.   return $upgrade->bcmp($x,$y) if defined $upgrade &&
  384.     ((!$x->isa($self)) || (!$y->isa($self)));
  385.  
  386.   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
  387.     {
  388.     # handle +-inf and NaN
  389.     return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
  390.     return 0 if ($x->{sign} eq $y->{sign}) && ($x->{sign} =~ /^[+-]inf$/);
  391.     return +1 if $x->{sign} eq '+inf';
  392.     return -1 if $x->{sign} eq '-inf';
  393.     return -1 if $y->{sign} eq '+inf';
  394.     return +1;
  395.     }
  396.  
  397.   # check sign for speed first
  398.   return 1 if $x->{sign} eq '+' && $y->{sign} eq '-';    # does also 0 <=> -y
  399.   return -1 if $x->{sign} eq '-' && $y->{sign} eq '+';    # does also -x <=> 0
  400.  
  401.   # shortcut 
  402.   my $xz = $x->is_zero();
  403.   my $yz = $y->is_zero();
  404.   return 0 if $xz && $yz;                # 0 <=> 0
  405.   return -1 if $xz && $y->{sign} eq '+';        # 0 <=> +y
  406.   return 1 if $yz && $x->{sign} eq '+';            # +x <=> 0
  407.  
  408.   # adjust so that exponents are equal
  409.   my $lxm = $x->{_m}->length();
  410.   my $lym = $y->{_m}->length();
  411.   # the numify somewhat limits our length, but makes it much faster
  412.   my $lx = $lxm + $x->{_e}->numify();
  413.   my $ly = $lym + $y->{_e}->numify();
  414.   my $l = $lx - $ly; $l = -$l if $x->{sign} eq '-';
  415.   return $l <=> 0 if $l != 0;
  416.   
  417.   # lengths (corrected by exponent) are equal
  418.   # so make mantissa equal length by padding with zero (shift left)
  419.   my $diff = $lxm - $lym;
  420.   my $xm = $x->{_m};        # not yet copy it
  421.   my $ym = $y->{_m};
  422.   if ($diff > 0)
  423.     {
  424.     $ym = $y->{_m}->copy()->blsft($diff,10);
  425.     }
  426.   elsif ($diff < 0)
  427.     {
  428.     $xm = $x->{_m}->copy()->blsft(-$diff,10);
  429.     }
  430.   my $rc = $xm->bacmp($ym);
  431.   $rc = -$rc if $x->{sign} eq '-';        # -124 < -123
  432.   $rc <=> 0;
  433.   }
  434.  
  435. sub bacmp 
  436.   {
  437.   # Compares 2 values, ignoring their signs. 
  438.   # Returns one of undef, <0, =0, >0. (suitable for sort)
  439.   # (BFLOAT or num_str, BFLOAT or num_str) return cond_code
  440.   
  441.   # set up parameters
  442.   my ($self,$x,$y) = (ref($_[0]),@_);
  443.   # objectify is costly, so avoid it
  444.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  445.     {
  446.     ($self,$x,$y) = objectify(2,@_);
  447.     }
  448.  
  449.   return $upgrade->bacmp($x,$y) if defined $upgrade &&
  450.     ((!$x->isa($self)) || (!$y->isa($self)));
  451.  
  452.   # handle +-inf and NaN's
  453.   if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/)
  454.     {
  455.     return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
  456.     return 0 if ($x->is_inf() && $y->is_inf());
  457.     return 1 if ($x->is_inf() && !$y->is_inf());
  458.     return -1;
  459.     }
  460.  
  461.   # shortcut 
  462.   my $xz = $x->is_zero();
  463.   my $yz = $y->is_zero();
  464.   return 0 if $xz && $yz;                # 0 <=> 0
  465.   return -1 if $xz && !$yz;                # 0 <=> +y
  466.   return 1 if $yz && !$xz;                # +x <=> 0
  467.  
  468.   # adjust so that exponents are equal
  469.   my $lxm = $x->{_m}->length();
  470.   my $lym = $y->{_m}->length();
  471.   # the numify somewhat limits our length, but makes it much faster
  472.   my $lx = $lxm + $x->{_e}->numify();
  473.   my $ly = $lym + $y->{_e}->numify();
  474.   my $l = $lx - $ly;
  475.   return $l <=> 0 if $l != 0;
  476.   
  477.   # lengths (corrected by exponent) are equal
  478.   # so make mantissa equal-length by padding with zero (shift left)
  479.   my $diff = $lxm - $lym;
  480.   my $xm = $x->{_m};        # not yet copy it
  481.   my $ym = $y->{_m};
  482.   if ($diff > 0)
  483.     {
  484.     $ym = $y->{_m}->copy()->blsft($diff,10);
  485.     }
  486.   elsif ($diff < 0)
  487.     {
  488.     $xm = $x->{_m}->copy()->blsft(-$diff,10);
  489.     }
  490.   $xm->bacmp($ym) <=> 0;
  491.   }
  492.  
  493. sub badd 
  494.   {
  495.   # add second arg (BFLOAT or string) to first (BFLOAT) (modifies first)
  496.   # return result as BFLOAT
  497.  
  498.   # set up parameters
  499.   my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
  500.   # objectify is costly, so avoid it
  501.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  502.     {
  503.     ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
  504.     }
  505.  
  506.   # inf and NaN handling
  507.   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
  508.     {
  509.     # NaN first
  510.     return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
  511.     # inf handling
  512.     if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
  513.       {
  514.       # +inf++inf or -inf+-inf => same, rest is NaN
  515.       return $x if $x->{sign} eq $y->{sign};
  516.       return $x->bnan();
  517.       }
  518.     # +-inf + something => +inf; something +-inf => +-inf
  519.     $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/;
  520.     return $x;
  521.     }
  522.  
  523.   return $upgrade->badd($x,$y,$a,$p,$r) if defined $upgrade &&
  524.    ((!$x->isa($self)) || (!$y->isa($self)));
  525.  
  526.   # speed: no add for 0+y or x+0
  527.   return $x->bround($a,$p,$r) if $y->is_zero();        # x+0
  528.   if ($x->is_zero())                    # 0+y
  529.     {
  530.     # make copy, clobbering up x (modify in place!)
  531.     $x->{_e} = $y->{_e}->copy();
  532.     $x->{_m} = $y->{_m}->copy();
  533.     $x->{sign} = $y->{sign} || $nan;
  534.     return $x->round($a,$p,$r,$y);
  535.     }
  536.  
  537.   # take lower of the two e's and adapt m1 to it to match m2
  538.   my $e = $y->{_e};
  539.   $e = $MBI->bzero() if !defined $e;    # if no BFLOAT ?
  540.   $e = $e->copy();            # make copy (didn't do it yet)
  541.   $e->bsub($x->{_e});
  542.   my $add = $y->{_m}->copy();
  543.   if ($e->{sign} eq '-')        # < 0
  544.     {
  545.     my $e1 = $e->copy()->babs();
  546.     #$x->{_m} *= (10 ** $e1);
  547.     $x->{_m}->blsft($e1,10);
  548.     $x->{_e} += $e;            # need the sign of e
  549.     }
  550.   elsif (!$e->is_zero())        # > 0
  551.     {
  552.     #$add *= (10 ** $e);
  553.     $add->blsft($e,10);
  554.     }
  555.   # else: both e are the same, so just leave them
  556.   $x->{_m}->{sign} = $x->{sign};         # fiddle with signs
  557.   $add->{sign} = $y->{sign};
  558.   $x->{_m} += $add;                 # finally do add/sub
  559.   $x->{sign} = $x->{_m}->{sign};         # re-adjust signs
  560.   $x->{_m}->{sign} = '+';            # mantissa always positiv
  561.   # delete trailing zeros, then round
  562.   return $x->bnorm()->round($a,$p,$r,$y);
  563.   }
  564.  
  565. sub bsub 
  566.   {
  567.   # (BigFloat or num_str, BigFloat or num_str) return BigFloat
  568.   # subtract second arg from first, modify first
  569.  
  570.   # set up parameters
  571.   my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
  572.   # objectify is costly, so avoid it
  573.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  574.     {
  575.     ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
  576.     }
  577.  
  578.   if ($y->is_zero())        # still round for not adding zero
  579.     {
  580.     return $x->round($a,$p,$r);
  581.     }
  582.   
  583.   $y->{sign} =~ tr/+\-/-+/;    # does nothing for NaN
  584.   $x->badd($y,$a,$p,$r);    # badd does not leave internal zeros
  585.   $y->{sign} =~ tr/+\-/-+/;    # refix $y (does nothing for NaN)
  586.   $x;                # already rounded by badd()
  587.   }
  588.  
  589. sub binc
  590.   {
  591.   # increment arg by one
  592.   my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
  593.  
  594.   if ($x->{_e}->sign() eq '-')
  595.     {
  596.     return $x->badd($self->bone(),$a,$p,$r);    #  digits after dot
  597.     }
  598.  
  599.   if (!$x->{_e}->is_zero())
  600.     {
  601.     $x->{_m}->blsft($x->{_e},10);        # 1e2 => 100
  602.     $x->{_e}->bzero();
  603.     }
  604.   # now $x->{_e} == 0
  605.   if ($x->{sign} eq '+')
  606.     {
  607.     $x->{_m}->binc();
  608.     return $x->bnorm()->bround($a,$p,$r);
  609.     }
  610.   elsif ($x->{sign} eq '-')
  611.     {
  612.     $x->{_m}->bdec();
  613.     $x->{sign} = '+' if $x->{_m}->is_zero(); # -1 +1 => -0 => +0
  614.     return $x->bnorm()->bround($a,$p,$r);
  615.     }
  616.   # inf, nan handling etc
  617.   $x->badd($self->__one(),$a,$p,$r);        # does round 
  618.   }
  619.  
  620. sub bdec
  621.   {
  622.   # decrement arg by one
  623.   my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
  624.  
  625.   if ($x->{_e}->sign() eq '-')
  626.     {
  627.     return $x->badd($self->bone('-'),$a,$p,$r);    #  digits after dot
  628.     }
  629.  
  630.   if (!$x->{_e}->is_zero())
  631.     {
  632.     $x->{_m}->blsft($x->{_e},10);        # 1e2 => 100
  633.     $x->{_e}->bzero();
  634.     }
  635.   # now $x->{_e} == 0
  636.   my $zero = $x->is_zero();
  637.   # <= 0
  638.   if (($x->{sign} eq '-') || $zero)
  639.     {
  640.     $x->{_m}->binc();
  641.     $x->{sign} = '-' if $zero;            # 0 => 1 => -1
  642.     $x->{sign} = '+' if $x->{_m}->is_zero();    # -1 +1 => -0 => +0
  643.     return $x->bnorm()->round($a,$p,$r);
  644.     }
  645.   # > 0
  646.   elsif ($x->{sign} eq '+')
  647.     {
  648.     $x->{_m}->bdec();
  649.     return $x->bnorm()->round($a,$p,$r);
  650.     }
  651.   # inf, nan handling etc
  652.   $x->badd($self->bone('-'),$a,$p,$r);        # does round 
  653.   } 
  654.  
  655. sub DEBUG () { 0; }
  656.  
  657. sub blog
  658.   {
  659.   my ($self,$x,$base,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
  660.  
  661.   # $base > 0, $base != 1; if $base == undef default to $base == e
  662.   # $x >= 0
  663.  
  664.   # we need to limit the accuracy to protect against overflow
  665.   my $fallback = 0;
  666.   my ($scale,@params);
  667.   ($x,@params) = $x->_find_round_parameters($a,$p,$r);
  668.  
  669.   # also takes care of the "error in _find_round_parameters?" case
  670.   return $x->bnan() if $x->{sign} ne '+' || $x->is_zero();
  671.     
  672.   # no rounding at all, so must use fallback
  673.   if (scalar @params == 0)
  674.     {
  675.     # simulate old behaviour
  676.     $params[0] = $self->div_scale();    # and round to it as accuracy
  677.     $params[1] = undef;            # P = undef
  678.     $scale = $params[0]+4;         # at least four more for proper round
  679.     $params[2] = $r;            # round mode by caller or undef
  680.     $fallback = 1;            # to clear a/p afterwards
  681.     }
  682.   else
  683.     {
  684.     # the 4 below is empirical, and there might be cases where it is not
  685.     # enough...
  686.     $scale = abs($params[0] || $params[1]) + 4;    # take whatever is defined
  687.     }
  688.  
  689.   return $x->bzero(@params) if $x->is_one();
  690.   # base not defined => base == Euler's constant e
  691.   if (defined $base)
  692.     {
  693.     # make object, since we don't feed it trough objectify() to still get the
  694.     # case of $base == undef
  695.     $base = $self->new($base) unless ref($base);
  696.     # $base > 0; $base != 1
  697.     return $x->bnan() if $base->is_zero() || $base->is_one() ||
  698.       $base->{sign} ne '+';
  699.     return $x->bone('+',@params) if $x->bcmp($base) == 0;
  700.     }
  701.  
  702.   # when user set globals, they would interfere with our calculation, so
  703.   # disable them and later re-enable them
  704.   no strict 'refs';
  705.   my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
  706.   my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
  707.   # we also need to disable any set A or P on $x (_find_round_parameters took
  708.   # them already into account), since these would interfere, too
  709.   delete $x->{_a}; delete $x->{_p};
  710.   # need to disable $upgrade in BigInt, to avoid deep recursion
  711.   local $Math::BigInt::upgrade = undef;
  712.   local $Math::BigFloat::downgrade = undef;
  713.  
  714.   # upgrade $x if $x is not a BigFloat (handle BigInt input)
  715.   if (!$x->isa('Math::BigFloat'))
  716.     {
  717.     $x = Math::BigFloat->new($x);
  718.     $self = ref($x);
  719.     }
  720.   # first calculate the log to base e (using reduction by 10 (and probably 2))
  721.   $self->_log_10($x,$scale);
  722.  
  723.   # and if a different base was requested, convert it
  724.   if (defined $base)
  725.     {
  726.     $base = Math::BigFloat->new($base) unless $base->isa('Math::BigFloat');
  727.     # not ln, but some other base
  728.     $x->bdiv( $base->copy()->blog(undef,$scale), $scale );
  729.     }
  730.  
  731.   # shortcut to not run trough _find_round_parameters again
  732.   if (defined $params[0])
  733.     {
  734.     $x->bround($params[0],$params[2]);        # then round accordingly
  735.     }
  736.   else
  737.     {
  738.     $x->bfround($params[1],$params[2]);        # then round accordingly
  739.     }
  740.   if ($fallback)
  741.     {
  742.     # clear a/p after round, since user did not request it
  743.     $x->{_a} = undef; $x->{_p} = undef;
  744.     }
  745.   # restore globals
  746.   $$abr = $ab; $$pbr = $pb;
  747.  
  748.   $x;
  749.   }
  750.  
  751. sub _log
  752.   {
  753.   # internal log function to calculate log based on Taylor.
  754.   # Modifies $x in place.
  755.   my ($self,$x,$scale) = @_;
  756.  
  757.   # http://www.efunda.com/math/taylor_series/logarithmic.cfm?search_string=log
  758.  
  759.   # u = x-1, v = x+1
  760.   #              _                               _
  761.   # Taylor:     |    u    1   u^3   1   u^5       |
  762.   # ln (x)  = 2 |   --- + - * --- + - * --- + ... |  x > 0
  763.   #             |_   v    3   v^3   5   v^5      _|
  764.  
  765.   # This takes much more steps to calculate the result and is thus not used
  766.   # u = x-1
  767.   #              _                               _
  768.   # Taylor:     |    u    1   u^2   1   u^3       |
  769.   # ln (x)  = 2 |   --- + - * --- + - * --- + ... |  x > 1/2
  770.   #             |_   x    2   x^2   3   x^3      _|
  771.  
  772.   # "normal" log algorithmn
  773.  
  774.   my ($limit,$v,$u,$below,$factor,$two,$next,$over,$f);
  775.  
  776.   $v = $x->copy(); $v->binc();        # v = x+1
  777.   $x->bdec(); $u = $x->copy();        # u = x-1; x = x-1
  778.   $x->bdiv($v,$scale);            # first term: u/v
  779.   $below = $v->copy();
  780.   $over = $u->copy();
  781.   $u *= $u; $v *= $v;                # u^2, v^2
  782.   $below->bmul($v);                # u^3, v^3
  783.   $over->bmul($u);
  784.   $factor = $self->new(3); $f = $self->new(2);
  785.  
  786.   my $steps = 0 if DEBUG;  
  787.   $limit = $self->new("1E-". ($scale-1));
  788.   while (3 < 5)
  789.     {
  790.     # we calculate the next term, and add it to the last
  791.     # when the next term is below our limit, it won't affect the outcome
  792.     # anymore, so we stop
  793.  
  794.     # calculating the next term simple from over/below will result in quite
  795.     # a time hog if the input has many digits, since over and below will
  796.     # accumulate more and more digits, and the result will also have many
  797.     # digits, but in the end it is rounded to $scale digits anyway. So if we
  798.     # round $over and $below first, we save a lot of time for the division
  799.     # (not with log(1.2345), but try log (123**123) to see what I mean. This
  800.     # can introduce a rounding error if the division result would be f.i.
  801.     # 0.1234500000001 and we round it to 5 digits it would become 0.12346, but
  802.     # if we truncated the $over and $below we might get 0.12345. Does this
  803.     # matter for the end result? So we give over and below 4 more digits to be
  804.     # on the safe side (unscientific error handling as usual...)
  805.     # Makes blog(1.23) *slightly* slower, but try blog(123*123) w/o it :o)
  806.     
  807.     $next = $over->copy->bround($scale+4)->bdiv(
  808.       $below->copy->bmul($factor)->bround($scale+4), 
  809.       $scale);
  810.  
  811. ## old version:    
  812. ##    $next = $over->copy()->bdiv($below->copy()->bmul($factor),$scale);
  813.  
  814.     last if $next->bacmp($limit) <= 0;
  815.  
  816.     delete $next->{_a}; delete $next->{_p};
  817.     $x->badd($next);
  818.     #print "step  $x\n  ($next - $limit = ",$next - $limit,")\n";
  819.     # calculate things for the next term
  820.     $over *= $u; $below *= $v; $factor->badd($f);
  821.     if (DEBUG)
  822.       {
  823.       $steps++; print "step $steps = $x\n" if $steps % 10 == 0;
  824.       }
  825.     }
  826.   $x->bmul($f);                    # $x *= 2
  827.   print "took $steps steps\n" if DEBUG;
  828.   }
  829.  
  830. sub _log_10
  831.   {
  832.   # internal log function based on reducing input to the range of 0.1 .. 9.99
  833.   my ($self,$x,$scale) = @_;
  834.  
  835.   # taking blog() from numbers greater than 10 takes a *very long* time, so we
  836.   # break the computation down into parts based on the observation that:
  837.   #  blog(x*y) = blog(x) + blog(y)
  838.   # We set $y here to multiples of 10 so that $x is below 1 (the smaller $x is
  839.   # the faster it get's, especially because 2*$x takes about 10 times as long,
  840.   # so by dividing $x by 10 we make it at least factor 100 faster...)
  841.  
  842.   # The same observation is valid for numbers smaller than 0.1 (e.g. computing
  843.   # log(1) is fastest, and the farther away we get from 1, the longer it takes)
  844.   # so we also 'break' this down by multiplying $x with 10 and subtract the
  845.   # log(10) afterwards to get the correct result.
  846.  
  847.   # calculate nr of digits before dot
  848.   my $dbd = $x->{_m}->length() + $x->{_e}->numify();
  849.  
  850.   # more than one digit (e.g. at least 10), but *not* exactly 10 to avoid
  851.   # infinite recursion
  852.  
  853.   my $calc = 1;                    # do some calculation?
  854.  
  855.   # disable the shortcut for 10, since we need log(10) and this would recurse
  856.   # infinitely deep
  857.   if ($x->{_e}->is_one() && $x->{_m}->is_one())
  858.     {
  859.     $dbd = 0;                    # disable shortcut
  860.     # we can use the cached value in these cases
  861.     if ($scale <= $LOG_10_A)
  862.       {
  863.       $x->bzero(); $x->badd($LOG_10);
  864.       $calc = 0;                 # no need to calc, but round
  865.       }
  866.     }
  867.   # disable the shortcut for 2, since we maybe have it cached
  868.   my $two = $self->new(2);            # also used later on
  869.   if ($x->{_e}->is_zero() && $x->{_m}->bcmp($two) == 0)
  870.     {
  871.     $dbd = 0;                    # disable shortcut
  872.     # we can use the cached value in these cases
  873.     if ($scale <= $LOG_2_A)
  874.       {
  875.       $x->bzero(); $x->badd($LOG_2);
  876.       $calc = 0;                 # no need to calc, but round
  877.       }
  878.     }
  879.  
  880.   # if $x = 0.1, we know the result must be 0-log(10)
  881.   if ($x->{_e}->is_one('-') && $x->{_m}->is_one())
  882.     {
  883.     $dbd = 0;                    # disable shortcut
  884.     # we can use the cached value in these cases
  885.     if ($scale <= $LOG_10_A)
  886.       {
  887.       $x->bzero(); $x->bsub($LOG_10);
  888.       $calc = 0;                 # no need to calc, but round
  889.       }
  890.     }
  891.  
  892.   # default: these correction factors are undef and thus not used
  893.   my $l_10;                # value of ln(10) to A of $scale
  894.   my $l_2;                # value of ln(2) to A of $scale
  895.  
  896.   # $x == 2 => 1, $x == 13 => 2, $x == 0.1 => 0, $x == 0.01 => -1
  897.   # so don't do this shortcut for 1 or 0
  898.   if (($dbd > 1) || ($dbd < 0))
  899.     {
  900.     # convert our cached value to an object if not already (avoid doing this
  901.     # at import() time, since not everybody needs this)
  902.     $LOG_10 = $self->new($LOG_10,undef,undef) unless ref $LOG_10;
  903.  
  904.     #print "x = $x, dbd = $dbd, calc = $calc\n";
  905.     # got more than one digit before the dot, or more than one zero after the
  906.     # dot, so do:
  907.     #  log(123)    == log(1.23) + log(10) * 2
  908.     #  log(0.0123) == log(1.23) - log(10) * 2
  909.   
  910.     if ($scale <= $LOG_10_A)
  911.       {
  912.       # use cached value
  913.       #print "using cached value for l_10\n";
  914.       $l_10 = $LOG_10->copy();        # copy for mul
  915.       }
  916.     else
  917.       {
  918.       # else: slower, compute it (but don't cache it, because it could be big)
  919.       # also disable downgrade for this code path
  920.       local $Math::BigFloat::downgrade = undef;
  921.       #print "l_10 = $l_10 (self = $self', 
  922.       #  ", ref(l_10) = ",ref($l_10)," scale $scale)\n";
  923.       #print "calculating value for l_10, scale $scale\n";
  924.       $l_10 = $self->new(10)->blog(undef,$scale);    # scale+4, actually
  925.       }
  926.     $dbd-- if ($dbd > 1);         # 20 => dbd=2, so make it dbd=1    
  927.     # make object
  928.     $dbd = $self->new($dbd);
  929.     #print "dbd $dbd\n";  
  930.     $l_10->bmul($dbd);            # log(10) * (digits_before_dot-1)
  931.     #print "l_10 = $l_10\n";
  932.     #print "x = $x";
  933.     $x->{_e}->bsub($dbd);        # 123 => 1.23
  934.     #print " => $x\n";
  935.     #print "calculating log($x) with scale=$scale\n";
  936.  
  937.     }
  938.  
  939.   # Now: 0.1 <= $x < 10 (and possible correction in l_10)
  940.  
  941.   ### Since $x in the range 0.5 .. 1.5 is MUCH faster, we do a repeated div
  942.   ### or mul by 2 (maximum times 3, since x < 10 and x > 0.1)
  943.  
  944.   if ($calc != 0)
  945.     {
  946.     my $half = $self->new('0.5');
  947.     my $twos = 0;                # default: none (0 times)    
  948.     while ($x->bacmp($half) < 0)
  949.       {
  950.       #print "$x\n";
  951.       $twos--; $x->bmul($two);
  952.       }
  953.     while ($x->bacmp($two) > 0)
  954.       {
  955.       #print "$x\n";
  956.       $twos++; $x->bdiv($two,$scale+4);        # keep all digits
  957.       }
  958.     #print "$twos\n";
  959.     # $twos > 0 => did mul 2, < 0 => did div 2 (never both)
  960.     # calculate correction factor based on ln(2)
  961.     if ($twos != 0)
  962.       {
  963.       $LOG_2 = $self->new($LOG_2,undef,undef) unless ref $LOG_2;
  964.       if ($scale <= $LOG_2_A)
  965.         {
  966.         # use cached value
  967.         #print "using cached value for l_10\n";
  968.         $l_2 = $LOG_2->copy();            # copy for mul
  969.         }
  970.       else
  971.         {
  972.         # else: slower, compute it (but don't cache it, because it could be big)
  973.         # also disable downgrade for this code path
  974.         local $Math::BigFloat::downgrade = undef;
  975.         #print "calculating value for l_2, scale $scale\n";
  976.         $l_2 = $two->blog(undef,$scale);    # scale+4, actually
  977.         }
  978.       #print "$l_2 => \n";
  979.       $l_2->bmul($twos);        # * -2 => subtract, * 2 => add
  980.       #print "$l_2\n";
  981.       }
  982.     }
  983.   
  984.   if ($calc != 0)
  985.     {
  986.     $self->_log($x,$scale);            # need to do the "normal" way
  987.     #print "log(x) = $x\n";
  988.     $x->badd($l_10) if defined $l_10;         # correct it by ln(10)
  989.     #print "result = $x\n";
  990.     $x->badd($l_2) if defined $l_2;        # and maybe by ln(2)
  991.     #print "result = $x\n";
  992.     }
  993.   # all done, $x contains now the result
  994.   }
  995.  
  996. sub blcm 
  997.   { 
  998.   # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT
  999.   # does not modify arguments, but returns new object
  1000.   # Lowest Common Multiplicator
  1001.  
  1002.   my ($self,@arg) = objectify(0,@_);
  1003.   my $x = $self->new(shift @arg);
  1004.   while (@arg) { $x = _lcm($x,shift @arg); } 
  1005.   $x;
  1006.   }
  1007.  
  1008. sub bgcd 
  1009.   { 
  1010.   # (BFLOAT or num_str, BFLOAT or num_str) return BINT
  1011.   # does not modify arguments, but returns new object
  1012.   # GCD -- Euclids algorithm Knuth Vol 2 pg 296
  1013.    
  1014.   my ($self,@arg) = objectify(0,@_);
  1015.   my $x = $self->new(shift @arg);
  1016.   while (@arg) { $x = _gcd($x,shift @arg); } 
  1017.   $x;
  1018.   }
  1019.  
  1020. ###############################################################################
  1021. # is_foo methods (is_negative, is_positive are inherited from BigInt)
  1022.  
  1023. sub is_int
  1024.   {
  1025.   # return true if arg (BFLOAT or num_str) is an integer
  1026.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  1027.  
  1028.   return 1 if ($x->{sign} =~ /^[+-]$/) &&    # NaN and +-inf aren't
  1029.     $x->{_e}->{sign} eq '+';            # 1e-1 => no integer
  1030.   0;
  1031.   }
  1032.  
  1033. sub is_zero
  1034.   {
  1035.   # return true if arg (BFLOAT or num_str) is zero
  1036.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  1037.  
  1038.   return 1 if $x->{sign} eq '+' && $x->{_m}->is_zero();
  1039.   0;
  1040.   }
  1041.  
  1042. sub is_one
  1043.   {
  1044.   # return true if arg (BFLOAT or num_str) is +1 or -1 if signis given
  1045.   my ($self,$x,$sign) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
  1046.  
  1047.   $sign = '+' if !defined $sign || $sign ne '-';
  1048.   return 1
  1049.    if ($x->{sign} eq $sign && $x->{_e}->is_zero() && $x->{_m}->is_one()); 
  1050.   0;
  1051.   }
  1052.  
  1053. sub is_odd
  1054.   {
  1055.   # return true if arg (BFLOAT or num_str) is odd or false if even
  1056.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  1057.   
  1058.   return 1 if ($x->{sign} =~ /^[+-]$/) &&        # NaN & +-inf aren't
  1059.     ($x->{_e}->is_zero() && $x->{_m}->is_odd()); 
  1060.   0;
  1061.   }
  1062.  
  1063. sub is_even
  1064.   {
  1065.   # return true if arg (BINT or num_str) is even or false if odd
  1066.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  1067.  
  1068.   return 0 if $x->{sign} !~ /^[+-]$/;            # NaN & +-inf aren't
  1069.   return 1 if ($x->{_e}->{sign} eq '+'             # 123.45 is never
  1070.      && $x->{_m}->is_even());                 # but 1200 is
  1071.   0;
  1072.   }
  1073.  
  1074. sub bmul 
  1075.   { 
  1076.   # multiply two numbers -- stolen from Knuth Vol 2 pg 233
  1077.   # (BINT or num_str, BINT or num_str) return BINT
  1078.   
  1079.   # set up parameters
  1080.   my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
  1081.   # objectify is costly, so avoid it
  1082.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  1083.     {
  1084.     ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
  1085.     }
  1086.  
  1087.   return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
  1088.  
  1089.   # inf handling
  1090.   if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
  1091.     {
  1092.     return $x->bnan() if $x->is_zero() || $y->is_zero(); 
  1093.     # result will always be +-inf:
  1094.     # +inf * +/+inf => +inf, -inf * -/-inf => +inf
  1095.     # +inf * -/-inf => -inf, -inf * +/+inf => -inf
  1096.     return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
  1097.     return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
  1098.     return $x->binf('-');
  1099.     }
  1100.   # handle result = 0
  1101.   return $x->bzero() if $x->is_zero() || $y->is_zero();
  1102.   
  1103.   return $upgrade->bmul($x,$y,$a,$p,$r) if defined $upgrade &&
  1104.    ((!$x->isa($self)) || (!$y->isa($self)));
  1105.  
  1106.   # aEb * cEd = (a*c)E(b+d)
  1107.   $x->{_m}->bmul($y->{_m});
  1108.   $x->{_e}->badd($y->{_e});
  1109.   # adjust sign:
  1110.   $x->{sign} = $x->{sign} ne $y->{sign} ? '-' : '+';
  1111.   return $x->bnorm()->round($a,$p,$r,$y);
  1112.   }
  1113.  
  1114. sub bdiv 
  1115.   {
  1116.   # (dividend: BFLOAT or num_str, divisor: BFLOAT or num_str) return 
  1117.   # (BFLOAT,BFLOAT) (quo,rem) or BFLOAT (only rem)
  1118.  
  1119.   # set up parameters
  1120.   my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
  1121.   # objectify is costly, so avoid it
  1122.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  1123.     {
  1124.     ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
  1125.     }
  1126.  
  1127.   return $self->_div_inf($x,$y)
  1128.    if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
  1129.  
  1130.   # x== 0 # also: or y == 1 or y == -1
  1131.   return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
  1132.  
  1133.   # upgrade ?
  1134.   return $upgrade->bdiv($upgrade->new($x),$y,$a,$p,$r) if defined $upgrade;
  1135.  
  1136.   # we need to limit the accuracy to protect against overflow
  1137.   my $fallback = 0;
  1138.   my (@params,$scale);
  1139.   ($x,@params) = $x->_find_round_parameters($a,$p,$r,$y);
  1140.  
  1141.   return $x if $x->is_nan();        # error in _find_round_parameters?
  1142.  
  1143.   # no rounding at all, so must use fallback
  1144.   if (scalar @params == 0)
  1145.     {
  1146.     # simulate old behaviour
  1147.     $params[0] = $self->div_scale();    # and round to it as accuracy
  1148.     $scale = $params[0]+4;         # at least four more for proper round
  1149.     $params[2] = $r;            # round mode by caller or undef
  1150.     $fallback = 1;            # to clear a/p afterwards
  1151.     }
  1152.   else
  1153.     {
  1154.     # the 4 below is empirical, and there might be cases where it is not
  1155.     # enough...
  1156.     $scale = abs($params[0] || $params[1]) + 4;    # take whatever is defined
  1157.     }
  1158.   my $lx = $x->{_m}->length(); my $ly = $y->{_m}->length();
  1159.   $scale = $lx if $lx > $scale;
  1160.   $scale = $ly if $ly > $scale;
  1161.   my $diff = $ly - $lx;
  1162.   $scale += $diff if $diff > 0;        # if lx << ly, but not if ly << lx!
  1163.     
  1164.   # make copy of $x in case of list context for later reminder calculation
  1165.   my $rem;
  1166.   if (wantarray && !$y->is_one())
  1167.     {
  1168.     $rem = $x->copy();
  1169.     }
  1170.  
  1171.   $x->{sign} = $x->{sign} ne $y->sign() ? '-' : '+'; 
  1172.  
  1173.   # check for / +-1 ( +/- 1E0)
  1174.   if (!$y->is_one())
  1175.     {
  1176.     # promote BigInts and it's subclasses (except when already a BigFloat)
  1177.     $y = $self->new($y) unless $y->isa('Math::BigFloat'); 
  1178.  
  1179.     # need to disable $upgrade in BigInt, to avoid deep recursion
  1180.     local $Math::BigInt::upgrade = undef;     # should be parent class vs MBI
  1181.  
  1182.     # calculate the result to $scale digits and then round it
  1183.     # a * 10 ** b / c * 10 ** d => a/c * 10 ** (b-d)
  1184.     $x->{_m}->blsft($scale,10);
  1185.     $x->{_m}->bdiv( $y->{_m} );    # a/c
  1186.     $x->{_e}->bsub( $y->{_e} );    # b-d
  1187.     $x->{_e}->bsub($scale);    # correct for 10**scale
  1188.     $x->bnorm();        # remove trailing 0's
  1189.     }
  1190.  
  1191.   # shortcut to not run trough _find_round_parameters again
  1192.   if (defined $params[0])
  1193.     {
  1194.     $x->{_a} = undef;                 # clear before round
  1195.     $x->bround($params[0],$params[2]);        # then round accordingly
  1196.     }
  1197.   else
  1198.     {
  1199.     $x->{_p} = undef;                 # clear before round
  1200.     $x->bfround($params[1],$params[2]);        # then round accordingly
  1201.     }
  1202.   if ($fallback)
  1203.     {
  1204.     # clear a/p after round, since user did not request it
  1205.     $x->{_a} = undef; $x->{_p} = undef;
  1206.     }
  1207.   
  1208.   if (wantarray)
  1209.     {
  1210.     if (!$y->is_one())
  1211.       {
  1212.       $rem->bmod($y,@params);            # copy already done
  1213.       }
  1214.     else
  1215.       {
  1216.       $rem = $self->bzero();
  1217.       }
  1218.     if ($fallback)
  1219.       {
  1220.       # clear a/p after round, since user did not request it
  1221.       $rem->{_a} = undef; $rem->{_p} = undef;
  1222.       }
  1223.     return ($x,$rem);
  1224.     }
  1225.   $x;
  1226.   }
  1227.  
  1228. sub bmod 
  1229.   {
  1230.   # (dividend: BFLOAT or num_str, divisor: BFLOAT or num_str) return reminder 
  1231.  
  1232.   # set up parameters
  1233.   my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
  1234.   # objectify is costly, so avoid it
  1235.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  1236.     {
  1237.     ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
  1238.     }
  1239.  
  1240.   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
  1241.     {
  1242.     my ($d,$re) = $self->SUPER::_div_inf($x,$y);
  1243.     $x->{sign} = $re->{sign};
  1244.     $x->{_e} = $re->{_e};
  1245.     $x->{_m} = $re->{_m};
  1246.     return $x->round($a,$p,$r,$y);
  1247.     } 
  1248.   return $x->bnan() if $x->is_zero() && $y->is_zero();
  1249.   return $x if $y->is_zero();
  1250.   return $x->bnan() if $x->is_nan() || $y->is_nan();
  1251.   return $x->bzero() if $y->is_one() || $x->is_zero();
  1252.  
  1253.   # inf handling is missing here
  1254.  
  1255.   my $cmp = $x->bacmp($y);            # equal or $x < $y?
  1256.   return $x->bzero($a,$p) if $cmp == 0;        # $x == $y => result 0
  1257.  
  1258.   # only $y of the operands negative? 
  1259.   my $neg = 0; $neg = 1 if $x->{sign} ne $y->{sign};
  1260.  
  1261.   $x->{sign} = $y->{sign};                # calc sign first
  1262.   return $x->round($a,$p,$r) if $cmp < 0 && $neg == 0;    # $x < $y => result $x
  1263.   
  1264.   my $ym = $y->{_m}->copy();
  1265.   
  1266.   # 2e1 => 20
  1267.   $ym->blsft($y->{_e},10) if $y->{_e}->{sign} eq '+' && !$y->{_e}->is_zero();
  1268.  
  1269.   # if $y has digits after dot
  1270.   my $shifty = 0;            # correct _e of $x by this
  1271.   if ($y->{_e}->{sign} eq '-')        # has digits after dot
  1272.     {
  1273.     # 123 % 2.5 => 1230 % 25 => 5 => 0.5
  1274.     $shifty = $y->{_e}->copy()->babs();    # no more digits after dot
  1275.     $x->blsft($shifty,10);        # 123 => 1230, $y->{_m} is already 25
  1276.     }
  1277.   # $ym is now mantissa of $y based on exponent 0
  1278.  
  1279.   my $shiftx = 0;            # correct _e of $x by this
  1280.   if ($x->{_e}->{sign} eq '-')        # has digits after dot
  1281.     {
  1282.     # 123.4 % 20 => 1234 % 200
  1283.     $shiftx = $x->{_e}->copy()->babs();    # no more digits after dot
  1284.     $ym->blsft($shiftx,10);
  1285.     }
  1286.   # 123e1 % 20 => 1230 % 20
  1287.   if ($x->{_e}->{sign} eq '+' && !$x->{_e}->is_zero())
  1288.     {
  1289.     $x->{_m}->blsft($x->{_e},10);
  1290.     }
  1291.   $x->{_e} = $MBI->bzero() unless $x->{_e}->is_zero();
  1292.   
  1293.   $x->{_e}->bsub($shiftx) if $shiftx != 0;
  1294.   $x->{_e}->bsub($shifty) if $shifty != 0;
  1295.   
  1296.   # now mantissas are equalized, exponent of $x is adjusted, so calc result
  1297.  
  1298.   $x->{_m}->bmod($ym);
  1299.  
  1300.   $x->{sign} = '+' if $x->{_m}->is_zero();        # fix sign for -0
  1301.   $x->bnorm();
  1302.  
  1303.   if ($neg != 0)    # one of them negative => correct in place
  1304.     {
  1305.     my $r = $y - $x;
  1306.     $x->{_m} = $r->{_m};
  1307.     $x->{_e} = $r->{_e};
  1308.     $x->{sign} = '+' if $x->{_m}->is_zero();        # fix sign for -0
  1309.     $x->bnorm();
  1310.     }
  1311.  
  1312.   $x->round($a,$p,$r,$y);    # round and return
  1313.   }
  1314.  
  1315. sub broot
  1316.   {
  1317.   # calculate $y'th root of $x
  1318.   my ($self,$x,$y,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(2,@_);
  1319.  
  1320.   # NaN handling: $x ** 1/0, x or y NaN, or y inf/-inf or y == 0
  1321.   return $x->bnan() if $x->{sign} !~ /^\+/ || $y->is_zero() ||
  1322.          $y->{sign} !~ /^\+$/;
  1323.  
  1324.   return $x if $x->is_zero() || $x->is_one() || $x->is_inf() || $y->is_one();
  1325.   
  1326.   # we need to limit the accuracy to protect against overflow
  1327.   my $fallback = 0;
  1328.   my (@params,$scale);
  1329.   ($x,@params) = $x->_find_round_parameters($a,$p,$r);
  1330.  
  1331.   return $x if $x->is_nan();        # error in _find_round_parameters?
  1332.  
  1333.   # no rounding at all, so must use fallback
  1334.   if (scalar @params == 0) 
  1335.     {
  1336.     # simulate old behaviour
  1337.     $params[0] = $self->div_scale();    # and round to it as accuracy
  1338.     $scale = $params[0]+4;         # at least four more for proper round
  1339.     $params[2] = $r;            # round mode by caller or undef
  1340.     $fallback = 1;            # to clear a/p afterwards
  1341.     }
  1342.   else
  1343.     {
  1344.     # the 4 below is empirical, and there might be cases where it is not
  1345.     # enough...
  1346.     $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
  1347.     }
  1348.  
  1349.   # when user set globals, they would interfere with our calculation, so
  1350.   # disable them and later re-enable them
  1351.   no strict 'refs';
  1352.   my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
  1353.   my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
  1354.   # we also need to disable any set A or P on $x (_find_round_parameters took
  1355.   # them already into account), since these would interfere, too
  1356.   delete $x->{_a}; delete $x->{_p};
  1357.   # need to disable $upgrade in BigInt, to avoid deep recursion
  1358.   local $Math::BigInt::upgrade = undef;    # should be really parent class vs MBI
  1359.  
  1360.   # remember sign and make $x positive, since -4 ** (1/2) => -2
  1361.   my $sign = 0; $sign = 1 if $x->is_negative(); $x->babs();
  1362.  
  1363.   if ($y->bcmp(2) == 0)        # normal square root
  1364.     {
  1365.     $x->bsqrt($scale+4);
  1366.     }
  1367.   elsif ($y->is_one('-'))
  1368.     {
  1369.     # $x ** -1 => 1/$x
  1370.     my $u = $self->bone()->bdiv($x,$scale);
  1371.     # copy private parts over
  1372.     $x->{_m} = $u->{_m};
  1373.     $x->{_e} = $u->{_e};
  1374.     }
  1375.   else
  1376.     {
  1377.     my $u = $self->bone()->bdiv($y,$scale+4);
  1378.     delete $u->{_a}; delete $u->{_p};        # otherwise it conflicts
  1379.     $x->bpow($u,$scale+4);             # el cheapo
  1380.     }
  1381.   $x->bneg() if $sign == 1;
  1382.   
  1383.   # shortcut to not run trough _find_round_parameters again
  1384.   if (defined $params[0])
  1385.     {
  1386.     $x->bround($params[0],$params[2]);        # then round accordingly
  1387.     }
  1388.   else
  1389.     {
  1390.     $x->bfround($params[1],$params[2]);        # then round accordingly
  1391.     }
  1392.   if ($fallback)
  1393.     {
  1394.     # clear a/p after round, since user did not request it
  1395.     $x->{_a} = undef; $x->{_p} = undef;
  1396.     }
  1397.   # restore globals
  1398.   $$abr = $ab; $$pbr = $pb;
  1399.   $x;
  1400.   }
  1401.  
  1402. sub bsqrt
  1403.   { 
  1404.   # calculate square root
  1405.   my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
  1406.  
  1407.   return $x->bnan() if $x->{sign} !~ /^[+]/;    # NaN, -inf or < 0
  1408.   return $x if $x->{sign} eq '+inf';        # sqrt(inf) == inf
  1409.   return $x->round($a,$p,$r) if $x->is_zero() || $x->is_one();
  1410.  
  1411.   # we need to limit the accuracy to protect against overflow
  1412.   my $fallback = 0;
  1413.   my (@params,$scale);
  1414.   ($x,@params) = $x->_find_round_parameters($a,$p,$r);
  1415.  
  1416.   return $x if $x->is_nan();        # error in _find_round_parameters?
  1417.  
  1418.   # no rounding at all, so must use fallback
  1419.   if (scalar @params == 0) 
  1420.     {
  1421.     # simulate old behaviour
  1422.     $params[0] = $self->div_scale();    # and round to it as accuracy
  1423.     $scale = $params[0]+4;         # at least four more for proper round
  1424.     $params[2] = $r;            # round mode by caller or undef
  1425.     $fallback = 1;            # to clear a/p afterwards
  1426.     }
  1427.   else
  1428.     {
  1429.     # the 4 below is empirical, and there might be cases where it is not
  1430.     # enough...
  1431.     $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
  1432.     }
  1433.  
  1434.   # when user set globals, they would interfere with our calculation, so
  1435.   # disable them and later re-enable them
  1436.   no strict 'refs';
  1437.   my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
  1438.   my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
  1439.   # we also need to disable any set A or P on $x (_find_round_parameters took
  1440.   # them already into account), since these would interfere, too
  1441.   delete $x->{_a}; delete $x->{_p};
  1442.   # need to disable $upgrade in BigInt, to avoid deep recursion
  1443.   local $Math::BigInt::upgrade = undef;    # should be really parent class vs MBI
  1444.  
  1445.   my $xas = $x->as_number();
  1446.   my $gs = $xas->copy()->bsqrt();    # some guess
  1447.  
  1448.   if (($x->{_e}->{sign} ne '-')        # guess can't be accurate if there are
  1449.                     # digits after the dot
  1450.    && ($xas->bacmp($gs * $gs) == 0))    # guess hit the nail on the head?
  1451.     {
  1452.     # exact result
  1453.     $x->{_m} = $gs; $x->{_e} = $MBI->bzero(); $x->bnorm();
  1454.     # shortcut to not run trough _find_round_parameters again
  1455.     if (defined $params[0])
  1456.       {
  1457.       $x->bround($params[0],$params[2]);    # then round accordingly
  1458.       }
  1459.     else
  1460.       {
  1461.       $x->bfround($params[1],$params[2]);    # then round accordingly
  1462.       }
  1463.     if ($fallback)
  1464.       {
  1465.       # clear a/p after round, since user did not request it
  1466.       $x->{_a} = undef; $x->{_p} = undef;
  1467.       }
  1468.     # re-enable A and P, upgrade is taken care of by "local"
  1469.     ${"$self\::accuracy"} = $ab; ${"$self\::precision"} = $pb;
  1470.     return $x;
  1471.     }
  1472.  
  1473.   # sqrt(2) = 1.4 because sqrt(2*100) = 1.4*10; so we can increase the accuracy
  1474.   # of the result by multipyling the input by 100 and then divide the integer
  1475.   # result of sqrt(input) by 10. Rounding afterwards returns the real result.
  1476.   # this will transform 123.456 (in $x) into 123456 (in $y1)
  1477.   my $y1 = $x->{_m}->copy();
  1478.   # We now make sure that $y1 has the same odd or even number of digits than
  1479.   # $x had. So when _e of $x is odd, we must shift $y1 by one digit left,
  1480.   # because we always must multiply by steps of 100 (sqrt(100) is 10) and not
  1481.   # steps of 10. The length of $x does not count, since an even or odd number
  1482.   # of digits before the dot is not changed by adding an even number of digits
  1483.   # after the dot (the result is still odd or even digits long).
  1484.   my $length = $y1->length();
  1485.   $y1->bmul(10) if $x->{_e}->is_odd();
  1486.   # now calculate how many digits the result of sqrt(y1) would have
  1487.   my $digits = int($length / 2);
  1488.   # but we need at least $scale digits, so calculate how many are missing
  1489.   my $shift = $scale - $digits;
  1490.   # that should never happen (we take care of integer guesses above)
  1491.   # $shift = 0 if $shift < 0; 
  1492.   # multiply in steps of 100, by shifting left two times the "missing" digits
  1493.   $y1->blsft($shift*2,10);
  1494.   # now take the square root and truncate to integer
  1495.   $y1->bsqrt();
  1496.   # By "shifting" $y1 right (by creating a negative _e) we calculate the final
  1497.   # result, which is than later rounded to the desired scale.
  1498.  
  1499.   # calculate how many zeros $x had after the '.' (or before it, depending
  1500.   #  on sign of $dat, the result should have half as many:
  1501.   my $dat = $length + $x->{_e}->numify();
  1502.  
  1503.   if ($dat > 0)
  1504.     {
  1505.     # no zeros after the dot (e.g. 1.23, 0.49 etc)
  1506.     # preserve half as many digits before the dot than the input had 
  1507.     # (but round this "up")
  1508.     $dat = int(($dat+1)/2);
  1509.     }
  1510.   else
  1511.     {
  1512.     $dat = int(($dat)/2);
  1513.     }
  1514.   $x->{_e}= $MBI->new( $dat - $y1->length() );
  1515.  
  1516.   $x->{_m} = $y1;
  1517.  
  1518.   # shortcut to not run trough _find_round_parameters again
  1519.   if (defined $params[0])
  1520.     {
  1521.     $x->bround($params[0],$params[2]);        # then round accordingly
  1522.     }
  1523.   else
  1524.     {
  1525.     $x->bfround($params[1],$params[2]);        # then round accordingly
  1526.     }
  1527.   if ($fallback)
  1528.     {
  1529.     # clear a/p after round, since user did not request it
  1530.     $x->{_a} = undef; $x->{_p} = undef;
  1531.     }
  1532.   # restore globals
  1533.   $$abr = $ab; $$pbr = $pb;
  1534.   $x;
  1535.   }
  1536.  
  1537. sub bfac
  1538.   {
  1539.   # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT
  1540.   # compute factorial numbers
  1541.   # modifies first argument
  1542.   my ($self,$x,@r) = objectify(1,@_);
  1543.  
  1544.   return $x->bnan() 
  1545.     if (($x->{sign} ne '+') ||        # inf, NaN, <0 etc => NaN
  1546.      ($x->{_e}->{sign} ne '+'));    # digits after dot?
  1547.  
  1548.   return $x->bone('+',@r) if $x->is_zero() || $x->is_one();    # 0 or 1 => 1
  1549.   
  1550.   # use BigInt's bfac() for faster calc
  1551.   $x->{_m}->blsft($x->{_e},10);        # un-norm m
  1552.   $x->{_e}->bzero();            # norm $x again
  1553.   $x->{_m}->bfac();            # factorial
  1554.   $x->bnorm()->round(@r);
  1555.   }
  1556.  
  1557. sub _pow
  1558.   {
  1559.   # Calculate a power where $y is a non-integer, like 2 ** 0.5
  1560.   my ($x,$y,$a,$p,$r) = @_;
  1561.   my $self = ref($x);
  1562.  
  1563.   # if $y == 0.5, it is sqrt($x)
  1564.   return $x->bsqrt($a,$p,$r,$y) if $y->bcmp('0.5') == 0;
  1565.  
  1566.   # Using:
  1567.   # a ** x == e ** (x * ln a)
  1568.  
  1569.   # u = y * ln x
  1570.   #                _                         _
  1571.   # Taylor:       |   u    u^2    u^3         |
  1572.   # x ** y  = 1 + |  --- + --- + ----- + ...  |
  1573.   #               |_  1    1*2   1*2*3       _|
  1574.  
  1575.   # we need to limit the accuracy to protect against overflow
  1576.   my $fallback = 0;
  1577.   my ($scale,@params);
  1578.   ($x,@params) = $x->_find_round_parameters($a,$p,$r);
  1579.     
  1580.   return $x if $x->is_nan();        # error in _find_round_parameters?
  1581.  
  1582.   # no rounding at all, so must use fallback
  1583.   if (scalar @params == 0)
  1584.     {
  1585.     # simulate old behaviour
  1586.     $params[0] = $self->div_scale();    # and round to it as accuracy
  1587.     $params[1] = undef;            # disable P
  1588.     $scale = $params[0]+4;         # at least four more for proper round
  1589.     $params[2] = $r;            # round mode by caller or undef
  1590.     $fallback = 1;            # to clear a/p afterwards
  1591.     }
  1592.   else
  1593.     {
  1594.     # the 4 below is empirical, and there might be cases where it is not
  1595.     # enough...
  1596.     $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
  1597.     }
  1598.  
  1599.   # when user set globals, they would interfere with our calculation, so
  1600.   # disable them and later re-enable them
  1601.   no strict 'refs';
  1602.   my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
  1603.   my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
  1604.   # we also need to disable any set A or P on $x (_find_round_parameters took
  1605.   # them already into account), since these would interfere, too
  1606.   delete $x->{_a}; delete $x->{_p};
  1607.   # need to disable $upgrade in BigInt, to avoid deep recursion
  1608.   local $Math::BigInt::upgrade = undef;
  1609.  
  1610.   my ($limit,$v,$u,$below,$factor,$next,$over);
  1611.  
  1612.   $u = $x->copy()->blog(undef,$scale)->bmul($y);
  1613.   $v = $self->bone();                # 1
  1614.   $factor = $self->new(2);            # 2
  1615.   $x->bone();                    # first term: 1
  1616.  
  1617.   $below = $v->copy();
  1618.   $over = $u->copy();
  1619.  
  1620.   $limit = $self->new("1E-". ($scale-1));
  1621.   #my $steps = 0;
  1622.   while (3 < 5)
  1623.     {
  1624.     # we calculate the next term, and add it to the last
  1625.     # when the next term is below our limit, it won't affect the outcome
  1626.     # anymore, so we stop
  1627.     $next = $over->copy()->bdiv($below,$scale);
  1628.     last if $next->bacmp($limit) <= 0;
  1629.     $x->badd($next);
  1630.     # calculate things for the next term
  1631.     $over *= $u; $below *= $factor; $factor->binc();
  1632.     #$steps++;
  1633.     }
  1634.   
  1635.   # shortcut to not run trough _find_round_parameters again
  1636.   if (defined $params[0])
  1637.     {
  1638.     $x->bround($params[0],$params[2]);        # then round accordingly
  1639.     }
  1640.   else
  1641.     {
  1642.     $x->bfround($params[1],$params[2]);        # then round accordingly
  1643.     }
  1644.   if ($fallback)
  1645.     {
  1646.     # clear a/p after round, since user did not request it
  1647.     $x->{_a} = undef; $x->{_p} = undef;
  1648.     }
  1649.   # restore globals
  1650.   $$abr = $ab; $$pbr = $pb;
  1651.   $x;
  1652.   }
  1653.  
  1654. sub bpow 
  1655.   {
  1656.   # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT
  1657.   # compute power of two numbers, second arg is used as integer
  1658.   # modifies first argument
  1659.  
  1660.   # set up parameters
  1661.   my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
  1662.   # objectify is costly, so avoid it
  1663.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  1664.     {
  1665.     ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
  1666.     }
  1667.  
  1668.   return $x if $x->{sign} =~ /^[+-]inf$/;
  1669.   return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
  1670.   return $x->bone() if $y->is_zero();
  1671.   return $x         if $x->is_one() || $y->is_one();
  1672.  
  1673.   return $x->_pow($y,$a,$p,$r) if !$y->is_int();    # non-integer power
  1674.  
  1675.   my $y1 = $y->as_number();        # make bigint
  1676.   # if ($x == -1)
  1677.   if ($x->{sign} eq '-' && $x->{_m}->is_one() && $x->{_e}->is_zero())
  1678.     {
  1679.     # if $x == -1 and odd/even y => +1/-1  because +-1 ^ (+-1) => +-1
  1680.     return $y1->is_odd() ? $x : $x->babs(1);
  1681.     }
  1682.   if ($x->is_zero())
  1683.     {
  1684.     return $x if $y->{sign} eq '+';     # 0**y => 0 (if not y <= 0)
  1685.     # 0 ** -y => 1 / (0 ** y) => / 0! (1 / 0 => +inf)
  1686.     $x->binf();
  1687.     }
  1688.  
  1689.   # calculate $x->{_m} ** $y and $x->{_e} * $y separately (faster)
  1690.   $y1->babs();
  1691.   $x->{_m}->bpow($y1);
  1692.   $x->{_e}->bmul($y1);
  1693.   $x->{sign} = $nan if $x->{_m}->{sign} eq $nan || $x->{_e}->{sign} eq $nan;
  1694.   $x->bnorm();
  1695.   if ($y->{sign} eq '-')
  1696.     {
  1697.     # modify $x in place!
  1698.     my $z = $x->copy(); $x->bzero()->binc();
  1699.     return $x->bdiv($z,$a,$p,$r);    # round in one go (might ignore y's A!)
  1700.     }
  1701.   $x->round($a,$p,$r,$y);
  1702.   }
  1703.  
  1704. ###############################################################################
  1705. # rounding functions
  1706.  
  1707. sub bfround
  1708.   {
  1709.   # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
  1710.   # $n == 0 means round to integer
  1711.   # expects and returns normalized numbers!
  1712.   my $x = shift; my $self = ref($x) || $x; $x = $self->new(shift) if !ref($x);
  1713.  
  1714.   return $x if $x->modify('bfround');
  1715.   
  1716.   my ($scale,$mode) = $x->_scale_p($self->precision(),$self->round_mode(),@_);
  1717.   return $x if !defined $scale;            # no-op
  1718.  
  1719.   # never round a 0, +-inf, NaN
  1720.   if ($x->is_zero())
  1721.     {
  1722.     $x->{_p} = $scale if !defined $x->{_p} || $x->{_p} < $scale; # -3 < -2
  1723.     return $x; 
  1724.     }
  1725.   return $x if $x->{sign} !~ /^[+-]$/;
  1726.  
  1727.   # don't round if x already has lower precision
  1728.   return $x if (defined $x->{_p} && $x->{_p} < 0 && $scale < $x->{_p});
  1729.  
  1730.   $x->{_p} = $scale;            # remember round in any case
  1731.   $x->{_a} = undef;            # and clear A
  1732.   if ($scale < 0)
  1733.     {
  1734.     # round right from the '.'
  1735.  
  1736.     return $x if $x->{_e}->{sign} eq '+';    # e >= 0 => nothing to round
  1737.  
  1738.     $scale = -$scale;                # positive for simplicity
  1739.     my $len = $x->{_m}->length();        # length of mantissa
  1740.  
  1741.     # the following poses a restriction on _e, but if _e is bigger than a
  1742.     # scalar, you got other problems (memory etc) anyway
  1743.     my $dad = -($x->{_e}->numify());        # digits after dot
  1744.     my $zad = 0;                # zeros after dot
  1745.     $zad = $dad - $len if (-$dad < -$len);    # for 0.00..00xxx style
  1746.     
  1747.     #print "scale $scale dad $dad zad $zad len $len\n";
  1748.     # number  bsstr   len zad dad    
  1749.     # 0.123   123e-3    3   0 3
  1750.     # 0.0123  123e-4    3   1 4
  1751.     # 0.001   1e-3      1   2 3
  1752.     # 1.23    123e-2    3   0 2
  1753.     # 1.2345  12345e-4    5   0 4
  1754.  
  1755.     # do not round after/right of the $dad
  1756.     return $x if $scale > $dad;            # 0.123, scale >= 3 => exit
  1757.  
  1758.     # round to zero if rounding inside the $zad, but not for last zero like:
  1759.     # 0.0065, scale -2, round last '0' with following '65' (scale == zad case)
  1760.     return $x->bzero() if $scale < $zad;
  1761.     if ($scale == $zad)            # for 0.006, scale -3 and trunc
  1762.       {
  1763.       $scale = -$len;
  1764.       }
  1765.     else
  1766.       {
  1767.       # adjust round-point to be inside mantissa
  1768.       if ($zad != 0)
  1769.         {
  1770.     $scale = $scale-$zad;
  1771.         }
  1772.       else
  1773.         {
  1774.         my $dbd = $len - $dad; $dbd = 0 if $dbd < 0;    # digits before dot
  1775.     $scale = $dbd+$scale;
  1776.         }
  1777.       }
  1778.     }
  1779.   else
  1780.     {
  1781.     # round left from the '.'
  1782.  
  1783.     # 123 => 100 means length(123) = 3 - $scale (2) => 1
  1784.  
  1785.     my $dbt = $x->{_m}->length(); 
  1786.     # digits before dot 
  1787.     my $dbd = $dbt + $x->{_e}->numify(); 
  1788.     # should be the same, so treat it as this 
  1789.     $scale = 1 if $scale == 0; 
  1790.     # shortcut if already integer 
  1791.     return $x if $scale == 1 && $dbt <= $dbd; 
  1792.     # maximum digits before dot 
  1793.     ++$dbd;
  1794.  
  1795.     if ($scale > $dbd) 
  1796.        { 
  1797.        # not enough digits before dot, so round to zero 
  1798.        return $x->bzero; 
  1799.        }
  1800.     elsif ( $scale == $dbd )
  1801.        { 
  1802.        # maximum 
  1803.        $scale = -$dbt; 
  1804.        } 
  1805.     else
  1806.        { 
  1807.        $scale = $dbd - $scale; 
  1808.        }
  1809.     }
  1810.   # pass sign to bround for rounding modes '+inf' and '-inf'
  1811.   $x->{_m}->{sign} = $x->{sign};
  1812.   $x->{_m}->bround($scale,$mode);
  1813.   $x->{_m}->{sign} = '+';        # fix sign back
  1814.   $x->bnorm();
  1815.   }
  1816.  
  1817. sub bround
  1818.   {
  1819.   # accuracy: preserve $N digits, and overwrite the rest with 0's
  1820.   my $x = shift; my $self = ref($x) || $x; $x = $self->new(shift) if !ref($x);
  1821.   
  1822.   if (($_[0] || 0) < 0)
  1823.     {
  1824.     require Carp; Carp::croak ('bround() needs positive accuracy');
  1825.     }
  1826.  
  1827.   my ($scale,$mode) = $x->_scale_a($self->accuracy(),$self->round_mode(),@_);
  1828.   return $x if !defined $scale;                # no-op
  1829.  
  1830.   return $x if $x->modify('bround');
  1831.  
  1832.   # scale is now either $x->{_a}, $accuracy, or the user parameter
  1833.   # test whether $x already has lower accuracy, do nothing in this case 
  1834.   # but do round if the accuracy is the same, since a math operation might
  1835.   # want to round a number with A=5 to 5 digits afterwards again
  1836.   return $x if defined $_[0] && defined $x->{_a} && $x->{_a} < $_[0];
  1837.  
  1838.   # scale < 0 makes no sense
  1839.   # never round a +-inf, NaN
  1840.   return $x if ($scale < 0) ||    $x->{sign} !~ /^[+-]$/;
  1841.  
  1842.   # 1: $scale == 0 => keep all digits
  1843.   # 2: never round a 0
  1844.   # 3: if we should keep more digits than the mantissa has, do nothing
  1845.   if ($scale == 0 || $x->is_zero() || $x->{_m}->length() <= $scale)
  1846.     {
  1847.     $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale;
  1848.     return $x; 
  1849.     }
  1850.  
  1851.   # pass sign to bround for '+inf' and '-inf' rounding modes
  1852.   $x->{_m}->{sign} = $x->{sign};
  1853.   $x->{_m}->bround($scale,$mode);    # round mantissa
  1854.   $x->{_m}->{sign} = '+';        # fix sign back
  1855.   # $x->{_m}->{_a} = undef; $x->{_m}->{_p} = undef;
  1856.   $x->{_a} = $scale;            # remember rounding
  1857.   $x->{_p} = undef;            # and clear P
  1858.   $x->bnorm();                # del trailing zeros gen. by bround()
  1859.   }
  1860.  
  1861. sub bfloor
  1862.   {
  1863.   # return integer less or equal then $x
  1864.   my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
  1865.  
  1866.   return $x if $x->modify('bfloor');
  1867.    
  1868.   return $x if $x->{sign} !~ /^[+-]$/;    # nan, +inf, -inf
  1869.  
  1870.   # if $x has digits after dot
  1871.   if ($x->{_e}->{sign} eq '-')
  1872.     {
  1873.     $x->{_e}->{sign} = '+';            # negate e
  1874.     $x->{_m}->brsft($x->{_e},10);        # cut off digits after dot
  1875.     $x->{_e}->bzero();                # trunc/norm    
  1876.     $x->{_m}->binc() if $x->{sign} eq '-';    # decrement if negative
  1877.     }
  1878.   $x->round($a,$p,$r);
  1879.   }
  1880.  
  1881. sub bceil
  1882.   {
  1883.   # return integer greater or equal then $x
  1884.   my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
  1885.  
  1886.   return $x if $x->modify('bceil');
  1887.   return $x if $x->{sign} !~ /^[+-]$/;    # nan, +inf, -inf
  1888.  
  1889.   # if $x has digits after dot
  1890.   if ($x->{_e}->{sign} eq '-')
  1891.     {
  1892.     #$x->{_m}->brsft(-$x->{_e},10);
  1893.     #$x->{_e}->bzero();
  1894.     #$x++ if $x->{sign} eq '+';
  1895.  
  1896.     $x->{_e}->{sign} = '+';            # negate e
  1897.     $x->{_m}->brsft($x->{_e},10);        # cut off digits after dot
  1898.     $x->{_e}->bzero();                # trunc/norm    
  1899.     $x->{_m}->binc() if $x->{sign} eq '+';    # decrement if negative
  1900.     }
  1901.   $x->round($a,$p,$r);
  1902.   }
  1903.  
  1904. sub brsft
  1905.   {
  1906.   # shift right by $y (divide by power of $n)
  1907.   
  1908.   # set up parameters
  1909.   my ($self,$x,$y,$n,$a,$p,$r) = (ref($_[0]),@_);
  1910.   # objectify is costly, so avoid it
  1911.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  1912.     {
  1913.     ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
  1914.     }
  1915.  
  1916.   return $x if $x->modify('brsft');
  1917.   return $x if $x->{sign} !~ /^[+-]$/;    # nan, +inf, -inf
  1918.  
  1919.   $n = 2 if !defined $n; $n = $self->new($n);
  1920.   $x->bdiv($n->bpow($y),$a,$p,$r,$y);
  1921.   }
  1922.  
  1923. sub blsft
  1924.   {
  1925.   # shift left by $y (multiply by power of $n)
  1926.   
  1927.   # set up parameters
  1928.   my ($self,$x,$y,$n,$a,$p,$r) = (ref($_[0]),@_);
  1929.   # objectify is costly, so avoid it
  1930.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  1931.     {
  1932.     ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
  1933.     }
  1934.  
  1935.   return $x if $x->modify('blsft');
  1936.   return $x if $x->{sign} !~ /^[+-]$/;    # nan, +inf, -inf
  1937.  
  1938.   $n = 2 if !defined $n; $n = $self->new($n);
  1939.   $x->bmul($n->bpow($y),$a,$p,$r,$y);
  1940.   }
  1941.  
  1942. ###############################################################################
  1943.  
  1944. sub DESTROY
  1945.   {
  1946.   # going through AUTOLOAD for every DESTROY is costly, so avoid it by empty sub
  1947.   }
  1948.  
  1949. sub AUTOLOAD
  1950.   {
  1951.   # make fxxx and bxxx both work by selectively mapping fxxx() to MBF::bxxx()
  1952.   # or falling back to MBI::bxxx()
  1953.   my $name = $AUTOLOAD;
  1954.  
  1955.   $name =~ s/.*:://;    # split package
  1956.   no strict 'refs';
  1957.   $class->import() if $IMPORT == 0;
  1958.   if (!method_alias($name))
  1959.     {
  1960.     if (!defined $name)
  1961.       {
  1962.       # delayed load of Carp and avoid recursion    
  1963.       require Carp;
  1964.       Carp::croak ("Can't call a method without name");
  1965.       }
  1966.     if (!method_hand_up($name))
  1967.       {
  1968.       # delayed load of Carp and avoid recursion    
  1969.       require Carp;
  1970.       Carp::croak ("Can't call $class\-\>$name, not a valid method");
  1971.       }
  1972.     # try one level up, but subst. bxxx() for fxxx() since MBI only got bxxx()
  1973.     $name =~ s/^f/b/;
  1974.     return &{"$MBI"."::$name"}(@_);
  1975.     }
  1976.   my $bname = $name; $bname =~ s/^f/b/;
  1977.   *{$class."::$name"} = \&$bname;
  1978.   &$bname;    # uses @_
  1979.   }
  1980.  
  1981. sub exponent
  1982.   {
  1983.   # return a copy of the exponent
  1984.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  1985.  
  1986.   if ($x->{sign} !~ /^[+-]$/)
  1987.     {
  1988.     my $s = $x->{sign}; $s =~ s/^[+-]//;
  1989.     return $self->new($s);             # -inf, +inf => +inf
  1990.     }
  1991.   return $x->{_e}->copy();
  1992.   }
  1993.  
  1994. sub mantissa
  1995.   {
  1996.   # return a copy of the mantissa
  1997.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  1998.  
  1999.   if ($x->{sign} !~ /^[+-]$/)
  2000.     {
  2001.     my $s = $x->{sign}; $s =~ s/^[+]//;
  2002.     return $self->new($s);             # -inf, +inf => +inf
  2003.     }
  2004.   my $m = $x->{_m}->copy();        # faster than going via bstr()
  2005.   $m->bneg() if $x->{sign} eq '-';
  2006.  
  2007.   $m;
  2008.   }
  2009.  
  2010. sub parts
  2011.   {
  2012.   # return a copy of both the exponent and the mantissa
  2013.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  2014.  
  2015.   if ($x->{sign} !~ /^[+-]$/)
  2016.     {
  2017.     my $s = $x->{sign}; $s =~ s/^[+]//; my $se = $s; $se =~ s/^[-]//;
  2018.     return ($self->new($s),$self->new($se)); # +inf => inf and -inf,+inf => inf
  2019.     }
  2020.   my $m = $x->{_m}->copy();    # faster than going via bstr()
  2021.   $m->bneg() if $x->{sign} eq '-';
  2022.   return ($m,$x->{_e}->copy());
  2023.   }
  2024.  
  2025. ##############################################################################
  2026. # private stuff (internal use only)
  2027.  
  2028. sub import
  2029.   {
  2030.   my $self = shift;
  2031.   my $l = scalar @_;
  2032.   my $lib = ''; my @a;
  2033.   $IMPORT=1;
  2034.   for ( my $i = 0; $i < $l ; $i++)
  2035.     {
  2036.     if ( $_[$i] eq ':constant' )
  2037.       {
  2038.       # this rest causes overlord er load to step in
  2039.       overload::constant float => sub { $self->new(shift); }; 
  2040.       }
  2041.     elsif ($_[$i] eq 'upgrade')
  2042.       {
  2043.       # this causes upgrading
  2044.       $upgrade = $_[$i+1];        # or undef to disable
  2045.       $i++;
  2046.       }
  2047.     elsif ($_[$i] eq 'downgrade')
  2048.       {
  2049.       # this causes downgrading
  2050.       $downgrade = $_[$i+1];        # or undef to disable
  2051.       $i++;
  2052.       }
  2053.     elsif ($_[$i] eq 'lib')
  2054.       {
  2055.       # alternative library
  2056.       $lib = $_[$i+1] || '';        # default Calc
  2057.       $i++;
  2058.       }
  2059.     elsif ($_[$i] eq 'with')
  2060.       {
  2061.       # alternative class for our private parts()
  2062.       $MBI = $_[$i+1] || 'Math::BigInt';    # default Math::BigInt
  2063.       $i++;
  2064.       }
  2065.     else
  2066.       {
  2067.       push @a, $_[$i];
  2068.       }
  2069.     }
  2070.  
  2071.   # let use Math::BigInt lib => 'GMP'; use Math::BigFloat; still work
  2072.   my $mbilib = eval { Math::BigInt->config()->{lib} };
  2073.   if ((defined $mbilib) && ($MBI eq 'Math::BigInt'))
  2074.     {
  2075.     # MBI already loaded
  2076.     $MBI->import('lib',"$lib,$mbilib", 'objectify');
  2077.     }
  2078.   else
  2079.     {
  2080.     # MBI not loaded, or with ne "Math::BigInt"
  2081.     $lib .= ",$mbilib" if defined $mbilib;
  2082.     $lib =~ s/^,//;                # don't leave empty 
  2083.     # replacement library can handle lib statement, but also could ignore it
  2084.     if ($] < 5.006)
  2085.       {
  2086.       # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
  2087.       # used in the same script, or eval inside import().
  2088.       my @parts = split /::/, $MBI;        # Math::BigInt => Math BigInt
  2089.       my $file = pop @parts; $file .= '.pm';    # BigInt => BigInt.pm
  2090.       require File::Spec;
  2091.       $file = File::Spec->catfile (@parts, $file);
  2092.       eval { require "$file"; };
  2093.       $MBI->import( lib => $lib, 'objectify' );
  2094.       }
  2095.     else
  2096.       {
  2097.       my $rc = "use $MBI lib => '$lib', 'objectify';";
  2098.       eval $rc;
  2099.       }
  2100.     }
  2101.   if ($@)
  2102.     {
  2103.     require Carp; Carp::croak ("Couldn't load $MBI: $! $@");
  2104.     }
  2105.  
  2106.   # any non :constant stuff is handled by our parent, Exporter
  2107.   # even if @_ is empty, to give it a chance
  2108.   $self->SUPER::import(@a);          # for subclasses
  2109.   $self->export_to_level(1,$self,@a);    # need this, too
  2110.   }
  2111.  
  2112. sub bnorm
  2113.   {
  2114.   # adjust m and e so that m is smallest possible
  2115.   # round number according to accuracy and precision settings
  2116.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  2117.  
  2118.   return $x if $x->{sign} !~ /^[+-]$/;        # inf, nan etc
  2119.  
  2120. #  if (!$x->{_m}->is_odd())
  2121. #    {
  2122.     my $zeros = $x->{_m}->_trailing_zeros();    # correct for trailing zeros 
  2123.     if ($zeros != 0)
  2124.       {
  2125.       $x->{_m}->brsft($zeros,10); $x->{_e}->badd($zeros);
  2126.       }
  2127.     # for something like 0Ey, set y to 1, and -0 => +0
  2128.     $x->{sign} = '+', $x->{_e}->bone() if $x->{_m}->is_zero();
  2129. #    }
  2130.   # this is to prevent automatically rounding when MBI's globals are set
  2131.   $x->{_m}->{_f} = MB_NEVER_ROUND;
  2132.   $x->{_e}->{_f} = MB_NEVER_ROUND;
  2133.   # 'forget' that mantissa was rounded via MBI::bround() in MBF's bfround()
  2134.   $x->{_m}->{_a} = undef; $x->{_e}->{_a} = undef;
  2135.   $x->{_m}->{_p} = undef; $x->{_e}->{_p} = undef;
  2136.   $x;                    # MBI bnorm is no-op, so dont call it
  2137.   } 
  2138.  
  2139. ##############################################################################
  2140.  
  2141. sub as_hex
  2142.   {
  2143.   # return number as hexadecimal string (only for integers defined)
  2144.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  2145.  
  2146.   return $x->bstr() if $x->{sign} !~ /^[+-]$/;  # inf, nan etc
  2147.   return '0x0' if $x->is_zero();
  2148.  
  2149.   return $nan if $x->{_e}->{sign} ne '+';    # how to do 1e-1 in hex!?
  2150.  
  2151.   my $z = $x->{_m}->copy();
  2152.   if (!$x->{_e}->is_zero())        # > 0 
  2153.     {
  2154.     $z->blsft($x->{_e},10);
  2155.     }
  2156.   $z->{sign} = $x->{sign};
  2157.   $z->as_hex();
  2158.   }
  2159.  
  2160. sub as_bin
  2161.   {
  2162.   # return number as binary digit string (only for integers defined)
  2163.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  2164.  
  2165.   return $x->bstr() if $x->{sign} !~ /^[+-]$/;  # inf, nan etc
  2166.   return '0b0' if $x->is_zero();
  2167.  
  2168.   return $nan if $x->{_e}->{sign} ne '+';    # how to do 1e-1 in hex!?
  2169.  
  2170.   my $z = $x->{_m}->copy();
  2171.   if (!$x->{_e}->is_zero())        # > 0 
  2172.     {
  2173.     $z->blsft($x->{_e},10);
  2174.     }
  2175.   $z->{sign} = $x->{sign};
  2176.   $z->as_bin();
  2177.   }
  2178.  
  2179. sub as_number
  2180.   {
  2181.   # return copy as a bigint representation of this BigFloat number
  2182.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  2183.  
  2184.   my $z = $x->{_m}->copy();
  2185.   if ($x->{_e}->{sign} eq '-')        # < 0
  2186.     {
  2187.     $x->{_e}->{sign} = '+';        # flip
  2188.     $z->brsft($x->{_e},10);
  2189.     $x->{_e}->{sign} = '-';        # flip back
  2190.     } 
  2191.   elsif (!$x->{_e}->is_zero())        # > 0 
  2192.     {
  2193.     $z->blsft($x->{_e},10);
  2194.     }
  2195.   $z->{sign} = $x->{sign};
  2196.   $z;
  2197.   }
  2198.  
  2199. sub length
  2200.   {
  2201.   my $x = shift;
  2202.   my $class = ref($x) || $x;
  2203.   $x = $class->new(shift) unless ref($x);
  2204.  
  2205.   return 1 if $x->{_m}->is_zero();
  2206.   my $len = $x->{_m}->length();
  2207.   $len += $x->{_e} if $x->{_e}->sign() eq '+';
  2208.   if (wantarray())
  2209.     {
  2210.     my $t = $MBI->bzero();
  2211.     $t = $x->{_e}->copy()->babs() if $x->{_e}->sign() eq '-';
  2212.     return ($len,$t);
  2213.     }
  2214.   $len;
  2215.   }
  2216.  
  2217. 1;
  2218. __END__
  2219.  
  2220. =head1 NAME
  2221.  
  2222. Math::BigFloat - Arbitrary size floating point math package
  2223.  
  2224. =head1 SYNOPSIS
  2225.  
  2226.   use Math::BigFloat;
  2227.  
  2228.   # Number creation
  2229.   $x = Math::BigFloat->new($str);    # defaults to 0
  2230.   $nan  = Math::BigFloat->bnan();    # create a NotANumber
  2231.   $zero = Math::BigFloat->bzero();    # create a +0
  2232.   $inf = Math::BigFloat->binf();    # create a +inf
  2233.   $inf = Math::BigFloat->binf('-');    # create a -inf
  2234.   $one = Math::BigFloat->bone();    # create a +1
  2235.   $one = Math::BigFloat->bone('-');    # create a -1
  2236.  
  2237.   # Testing
  2238.   $x->is_zero();        # true if arg is +0
  2239.   $x->is_nan();            # true if arg is NaN
  2240.   $x->is_one();            # true if arg is +1
  2241.   $x->is_one('-');        # true if arg is -1
  2242.   $x->is_odd();            # true if odd, false for even
  2243.   $x->is_even();        # true if even, false for odd
  2244.   $x->is_positive();        # true if >= 0
  2245.   $x->is_negative();        # true if <  0
  2246.   $x->is_inf(sign);        # true if +inf, or -inf (default is '+')
  2247.  
  2248.   $x->bcmp($y);            # compare numbers (undef,<0,=0,>0)
  2249.   $x->bacmp($y);        # compare absolutely (undef,<0,=0,>0)
  2250.   $x->sign();            # return the sign, either +,- or NaN
  2251.   $x->digit($n);        # return the nth digit, counting from right
  2252.   $x->digit(-$n);        # return the nth digit, counting from left 
  2253.  
  2254.   # The following all modify their first argument. If you want to preserve
  2255.   # $x, use $z = $x->copy()->bXXX($y); See under L<CAVEATS> for why this is
  2256.   # neccessary when mixing $a = $b assigments with non-overloaded math.
  2257.  
  2258.   # set 
  2259.   $x->bzero();            # set $i to 0
  2260.   $x->bnan();            # set $i to NaN
  2261.   $x->bone();                   # set $x to +1
  2262.   $x->bone('-');                # set $x to -1
  2263.   $x->binf();                   # set $x to inf
  2264.   $x->binf('-');                # set $x to -inf
  2265.  
  2266.   $x->bneg();            # negation
  2267.   $x->babs();            # absolute value
  2268.   $x->bnorm();            # normalize (no-op)
  2269.   $x->bnot();            # two's complement (bit wise not)
  2270.   $x->binc();            # increment x by 1
  2271.   $x->bdec();            # decrement x by 1
  2272.   
  2273.   $x->badd($y);            # addition (add $y to $x)
  2274.   $x->bsub($y);            # subtraction (subtract $y from $x)
  2275.   $x->bmul($y);            # multiplication (multiply $x by $y)
  2276.   $x->bdiv($y);            # divide, set $x to quotient
  2277.                 # return (quo,rem) or quo if scalar
  2278.  
  2279.   $x->bmod($y);            # modulus ($x % $y)
  2280.   $x->bpow($y);            # power of arguments ($x ** $y)
  2281.   $x->blsft($y);        # left shift
  2282.   $x->brsft($y);        # right shift 
  2283.                 # return (quo,rem) or quo if scalar
  2284.   
  2285.   $x->blog();            # logarithm of $x to base e (Euler's number)
  2286.   $x->blog($base);        # logarithm of $x to base $base (f.i. 2)
  2287.   
  2288.   $x->band($y);            # bit-wise and
  2289.   $x->bior($y);            # bit-wise inclusive or
  2290.   $x->bxor($y);            # bit-wise exclusive or
  2291.   $x->bnot();            # bit-wise not (two's complement)
  2292.  
  2293.   $x->bsqrt();            # calculate square-root
  2294.   $x->broot($y);        # $y'th root of $x (e.g. $y == 3 => cubic root)
  2295.   $x->bfac();            # factorial of $x (1*2*3*4*..$x)
  2296.  
  2297.   $x->bround($N);         # accuracy: preserve $N digits
  2298.   $x->bfround($N);        # precision: round to the $Nth digit
  2299.  
  2300.   $x->bfloor();            # return integer less or equal than $x
  2301.   $x->bceil();            # return integer greater or equal than $x
  2302.  
  2303.   # The following do not modify their arguments:
  2304.  
  2305.   bgcd(@values);        # greatest common divisor
  2306.   blcm(@values);        # lowest common multiplicator
  2307.   
  2308.   $x->bstr();            # return string
  2309.   $x->bsstr();            # return string in scientific notation
  2310.  
  2311.   $x->exponent();        # return exponent as BigInt
  2312.   $x->mantissa();        # return mantissa as BigInt
  2313.   $x->parts();            # return (mantissa,exponent) as BigInt
  2314.  
  2315.   $x->length();            # number of digits (w/o sign and '.')
  2316.   ($l,$f) = $x->length();    # number of digits, and length of fraction    
  2317.  
  2318.   $x->precision();        # return P of $x (or global, if P of $x undef)
  2319.   $x->precision($n);        # set P of $x to $n
  2320.   $x->accuracy();        # return A of $x (or global, if A of $x undef)
  2321.   $x->accuracy($n);        # set A $x to $n
  2322.  
  2323.   # these get/set the appropriate global value for all BigFloat objects
  2324.   Math::BigFloat->precision();    # Precision
  2325.   Math::BigFloat->accuracy();    # Accuracy
  2326.   Math::BigFloat->round_mode();    # rounding mode
  2327.  
  2328. =head1 DESCRIPTION
  2329.  
  2330. All operators (inlcuding basic math operations) are overloaded if you
  2331. declare your big floating point numbers as
  2332.  
  2333.   $i = new Math::BigFloat '12_3.456_789_123_456_789E-2';
  2334.  
  2335. Operations with overloaded operators preserve the arguments, which is
  2336. exactly what you expect.
  2337.  
  2338. =head2 Canonical notation
  2339.  
  2340. Input to these routines are either BigFloat objects, or strings of the
  2341. following four forms:
  2342.  
  2343. =over 2
  2344.  
  2345. =item *
  2346.  
  2347. C</^[+-]\d+$/>
  2348.  
  2349. =item *
  2350.  
  2351. C</^[+-]\d+\.\d*$/>
  2352.  
  2353. =item *
  2354.  
  2355. C</^[+-]\d+E[+-]?\d+$/>
  2356.  
  2357. =item *
  2358.  
  2359. C</^[+-]\d*\.\d+E[+-]?\d+$/>
  2360.  
  2361. =back
  2362.  
  2363. all with optional leading and trailing zeros and/or spaces. Additonally,
  2364. numbers are allowed to have an underscore between any two digits.
  2365.  
  2366. Empty strings as well as other illegal numbers results in 'NaN'.
  2367.  
  2368. bnorm() on a BigFloat object is now effectively a no-op, since the numbers 
  2369. are always stored in normalized form. On a string, it creates a BigFloat 
  2370. object.
  2371.  
  2372. =head2 Output
  2373.  
  2374. Output values are BigFloat objects (normalized), except for bstr() and bsstr().
  2375.  
  2376. The string output will always have leading and trailing zeros stripped and drop
  2377. a plus sign. C<bstr()> will give you always the form with a decimal point,
  2378. while C<bsstr()> (s for scientific) gives you the scientific notation.
  2379.  
  2380.     Input            bstr()        bsstr()
  2381.     '-0'            '0'        '0E1'
  2382.        '  -123 123 123'    '-123123123'    '-123123123E0'
  2383.     '00.0123'        '0.0123'    '123E-4'
  2384.     '123.45E-2'        '1.2345'    '12345E-4'
  2385.     '10E+3'            '10000'        '1E4'
  2386.  
  2387. Some routines (C<is_odd()>, C<is_even()>, C<is_zero()>, C<is_one()>,
  2388. C<is_nan()>) return true or false, while others (C<bcmp()>, C<bacmp()>)
  2389. return either undef, <0, 0 or >0 and are suited for sort.
  2390.  
  2391. Actual math is done by using the class defined with C<with => Class;> (which
  2392. defaults to BigInts) to represent the mantissa and exponent.
  2393.  
  2394. The sign C</^[+-]$/> is stored separately. The string 'NaN' is used to 
  2395. represent the result when input arguments are not numbers, as well as 
  2396. the result of dividing by zero.
  2397.  
  2398. =head2 C<mantissa()>, C<exponent()> and C<parts()>
  2399.  
  2400. C<mantissa()> and C<exponent()> return the said parts of the BigFloat 
  2401. as BigInts such that:
  2402.  
  2403.     $m = $x->mantissa();
  2404.     $e = $x->exponent();
  2405.     $y = $m * ( 10 ** $e );
  2406.     print "ok\n" if $x == $y;
  2407.  
  2408. C<< ($m,$e) = $x->parts(); >> is just a shortcut giving you both of them.
  2409.  
  2410. A zero is represented and returned as C<0E1>, B<not> C<0E0> (after Knuth).
  2411.  
  2412. Currently the mantissa is reduced as much as possible, favouring higher
  2413. exponents over lower ones (e.g. returning 1e7 instead of 10e6 or 10000000e0).
  2414. This might change in the future, so do not depend on it.
  2415.  
  2416. =head2 Accuracy vs. Precision
  2417.  
  2418. See also: L<Rounding|Rounding>.
  2419.  
  2420. Math::BigFloat supports both precision and accuracy. For a full documentation,
  2421. examples and tips on these topics please see the large section in
  2422. L<Math::BigInt>.
  2423.  
  2424. Since things like sqrt(2) or 1/3 must presented with a limited precision lest
  2425. a operation consumes all resources, each operation produces no more than
  2426. the requested number of digits.
  2427.  
  2428. Please refer to BigInt's documentation for the precedence rules of which
  2429. accuracy/precision setting will be used.
  2430.  
  2431. If there is no gloabl precision set, B<and> the operation inquestion was not
  2432. called with a requested precision or accuracy, B<and> the input $x has no
  2433. accuracy or precision set, then a fallback parameter will be used. For
  2434. historical reasons, it is called C<div_scale> and can be accessed via:
  2435.  
  2436.     $d = Math::BigFloat->div_scale();        # query
  2437.     Math::BigFloat->div_scale($n);            # set to $n digits
  2438.  
  2439. The default value is 40 digits.
  2440.  
  2441. In case the result of one operation has more precision than specified,
  2442. it is rounded. The rounding mode taken is either the default mode, or the one
  2443. supplied to the operation after the I<scale>:
  2444.  
  2445.     $x = Math::BigFloat->new(2);
  2446.     Math::BigFloat->precision(5);        # 5 digits max
  2447.     $y = $x->copy()->bdiv(3);        # will give 0.66666
  2448.     $y = $x->copy()->bdiv(3,6);        # will give 0.666666
  2449.     $y = $x->copy()->bdiv(3,6,'odd');    # will give 0.666667
  2450.     Math::BigFloat->round_mode('zero');
  2451.     $y = $x->copy()->bdiv(3,6);        # will give 0.666666
  2452.  
  2453. =head2 Rounding
  2454.  
  2455. =over 2
  2456.  
  2457. =item ffround ( +$scale )
  2458.  
  2459. Rounds to the $scale'th place left from the '.', counting from the dot.
  2460. The first digit is numbered 1. 
  2461.  
  2462. =item ffround ( -$scale )
  2463.  
  2464. Rounds to the $scale'th place right from the '.', counting from the dot.
  2465.  
  2466. =item ffround ( 0 )
  2467.  
  2468. Rounds to an integer.
  2469.  
  2470. =item fround  ( +$scale )
  2471.  
  2472. Preserves accuracy to $scale digits from the left (aka significant digits)
  2473. and pads the rest with zeros. If the number is between 1 and -1, the
  2474. significant digits count from the first non-zero after the '.'
  2475.  
  2476. =item fround  ( -$scale ) and fround ( 0 )
  2477.  
  2478. These are effectively no-ops.
  2479.  
  2480. =back
  2481.  
  2482. All rounding functions take as a second parameter a rounding mode from one of
  2483. the following: 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'.
  2484.  
  2485. The default rounding mode is 'even'. By using
  2486. C<< Math::BigFloat->round_mode($round_mode); >> you can get and set the default
  2487. mode for subsequent rounding. The usage of C<$Math::BigFloat::$round_mode> is
  2488. no longer supported.
  2489. The second parameter to the round functions then overrides the default
  2490. temporarily. 
  2491.  
  2492. The C<as_number()> function returns a BigInt from a Math::BigFloat. It uses
  2493. 'trunc' as rounding mode to make it equivalent to:
  2494.  
  2495.     $x = 2.5;
  2496.     $y = int($x) + 2;
  2497.  
  2498. You can override this by passing the desired rounding mode as parameter to
  2499. C<as_number()>:
  2500.  
  2501.     $x = Math::BigFloat->new(2.5);
  2502.     $y = $x->as_number('odd');    # $y = 3
  2503.  
  2504. =head1 EXAMPLES
  2505.  
  2506.   # not ready yet
  2507.  
  2508. =head1 Autocreating constants
  2509.  
  2510. After C<use Math::BigFloat ':constant'> all the floating point constants
  2511. in the given scope are converted to C<Math::BigFloat>. This conversion
  2512. happens at compile time.
  2513.  
  2514. In particular
  2515.  
  2516.   perl -MMath::BigFloat=:constant -e 'print 2E-100,"\n"'
  2517.  
  2518. prints the value of C<2E-100>. Note that without conversion of 
  2519. constants the expression 2E-100 will be calculated as normal floating point 
  2520. number.
  2521.  
  2522. Please note that ':constant' does not affect integer constants, nor binary 
  2523. nor hexadecimal constants. Use L<bignum> or L<Math::BigInt> to get this to
  2524. work.
  2525.  
  2526. =head2 Math library
  2527.  
  2528. Math with the numbers is done (by default) by a module called
  2529. Math::BigInt::Calc. This is equivalent to saying:
  2530.  
  2531.     use Math::BigFloat lib => 'Calc';
  2532.  
  2533. You can change this by using:
  2534.  
  2535.     use Math::BigFloat lib => 'BitVect';
  2536.  
  2537. The following would first try to find Math::BigInt::Foo, then
  2538. Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
  2539.  
  2540.     use Math::BigFloat lib => 'Foo,Math::BigInt::Bar';
  2541.  
  2542. Calc.pm uses as internal format an array of elements of some decimal base
  2543. (usually 1e7, but this might be differen for some systems) with the least
  2544. significant digit first, while BitVect.pm uses a bit vector of base 2, most
  2545. significant bit first. Other modules might use even different means of
  2546. representing the numbers. See the respective module documentation for further
  2547. details.
  2548.  
  2549. Please note that Math::BigFloat does B<not> use the denoted library itself,
  2550. but it merely passes the lib argument to Math::BigInt. So, instead of the need
  2551. to do:
  2552.  
  2553.     use Math::BigInt lib => 'GMP';
  2554.     use Math::BigFloat;
  2555.  
  2556. you can roll it all into one line:
  2557.  
  2558.     use Math::BigFloat lib => 'GMP';
  2559.  
  2560. It is also possible to just require Math::BigFloat:
  2561.  
  2562.     require Math::BigFloat;
  2563.  
  2564. This will load the neccessary things (like BigInt) when they are needed, and
  2565. automatically.
  2566.  
  2567. Use the lib, Luke! And see L<Using Math::BigInt::Lite> for more details than
  2568. you ever wanted to know about loading a different library.
  2569.  
  2570. =head2 Using Math::BigInt::Lite
  2571.  
  2572. It is possible to use L<Math::BigInt::Lite> with Math::BigFloat:
  2573.  
  2574.         # 1
  2575.         use Math::BigFloat with => 'Math::BigInt::Lite';
  2576.  
  2577. There is no need to "use Math::BigInt" or "use Math::BigInt::Lite", but you
  2578. can combine these if you want. For instance, you may want to use
  2579. Math::BigInt objects in your main script, too.
  2580.  
  2581.         # 2
  2582.         use Math::BigInt;
  2583.         use Math::BigFloat with => 'Math::BigInt::Lite';
  2584.  
  2585. Of course, you can combine this with the C<lib> parameter.
  2586.  
  2587.         # 3
  2588.         use Math::BigFloat with => 'Math::BigInt::Lite', lib => 'GMP,Pari';
  2589.  
  2590. There is no need for a "use Math::BigInt;" statement, even if you want to
  2591. use Math::BigInt's, since Math::BigFloat will needs Math::BigInt and thus
  2592. always loads it. But if you add it, add it B<before>:
  2593.  
  2594.         # 4
  2595.         use Math::BigInt;
  2596.         use Math::BigFloat with => 'Math::BigInt::Lite', lib => 'GMP,Pari';
  2597.  
  2598. Notice that the module with the last C<lib> will "win" and thus
  2599. it's lib will be used if the lib is available:
  2600.  
  2601.         # 5
  2602.         use Math::BigInt lib => 'Bar,Baz';
  2603.         use Math::BigFloat with => 'Math::BigInt::Lite', lib => 'Foo';
  2604.  
  2605. That would try to load Foo, Bar, Baz and Calc (in that order). Or in other
  2606. words, Math::BigFloat will try to retain previously loaded libs when you
  2607. don't specify it onem but if you specify one, it will try to load them.
  2608.  
  2609. Actually, the lib loading order would be "Bar,Baz,Calc", and then
  2610. "Foo,Bar,Baz,Calc", but independend of which lib exists, the result is the
  2611. same as trying the latter load alone, except for the fact that one of Bar or
  2612. Baz might be loaded needlessly in an intermidiate step (and thus hang around
  2613. and waste memory). If neither Bar nor Baz exist (or don't work/compile), they
  2614. will still be tried to be loaded, but this is not as time/memory consuming as
  2615. actually loading one of them. Still, this type of usage is not recommended due
  2616. to these issues.
  2617.  
  2618. The old way (loading the lib only in BigInt) still works though:
  2619.  
  2620.         # 6
  2621.         use Math::BigInt lib => 'Bar,Baz';
  2622.         use Math::BigFloat;
  2623.  
  2624. You can even load Math::BigInt afterwards:
  2625.  
  2626.         # 7
  2627.         use Math::BigFloat;
  2628.         use Math::BigInt lib => 'Bar,Baz';
  2629.  
  2630. But this has the same problems like #5, it will first load Calc
  2631. (Math::BigFloat needs Math::BigInt and thus loads it) and then later Bar or
  2632. Baz, depending on which of them works and is usable/loadable. Since this
  2633. loads Calc unnecc., it is not recommended.
  2634.  
  2635. Since it also possible to just require Math::BigFloat, this poses the question
  2636. about what libary this will use:
  2637.  
  2638.     require Math::BigFloat;
  2639.     my $x = Math::BigFloat->new(123); $x += 123;
  2640.  
  2641. It will use Calc. Please note that the call to import() is still done, but
  2642. only when you use for the first time some Math::BigFloat math (it is triggered
  2643. via any constructor, so the first time you create a Math::BigFloat, the load
  2644. will happen in the background). This means:
  2645.  
  2646.     require Math::BigFloat;
  2647.     Math::BigFloat->import ( lib => 'Foo,Bar' );
  2648.  
  2649. would be the same as:
  2650.  
  2651.     use Math::BigFloat lib => 'Foo, Bar';
  2652.  
  2653. But don't try to be clever to insert some operations in between:
  2654.  
  2655.     require Math::BigFloat;
  2656.     my $x = Math::BigFloat->bone() + 4;        # load BigInt and Calc
  2657.     Math::BigFloat->import( lib => 'Pari' );    # load Pari, too
  2658.     $x = Math::BigFloat->bone()+4;            # now use Pari
  2659.  
  2660. While this works, it loads Calc needlessly. But maybe you just wanted that?
  2661.  
  2662. B<Examples #3 is highly recommended> for daily usage.
  2663.  
  2664. =head1 BUGS
  2665.  
  2666. Please see the file BUGS in the CPAN distribution Math::BigInt for known bugs.
  2667.  
  2668. =head1 CAVEATS
  2669.  
  2670. =over 1
  2671.  
  2672. =item stringify, bstr()
  2673.  
  2674. Both stringify and bstr() now drop the leading '+'. The old code would return
  2675. '+1.23', the new returns '1.23'. See the documentation in L<Math::BigInt> for
  2676. reasoning and details.
  2677.  
  2678. =item bdiv
  2679.  
  2680. The following will probably not do what you expect:
  2681.  
  2682.     print $c->bdiv(123.456),"\n";
  2683.  
  2684. It prints both quotient and reminder since print works in list context. Also,
  2685. bdiv() will modify $c, so be carefull. You probably want to use
  2686.     
  2687.     print $c / 123.456,"\n";
  2688.     print scalar $c->bdiv(123.456),"\n";  # or if you want to modify $c
  2689.  
  2690. instead.
  2691.  
  2692. =item Modifying and =
  2693.  
  2694. Beware of:
  2695.  
  2696.     $x = Math::BigFloat->new(5);
  2697.     $y = $x;
  2698.  
  2699. It will not do what you think, e.g. making a copy of $x. Instead it just makes
  2700. a second reference to the B<same> object and stores it in $y. Thus anything
  2701. that modifies $x will modify $y (except overloaded math operators), and vice
  2702. versa. See L<Math::BigInt> for details and how to avoid that.
  2703.  
  2704. =item bpow
  2705.  
  2706. C<bpow()> now modifies the first argument, unlike the old code which left
  2707. it alone and only returned the result. This is to be consistent with
  2708. C<badd()> etc. The first will modify $x, the second one won't:
  2709.  
  2710.     print bpow($x,$i),"\n";     # modify $x
  2711.     print $x->bpow($i),"\n";     # ditto
  2712.     print $x ** $i,"\n";        # leave $x alone 
  2713.  
  2714. =back
  2715.  
  2716. =head1 SEE ALSO
  2717.  
  2718. L<Math::BigInt>, L<Math::BigRat> and L<Math::Big> as well as
  2719. L<Math::BigInt::BitVect>, L<Math::BigInt::Pari> and  L<Math::BigInt::GMP>.
  2720.  
  2721. The pragmas L<bignum>, L<bigint> and L<bigrat> might also be of interest
  2722. because they solve the autoupgrading/downgrading issue, at least partly.
  2723.  
  2724. The package at
  2725. L<http://search.cpan.org/search?mode=module&query=Math%3A%3ABigInt> contains
  2726. more documentation including a full version history, testcases, empty
  2727. subclass files and benchmarks.
  2728.  
  2729. =head1 LICENSE
  2730.  
  2731. This program is free software; you may redistribute it and/or modify it under
  2732. the same terms as Perl itself.
  2733.  
  2734. =head1 AUTHORS
  2735.  
  2736. Mark Biggar, overloaded interface by Ilya Zakharevich.
  2737. Completely rewritten by Tels http://bloodgate.com in 2001, 2002, and still
  2738. at it in 2003.
  2739.  
  2740. =cut
  2741.