xref: /openbsd-src/gnu/usr.bin/perl/cpan/Math-BigInt/lib/Math/BigFloat.pm (revision 3d61058aa5c692477b6d18acfbbdb653a9930ff9)
1b8851fccSafresh1package Math::BigFloat;
2b8851fccSafresh1
3b8851fccSafresh1#
4b8851fccSafresh1# Mike grinned. 'Two down, infinity to go' - Mike Nostrus in 'Before and After'
5b8851fccSafresh1#
6b8851fccSafresh1
79f11ffb7Safresh1# The following hash values are used internally:
8*3d61058aSafresh1#
9*3d61058aSafresh1#          sign : "+", "-", "+inf", "-inf", or "NaN"
10*3d61058aSafresh1#            _m : absolute value of mantissa ($LIB thingy)
11*3d61058aSafresh1#           _es : sign of exponent ("+" or "-")
12*3d61058aSafresh1#            _e : absolute value of exponent ($LIB thingy)
13*3d61058aSafresh1#      accuracy : accuracy (scalar)
14*3d61058aSafresh1#     precision : precision (scalar)
15b8851fccSafresh1
16b8851fccSafresh1use 5.006001;
17b8851fccSafresh1use strict;
18b8851fccSafresh1use warnings;
19b8851fccSafresh1
20b46d8ef2Safresh1use Carp          qw< carp croak >;
21eac174f2Safresh1use Scalar::Util  qw< blessed >;
22eac174f2Safresh1use Math::BigInt  qw< >;
239f11ffb7Safresh1
24*3d61058aSafresh1our $VERSION = '2.003002';
25eac174f2Safresh1$VERSION =~ tr/_//d;
26b8851fccSafresh1
2756d68f1eSafresh1require Exporter;
28b8851fccSafresh1our @ISA        = qw/Math::BigInt/;
29b8851fccSafresh1our @EXPORT_OK  = qw/bpi/;
30b8851fccSafresh1
31b8851fccSafresh1# $_trap_inf/$_trap_nan are internal and should never be accessed from outside
32b8851fccSafresh1our ($AUTOLOAD, $accuracy, $precision, $div_scale, $round_mode, $rnd_mode,
33b8851fccSafresh1     $upgrade, $downgrade, $_trap_nan, $_trap_inf);
34b8851fccSafresh1
35b8851fccSafresh1use overload
369f11ffb7Safresh1
379f11ffb7Safresh1  # overload key: with_assign
389f11ffb7Safresh1
399f11ffb7Safresh1  '+'     =>      sub { $_[0] -> copy() -> badd($_[1]); },
409f11ffb7Safresh1
419f11ffb7Safresh1  '-'     =>      sub { my $c = $_[0] -> copy();
429f11ffb7Safresh1                        $_[2] ? $c -> bneg() -> badd($_[1])
439f11ffb7Safresh1                              : $c -> bsub($_[1]); },
449f11ffb7Safresh1
459f11ffb7Safresh1  '*'     =>      sub { $_[0] -> copy() -> bmul($_[1]); },
469f11ffb7Safresh1
479f11ffb7Safresh1  '/'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bdiv($_[0])
489f11ffb7Safresh1                              : $_[0] -> copy() -> bdiv($_[1]); },
499f11ffb7Safresh1
509f11ffb7Safresh1  '%'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bmod($_[0])
519f11ffb7Safresh1                              : $_[0] -> copy() -> bmod($_[1]); },
529f11ffb7Safresh1
539f11ffb7Safresh1  '**'    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bpow($_[0])
549f11ffb7Safresh1                              : $_[0] -> copy() -> bpow($_[1]); },
559f11ffb7Safresh1
56*3d61058aSafresh1  '<<'    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bblsft($_[0])
57*3d61058aSafresh1                              : $_[0] -> copy() -> bblsft($_[1]); },
589f11ffb7Safresh1
59*3d61058aSafresh1  '>>'    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bbrsft($_[0])
60*3d61058aSafresh1                              : $_[0] -> copy() -> bbrsft($_[1]); },
619f11ffb7Safresh1
629f11ffb7Safresh1  # overload key: assign
639f11ffb7Safresh1
649f11ffb7Safresh1  '+='    =>      sub { $_[0] -> badd($_[1]); },
659f11ffb7Safresh1
669f11ffb7Safresh1  '-='    =>      sub { $_[0] -> bsub($_[1]); },
679f11ffb7Safresh1
689f11ffb7Safresh1  '*='    =>      sub { $_[0] -> bmul($_[1]); },
699f11ffb7Safresh1
709f11ffb7Safresh1  '/='    =>      sub { scalar $_[0] -> bdiv($_[1]); },
719f11ffb7Safresh1
729f11ffb7Safresh1  '%='    =>      sub { $_[0] -> bmod($_[1]); },
739f11ffb7Safresh1
749f11ffb7Safresh1  '**='   =>      sub { $_[0] -> bpow($_[1]); },
759f11ffb7Safresh1
76*3d61058aSafresh1  '<<='   =>      sub { $_[0] -> bblsft($_[1]); },
779f11ffb7Safresh1
78*3d61058aSafresh1  '>>='   =>      sub { $_[0] -> bbrsft($_[1]); },
799f11ffb7Safresh1
809f11ffb7Safresh1#  'x='    =>      sub { },
819f11ffb7Safresh1
829f11ffb7Safresh1#  '.='    =>      sub { },
839f11ffb7Safresh1
849f11ffb7Safresh1  # overload key: num_comparison
859f11ffb7Safresh1
869f11ffb7Safresh1  '<'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> blt($_[0])
879f11ffb7Safresh1                              : $_[0] -> blt($_[1]); },
889f11ffb7Safresh1
899f11ffb7Safresh1  '<='    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> ble($_[0])
909f11ffb7Safresh1                              : $_[0] -> ble($_[1]); },
919f11ffb7Safresh1
929f11ffb7Safresh1  '>'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bgt($_[0])
939f11ffb7Safresh1                              : $_[0] -> bgt($_[1]); },
949f11ffb7Safresh1
959f11ffb7Safresh1  '>='    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bge($_[0])
969f11ffb7Safresh1                              : $_[0] -> bge($_[1]); },
979f11ffb7Safresh1
989f11ffb7Safresh1  '=='    =>      sub { $_[0] -> beq($_[1]); },
999f11ffb7Safresh1
1009f11ffb7Safresh1  '!='    =>      sub { $_[0] -> bne($_[1]); },
1019f11ffb7Safresh1
1029f11ffb7Safresh1  # overload key: 3way_comparison
1039f11ffb7Safresh1
1049f11ffb7Safresh1  '<=>'   =>      sub { my $cmp = $_[0] -> bcmp($_[1]);
1059f11ffb7Safresh1                        defined($cmp) && $_[2] ? -$cmp : $cmp; },
1069f11ffb7Safresh1
1079f11ffb7Safresh1  'cmp'   =>      sub { $_[2] ? "$_[1]" cmp $_[0] -> bstr()
1089f11ffb7Safresh1                              : $_[0] -> bstr() cmp "$_[1]"; },
1099f11ffb7Safresh1
1109f11ffb7Safresh1  # overload key: str_comparison
1119f11ffb7Safresh1
1129f11ffb7Safresh1#  'lt'    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrlt($_[0])
1139f11ffb7Safresh1#                              : $_[0] -> bstrlt($_[1]); },
1149f11ffb7Safresh1#
1159f11ffb7Safresh1#  'le'    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrle($_[0])
1169f11ffb7Safresh1#                              : $_[0] -> bstrle($_[1]); },
1179f11ffb7Safresh1#
1189f11ffb7Safresh1#  'gt'    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrgt($_[0])
1199f11ffb7Safresh1#                              : $_[0] -> bstrgt($_[1]); },
1209f11ffb7Safresh1#
1219f11ffb7Safresh1#  'ge'    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrge($_[0])
1229f11ffb7Safresh1#                              : $_[0] -> bstrge($_[1]); },
1239f11ffb7Safresh1#
1249f11ffb7Safresh1#  'eq'    =>      sub { $_[0] -> bstreq($_[1]); },
1259f11ffb7Safresh1#
1269f11ffb7Safresh1#  'ne'    =>      sub { $_[0] -> bstrne($_[1]); },
1279f11ffb7Safresh1
1289f11ffb7Safresh1  # overload key: binary
1299f11ffb7Safresh1
1309f11ffb7Safresh1  '&'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> band($_[0])
1319f11ffb7Safresh1                              : $_[0] -> copy() -> band($_[1]); },
1329f11ffb7Safresh1
1339f11ffb7Safresh1  '&='    =>      sub { $_[0] -> band($_[1]); },
1349f11ffb7Safresh1
1359f11ffb7Safresh1  '|'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bior($_[0])
1369f11ffb7Safresh1                              : $_[0] -> copy() -> bior($_[1]); },
1379f11ffb7Safresh1
1389f11ffb7Safresh1  '|='    =>      sub { $_[0] -> bior($_[1]); },
1399f11ffb7Safresh1
1409f11ffb7Safresh1  '^'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bxor($_[0])
1419f11ffb7Safresh1                              : $_[0] -> copy() -> bxor($_[1]); },
1429f11ffb7Safresh1
1439f11ffb7Safresh1  '^='    =>      sub { $_[0] -> bxor($_[1]); },
1449f11ffb7Safresh1
1459f11ffb7Safresh1#  '&.'    =>      sub { },
1469f11ffb7Safresh1
1479f11ffb7Safresh1#  '&.='   =>      sub { },
1489f11ffb7Safresh1
1499f11ffb7Safresh1#  '|.'    =>      sub { },
1509f11ffb7Safresh1
1519f11ffb7Safresh1#  '|.='   =>      sub { },
1529f11ffb7Safresh1
1539f11ffb7Safresh1#  '^.'    =>      sub { },
1549f11ffb7Safresh1
1559f11ffb7Safresh1#  '^.='   =>      sub { },
1569f11ffb7Safresh1
1579f11ffb7Safresh1  # overload key: unary
1589f11ffb7Safresh1
1599f11ffb7Safresh1  'neg'   =>      sub { $_[0] -> copy() -> bneg(); },
1609f11ffb7Safresh1
1619f11ffb7Safresh1#  '!'     =>      sub { },
1629f11ffb7Safresh1
1639f11ffb7Safresh1  '~'     =>      sub { $_[0] -> copy() -> bnot(); },
1649f11ffb7Safresh1
1659f11ffb7Safresh1#  '~.'    =>      sub { },
1669f11ffb7Safresh1
1679f11ffb7Safresh1  # overload key: mutators
1689f11ffb7Safresh1
1699f11ffb7Safresh1  '++'    =>      sub { $_[0] -> binc() },
1709f11ffb7Safresh1
1719f11ffb7Safresh1  '--'    =>      sub { $_[0] -> bdec() },
1729f11ffb7Safresh1
1739f11ffb7Safresh1  # overload key: func
1749f11ffb7Safresh1
1759f11ffb7Safresh1  'atan2' =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> batan2($_[0])
1769f11ffb7Safresh1                              : $_[0] -> copy() -> batan2($_[1]); },
1779f11ffb7Safresh1
1789f11ffb7Safresh1  'cos'   =>      sub { $_[0] -> copy() -> bcos(); },
1799f11ffb7Safresh1
1809f11ffb7Safresh1  'sin'   =>      sub { $_[0] -> copy() -> bsin(); },
1819f11ffb7Safresh1
1829f11ffb7Safresh1  'exp'   =>      sub { $_[0] -> copy() -> bexp($_[1]); },
1839f11ffb7Safresh1
1849f11ffb7Safresh1  'abs'   =>      sub { $_[0] -> copy() -> babs(); },
1859f11ffb7Safresh1
1869f11ffb7Safresh1  'log'   =>      sub { $_[0] -> copy() -> blog(); },
1879f11ffb7Safresh1
1889f11ffb7Safresh1  'sqrt'  =>      sub { $_[0] -> copy() -> bsqrt(); },
1899f11ffb7Safresh1
1909f11ffb7Safresh1  'int'   =>      sub { $_[0] -> copy() -> bint(); },
1919f11ffb7Safresh1
1929f11ffb7Safresh1  # overload key: conversion
1939f11ffb7Safresh1
1949f11ffb7Safresh1  'bool'  =>      sub { $_[0] -> is_zero() ? '' : 1; },
1959f11ffb7Safresh1
1969f11ffb7Safresh1  '""'    =>      sub { $_[0] -> bstr(); },
1979f11ffb7Safresh1
1989f11ffb7Safresh1  '0+'    =>      sub { $_[0] -> numify(); },
1999f11ffb7Safresh1
2009f11ffb7Safresh1  '='     =>      sub { $_[0] -> copy(); },
2019f11ffb7Safresh1
202b8851fccSafresh1  ;
203b8851fccSafresh1
204b8851fccSafresh1##############################################################################
205b8851fccSafresh1# global constants, flags and assorted stuff
206b8851fccSafresh1
207b8851fccSafresh1# the following are public, but their usage is not recommended. Use the
208b8851fccSafresh1# accessor methods instead.
209b8851fccSafresh1
210b8851fccSafresh1# class constants, use Class->constant_name() to access
211b8851fccSafresh1# one of 'even', 'odd', '+inf', '-inf', 'zero', 'trunc' or 'common'
212b8851fccSafresh1$round_mode = 'even';
213b8851fccSafresh1$accuracy   = undef;
214b8851fccSafresh1$precision  = undef;
215b8851fccSafresh1$div_scale  = 40;
216b8851fccSafresh1
217b8851fccSafresh1$upgrade = undef;
218b8851fccSafresh1$downgrade = undef;
219b8851fccSafresh1# the package we are using for our private parts, defaults to:
2209f11ffb7Safresh1# Math::BigInt->config('lib')
221b46d8ef2Safresh1my $LIB = 'Math::BigInt::Calc';
222b8851fccSafresh1
223b8851fccSafresh1# are NaNs ok? (otherwise it dies when encountering an NaN) set w/ config()
224b8851fccSafresh1$_trap_nan = 0;
225b8851fccSafresh1# the same for infinity
226b8851fccSafresh1$_trap_inf = 0;
227b8851fccSafresh1
228b8851fccSafresh1# constant for easier life
229b8851fccSafresh1my $nan = 'NaN';
230b8851fccSafresh1
231*3d61058aSafresh1# Has import() been called yet? This variable is needed to make "require" work.
232*3d61058aSafresh1
233*3d61058aSafresh1my $IMPORT = 0;
234b8851fccSafresh1
235b8851fccSafresh1# some digits of accuracy for blog(undef, 10); which we use in blog() for speed
236b8851fccSafresh1my $LOG_10 =
237b8851fccSafresh1 '2.3025850929940456840179914546843642076011014886287729760333279009675726097';
238b8851fccSafresh1my $LOG_10_A = length($LOG_10)-1;
239b8851fccSafresh1# ditto for log(2)
240b8851fccSafresh1my $LOG_2 =
241b8851fccSafresh1 '0.6931471805599453094172321214581765680755001343602552541206800094933936220';
242b8851fccSafresh1my $LOG_2_A = length($LOG_2)-1;
243b8851fccSafresh1my $HALF = '0.5';                       # made into an object if nec.
244b8851fccSafresh1
245b8851fccSafresh1##############################################################################
246b8851fccSafresh1# the old code had $rnd_mode, so we need to support it, too
247b8851fccSafresh1
2489f11ffb7Safresh1sub TIESCALAR {
2499f11ffb7Safresh1    my ($class) = @_;
2509f11ffb7Safresh1    bless \$round_mode, $class;
2519f11ffb7Safresh1}
252b8851fccSafresh1
2539f11ffb7Safresh1sub FETCH {
2549f11ffb7Safresh1    return $round_mode;
2559f11ffb7Safresh1}
2569f11ffb7Safresh1
2579f11ffb7Safresh1sub STORE {
258*3d61058aSafresh1    $rnd_mode = (ref $_[0]) -> round_mode($_[1]);
2599f11ffb7Safresh1}
2609f11ffb7Safresh1
2619f11ffb7Safresh1BEGIN {
262*3d61058aSafresh1    *objectify = \&Math::BigInt::objectify;
263*3d61058aSafresh1
264b8851fccSafresh1    # when someone sets $rnd_mode, we catch this and check the value to see
265b8851fccSafresh1    # whether it is valid or not.
2669f11ffb7Safresh1    $rnd_mode   = 'even';
2679f11ffb7Safresh1    tie $rnd_mode, 'Math::BigFloat';
268b8851fccSafresh1
269e0680481Safresh1    *as_number = \&as_int;
270b8851fccSafresh1}
271b8851fccSafresh1
2729f11ffb7Safresh1sub DESTROY {
2739f11ffb7Safresh1    # going through AUTOLOAD for every DESTROY is costly, avoid it by empty sub
2749f11ffb7Safresh1}
2759f11ffb7Safresh1
2769f11ffb7Safresh1sub AUTOLOAD {
277*3d61058aSafresh1
278*3d61058aSafresh1    # Make fxxx() work by mapping fxxx() to Math::BigFloat::bxxx().
279*3d61058aSafresh1
2809f11ffb7Safresh1    my $name = $AUTOLOAD;
281*3d61058aSafresh1    $name =~ s/^(.*):://;               # strip package name
282*3d61058aSafresh1    my $class = $1 || __PACKAGE__;
283*3d61058aSafresh1
284*3d61058aSafresh1    $class -> import() if $IMPORT == 0;
285*3d61058aSafresh1
286*3d61058aSafresh1    # E.g., "fabs" -> "babs", but "is_neg" -> "is_neg"
287*3d61058aSafresh1
2889f11ffb7Safresh1    my $bname = $name;
2899f11ffb7Safresh1    $bname =~ s/^f/b/;
290*3d61058aSafresh1
291*3d61058aSafresh1    # Map, e.g., Math::BigFloat::fabs() to Math::BigFloat::babs()
292*3d61058aSafresh1
293*3d61058aSafresh1    if ($bname ne $name && Math::BigFloat -> can($bname)) {
294*3d61058aSafresh1        no strict 'refs';
295*3d61058aSafresh1        return &{"Math::BigFloat::$bname"}(@_);
296*3d61058aSafresh1    }
297*3d61058aSafresh1
298*3d61058aSafresh1    # Map, e.g., Math::BigFloat::babs() to Math::BigInt::babs()
299*3d61058aSafresh1
300*3d61058aSafresh1    elsif (Math::BigInt -> can($bname)) {
301*3d61058aSafresh1        no strict 'refs';
302*3d61058aSafresh1        return &{"Math::BigInt::$bname"}(@_);
303*3d61058aSafresh1    }
304*3d61058aSafresh1
305*3d61058aSafresh1    else {
306*3d61058aSafresh1        croak("Can't call $class->$name(), not a valid method");
307*3d61058aSafresh1    }
3089f11ffb7Safresh1}
3099f11ffb7Safresh1
310b8851fccSafresh1##############################################################################
311b8851fccSafresh1
312*3d61058aSafresh1# Compare the following function with @ISA above. This inheritance mess needs a
313*3d61058aSafresh1# clean up. When doing so, also consider the BEGIN block and the AUTOLOAD code.
314*3d61058aSafresh1# Fixme!
315b8851fccSafresh1
3169f11ffb7Safresh1sub isa {
3179f11ffb7Safresh1    my ($self, $class) = @_;
3189f11ffb7Safresh1    return if $class =~ /^Math::BigInt/; # we aren't one of these
3199f11ffb7Safresh1    UNIVERSAL::isa($self, $class);
3209f11ffb7Safresh1}
3219f11ffb7Safresh1
3229f11ffb7Safresh1sub config {
3239f11ffb7Safresh1    # return (later set?) configuration data as hash ref
3249f11ffb7Safresh1    my $class = shift || 'Math::BigFloat';
3259f11ffb7Safresh1
326b46d8ef2Safresh1    # Getter/accessor.
327b46d8ef2Safresh1
3289f11ffb7Safresh1    if (@_ == 1 && ref($_[0]) ne 'HASH') {
329b46d8ef2Safresh1        my $param = shift;
330b46d8ef2Safresh1        return $class if $param eq 'class';
331b46d8ef2Safresh1        return $LIB   if $param eq 'with';
332b46d8ef2Safresh1        return $class->SUPER::config($param);
3339f11ffb7Safresh1    }
3349f11ffb7Safresh1
335b46d8ef2Safresh1    # Setter.
336b46d8ef2Safresh1
3379f11ffb7Safresh1    my $cfg = $class->SUPER::config(@_);
3389f11ffb7Safresh1
3399f11ffb7Safresh1    # now we need only to override the ones that are different from our parent
3409f11ffb7Safresh1    $cfg->{class} = $class;
341b46d8ef2Safresh1    $cfg->{with} = $LIB;
3429f11ffb7Safresh1    $cfg;
3439f11ffb7Safresh1}
3449f11ffb7Safresh1
3459f11ffb7Safresh1###############################################################################
3469f11ffb7Safresh1# Constructor methods
3479f11ffb7Safresh1###############################################################################
348b8851fccSafresh1
349b8851fccSafresh1sub new {
350e0680481Safresh1    # Create a new Math::BigFloat object from a string or another bigfloat
351e0680481Safresh1    # object.
352b8851fccSafresh1    # _e: exponent
353b8851fccSafresh1    # _m: mantissa
3549f11ffb7Safresh1    # sign  => ("+", "-", "+inf", "-inf", or "NaN")
355b8851fccSafresh1
356b8851fccSafresh1    my $self    = shift;
357b8851fccSafresh1    my $selfref = ref $self;
358b8851fccSafresh1    my $class   = $selfref || $self;
359b8851fccSafresh1
360eac174f2Safresh1    # Make "require" work.
361eac174f2Safresh1
362eac174f2Safresh1    $class -> import() if $IMPORT == 0;
363eac174f2Safresh1
364eac174f2Safresh1    # Although this use has been discouraged for more than 10 years, people
365eac174f2Safresh1    # apparently still use it, so we still support it.
366eac174f2Safresh1
367eac174f2Safresh1    return $class -> bzero() unless @_;
368eac174f2Safresh1
369b8851fccSafresh1    my ($wanted, @r) = @_;
370b8851fccSafresh1
371eac174f2Safresh1    if (!defined($wanted)) {
372eac174f2Safresh1        #if (warnings::enabled("uninitialized")) {
373eac174f2Safresh1        #    warnings::warn("uninitialized",
374eac174f2Safresh1        #                   "Use of uninitialized value in new()");
375eac174f2Safresh1        #}
376eac174f2Safresh1        return $class -> bzero(@r);
377b8851fccSafresh1    }
378b8851fccSafresh1
379eac174f2Safresh1    if (!ref($wanted) && $wanted eq "") {
380eac174f2Safresh1        #if (warnings::enabled("numeric")) {
381eac174f2Safresh1        #    warnings::warn("numeric",
382eac174f2Safresh1        #                   q|Argument "" isn't numeric in new()|);
383eac174f2Safresh1        #}
384eac174f2Safresh1        #return $class -> bzero(@r);
385eac174f2Safresh1        return $class -> bnan(@r);
386b8851fccSafresh1    }
387b8851fccSafresh1
388eac174f2Safresh1    # Initialize a new object.
389b8851fccSafresh1
390b8851fccSafresh1    $self = bless {}, $class unless $selfref;
391b8851fccSafresh1
392e0680481Safresh1    # Math::BigFloat or subclass
393eac174f2Safresh1
394*3d61058aSafresh1    if (defined(blessed($wanted)) && $wanted -> isa(__PACKAGE__)) {
395e0680481Safresh1
396e0680481Safresh1        # Don't copy the accuracy and precision, because a new object should get
397e0680481Safresh1        # them from the global configuration.
398e0680481Safresh1
399eac174f2Safresh1        $self -> {sign} = $wanted -> {sign};
400eac174f2Safresh1        $self -> {_m}   = $LIB -> _copy($wanted -> {_m});
401eac174f2Safresh1        $self -> {_es}  = $wanted -> {_es};
402eac174f2Safresh1        $self -> {_e}   = $LIB -> _copy($wanted -> {_e});
403e0680481Safresh1        $self = $self->round(@r)
404e0680481Safresh1          unless @r >= 2 && !defined($r[0]) && !defined($r[1]);
405eac174f2Safresh1        return $self;
406eac174f2Safresh1    }
407eac174f2Safresh1
408eac174f2Safresh1    # Shortcut for Math::BigInt and its subclasses. This should be improved.
409eac174f2Safresh1
410eac174f2Safresh1    if (defined(blessed($wanted))) {
411eac174f2Safresh1        if ($wanted -> isa('Math::BigInt')) {
412eac174f2Safresh1            $self->{sign} = $wanted -> {sign};
413eac174f2Safresh1            $self->{_m}   = $LIB -> _copy($wanted -> {value});
414b8851fccSafresh1            $self->{_es}  = '+';
415eac174f2Safresh1            $self->{_e}   = $LIB -> _zero();
416b8851fccSafresh1            return $self -> bnorm();
417b8851fccSafresh1        }
418b8851fccSafresh1
419eac174f2Safresh1        if ($wanted -> can("as_number")) {
420eac174f2Safresh1            $self->{sign} = $wanted -> sign();
421eac174f2Safresh1            $self->{_m}   = $wanted -> as_number() -> {value};
422eac174f2Safresh1            $self->{_es}  = '+';
423eac174f2Safresh1            $self->{_e}   = $LIB -> _zero();
424eac174f2Safresh1            return $self -> bnorm();
425eac174f2Safresh1        }
426eac174f2Safresh1    }
427b8851fccSafresh1
428e0680481Safresh1    # Shortcut for simple forms like '123' that have no trailing zeros. Trailing
429e0680481Safresh1    # zeros would require a non-zero exponent.
430b8851fccSafresh1
431e0680481Safresh1    if ($wanted =~
432e0680481Safresh1        / ^
433eac174f2Safresh1          \s*                           # optional leading whitespace
434eac174f2Safresh1          ( [+-]? )                     # optional sign
435eac174f2Safresh1          0*                            # optional leading zeros
436eac174f2Safresh1          ( [1-9] (?: [0-9]* [1-9] )? ) # significand
437eac174f2Safresh1          \s*                           # optional trailing whitespace
43856d68f1eSafresh1          $
43956d68f1eSafresh1        /x)
44056d68f1eSafresh1    {
441eac174f2Safresh1        return $downgrade -> new($1 . $2) if defined $downgrade;
442b8851fccSafresh1        $self->{sign} = $1 || '+';
443b46d8ef2Safresh1        $self->{_m}   = $LIB -> _new($2);
444b8851fccSafresh1        $self->{_es}  = '+';
445eac174f2Safresh1        $self->{_e}   = $LIB -> _zero();
446e0680481Safresh1        $self = $self->round(@r)
447e0680481Safresh1          unless @r >= 2 && !defined $r[0] && !defined $r[1];
4489f11ffb7Safresh1        return $self;
449b8851fccSafresh1    }
450eac174f2Safresh1
451e0680481Safresh1    # Handle Infs.
452e0680481Safresh1
453e0680481Safresh1    if ($wanted =~ / ^
454e0680481Safresh1                     \s*
455e0680481Safresh1                     ( [+-]? )
456e0680481Safresh1                     inf (?: inity )?
457e0680481Safresh1                     \s*
458e0680481Safresh1                     \z
459e0680481Safresh1                   /ix)
460e0680481Safresh1    {
461e0680481Safresh1        my $sgn = $1 || '+';
462e0680481Safresh1        return $class -> binf($sgn, @r);
463e0680481Safresh1    }
464e0680481Safresh1
465e0680481Safresh1    # Handle explicit NaNs (not the ones returned due to invalid input).
466e0680481Safresh1
467e0680481Safresh1    if ($wanted =~ / ^
468e0680481Safresh1                     \s*
469e0680481Safresh1                     ( [+-]? )
470e0680481Safresh1                     nan
471e0680481Safresh1                     \s*
472e0680481Safresh1                     \z
473e0680481Safresh1                   /ix)
474e0680481Safresh1    {
475e0680481Safresh1        return $class -> bnan(@r);
476e0680481Safresh1    }
477e0680481Safresh1
478eac174f2Safresh1    my @parts;
479eac174f2Safresh1
480eac174f2Safresh1    if (
481eac174f2Safresh1        # Handle hexadecimal numbers. We auto-detect hexadecimal numbers if they
482eac174f2Safresh1        # have a "0x", "0X", "x", or "X" prefix, cf. CORE::oct().
483eac174f2Safresh1
484eac174f2Safresh1        $wanted =~ /^\s*[+-]?0?[Xx]/ and
485e0680481Safresh1        @parts = $class -> _hex_str_to_flt_lib_parts($wanted)
486eac174f2Safresh1
487eac174f2Safresh1          or
488eac174f2Safresh1
489eac174f2Safresh1        # Handle octal numbers. We auto-detect octal numbers if they have a
490eac174f2Safresh1        # "0o", "0O", "o", "O" prefix, cf. CORE::oct().
491eac174f2Safresh1
492eac174f2Safresh1        $wanted =~ /^\s*[+-]?0?[Oo]/ and
493e0680481Safresh1        @parts = $class -> _oct_str_to_flt_lib_parts($wanted)
494eac174f2Safresh1
495eac174f2Safresh1          or
496eac174f2Safresh1
497eac174f2Safresh1        # Handle binary numbers. We auto-detect binary numbers if they have a
498eac174f2Safresh1        # "0b", "0B", "b", or "B" prefix, cf. CORE::oct().
499eac174f2Safresh1
500eac174f2Safresh1        $wanted =~ /^\s*[+-]?0?[Bb]/ and
501e0680481Safresh1        @parts = $class -> _bin_str_to_flt_lib_parts($wanted)
502eac174f2Safresh1
503eac174f2Safresh1          or
504eac174f2Safresh1
505eac174f2Safresh1        # At this point, what is left are decimal numbers that aren't handled
506eac174f2Safresh1        # above and octal floating point numbers that don't have any of the
507eac174f2Safresh1        # "0o", "0O", "o", or "O" prefixes. First see if it is a decimal number.
508eac174f2Safresh1
509e0680481Safresh1        @parts = $class -> _dec_str_to_flt_lib_parts($wanted)
510eac174f2Safresh1          or
511eac174f2Safresh1
512eac174f2Safresh1        # See if it is an octal floating point number. The extra check is
513e0680481Safresh1        # included because _oct_str_to_flt_lib_parts() accepts octal numbers
514e0680481Safresh1        # that don't have a prefix (this is needed to make it work with, e.g.,
515eac174f2Safresh1        # from_oct() that don't require a prefix). However, Perl requires a
516eac174f2Safresh1        # prefix for octal floating point literals. For example, "1p+0" is not
517eac174f2Safresh1        # valid, but "01p+0" and "0__1p+0" are.
518eac174f2Safresh1
519eac174f2Safresh1        $wanted =~ /^\s*[+-]?0_*\d/ and
520e0680481Safresh1        @parts = $class -> _oct_str_to_flt_lib_parts($wanted))
521eac174f2Safresh1    {
522eac174f2Safresh1        ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts;
523e0680481Safresh1
524e0680481Safresh1        $self = $self->round(@r)
525e0680481Safresh1          unless @r >= 2 && !defined($r[0]) && !defined($r[1]);
526e0680481Safresh1
527e0680481Safresh1        return $downgrade -> new($self -> bdstr(), @r)
528e0680481Safresh1          if defined($downgrade) && $self -> is_int();
5299f11ffb7Safresh1        return $self;
5309f11ffb7Safresh1    }
5319f11ffb7Safresh1
532eac174f2Safresh1    # If we get here, the value is neither a valid decimal, binary, octal, or
533eac174f2Safresh1    # hexadecimal number. It is not an explicit Inf or a NaN either.
534eac174f2Safresh1
535e0680481Safresh1    return $class -> bnan(@r);
536eac174f2Safresh1}
537eac174f2Safresh1
538eac174f2Safresh1sub from_dec {
539eac174f2Safresh1    my $self    = shift;
540eac174f2Safresh1    my $selfref = ref $self;
541eac174f2Safresh1    my $class   = $selfref || $self;
542eac174f2Safresh1
543*3d61058aSafresh1    # Make "require" work.
544*3d61058aSafresh1
545*3d61058aSafresh1    $class -> import() if $IMPORT == 0;
546*3d61058aSafresh1
547eac174f2Safresh1    # Don't modify constant (read-only) objects.
548eac174f2Safresh1
549e0680481Safresh1    return $self if $selfref && $self->modify('from_dec');
550eac174f2Safresh1
551eac174f2Safresh1    my $str = shift;
552eac174f2Safresh1    my @r = @_;
553eac174f2Safresh1
554eac174f2Safresh1    # If called as a class method, initialize a new object.
555eac174f2Safresh1
556e0680481Safresh1    $self = bless {}, $class unless $selfref;
557eac174f2Safresh1
558e0680481Safresh1    if (my @parts = $class -> _dec_str_to_flt_lib_parts($str)) {
559eac174f2Safresh1        ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts;
560e0680481Safresh1
561e0680481Safresh1        $self = $self->round(@r)
562e0680481Safresh1          unless @r >= 2 && !defined($r[0]) && !defined($r[1]);
563e0680481Safresh1
564e0680481Safresh1        return $downgrade -> new($self -> bdstr(), @r)
565e0680481Safresh1          if defined($downgrade) && $self -> is_int();
566eac174f2Safresh1        return $self;
567eac174f2Safresh1    }
568eac174f2Safresh1
569eac174f2Safresh1    return $self -> bnan(@r);
570eac174f2Safresh1}
571eac174f2Safresh1
5729f11ffb7Safresh1sub from_hex {
5739f11ffb7Safresh1    my $self    = shift;
5749f11ffb7Safresh1    my $selfref = ref $self;
5759f11ffb7Safresh1    my $class   = $selfref || $self;
5769f11ffb7Safresh1
577*3d61058aSafresh1    # Make "require" work.
578*3d61058aSafresh1
579*3d61058aSafresh1    $class -> import() if $IMPORT == 0;
580*3d61058aSafresh1
5819f11ffb7Safresh1    # Don't modify constant (read-only) objects.
5829f11ffb7Safresh1
583e0680481Safresh1    return $self if $selfref && $self->modify('from_hex');
5849f11ffb7Safresh1
5859f11ffb7Safresh1    my $str = shift;
586eac174f2Safresh1    my @r = @_;
5879f11ffb7Safresh1
5889f11ffb7Safresh1    # If called as a class method, initialize a new object.
5899f11ffb7Safresh1
590e0680481Safresh1    $self = bless {}, $class unless $selfref;
5919f11ffb7Safresh1
592e0680481Safresh1    if (my @parts = $class -> _hex_str_to_flt_lib_parts($str)) {
593eac174f2Safresh1        ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts;
594e0680481Safresh1
595e0680481Safresh1        $self = $self->round(@r)
596e0680481Safresh1          unless @r >= 2 && !defined($r[0]) && !defined($r[1]);
597e0680481Safresh1
598e0680481Safresh1        return $downgrade -> new($self -> bdstr(), @r)
599e0680481Safresh1          if defined($downgrade) && $self -> is_int();
6009f11ffb7Safresh1        return $self;
6019f11ffb7Safresh1    }
6029f11ffb7Safresh1
603eac174f2Safresh1    return $self -> bnan(@r);
6049f11ffb7Safresh1}
6059f11ffb7Safresh1
6069f11ffb7Safresh1sub from_oct {
6079f11ffb7Safresh1    my $self    = shift;
6089f11ffb7Safresh1    my $selfref = ref $self;
6099f11ffb7Safresh1    my $class   = $selfref || $self;
6109f11ffb7Safresh1
611*3d61058aSafresh1    # Make "require" work.
612*3d61058aSafresh1
613*3d61058aSafresh1    $class -> import() if $IMPORT == 0;
614*3d61058aSafresh1
6159f11ffb7Safresh1    # Don't modify constant (read-only) objects.
6169f11ffb7Safresh1
617e0680481Safresh1    return $self if $selfref && $self->modify('from_oct');
6189f11ffb7Safresh1
6199f11ffb7Safresh1    my $str = shift;
620eac174f2Safresh1    my @r = @_;
6219f11ffb7Safresh1
6229f11ffb7Safresh1    # If called as a class method, initialize a new object.
6239f11ffb7Safresh1
624e0680481Safresh1    $self = bless {}, $class unless $selfref;
6259f11ffb7Safresh1
626e0680481Safresh1    if (my @parts = $class -> _oct_str_to_flt_lib_parts($str)) {
627eac174f2Safresh1        ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts;
628e0680481Safresh1
629e0680481Safresh1        $self = $self->round(@r)
630e0680481Safresh1          unless @r >= 2 && !defined($r[0]) && !defined($r[1]);
631e0680481Safresh1
632e0680481Safresh1        return $downgrade -> new($self -> bdstr(), @r)
633e0680481Safresh1          if defined($downgrade) && $self -> is_int();
6349f11ffb7Safresh1        return $self;
6359f11ffb7Safresh1    }
6369f11ffb7Safresh1
637eac174f2Safresh1    return $self -> bnan(@r);
6389f11ffb7Safresh1}
6399f11ffb7Safresh1
6409f11ffb7Safresh1sub from_bin {
6419f11ffb7Safresh1    my $self    = shift;
6429f11ffb7Safresh1    my $selfref = ref $self;
6439f11ffb7Safresh1    my $class   = $selfref || $self;
6449f11ffb7Safresh1
645*3d61058aSafresh1    # Make "require" work.
646*3d61058aSafresh1
647*3d61058aSafresh1    $class -> import() if $IMPORT == 0;
648*3d61058aSafresh1
6499f11ffb7Safresh1    # Don't modify constant (read-only) objects.
6509f11ffb7Safresh1
651e0680481Safresh1    return $self if $selfref && $self->modify('from_bin');
6529f11ffb7Safresh1
6539f11ffb7Safresh1    my $str = shift;
654eac174f2Safresh1    my @r = @_;
6559f11ffb7Safresh1
6569f11ffb7Safresh1    # If called as a class method, initialize a new object.
6579f11ffb7Safresh1
658e0680481Safresh1    $self = bless {}, $class unless $selfref;
6599f11ffb7Safresh1
660e0680481Safresh1    if (my @parts = $class -> _bin_str_to_flt_lib_parts($str)) {
661eac174f2Safresh1        ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts;
662e0680481Safresh1
663e0680481Safresh1        $self = $self->round(@r)
664e0680481Safresh1          unless @r >= 2 && !defined($r[0]) && !defined($r[1]);
665e0680481Safresh1
666e0680481Safresh1        return $downgrade -> new($self -> bdstr(), @r)
667e0680481Safresh1          if defined($downgrade) && $self -> is_int();
6689f11ffb7Safresh1        return $self;
6699f11ffb7Safresh1    }
6709f11ffb7Safresh1
671eac174f2Safresh1    return $self -> bnan(@r);
6729f11ffb7Safresh1}
6739f11ffb7Safresh1
67456d68f1eSafresh1sub from_ieee754 {
67556d68f1eSafresh1    my $self    = shift;
67656d68f1eSafresh1    my $selfref = ref $self;
67756d68f1eSafresh1    my $class   = $selfref || $self;
67856d68f1eSafresh1
679*3d61058aSafresh1    # Make "require" work.
680*3d61058aSafresh1
681*3d61058aSafresh1    $class -> import() if $IMPORT == 0;
682*3d61058aSafresh1
68356d68f1eSafresh1    # Don't modify constant (read-only) objects.
68456d68f1eSafresh1
685e0680481Safresh1    return $self if $selfref && $self->modify('from_ieee754');
68656d68f1eSafresh1
68756d68f1eSafresh1    my $in     = shift;     # input string (or raw bytes)
68856d68f1eSafresh1    my $format = shift;     # format ("binary32", "decimal64" etc.)
68956d68f1eSafresh1    my $enc;                # significand encoding (applies only to decimal)
69056d68f1eSafresh1    my $k;                  # storage width in bits
69156d68f1eSafresh1    my $b;                  # base
692e0680481Safresh1    my @r = @_;             # rounding parameters, if any
69356d68f1eSafresh1
69456d68f1eSafresh1    if ($format =~ /^binary(\d+)\z/) {
69556d68f1eSafresh1        $k = $1;
69656d68f1eSafresh1        $b = 2;
69756d68f1eSafresh1    } elsif ($format =~ /^decimal(\d+)(dpd|bcd)?\z/) {
69856d68f1eSafresh1        $k = $1;
69956d68f1eSafresh1        $b = 10;
70056d68f1eSafresh1        $enc = $2 || 'dpd';     # default is dencely-packed decimals (DPD)
70156d68f1eSafresh1    } elsif ($format eq 'half') {
70256d68f1eSafresh1        $k = 16;
70356d68f1eSafresh1        $b = 2;
70456d68f1eSafresh1    } elsif ($format eq 'single') {
70556d68f1eSafresh1        $k = 32;
70656d68f1eSafresh1        $b = 2;
70756d68f1eSafresh1    } elsif ($format eq 'double') {
70856d68f1eSafresh1        $k = 64;
70956d68f1eSafresh1        $b = 2;
71056d68f1eSafresh1    } elsif ($format eq 'quadruple') {
71156d68f1eSafresh1        $k = 128;
71256d68f1eSafresh1        $b = 2;
71356d68f1eSafresh1    } elsif ($format eq 'octuple') {
71456d68f1eSafresh1        $k = 256;
71556d68f1eSafresh1        $b = 2;
71656d68f1eSafresh1    } elsif ($format eq 'sexdecuple') {
71756d68f1eSafresh1        $k = 512;
71856d68f1eSafresh1        $b = 2;
71956d68f1eSafresh1    }
72056d68f1eSafresh1
72156d68f1eSafresh1    if ($b == 2) {
72256d68f1eSafresh1
72356d68f1eSafresh1        # Get the parameters for this format.
72456d68f1eSafresh1
72556d68f1eSafresh1        my $p;                      # precision (in bits)
72656d68f1eSafresh1        my $t;                      # number of bits in significand
72756d68f1eSafresh1        my $w;                      # number of bits in exponent
72856d68f1eSafresh1
72956d68f1eSafresh1        if ($k == 16) {             # binary16 (half-precision)
73056d68f1eSafresh1            $p = 11;
73156d68f1eSafresh1            $t = 10;
73256d68f1eSafresh1            $w =  5;
73356d68f1eSafresh1        } elsif ($k == 32) {        # binary32 (single-precision)
73456d68f1eSafresh1            $p = 24;
73556d68f1eSafresh1            $t = 23;
73656d68f1eSafresh1            $w =  8;
73756d68f1eSafresh1        } elsif ($k == 64) {        # binary64 (double-precision)
73856d68f1eSafresh1            $p = 53;
73956d68f1eSafresh1            $t = 52;
74056d68f1eSafresh1            $w = 11;
74156d68f1eSafresh1        } else {                    # binaryN (quadruple-precision and above)
74256d68f1eSafresh1            if ($k < 128 || $k != 32 * sprintf('%.0f', $k / 32)) {
74356d68f1eSafresh1                croak "Number of bits must be 16, 32, 64, or >= 128 and",
74456d68f1eSafresh1                  " a multiple of 32";
74556d68f1eSafresh1            }
74656d68f1eSafresh1            $p = $k - sprintf('%.0f', 4 * log($k) / log(2)) + 13;
74756d68f1eSafresh1            $t = $p - 1;
74856d68f1eSafresh1            $w = $k - $t - 1;
74956d68f1eSafresh1        }
75056d68f1eSafresh1
75156d68f1eSafresh1        # The maximum exponent, minimum exponent, and exponent bias.
75256d68f1eSafresh1
753*3d61058aSafresh1        my $emax = $class -> new(2) -> bpow($w - 1) -> bdec();
75456d68f1eSafresh1        my $emin = 1 - $emax;
75556d68f1eSafresh1        my $bias = $emax;
75656d68f1eSafresh1
75756d68f1eSafresh1        # Undefined input.
75856d68f1eSafresh1
75956d68f1eSafresh1        unless (defined $in) {
76056d68f1eSafresh1            carp("Input is undefined");
761eac174f2Safresh1            return $self -> bzero(@r);
76256d68f1eSafresh1        }
76356d68f1eSafresh1
76456d68f1eSafresh1        # Make sure input string is a string of zeros and ones.
76556d68f1eSafresh1
76656d68f1eSafresh1        my $len = CORE::length $in;
76756d68f1eSafresh1        if (8 * $len == $k) {                   # bytes
76856d68f1eSafresh1            $in = unpack "B*", $in;
76956d68f1eSafresh1        } elsif (4 * $len == $k) {              # hexadecimal
77056d68f1eSafresh1            if ($in =~ /([^\da-f])/i) {
77156d68f1eSafresh1                croak "Illegal hexadecimal digit '$1'";
77256d68f1eSafresh1            }
77356d68f1eSafresh1            $in = unpack "B*", pack "H*", $in;
77456d68f1eSafresh1        } elsif ($len == $k) {                  # bits
77556d68f1eSafresh1            if ($in =~ /([^01])/) {
77656d68f1eSafresh1                croak "Illegal binary digit '$1'";
77756d68f1eSafresh1            }
77856d68f1eSafresh1        } else {
77956d68f1eSafresh1            croak "Unknown input -- $in";
78056d68f1eSafresh1        }
78156d68f1eSafresh1
78256d68f1eSafresh1        # Split bit string into sign, exponent, and mantissa/significand.
78356d68f1eSafresh1
78456d68f1eSafresh1        my $sign = substr($in, 0, 1) eq '1' ? '-' : '+';
78556d68f1eSafresh1        my $expo = $class -> from_bin(substr($in, 1, $w));
78656d68f1eSafresh1        my $mant = $class -> from_bin(substr($in, $w + 1));
78756d68f1eSafresh1
78856d68f1eSafresh1        my $x;
78956d68f1eSafresh1
790e0680481Safresh1        $expo = $expo -> bsub($bias);           # subtract bias
79156d68f1eSafresh1
79256d68f1eSafresh1        if ($expo < $emin) {                    # zero and subnormals
79356d68f1eSafresh1            if ($mant == 0) {                   # zero
79456d68f1eSafresh1                $x = $class -> bzero();
79556d68f1eSafresh1            } else {                            # subnormals
79656d68f1eSafresh1                # compute (1/$b)**(N) rather than ($b)**(-N)
79756d68f1eSafresh1                $x = $class -> new("0.5");      # 1/$b
798e0680481Safresh1                $x = $x -> bpow($bias + $t - 1) -> bmul($mant);
799e0680481Safresh1                $x = $x -> bneg() if $sign eq '-';
80056d68f1eSafresh1            }
80156d68f1eSafresh1        }
80256d68f1eSafresh1
80356d68f1eSafresh1        elsif ($expo > $emax) {                 # inf and nan
80456d68f1eSafresh1            if ($mant == 0) {                   # inf
80556d68f1eSafresh1                $x = $class -> binf($sign);
80656d68f1eSafresh1            } else {                            # nan
807e0680481Safresh1                $x = $class -> bnan(@r);
80856d68f1eSafresh1            }
80956d68f1eSafresh1        }
81056d68f1eSafresh1
81156d68f1eSafresh1        else {                                  # normals
81256d68f1eSafresh1            $mant = $class -> new(2) -> bpow($t) -> badd($mant);
81356d68f1eSafresh1            if ($expo < $t) {
81456d68f1eSafresh1                # compute (1/$b)**(N) rather than ($b)**(-N)
81556d68f1eSafresh1                $x = $class -> new("0.5");      # 1/$b
816e0680481Safresh1                $x = $x -> bpow($t - $expo) -> bmul($mant);
81756d68f1eSafresh1            } else {
81856d68f1eSafresh1                $x = $class -> new(2);
819e0680481Safresh1                $x = $x -> bpow($expo - $t) -> bmul($mant);
82056d68f1eSafresh1            }
821e0680481Safresh1            $x = $x -> bneg() if $sign eq '-';
82256d68f1eSafresh1        }
82356d68f1eSafresh1
82456d68f1eSafresh1        if ($selfref) {
82556d68f1eSafresh1            $self -> {sign} = $x -> {sign};
82656d68f1eSafresh1            $self -> {_m}   = $x -> {_m};
82756d68f1eSafresh1            $self -> {_es}  = $x -> {_es};
82856d68f1eSafresh1            $self -> {_e}   = $x -> {_e};
82956d68f1eSafresh1        } else {
83056d68f1eSafresh1            $self = $x;
83156d68f1eSafresh1        }
832eac174f2Safresh1
833e0680481Safresh1        return $downgrade -> new($self -> bdstr(), @r)
834e0680481Safresh1          if defined($downgrade) && $self -> is_int();
835eac174f2Safresh1        return $self -> round(@r);
83656d68f1eSafresh1    }
83756d68f1eSafresh1
83856d68f1eSafresh1    croak("The format '$format' is not yet supported.");
83956d68f1eSafresh1}
84056d68f1eSafresh1
8419f11ffb7Safresh1sub bzero {
8429f11ffb7Safresh1    # create/assign '+0'
8439f11ffb7Safresh1
844e0680481Safresh1    # Class::method(...) -> Class->method(...)
845e0680481Safresh1    unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
846e0680481Safresh1                   $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
847e0680481Safresh1    {
848e0680481Safresh1        #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
849e0680481Safresh1        #  " use is as a method instead";
8509f11ffb7Safresh1        unshift @_, __PACKAGE__;
8519f11ffb7Safresh1    }
8529f11ffb7Safresh1
8539f11ffb7Safresh1    my $self    = shift;
8549f11ffb7Safresh1    my $selfref = ref $self;
8559f11ffb7Safresh1    my $class   = $selfref || $self;
8569f11ffb7Safresh1
857*3d61058aSafresh1    # Make "require" work.
858*3d61058aSafresh1
859*3d61058aSafresh1    $class -> import() if $IMPORT == 0;
8609f11ffb7Safresh1
861e0680481Safresh1    # Don't modify constant (read-only) objects.
862e0680481Safresh1
863e0680481Safresh1    return $self if $selfref && $self->modify('bzero');
864e0680481Safresh1
865e0680481Safresh1    # Get the rounding parameters, if any.
866e0680481Safresh1
867e0680481Safresh1    my @r = @_;
868e0680481Safresh1
869e0680481Safresh1    return $downgrade -> bzero(@r) if defined $downgrade;
870e0680481Safresh1
871e0680481Safresh1    # If called as a class method, initialize a new object.
872eac174f2Safresh1
8739f11ffb7Safresh1    $self = bless {}, $class unless $selfref;
8749f11ffb7Safresh1
8759f11ffb7Safresh1    $self -> {sign} = '+';
876b46d8ef2Safresh1    $self -> {_m}   = $LIB -> _zero();
8779f11ffb7Safresh1    $self -> {_es}  = '+';
878b46d8ef2Safresh1    $self -> {_e}   = $LIB -> _zero();
8799f11ffb7Safresh1
880b46d8ef2Safresh1    # If rounding parameters are given as arguments, use them. If no rounding
881b46d8ef2Safresh1    # parameters are given, and if called as a class method initialize the new
882b46d8ef2Safresh1    # instance with the class variables.
883b46d8ef2Safresh1
884e0680481Safresh1    #return $self -> round(@r);  # this should work, but doesnt; fixme!
885e0680481Safresh1
886e0680481Safresh1    if (@r) {
887*3d61058aSafresh1        if (@r >= 2 && defined($r[0]) && defined($r[1])) {
888*3d61058aSafresh1            carp "can't specify both accuracy and precision";
889*3d61058aSafresh1            return $self -> bnan();
890*3d61058aSafresh1        }
891*3d61058aSafresh1        $self->{accuracy} = $r[0];
892*3d61058aSafresh1        $self->{precision} = $r[1];
8939f11ffb7Safresh1    } else {
894b46d8ef2Safresh1        unless($selfref) {
895*3d61058aSafresh1            $self->{accuracy} = $class -> accuracy();
896*3d61058aSafresh1            $self->{precision} = $class -> precision();
8979f11ffb7Safresh1        }
8989f11ffb7Safresh1    }
8999f11ffb7Safresh1
9009f11ffb7Safresh1    return $self;
9019f11ffb7Safresh1}
9029f11ffb7Safresh1
9039f11ffb7Safresh1sub bone {
9049f11ffb7Safresh1    # Create or assign '+1' (or -1 if given sign '-').
9059f11ffb7Safresh1
906e0680481Safresh1    # Class::method(...) -> Class->method(...)
907e0680481Safresh1    unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
908e0680481Safresh1                   $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
909e0680481Safresh1    {
910e0680481Safresh1        #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
911e0680481Safresh1        #  " use is as a method instead";
9129f11ffb7Safresh1        unshift @_, __PACKAGE__;
9139f11ffb7Safresh1    }
9149f11ffb7Safresh1
9159f11ffb7Safresh1    my $self    = shift;
9169f11ffb7Safresh1    my $selfref = ref $self;
9179f11ffb7Safresh1    my $class   = $selfref || $self;
9189f11ffb7Safresh1
919*3d61058aSafresh1    # Make "require" work.
920*3d61058aSafresh1
921*3d61058aSafresh1    $class -> import() if $IMPORT == 0;
9229f11ffb7Safresh1
923e0680481Safresh1    # Don't modify constant (read-only) objects.
924eac174f2Safresh1
925e0680481Safresh1    return $self if $selfref && $self->modify('bone');
926e0680481Safresh1
927e0680481Safresh1    return $downgrade -> bone(@_) if defined $downgrade;
928e0680481Safresh1
929e0680481Safresh1    # Get the sign.
930e0680481Safresh1
931e0680481Safresh1    my $sign = '+';     # default is to return +1
932e0680481Safresh1    if (defined($_[0]) && $_[0] =~ /^\s*([+-])\s*$/) {
933e0680481Safresh1        $sign = $1;
934e0680481Safresh1        shift;
935e0680481Safresh1    }
936e0680481Safresh1
937e0680481Safresh1    # Get the rounding parameters, if any.
938e0680481Safresh1
939e0680481Safresh1    my @r = @_;
940e0680481Safresh1
941e0680481Safresh1    # If called as a class method, initialize a new object.
9429f11ffb7Safresh1
9439f11ffb7Safresh1    $self = bless {}, $class unless $selfref;
9449f11ffb7Safresh1
9459f11ffb7Safresh1    $self -> {sign} = $sign;
946b46d8ef2Safresh1    $self -> {_m}   = $LIB -> _one();
9479f11ffb7Safresh1    $self -> {_es}  = '+';
948b46d8ef2Safresh1    $self -> {_e}   = $LIB -> _zero();
9499f11ffb7Safresh1
950b46d8ef2Safresh1    # If rounding parameters are given as arguments, use them. If no rounding
951b46d8ef2Safresh1    # parameters are given, and if called as a class method initialize the new
952b46d8ef2Safresh1    # instance with the class variables.
953b46d8ef2Safresh1
954e0680481Safresh1    #return $self -> round(@r);  # this should work, but doesnt; fixme!
955e0680481Safresh1
956e0680481Safresh1    if (@r) {
957*3d61058aSafresh1        if (@r >= 2 && defined($r[0]) && defined($r[1])) {
958*3d61058aSafresh1            carp "can't specify both accuracy and precision";
959*3d61058aSafresh1            return $self -> bnan();
960*3d61058aSafresh1        }
961*3d61058aSafresh1        $self->{accuracy} = $_[0];
962*3d61058aSafresh1        $self->{precision} = $_[1];
9639f11ffb7Safresh1    } else {
964b46d8ef2Safresh1        unless($selfref) {
965*3d61058aSafresh1            $self->{accuracy} = $class -> accuracy();
966*3d61058aSafresh1            $self->{precision} = $class -> precision();
9679f11ffb7Safresh1        }
9689f11ffb7Safresh1    }
9699f11ffb7Safresh1
9709f11ffb7Safresh1    return $self;
9719f11ffb7Safresh1}
9729f11ffb7Safresh1
9739f11ffb7Safresh1sub binf {
9749f11ffb7Safresh1    # create/assign a '+inf' or '-inf'
9759f11ffb7Safresh1
976e0680481Safresh1    # Class::method(...) -> Class->method(...)
977e0680481Safresh1    unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
978e0680481Safresh1                   $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
9799f11ffb7Safresh1    {
980e0680481Safresh1        #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
981e0680481Safresh1        #  " use is as a method instead";
9829f11ffb7Safresh1        unshift @_, __PACKAGE__;
9839f11ffb7Safresh1    }
9849f11ffb7Safresh1
9859f11ffb7Safresh1    my $self    = shift;
9869f11ffb7Safresh1    my $selfref = ref $self;
9879f11ffb7Safresh1    my $class   = $selfref || $self;
9889f11ffb7Safresh1
9899f11ffb7Safresh1    {
9909f11ffb7Safresh1        no strict 'refs';
9919f11ffb7Safresh1        if (${"${class}::_trap_inf"}) {
992b46d8ef2Safresh1            croak("Tried to create +-inf in $class->binf()");
9939f11ffb7Safresh1        }
9949f11ffb7Safresh1    }
9959f11ffb7Safresh1
996*3d61058aSafresh1    # Make "require" work.
997*3d61058aSafresh1
998*3d61058aSafresh1    $class -> import() if $IMPORT == 0;
9999f11ffb7Safresh1
1000e0680481Safresh1    # Don't modify constant (read-only) objects.
1001e0680481Safresh1
1002e0680481Safresh1    return $self if $selfref && $self->modify('binf');
1003e0680481Safresh1
1004e0680481Safresh1    return $downgrade -> binf(@_) if $downgrade;
1005e0680481Safresh1
1006e0680481Safresh1    # Get the sign.
1007e0680481Safresh1
1008e0680481Safresh1    my $sign = '+';     # default is to return positive infinity
1009e0680481Safresh1    if (defined($_[0]) && $_[0] =~ /^\s*([+-])(inf|$)/i) {
1010e0680481Safresh1        $sign = $1;
1011e0680481Safresh1        shift;
1012e0680481Safresh1    }
1013e0680481Safresh1
1014e0680481Safresh1    # Get the rounding parameters, if any.
1015e0680481Safresh1
1016e0680481Safresh1    my @r = @_;
1017e0680481Safresh1
1018e0680481Safresh1    # If called as a class method, initialize a new object.
10199f11ffb7Safresh1
10209f11ffb7Safresh1    $self = bless {}, $class unless $selfref;
10219f11ffb7Safresh1
10229f11ffb7Safresh1    $self -> {sign} = $sign . 'inf';
1023b46d8ef2Safresh1    $self -> {_m}   = $LIB -> _zero();
10249f11ffb7Safresh1    $self -> {_es}  = '+';
1025b46d8ef2Safresh1    $self -> {_e}   = $LIB -> _zero();
1026b46d8ef2Safresh1
1027b46d8ef2Safresh1    # If rounding parameters are given as arguments, use them. If no rounding
1028b46d8ef2Safresh1    # parameters are given, and if called as a class method initialize the new
1029b46d8ef2Safresh1    # instance with the class variables.
1030b46d8ef2Safresh1
1031e0680481Safresh1    #return $self -> round(@r);  # this should work, but doesnt; fixme!
1032e0680481Safresh1
1033e0680481Safresh1    if (@r) {
1034*3d61058aSafresh1        if (@r >= 2 && defined($r[0]) && defined($r[1])) {
1035*3d61058aSafresh1            carp "can't specify both accuracy and precision";
1036*3d61058aSafresh1            return $self -> bnan();
1037*3d61058aSafresh1        }
1038*3d61058aSafresh1        $self->{accuracy} = $r[0];
1039*3d61058aSafresh1        $self->{precision} = $r[1];
1040b46d8ef2Safresh1    } else {
1041b46d8ef2Safresh1        unless($selfref) {
1042*3d61058aSafresh1            $self->{accuracy} = $class -> accuracy();
1043*3d61058aSafresh1            $self->{precision} = $class -> precision();
1044b46d8ef2Safresh1        }
1045b46d8ef2Safresh1    }
10469f11ffb7Safresh1
10479f11ffb7Safresh1    return $self;
10489f11ffb7Safresh1}
10499f11ffb7Safresh1
10509f11ffb7Safresh1sub bnan {
10519f11ffb7Safresh1    # create/assign a 'NaN'
10529f11ffb7Safresh1
1053e0680481Safresh1    # Class::method(...) -> Class->method(...)
1054e0680481Safresh1    unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
1055e0680481Safresh1                   $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
1056e0680481Safresh1    {
1057e0680481Safresh1        #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
1058e0680481Safresh1        #  " use is as a method instead";
10599f11ffb7Safresh1        unshift @_, __PACKAGE__;
10609f11ffb7Safresh1    }
10619f11ffb7Safresh1
10629f11ffb7Safresh1    my $self    = shift;
10639f11ffb7Safresh1    my $selfref = ref $self;
10649f11ffb7Safresh1    my $class   = $selfref || $self;
10659f11ffb7Safresh1
10669f11ffb7Safresh1    {
10679f11ffb7Safresh1        no strict 'refs';
10689f11ffb7Safresh1        if (${"${class}::_trap_nan"}) {
1069b46d8ef2Safresh1            croak("Tried to create NaN in $class->bnan()");
10709f11ffb7Safresh1        }
10719f11ffb7Safresh1    }
10729f11ffb7Safresh1
1073*3d61058aSafresh1    # Make "require" work.
1074*3d61058aSafresh1
1075*3d61058aSafresh1    $class -> import() if $IMPORT == 0;
1076e0680481Safresh1
1077e0680481Safresh1    # Don't modify constant (read-only) objects.
1078e0680481Safresh1
1079e0680481Safresh1    return $self if $selfref && $self->modify('bnan');
1080e0680481Safresh1
1081e0680481Safresh1    return $downgrade -> bnan(@_) if defined $downgrade;
1082e0680481Safresh1
1083e0680481Safresh1    # Get the rounding parameters, if any.
1084e0680481Safresh1
1085e0680481Safresh1    my @r = @_;
1086e0680481Safresh1
1087e0680481Safresh1    # If called as a class method, initialize a new object.
10889f11ffb7Safresh1
10899f11ffb7Safresh1    $self = bless {}, $class unless $selfref;
10909f11ffb7Safresh1
10919f11ffb7Safresh1    $self -> {sign} = $nan;
1092b46d8ef2Safresh1    $self -> {_m}   = $LIB -> _zero();
10939f11ffb7Safresh1    $self -> {_es}  = '+';
1094b46d8ef2Safresh1    $self -> {_e}   = $LIB -> _zero();
1095b46d8ef2Safresh1
1096b46d8ef2Safresh1    # If rounding parameters are given as arguments, use them. If no rounding
1097b46d8ef2Safresh1    # parameters are given, and if called as a class method initialize the new
1098b46d8ef2Safresh1    # instance with the class variables.
1099b46d8ef2Safresh1
1100e0680481Safresh1    #return $self -> round(@r);  # this should work, but doesnt; fixme!
1101e0680481Safresh1
1102e0680481Safresh1    if (@r) {
1103*3d61058aSafresh1        if (@r >= 2 && defined($r[0]) && defined($r[1])) {
1104*3d61058aSafresh1            carp "can't specify both accuracy and precision";
1105*3d61058aSafresh1            return $self -> bnan();
1106*3d61058aSafresh1        }
1107*3d61058aSafresh1        $self->{accuracy} = $r[0];
1108*3d61058aSafresh1        $self->{precision} = $r[1];
1109b46d8ef2Safresh1    } else {
1110b46d8ef2Safresh1        unless($selfref) {
1111*3d61058aSafresh1            $self->{accuracy} = $class -> accuracy();
1112*3d61058aSafresh1            $self->{precision} = $class -> precision();
1113b46d8ef2Safresh1        }
1114b46d8ef2Safresh1    }
11159f11ffb7Safresh1
11169f11ffb7Safresh1    return $self;
11179f11ffb7Safresh1}
11189f11ffb7Safresh1
11199f11ffb7Safresh1sub bpi {
11209f11ffb7Safresh1
1121e0680481Safresh1    # Class::method(...) -> Class->method(...)
1122e0680481Safresh1    unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
1123e0680481Safresh1                   $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
1124e0680481Safresh1    {
1125e0680481Safresh1        #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
1126e0680481Safresh1        #  " use is as a method instead";
1127e0680481Safresh1        unshift @_, __PACKAGE__;
1128e0680481Safresh1    }
1129e0680481Safresh1
11309f11ffb7Safresh1    # Called as                 Argument list
11319f11ffb7Safresh1    # ---------                 -------------
11329f11ffb7Safresh1    # Math::BigFloat->bpi()     ("Math::BigFloat")
11339f11ffb7Safresh1    # Math::BigFloat->bpi(10)   ("Math::BigFloat", 10)
11349f11ffb7Safresh1    # $x->bpi()                 ($x)
11359f11ffb7Safresh1    # $x->bpi(10)               ($x, 10)
11369f11ffb7Safresh1    # Math::BigFloat::bpi()     ()
11379f11ffb7Safresh1    # Math::BigFloat::bpi(10)   (10)
11389f11ffb7Safresh1    #
11399f11ffb7Safresh1    # In ambiguous cases, we favour the OO-style, so the following case
11409f11ffb7Safresh1    #
11419f11ffb7Safresh1    #   $n = Math::BigFloat->new("10");
11429f11ffb7Safresh1    #   $x = Math::BigFloat->bpi($n);
11439f11ffb7Safresh1    #
11449f11ffb7Safresh1    # which gives an argument list with the single element $n, is resolved as
11459f11ffb7Safresh1    #
11469f11ffb7Safresh1    #   $n->bpi();
11479f11ffb7Safresh1
11489f11ffb7Safresh1    my $self    = shift;
11499f11ffb7Safresh1    my $selfref = ref $self;
11509f11ffb7Safresh1    my $class   = $selfref || $self;
1151e0680481Safresh1    my @r       = @_;                   # rounding paramters
11529f11ffb7Safresh1
1153*3d61058aSafresh1    # Make "require" work.
1154*3d61058aSafresh1
1155*3d61058aSafresh1    $class -> import() if $IMPORT == 0;
1156*3d61058aSafresh1
1157e0680481Safresh1    if ($selfref) {                     # bpi() called as an instance method
11589f11ffb7Safresh1        return $self if $self -> modify('bpi');
1159e0680481Safresh1    } else {                            # bpi() called as a class method
1160e0680481Safresh1        $self  = bless {}, $class;      # initialize new instance
11619f11ffb7Safresh1    }
11629f11ffb7Safresh1
11639f11ffb7Safresh1    ($self, @r) = $self -> _find_round_parameters(@r);
11649f11ffb7Safresh1
11659f11ffb7Safresh1    # The accuracy, i.e., the number of digits. Pi has one digit before the
11669f11ffb7Safresh1    # dot, so a precision of 4 digits is equivalent to an accuracy of 5 digits.
11679f11ffb7Safresh1
11689f11ffb7Safresh1    my $n = defined $r[0] ? $r[0]
11699f11ffb7Safresh1          : defined $r[1] ? 1 - $r[1]
11709f11ffb7Safresh1          : $self -> div_scale();
11719f11ffb7Safresh1
11729f11ffb7Safresh1    my $rmode = defined $r[2] ? $r[2] : $self -> round_mode();
11739f11ffb7Safresh1
11749f11ffb7Safresh1    my $pi;
11759f11ffb7Safresh1
11769f11ffb7Safresh1    if ($n <= 1000) {
11779f11ffb7Safresh1
11789f11ffb7Safresh1        # 75 x 14 = 1050 digits
11799f11ffb7Safresh1
11809f11ffb7Safresh1        my $all_digits = <<EOF;
11819f11ffb7Safresh1314159265358979323846264338327950288419716939937510582097494459230781640628
11829f11ffb7Safresh1620899862803482534211706798214808651328230664709384460955058223172535940812
11839f11ffb7Safresh1848111745028410270193852110555964462294895493038196442881097566593344612847
11849f11ffb7Safresh1564823378678316527120190914564856692346034861045432664821339360726024914127
11859f11ffb7Safresh1372458700660631558817488152092096282925409171536436789259036001133053054882
11869f11ffb7Safresh1046652138414695194151160943305727036575959195309218611738193261179310511854
11879f11ffb7Safresh1807446237996274956735188575272489122793818301194912983367336244065664308602
11889f11ffb7Safresh1139494639522473719070217986094370277053921717629317675238467481846766940513
11899f11ffb7Safresh1200056812714526356082778577134275778960917363717872146844090122495343014654
11909f11ffb7Safresh1958537105079227968925892354201995611212902196086403441815981362977477130996
11919f11ffb7Safresh1051870721134999999837297804995105973173281609631859502445945534690830264252
11929f11ffb7Safresh1230825334468503526193118817101000313783875288658753320838142061717766914730
11939f11ffb7Safresh1359825349042875546873115956286388235378759375195778185778053217122680661300
11949f11ffb7Safresh1192787661119590921642019893809525720106548586327886593615338182796823030195
11959f11ffb7Safresh1EOF
11969f11ffb7Safresh1
11979f11ffb7Safresh1        # Should we round up?
11989f11ffb7Safresh1
11999f11ffb7Safresh1        my $round_up;
12009f11ffb7Safresh1
12019f11ffb7Safresh1        # From the string above, we need to extract the number of digits we
12029f11ffb7Safresh1        # want plus extra characters for the newlines.
12039f11ffb7Safresh1
12049f11ffb7Safresh1        my $nchrs = $n + int($n / 75);
12059f11ffb7Safresh1
12069f11ffb7Safresh1        # Extract the digits we want.
12079f11ffb7Safresh1
12089f11ffb7Safresh1        my $digits = substr($all_digits, 0, $nchrs);
12099f11ffb7Safresh1
1210b46d8ef2Safresh1        # Find out whether we should round up or down. Rounding is easy, since
1211b46d8ef2Safresh1        # pi is trancendental. With directed rounding, it doesn't matter what
1212b46d8ef2Safresh1        # the following digits are. With rounding to nearest, we only have to
1213b46d8ef2Safresh1        # look at one extra digit.
12149f11ffb7Safresh1
1215b46d8ef2Safresh1        if ($rmode eq 'trunc') {
12169f11ffb7Safresh1            $round_up = 0;
12179f11ffb7Safresh1        } else {
12189f11ffb7Safresh1            my $next_digit = substr($all_digits, $nchrs, 1);
12199f11ffb7Safresh1            $round_up = $next_digit lt '5' ? 0 : 1;
12209f11ffb7Safresh1        }
12219f11ffb7Safresh1
12229f11ffb7Safresh1        # Remove the newlines.
12239f11ffb7Safresh1
12249f11ffb7Safresh1        $digits =~ tr/0-9//cd;
12259f11ffb7Safresh1
12269f11ffb7Safresh1        # Now do the rounding. We could easily make the regex substitution
12279f11ffb7Safresh1        # handle all cases, but we avoid using the regex engine when it is
12289f11ffb7Safresh1        # simple to avoid it.
12299f11ffb7Safresh1
12309f11ffb7Safresh1        if ($round_up) {
12319f11ffb7Safresh1            my $last_digit = substr($digits, -1, 1);
12329f11ffb7Safresh1            if ($last_digit lt '9') {
12339f11ffb7Safresh1                substr($digits, -1, 1) = ++$last_digit;
12349f11ffb7Safresh1            } else {
1235e0680481Safresh1                $digits =~ s{([0-8])(9+)$}
1236e0680481Safresh1                            { ($1 + 1) . ("0" x CORE::length($2)) }e;
12379f11ffb7Safresh1            }
12389f11ffb7Safresh1        }
12399f11ffb7Safresh1
1240e0680481Safresh1        # Convert to an object.
12419f11ffb7Safresh1
1242e0680481Safresh1        $pi = bless {
1243e0680481Safresh1                     sign => '+',
1244e0680481Safresh1                     _m   => $LIB -> _new($digits),
1245e0680481Safresh1                     _es  => '-',
1246e0680481Safresh1                     _e   => $LIB -> _new($n - 1),
1247e0680481Safresh1                    }, $class;
12489f11ffb7Safresh1
12499f11ffb7Safresh1    } else {
12509f11ffb7Safresh1
12519f11ffb7Safresh1        # For large accuracy, the arctan formulas become very inefficient with
12529f11ffb7Safresh1        # Math::BigFloat, so use Brent-Salamin (aka AGM or Gauss-Legendre).
12539f11ffb7Safresh1
12549f11ffb7Safresh1        # Use a few more digits in the intermediate computations.
1255b46d8ef2Safresh1        $n += 8;
12569f11ffb7Safresh1
12579f11ffb7Safresh1        $HALF = $class -> new($HALF) unless ref($HALF);
1258e0680481Safresh1        my ($an, $bn, $tn, $pn)
1259e0680481Safresh1          = ($class -> bone, $HALF -> copy() -> bsqrt($n),
12609f11ffb7Safresh1             $HALF -> copy() -> bmul($HALF), $class -> bone);
12619f11ffb7Safresh1        while ($pn < $n) {
12629f11ffb7Safresh1            my $prev_an = $an -> copy();
1263e0680481Safresh1            $an = $an -> badd($bn) -> bmul($HALF, $n);
1264e0680481Safresh1            $bn = $bn -> bmul($prev_an) -> bsqrt($n);
1265e0680481Safresh1            $prev_an = $prev_an -> bsub($an);
1266e0680481Safresh1            $tn = $tn -> bsub($pn * $prev_an * $prev_an);
1267e0680481Safresh1            $pn = $pn -> badd($pn);
12689f11ffb7Safresh1        }
1269e0680481Safresh1        $an = $an -> badd($bn);
1270e0680481Safresh1        $an = $an -> bmul($an, $n) -> bdiv(4 * $tn, $n);
12719f11ffb7Safresh1
1272e0680481Safresh1        $an = $an -> round(@r);
12739f11ffb7Safresh1        $pi = $an;
12749f11ffb7Safresh1    }
12759f11ffb7Safresh1
12769f11ffb7Safresh1    if (defined $r[0]) {
12779f11ffb7Safresh1        $pi -> accuracy($r[0]);
12789f11ffb7Safresh1    } elsif (defined $r[1]) {
12799f11ffb7Safresh1        $pi -> precision($r[1]);
12809f11ffb7Safresh1    }
12819f11ffb7Safresh1
1282*3d61058aSafresh1    for my $key (qw/ sign _m _es _e accuracy precision /) {
12839f11ffb7Safresh1        $self -> {$key} = $pi -> {$key};
12849f11ffb7Safresh1    }
12859f11ffb7Safresh1
1286e0680481Safresh1    return $downgrade -> new($self -> bdstr(), @r)
1287e0680481Safresh1      if defined($downgrade) && $self->is_int();
12889f11ffb7Safresh1    return $self;
1289b8851fccSafresh1}
1290b8851fccSafresh1
1291b8851fccSafresh1sub copy {
1292e0680481Safresh1    my ($x, $class);
1293e0680481Safresh1    if (ref($_[0])) {           # $y = $x -> copy()
1294e0680481Safresh1        $x = shift;
1295e0680481Safresh1        $class = ref($x);
1296e0680481Safresh1    } else {                    # $y = Math::BigInt -> copy($y)
1297e0680481Safresh1        $class = shift;
1298e0680481Safresh1        $x = shift;
1299e0680481Safresh1    }
1300b8851fccSafresh1
1301e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @_;
1302b8851fccSafresh1
1303b8851fccSafresh1    my $copy = bless {}, $class;
1304b8851fccSafresh1
1305e0680481Safresh1    $copy->{sign} = $x->{sign};
1306e0680481Safresh1    $copy->{_es}  = $x->{_es};
1307e0680481Safresh1    $copy->{_m}   = $LIB->_copy($x->{_m});
1308e0680481Safresh1    $copy->{_e}   = $LIB->_copy($x->{_e});
1309*3d61058aSafresh1    $copy->{accuracy}   = $x->{accuracy} if exists $x->{accuracy};
1310*3d61058aSafresh1    $copy->{precision}   = $x->{precision} if exists $x->{precision};
1311b8851fccSafresh1
1312b8851fccSafresh1    return $copy;
1313b8851fccSafresh1}
1314b8851fccSafresh1
1315e0680481Safresh1sub as_int {
13169f11ffb7Safresh1    # return copy as a bigint representation of this Math::BigFloat number
1317e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
1318e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
1319b8851fccSafresh1
1320e0680481Safresh1    return $x -> copy() if $x -> isa("Math::BigInt");
13219f11ffb7Safresh1
1322*3d61058aSafresh1    # Disable upgrading and downgrading.
1323b8851fccSafresh1
1324e0680481Safresh1    require Math::BigInt;
1325e0680481Safresh1    my $upg = Math::BigInt -> upgrade();
1326e0680481Safresh1    my $dng = Math::BigInt -> downgrade();
1327e0680481Safresh1    Math::BigInt -> upgrade(undef);
1328e0680481Safresh1    Math::BigInt -> downgrade(undef);
13299f11ffb7Safresh1
1330*3d61058aSafresh1    # Copy the value.
1331*3d61058aSafresh1
1332e0680481Safresh1    my $y;
1333e0680481Safresh1    if ($x -> is_inf()) {
1334e0680481Safresh1        $y = Math::BigInt -> binf($x->sign());
1335e0680481Safresh1    } elsif ($x -> is_nan()) {
1336e0680481Safresh1        $y = Math::BigInt -> bnan();
1337e0680481Safresh1    } else {
1338e0680481Safresh1        $y = $LIB->_copy($x->{_m});
13399f11ffb7Safresh1        if ($x->{_es} eq '-') {                     # < 0
1340e0680481Safresh1            $y = $LIB->_rsft($y, $x->{_e}, 10);
1341b46d8ef2Safresh1        } elsif (! $LIB->_is_zero($x->{_e})) {      # > 0
1342e0680481Safresh1            $y = $LIB->_lsft($y, $x->{_e}, 10);
13439f11ffb7Safresh1        }
1344e0680481Safresh1        $y = Math::BigInt->new($x->{sign} . $LIB->_str($y));
1345e0680481Safresh1    }
1346e0680481Safresh1
1347*3d61058aSafresh1    # Copy the remaining instance variables.
1348*3d61058aSafresh1
1349*3d61058aSafresh1    ($y->{accuracy}, $y->{precision}) = ($x->{accuracy}, $x->{precision});
1350*3d61058aSafresh1
1351*3d61058aSafresh1    # Restore upgrading and downgrading.
1352e0680481Safresh1
1353e0680481Safresh1    Math::BigInt -> upgrade($upg);
1354e0680481Safresh1    Math::BigInt -> downgrade($dng);
1355e0680481Safresh1
1356e0680481Safresh1    return $y;
1357e0680481Safresh1}
1358e0680481Safresh1
1359e0680481Safresh1sub as_float {
1360e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
1361e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
1362e0680481Safresh1
1363e0680481Safresh1    return $x -> copy() if $x -> isa("Math::BigFloat");
1364e0680481Safresh1
1365*3d61058aSafresh1    # Disable upgrading and downgrading.
1366e0680481Safresh1
1367e0680481Safresh1    my $upg = Math::BigFloat -> upgrade();
1368e0680481Safresh1    my $dng = Math::BigFloat -> downgrade();
1369e0680481Safresh1    Math::BigFloat -> upgrade(undef);
1370e0680481Safresh1    Math::BigFloat -> downgrade(undef);
1371e0680481Safresh1
1372*3d61058aSafresh1    # Copy the value.
1373*3d61058aSafresh1
1374e0680481Safresh1    my $y = Math::BigFloat -> new($x);
1375e0680481Safresh1
1376*3d61058aSafresh1    # Copy the remaining instance variables.
1377*3d61058aSafresh1
1378*3d61058aSafresh1    ($y->{accuracy}, $y->{precision}) = ($x->{accuracy}, $x->{precision});
1379*3d61058aSafresh1
1380*3d61058aSafresh1    # Restore upgrading and downgrading.
1381e0680481Safresh1
1382e0680481Safresh1    Math::BigFloat -> upgrade($upg);
1383e0680481Safresh1    Math::BigFloat -> downgrade($dng);
1384e0680481Safresh1
1385e0680481Safresh1    return $y;
1386b8851fccSafresh1}
1387b8851fccSafresh1
1388*3d61058aSafresh1sub as_rat {
1389*3d61058aSafresh1    # return copy as a Math::BigRat representation of this Math::BigFloat
1390*3d61058aSafresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
1391*3d61058aSafresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
1392*3d61058aSafresh1
1393*3d61058aSafresh1    return $x -> copy() if $x -> isa("Math::BigRat");
1394*3d61058aSafresh1
1395*3d61058aSafresh1    # Disable upgrading and downgrading.
1396*3d61058aSafresh1
1397*3d61058aSafresh1    require Math::BigRat;
1398*3d61058aSafresh1    my $upg = Math::BigRat -> upgrade();
1399*3d61058aSafresh1    my $dng = Math::BigRat -> downgrade();
1400*3d61058aSafresh1    Math::BigRat -> upgrade(undef);
1401*3d61058aSafresh1    Math::BigRat -> downgrade(undef);
1402*3d61058aSafresh1
1403*3d61058aSafresh1    # Copy the value.
1404*3d61058aSafresh1
1405*3d61058aSafresh1    my $y;
1406*3d61058aSafresh1    if ($x -> is_inf()) {
1407*3d61058aSafresh1        $y = Math::BigRat -> binf($x -> sign());
1408*3d61058aSafresh1    } elsif ($x -> is_nan()) {
1409*3d61058aSafresh1        $y = Math::BigRat -> bnan();
1410*3d61058aSafresh1    } else {
1411*3d61058aSafresh1        my @flt_parts = ($x->{sign}, $x->{_m}, $x->{_es}, $x->{_e});
1412*3d61058aSafresh1        my @rat_parts = $class -> _flt_lib_parts_to_rat_lib_parts(@flt_parts);
1413*3d61058aSafresh1        $y = Math::BigRat -> new($rat_parts[0] . $LIB -> _str($rat_parts[1])
1414*3d61058aSafresh1                                         . '/' . $LIB -> _str($rat_parts[2]));
1415*3d61058aSafresh1    }
1416*3d61058aSafresh1
1417*3d61058aSafresh1    # Copy the remaining instance variables.
1418*3d61058aSafresh1
1419*3d61058aSafresh1    ($y->{accuracy}, $y->{precision}) = ($x->{accuracy}, $x->{precision});
1420*3d61058aSafresh1
1421*3d61058aSafresh1    # Restore upgrading and downgrading.
1422*3d61058aSafresh1
1423*3d61058aSafresh1    Math::BigRat -> upgrade($upg);
1424*3d61058aSafresh1    Math::BigRat -> downgrade($dng);
1425*3d61058aSafresh1
1426*3d61058aSafresh1    return $y;
1427*3d61058aSafresh1}
1428*3d61058aSafresh1
14299f11ffb7Safresh1###############################################################################
14309f11ffb7Safresh1# Boolean methods
14319f11ffb7Safresh1###############################################################################
1432b8851fccSafresh1
14339f11ffb7Safresh1sub is_zero {
14349f11ffb7Safresh1    # return true if arg (BFLOAT or num_str) is zero
1435e0680481Safresh1    my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
14369f11ffb7Safresh1
1437b46d8ef2Safresh1    ($x->{sign} eq '+' && $LIB->_is_zero($x->{_m})) ? 1 : 0;
1438b8851fccSafresh1}
1439b8851fccSafresh1
14409f11ffb7Safresh1sub is_one {
14419f11ffb7Safresh1    # return true if arg (BFLOAT or num_str) is +1 or -1 if signis given
1442e0680481Safresh1    my (undef, $x, $sign) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
14439f11ffb7Safresh1
14449f11ffb7Safresh1    $sign = '+' if !defined $sign || $sign ne '-';
14459f11ffb7Safresh1
14469f11ffb7Safresh1    ($x->{sign} eq $sign &&
1447b46d8ef2Safresh1     $LIB->_is_zero($x->{_e}) &&
1448b46d8ef2Safresh1     $LIB->_is_one($x->{_m})) ? 1 : 0;
1449b8851fccSafresh1}
1450b8851fccSafresh1
14519f11ffb7Safresh1sub is_odd {
14529f11ffb7Safresh1    # return true if arg (BFLOAT or num_str) is odd or false if even
1453e0680481Safresh1    my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
14549f11ffb7Safresh1
14559f11ffb7Safresh1    (($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't
1456b46d8ef2Safresh1     ($LIB->_is_zero($x->{_e})) &&
1457b46d8ef2Safresh1     ($LIB->_is_odd($x->{_m}))) ? 1 : 0;
1458b8851fccSafresh1}
1459b8851fccSafresh1
14609f11ffb7Safresh1sub is_even {
14619f11ffb7Safresh1    # return true if arg (BINT or num_str) is even or false if odd
1462e0680481Safresh1    my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
14639f11ffb7Safresh1
14649f11ffb7Safresh1    (($x->{sign} =~ /^[+-]$/) &&        # NaN & +-inf aren't
14659f11ffb7Safresh1     ($x->{_es} eq '+') &&              # 123.45 isn't
1466b46d8ef2Safresh1     ($LIB->_is_even($x->{_m}))) ? 1 : 0; # but 1200 is
1467b8851fccSafresh1}
1468b8851fccSafresh1
14699f11ffb7Safresh1sub is_int {
14709f11ffb7Safresh1    # return true if arg (BFLOAT or num_str) is an integer
1471e0680481Safresh1    my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
14729f11ffb7Safresh1
14739f11ffb7Safresh1    (($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't
14749f11ffb7Safresh1     ($x->{_es} eq '+')) ? 1 : 0; # 1e-1 => no integer
1475b8851fccSafresh1}
1476b8851fccSafresh1
14779f11ffb7Safresh1###############################################################################
14789f11ffb7Safresh1# Comparison methods
14799f11ffb7Safresh1###############################################################################
1480b8851fccSafresh1
14819f11ffb7Safresh1sub bcmp {
1482b8851fccSafresh1    # Compares 2 values.  Returns one of undef, <0, =0, >0. (suitable for sort)
1483b8851fccSafresh1
1484b8851fccSafresh1    # set up parameters
1485e0680481Safresh1    my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
1486e0680481Safresh1                            ? (ref($_[0]), @_)
1487e0680481Safresh1                            : objectify(2, @_);
1488b8851fccSafresh1
1489e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
1490b8851fccSafresh1
1491b8851fccSafresh1    # Handle all 'nan' cases.
1492b8851fccSafresh1
1493eac174f2Safresh1    return    if ($x->{sign} eq $nan) || ($y->{sign} eq $nan);
1494b8851fccSafresh1
1495b8851fccSafresh1    # Handle all '+inf' and '-inf' cases.
1496b8851fccSafresh1
1497b8851fccSafresh1    return  0 if ($x->{sign} eq '+inf' && $y->{sign} eq '+inf' ||
1498b8851fccSafresh1                  $x->{sign} eq '-inf' && $y->{sign} eq '-inf');
1499b8851fccSafresh1    return +1 if $x->{sign} eq '+inf'; # x = +inf and y < +inf
1500b8851fccSafresh1    return -1 if $x->{sign} eq '-inf'; # x = -inf and y > -inf
1501b8851fccSafresh1    return -1 if $y->{sign} eq '+inf'; # x < +inf and y = +inf
1502b8851fccSafresh1    return +1 if $y->{sign} eq '-inf'; # x > -inf and y = -inf
1503b8851fccSafresh1
1504b8851fccSafresh1    # Handle all cases with opposite signs.
1505b8851fccSafresh1
1506b8851fccSafresh1    return +1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # also does 0 <=> -y
1507b8851fccSafresh1    return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # also does -x <=> 0
1508b8851fccSafresh1
1509b8851fccSafresh1    # Handle all remaining zero cases.
1510b8851fccSafresh1
1511b8851fccSafresh1    my $xz = $x->is_zero();
1512b8851fccSafresh1    my $yz = $y->is_zero();
1513b8851fccSafresh1    return  0 if $xz && $yz;             # 0 <=> 0
1514b8851fccSafresh1    return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y
1515b8851fccSafresh1    return +1 if $yz && $x->{sign} eq '+'; # +x <=> 0
1516b8851fccSafresh1
1517b8851fccSafresh1    # Both arguments are now finite, non-zero numbers with the same sign.
1518b8851fccSafresh1
1519b8851fccSafresh1    my $cmp;
1520b8851fccSafresh1
1521b8851fccSafresh1    # The next step is to compare the exponents, but since each mantissa is an
1522b8851fccSafresh1    # integer of arbitrary value, the exponents must be normalized by the length
1523b8851fccSafresh1    # of the mantissas before we can compare them.
1524b8851fccSafresh1
1525b46d8ef2Safresh1    my $mxl = $LIB->_len($x->{_m});
1526b46d8ef2Safresh1    my $myl = $LIB->_len($y->{_m});
1527b8851fccSafresh1
1528e0680481Safresh1    # If the mantissas have the same length, there is no point in normalizing
1529e0680481Safresh1    # the exponents by the length of the mantissas, so treat that as a special
1530e0680481Safresh1    # case.
1531b8851fccSafresh1
1532b8851fccSafresh1    if ($mxl == $myl) {
1533b8851fccSafresh1
1534b8851fccSafresh1        # First handle the two cases where the exponents have different signs.
1535b8851fccSafresh1
1536b8851fccSafresh1        if ($x->{_es} eq '+' && $y->{_es} eq '-') {
1537b8851fccSafresh1            $cmp = +1;
15389f11ffb7Safresh1        } elsif ($x->{_es} eq '-' && $y->{_es} eq '+') {
1539b8851fccSafresh1            $cmp = -1;
1540b8851fccSafresh1        }
1541b8851fccSafresh1
1542b8851fccSafresh1        # Then handle the case where the exponents have the same sign.
1543b8851fccSafresh1
1544b8851fccSafresh1        else {
1545b46d8ef2Safresh1            $cmp = $LIB->_acmp($x->{_e}, $y->{_e});
1546b8851fccSafresh1            $cmp = -$cmp if $x->{_es} eq '-';
1547b8851fccSafresh1        }
1548b8851fccSafresh1
1549b8851fccSafresh1        # Adjust for the sign, which is the same for x and y, and bail out if
1550b8851fccSafresh1        # we're done.
1551b8851fccSafresh1
1552b8851fccSafresh1        $cmp = -$cmp if $x->{sign} eq '-'; # 124 > 123, but -124 < -123
1553b8851fccSafresh1        return $cmp if $cmp;
1554b8851fccSafresh1
1555b8851fccSafresh1    }
1556b8851fccSafresh1
1557b8851fccSafresh1    # We must normalize each exponent by the length of the corresponding
1558b8851fccSafresh1    # mantissa. Life is a lot easier if we first make both exponents
1559b8851fccSafresh1    # non-negative. We do this by adding the same positive value to both
1560b8851fccSafresh1    # exponent. This is safe, because when comparing the exponents, only the
1561b8851fccSafresh1    # relative difference is important.
1562b8851fccSafresh1
1563b8851fccSafresh1    my $ex;
1564b8851fccSafresh1    my $ey;
1565b8851fccSafresh1
1566b8851fccSafresh1    if ($x->{_es} eq '+') {
1567b8851fccSafresh1
1568e0680481Safresh1        # If the exponent of x is >= 0 and the exponent of y is >= 0, there is
1569e0680481Safresh1        # no need to do anything special.
1570b8851fccSafresh1
1571b8851fccSafresh1        if ($y->{_es} eq '+') {
1572b46d8ef2Safresh1            $ex = $LIB->_copy($x->{_e});
1573b46d8ef2Safresh1            $ey = $LIB->_copy($y->{_e});
1574b8851fccSafresh1        }
1575b8851fccSafresh1
1576b8851fccSafresh1        # If the exponent of x is >= 0 and the exponent of y is < 0, add the
1577b8851fccSafresh1        # absolute value of the exponent of y to both.
1578b8851fccSafresh1
1579b8851fccSafresh1        else {
1580b46d8ef2Safresh1            $ex = $LIB->_copy($x->{_e});
1581b46d8ef2Safresh1            $ex = $LIB->_add($ex, $y->{_e}); # ex + |ey|
1582b46d8ef2Safresh1            $ey = $LIB->_zero();             # -ex + |ey| = 0
1583b8851fccSafresh1        }
1584b8851fccSafresh1
1585b8851fccSafresh1    } else {
1586b8851fccSafresh1
1587b8851fccSafresh1        # If the exponent of x is < 0 and the exponent of y is >= 0, add the
1588b8851fccSafresh1        # absolute value of the exponent of x to both.
1589b8851fccSafresh1
1590b8851fccSafresh1        if ($y->{_es} eq '+') {
1591b46d8ef2Safresh1            $ex = $LIB->_zero(); # -ex + |ex| = 0
1592b46d8ef2Safresh1            $ey = $LIB->_copy($y->{_e});
1593b46d8ef2Safresh1            $ey = $LIB->_add($ey, $x->{_e}); # ey + |ex|
1594b8851fccSafresh1        }
1595b8851fccSafresh1
1596b8851fccSafresh1        # If the exponent of x is < 0 and the exponent of y is < 0, add the
1597b8851fccSafresh1        # absolute values of both exponents to both exponents.
1598b8851fccSafresh1
1599b8851fccSafresh1        else {
1600b46d8ef2Safresh1            $ex = $LIB->_copy($y->{_e}); # -ex + |ey| + |ex| = |ey|
1601b46d8ef2Safresh1            $ey = $LIB->_copy($x->{_e}); # -ey + |ex| + |ey| = |ex|
1602b8851fccSafresh1        }
1603b8851fccSafresh1
1604b8851fccSafresh1    }
1605b8851fccSafresh1
1606b8851fccSafresh1    # Now we can normalize the exponents by adding lengths of the mantissas.
1607b8851fccSafresh1
1608b46d8ef2Safresh1    $ex = $LIB->_add($ex, $LIB->_new($mxl));
1609b46d8ef2Safresh1    $ey = $LIB->_add($ey, $LIB->_new($myl));
1610b8851fccSafresh1
1611b8851fccSafresh1    # We're done if the exponents are different.
1612b8851fccSafresh1
1613b46d8ef2Safresh1    $cmp = $LIB->_acmp($ex, $ey);
1614b8851fccSafresh1    $cmp = -$cmp if $x->{sign} eq '-'; # 124 > 123, but -124 < -123
1615b8851fccSafresh1    return $cmp if $cmp;
1616b8851fccSafresh1
1617b8851fccSafresh1    # Compare the mantissas, but first normalize them by padding the shorter
1618e0680481Safresh1    # mantissa with zeros (shift left) until it has the same length as the
1619e0680481Safresh1    # longer mantissa.
1620b8851fccSafresh1
1621b8851fccSafresh1    my $mx = $x->{_m};
1622b8851fccSafresh1    my $my = $y->{_m};
1623b8851fccSafresh1
1624b8851fccSafresh1    if ($mxl > $myl) {
1625b46d8ef2Safresh1        $my = $LIB->_lsft($LIB->_copy($my), $LIB->_new($mxl - $myl), 10);
1626b8851fccSafresh1    } elsif ($mxl < $myl) {
1627b46d8ef2Safresh1        $mx = $LIB->_lsft($LIB->_copy($mx), $LIB->_new($myl - $mxl), 10);
1628b8851fccSafresh1    }
1629b8851fccSafresh1
1630b46d8ef2Safresh1    $cmp = $LIB->_acmp($mx, $my);
1631b8851fccSafresh1    $cmp = -$cmp if $x->{sign} eq '-'; # 124 > 123, but -124 < -123
1632b8851fccSafresh1    return $cmp;
1633b8851fccSafresh1
1634b8851fccSafresh1}
1635b8851fccSafresh1
16369f11ffb7Safresh1sub bacmp {
1637b8851fccSafresh1    # Compares 2 values, ignoring their signs.
1638b8851fccSafresh1    # Returns one of undef, <0, =0, >0. (suitable for sort)
1639b8851fccSafresh1
1640b8851fccSafresh1    # set up parameters
1641e0680481Safresh1    my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
1642e0680481Safresh1                            ? (ref($_[0]), @_)
1643e0680481Safresh1                            : objectify(2, @_);
1644b8851fccSafresh1
1645e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
1646b8851fccSafresh1
1647b8851fccSafresh1    # handle +-inf and NaN's
16489f11ffb7Safresh1    if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/) {
1649eac174f2Safresh1        return    if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
1650b8851fccSafresh1        return  0 if ($x->is_inf() && $y->is_inf());
1651b8851fccSafresh1        return  1 if ($x->is_inf() && !$y->is_inf());
1652b8851fccSafresh1        return -1;
1653b8851fccSafresh1    }
1654b8851fccSafresh1
1655b8851fccSafresh1    # shortcut
1656b8851fccSafresh1    my $xz = $x->is_zero();
1657b8851fccSafresh1    my $yz = $y->is_zero();
1658b8851fccSafresh1    return 0 if $xz && $yz;     # 0 <=> 0
1659b8851fccSafresh1    return -1 if $xz && !$yz;   # 0 <=> +y
1660b8851fccSafresh1    return 1 if $yz && !$xz;    # +x <=> 0
1661b8851fccSafresh1
1662b8851fccSafresh1    # adjust so that exponents are equal
1663b46d8ef2Safresh1    my $lxm = $LIB->_len($x->{_m});
1664b46d8ef2Safresh1    my $lym = $LIB->_len($y->{_m});
1665b8851fccSafresh1    my ($xes, $yes) = (1, 1);
1666b8851fccSafresh1    $xes = -1 if $x->{_es} ne '+';
1667b8851fccSafresh1    $yes = -1 if $y->{_es} ne '+';
1668b8851fccSafresh1    # the numify somewhat limits our length, but makes it much faster
1669b46d8ef2Safresh1    my $lx = $lxm + $xes * $LIB->_num($x->{_e});
1670b46d8ef2Safresh1    my $ly = $lym + $yes * $LIB->_num($y->{_e});
1671b8851fccSafresh1    my $l = $lx - $ly;
1672b8851fccSafresh1    return $l <=> 0 if $l != 0;
1673b8851fccSafresh1
1674b8851fccSafresh1    # lengths (corrected by exponent) are equal
1675b8851fccSafresh1    # so make mantissa equal-length by padding with zero (shift left)
1676b8851fccSafresh1    my $diff = $lxm - $lym;
1677b8851fccSafresh1    my $xm = $x->{_m};          # not yet copy it
1678b8851fccSafresh1    my $ym = $y->{_m};
16799f11ffb7Safresh1    if ($diff > 0) {
1680b46d8ef2Safresh1        $ym = $LIB->_copy($y->{_m});
1681b46d8ef2Safresh1        $ym = $LIB->_lsft($ym, $LIB->_new($diff), 10);
16829f11ffb7Safresh1    } elsif ($diff < 0) {
1683b46d8ef2Safresh1        $xm = $LIB->_copy($x->{_m});
1684b46d8ef2Safresh1        $xm = $LIB->_lsft($xm, $LIB->_new(-$diff), 10);
1685b8851fccSafresh1    }
1686b46d8ef2Safresh1    $LIB->_acmp($xm, $ym);
1687b8851fccSafresh1}
1688b8851fccSafresh1
16899f11ffb7Safresh1###############################################################################
16909f11ffb7Safresh1# Arithmetic methods
16919f11ffb7Safresh1###############################################################################
16929f11ffb7Safresh1
16939f11ffb7Safresh1sub bneg {
16949f11ffb7Safresh1    # (BINT or num_str) return BINT
16959f11ffb7Safresh1    # negate number or make a negated number from string
1696e0680481Safresh1    my (undef, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
16979f11ffb7Safresh1
16989f11ffb7Safresh1    return $x if $x->modify('bneg');
16999f11ffb7Safresh1
1700e0680481Safresh1    return $x -> bnan(@r) if $x -> is_nan();
1701eac174f2Safresh1
1702e0680481Safresh1    # For +0 do not negate (to have always normalized +0).
1703e0680481Safresh1    $x->{sign} =~ tr/+-/-+/
1704e0680481Safresh1      unless $x->{sign} eq '+' && $LIB->_is_zero($x->{_m});
1705e0680481Safresh1
1706e0680481Safresh1    return $downgrade -> new($x -> bdstr(), @r) if defined($downgrade)
1707e0680481Safresh1      && ($x -> is_int() || $x -> is_inf() || $x -> is_nan());
1708e0680481Safresh1    return $x -> round(@r);
17099f11ffb7Safresh1}
17109f11ffb7Safresh1
17119f11ffb7Safresh1sub bnorm {
1712e0680481Safresh1    # bnorm() can't support rounding, because bround() and bfround() call
1713e0680481Safresh1    # bnorm(), which would recurse indefinitely.
1714e0680481Safresh1
17159f11ffb7Safresh1    # adjust m and e so that m is smallest possible
1716e0680481Safresh1    my (undef, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
1717e0680481Safresh1
1718e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
17199f11ffb7Safresh1
1720eac174f2Safresh1    # inf, nan etc
1721eac174f2Safresh1    if ($x->{sign} !~ /^[+-]$/) {
1722eac174f2Safresh1        return $downgrade -> new($x) if defined $downgrade;
1723eac174f2Safresh1        return $x;
1724eac174f2Safresh1    }
17259f11ffb7Safresh1
1726b46d8ef2Safresh1    my $zeros = $LIB->_zeros($x->{_m}); # correct for trailing zeros
17279f11ffb7Safresh1    if ($zeros != 0) {
1728b46d8ef2Safresh1        my $z = $LIB->_new($zeros);
1729b46d8ef2Safresh1        $x->{_m} = $LIB->_rsft($x->{_m}, $z, 10);
17309f11ffb7Safresh1        if ($x->{_es} eq '-') {
1731b46d8ef2Safresh1            if ($LIB->_acmp($x->{_e}, $z) >= 0) {
1732b46d8ef2Safresh1                $x->{_e} = $LIB->_sub($x->{_e}, $z);
1733b46d8ef2Safresh1                $x->{_es} = '+' if $LIB->_is_zero($x->{_e});
17349f11ffb7Safresh1            } else {
1735b46d8ef2Safresh1                $x->{_e} = $LIB->_sub($LIB->_copy($z), $x->{_e});
17369f11ffb7Safresh1                $x->{_es} = '+';
17379f11ffb7Safresh1            }
17389f11ffb7Safresh1        } else {
1739b46d8ef2Safresh1            $x->{_e} = $LIB->_add($x->{_e}, $z);
17409f11ffb7Safresh1        }
17419f11ffb7Safresh1    } else {
17429f11ffb7Safresh1        # $x can only be 0Ey if there are no trailing zeros ('0' has 0 trailing
1743e0680481Safresh1        # zeros). So, for something like 0Ey, set y to 0, and -0 => +0
1744e0680481Safresh1        if ($LIB->_is_zero($x->{_m})) {
1745e0680481Safresh1            $x->{sign} = '+';
1746e0680481Safresh1            $x->{_es}  = '+';
1747e0680481Safresh1            $x->{_e}   = $LIB->_zero();
1748e0680481Safresh1        }
17499f11ffb7Safresh1    }
17509f11ffb7Safresh1
1751e0680481Safresh1    return $downgrade -> new($x)
1752e0680481Safresh1      if defined($downgrade) && $x->is_int();
1753e0680481Safresh1    return $x;
17549f11ffb7Safresh1}
17559f11ffb7Safresh1
17569f11ffb7Safresh1sub binc {
17579f11ffb7Safresh1    # increment arg by one
17589f11ffb7Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
17599f11ffb7Safresh1
17609f11ffb7Safresh1    return $x if $x->modify('binc');
17619f11ffb7Safresh1
1762e0680481Safresh1    # Inf and NaN
1763e0680481Safresh1
1764e0680481Safresh1    return $x -> bnan(@r)             if $x -> is_nan();
1765e0680481Safresh1    return $x -> binf($x->{sign}, @r) if $x -> is_inf();
1766e0680481Safresh1
1767e0680481Safresh1    # Non-integer
1768e0680481Safresh1
17699f11ffb7Safresh1    if ($x->{_es} eq '-') {
1770e0680481Safresh1        return $x->badd($class->bone(), @r);
17719f11ffb7Safresh1    }
17729f11ffb7Safresh1
1773e0680481Safresh1    # If the exponent is non-zero, convert the internal representation, so that,
1774e0680481Safresh1    # e.g., 12e+3 becomes 12000e+0 and we can easily increment the mantissa.
1775e0680481Safresh1
1776e0680481Safresh1    if (!$LIB->_is_zero($x->{_e})) {
1777b46d8ef2Safresh1        $x->{_m} = $LIB->_lsft($x->{_m}, $x->{_e}, 10); # 1e2 => 100
1778b46d8ef2Safresh1        $x->{_e} = $LIB->_zero();                       # normalize
17799f11ffb7Safresh1        $x->{_es} = '+';
17809f11ffb7Safresh1        # we know that the last digit of $x will be '1' or '9', depending on the
17819f11ffb7Safresh1        # sign
17829f11ffb7Safresh1    }
1783e0680481Safresh1
17849f11ffb7Safresh1    # now $x->{_e} == 0
17859f11ffb7Safresh1    if ($x->{sign} eq '+') {
1786b46d8ef2Safresh1        $x->{_m} = $LIB->_inc($x->{_m});
17879f11ffb7Safresh1        return $x->bnorm()->bround(@r);
17889f11ffb7Safresh1    } elsif ($x->{sign} eq '-') {
1789b46d8ef2Safresh1        $x->{_m} = $LIB->_dec($x->{_m});
1790b46d8ef2Safresh1        $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # -1 +1 => -0 => +0
17919f11ffb7Safresh1        return $x->bnorm()->bround(@r);
17929f11ffb7Safresh1    }
1793e0680481Safresh1
1794e0680481Safresh1    return $downgrade -> new($x -> bdstr(), @r)
1795e0680481Safresh1      if defined($downgrade) && $x -> is_int();
1796e0680481Safresh1    return $x;
17979f11ffb7Safresh1}
17989f11ffb7Safresh1
17999f11ffb7Safresh1sub bdec {
18009f11ffb7Safresh1    # decrement arg by one
18019f11ffb7Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
18029f11ffb7Safresh1
18039f11ffb7Safresh1    return $x if $x->modify('bdec');
18049f11ffb7Safresh1
1805e0680481Safresh1    # Inf and NaN
1806e0680481Safresh1
1807e0680481Safresh1    return $x -> bnan(@r)             if $x -> is_nan();
1808e0680481Safresh1    return $x -> binf($x->{sign}, @r) if $x -> is_inf();
1809e0680481Safresh1
1810e0680481Safresh1    # Non-integer
1811e0680481Safresh1
18129f11ffb7Safresh1    if ($x->{_es} eq '-') {
1813e0680481Safresh1        return $x->badd($class->bone('-'), @r);
18149f11ffb7Safresh1    }
18159f11ffb7Safresh1
1816e0680481Safresh1    # If the exponent is non-zero, convert the internal representation, so that,
1817e0680481Safresh1    # e.g., 12e+3 becomes 12000e+0 and we can easily increment the mantissa.
1818e0680481Safresh1
1819b46d8ef2Safresh1    if (!$LIB->_is_zero($x->{_e})) {
1820b46d8ef2Safresh1        $x->{_m} = $LIB->_lsft($x->{_m}, $x->{_e}, 10); # 1e2 => 100
1821b46d8ef2Safresh1        $x->{_e} = $LIB->_zero();                       # normalize
18229f11ffb7Safresh1        $x->{_es} = '+';
18239f11ffb7Safresh1    }
1824e0680481Safresh1
18259f11ffb7Safresh1    # now $x->{_e} == 0
18269f11ffb7Safresh1    my $zero = $x->is_zero();
1827e0680481Safresh1    if (($x->{sign} eq '-') || $zero) {           # x <= 0
1828b46d8ef2Safresh1        $x->{_m} = $LIB->_inc($x->{_m});
18299f11ffb7Safresh1        $x->{sign} = '-' if $zero;                # 0 => 1 => -1
1830b46d8ef2Safresh1        $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # -1 +1 => -0 => +0
18319f11ffb7Safresh1        return $x->bnorm()->round(@r);
18329f11ffb7Safresh1    }
1833e0680481Safresh1    elsif ($x->{sign} eq '+') {                   # x > 0
1834b46d8ef2Safresh1        $x->{_m} = $LIB->_dec($x->{_m});
18359f11ffb7Safresh1        return $x->bnorm()->round(@r);
18369f11ffb7Safresh1    }
1837e0680481Safresh1
1838e0680481Safresh1    return $downgrade -> new($x -> bdstr(), @r)
1839e0680481Safresh1      if defined($downgrade) && $x -> is_int();
1840e0680481Safresh1    return $x -> round(@r);
18419f11ffb7Safresh1}
18429f11ffb7Safresh1
18439f11ffb7Safresh1sub badd {
1844b8851fccSafresh1    # set up parameters
1845e0680481Safresh1    my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
1846e0680481Safresh1                            ? (ref($_[0]), @_)
1847e0680481Safresh1                            : objectify(2, @_);
1848b8851fccSafresh1
1849b8851fccSafresh1    return $x if $x->modify('badd');
1850b8851fccSafresh1
1851b8851fccSafresh1    # inf and NaN handling
1852eac174f2Safresh1    if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/) {
1853eac174f2Safresh1
1854e0680481Safresh1        # $x is NaN and/or $y is NaN
1855eac174f2Safresh1        if ($x->{sign} eq $nan || $y->{sign} eq $nan) {
1856e0680481Safresh1            $x = $x->bnan();
1857b8851fccSafresh1        }
1858eac174f2Safresh1
1859e0680481Safresh1        # $x is Inf and $y is Inf
1860eac174f2Safresh1        elsif ($x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/) {
1861e0680481Safresh1            # +Inf + +Inf or -Inf + -Inf => same, rest is NaN
1862e0680481Safresh1            $x = $x->bnan() if $x->{sign} ne $y->{sign};
1863eac174f2Safresh1        }
1864eac174f2Safresh1
1865e0680481Safresh1        # +-inf + something => +-inf; something +-inf => +-inf
1866eac174f2Safresh1        elsif ($y->{sign} =~ /^[+-]inf$/) {
1867eac174f2Safresh1            $x->{sign} = $y->{sign};
1868eac174f2Safresh1        }
1869eac174f2Safresh1
1870e0680481Safresh1        return $downgrade -> new($x -> bdstr(), @r) if defined $downgrade;
1871e0680481Safresh1        return $x -> round(@r);
1872b8851fccSafresh1    }
1873b8851fccSafresh1
1874e0680481Safresh1    return $upgrade->badd($x, $y, @r) if defined $upgrade;
1875b8851fccSafresh1
1876b8851fccSafresh1    $r[3] = $y;                 # no push!
1877b8851fccSafresh1
1878eac174f2Safresh1    # for speed: no add for $x + 0
1879eac174f2Safresh1    if ($y->is_zero()) {
1880e0680481Safresh1        $x = $x->round(@r);
1881eac174f2Safresh1    }
1882eac174f2Safresh1
1883eac174f2Safresh1    # for speed: no add for 0 + $y
1884eac174f2Safresh1    elsif ($x->is_zero()) {
1885b8851fccSafresh1        # make copy, clobbering up x (modify in place!)
1886b46d8ef2Safresh1        $x->{_e} = $LIB->_copy($y->{_e});
1887b8851fccSafresh1        $x->{_es} = $y->{_es};
1888b46d8ef2Safresh1        $x->{_m} = $LIB->_copy($y->{_m});
1889b8851fccSafresh1        $x->{sign} = $y->{sign} || $nan;
1890e0680481Safresh1        $x = $x->round(@r);
1891b8851fccSafresh1    }
1892b8851fccSafresh1
1893e0680481Safresh1    # both $x and $y are non-zero
1894eac174f2Safresh1    else {
1895eac174f2Safresh1
1896b8851fccSafresh1        # take lower of the two e's and adapt m1 to it to match m2
1897b8851fccSafresh1        my $e = $y->{_e};
1898b46d8ef2Safresh1        $e = $LIB->_zero() if !defined $e; # if no BFLOAT?
1899b46d8ef2Safresh1        $e = $LIB->_copy($e);              # make copy (didn't do it yet)
1900b8851fccSafresh1
1901b8851fccSafresh1        my $es;
1902b8851fccSafresh1
1903e0680481Safresh1        ($e, $es) = $LIB -> _ssub($e, $y->{_es} || '+', $x->{_e}, $x->{_es});
1904b8851fccSafresh1
1905b46d8ef2Safresh1        my $add = $LIB->_copy($y->{_m});
1906b8851fccSafresh1
1907eac174f2Safresh1        if ($es eq '-') {                       # < 0
1908b46d8ef2Safresh1            $x->{_m} = $LIB->_lsft($x->{_m}, $e, 10);
1909e0680481Safresh1            ($x->{_e}, $x->{_es}) = $LIB -> _sadd($x->{_e}, $x->{_es}, $e, $es);
1910eac174f2Safresh1        } elsif (!$LIB->_is_zero($e)) {         # > 0
1911b46d8ef2Safresh1            $add = $LIB->_lsft($add, $e, 10);
1912b8851fccSafresh1        }
1913eac174f2Safresh1
1914b8851fccSafresh1        # else: both e are the same, so just leave them
1915b8851fccSafresh1
19169f11ffb7Safresh1        if ($x->{sign} eq $y->{sign}) {
1917b46d8ef2Safresh1            $x->{_m} = $LIB->_add($x->{_m}, $add);
19189f11ffb7Safresh1        } else {
1919b8851fccSafresh1            ($x->{_m}, $x->{sign}) =
1920e0680481Safresh1              $LIB -> _sadd($x->{_m}, $x->{sign}, $add, $y->{sign});
1921b8851fccSafresh1        }
1922b8851fccSafresh1
1923b8851fccSafresh1        # delete trailing zeros, then round
1924e0680481Safresh1        $x = $x->bnorm()->round(@r);
1925b8851fccSafresh1    }
1926b8851fccSafresh1
1927e0680481Safresh1    return $downgrade -> new($x -> bdstr(), @r)
1928e0680481Safresh1      if defined($downgrade) && $x -> is_int();
1929e0680481Safresh1    return $x;          # rounding already done above
1930eac174f2Safresh1}
1931eac174f2Safresh1
19329f11ffb7Safresh1sub bsub {
19339f11ffb7Safresh1    # set up parameters
1934e0680481Safresh1    my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
1935e0680481Safresh1                            ? (ref($_[0]), @_)
1936e0680481Safresh1                            : objectify(2, @_);
1937b8851fccSafresh1
19389f11ffb7Safresh1    return $x if $x -> modify('bsub');
19399f11ffb7Safresh1
1940eac174f2Safresh1    if ($y -> is_zero()) {
1941e0680481Safresh1        $x = $x -> round(@r);
1942eac174f2Safresh1    } else {
19439f11ffb7Safresh1
1944eac174f2Safresh1        # To correctly handle the special case $x -> bsub($x), we note the sign
1945eac174f2Safresh1        # of $x, then flip the sign of $y, and if the sign of $x changed too,
1946eac174f2Safresh1        # then we know that $x and $y are the same object.
19479f11ffb7Safresh1
19489f11ffb7Safresh1        my $xsign = $x -> {sign};
19499f11ffb7Safresh1        $y -> {sign} =~ tr/+-/-+/;      # does nothing for NaN
19509f11ffb7Safresh1        if ($xsign ne $x -> {sign}) {
19519f11ffb7Safresh1            # special case of $x -> bsub($x) results in 0
1952eac174f2Safresh1            if ($xsign =~ /^[+-]$/) {
1953e0680481Safresh1                $x = $x -> bzero(@r);
1954eac174f2Safresh1            } else {
1955e0680481Safresh1                $x = $x -> bnan();      # NaN, -inf, +inf
19569f11ffb7Safresh1            }
1957e0680481Safresh1            return $downgrade -> new($x -> bdstr(), @r) if defined $downgrade;
1958e0680481Safresh1            return $x -> round(@r);
1959eac174f2Safresh1        }
1960eac174f2Safresh1        $x = $x -> badd($y, @r);        # badd does not leave internal zeros
1961eac174f2Safresh1        $y -> {sign} =~ tr/+-/-+/;      # reset $y (does nothing for NaN)
1962eac174f2Safresh1    }
1963e0680481Safresh1
1964e0680481Safresh1    return $downgrade -> new($x -> bdstr(), @r)
1965eac174f2Safresh1      if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan());
19669f11ffb7Safresh1    $x;                         # already rounded by badd() or no rounding
19679f11ffb7Safresh1}
19689f11ffb7Safresh1
19699f11ffb7Safresh1sub bmul {
19709f11ffb7Safresh1    # multiply two numbers
19719f11ffb7Safresh1
19729f11ffb7Safresh1    # set up parameters
1973e0680481Safresh1    my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
1974e0680481Safresh1                            ? (ref($_[0]), @_)
1975e0680481Safresh1                            : objectify(2, @_);
19769f11ffb7Safresh1
19779f11ffb7Safresh1    return $x if $x->modify('bmul');
19789f11ffb7Safresh1
1979e0680481Safresh1    return $x->bnan(@r) if ($x->{sign} eq $nan) || ($y->{sign} eq $nan);
19809f11ffb7Safresh1
19819f11ffb7Safresh1    # inf handling
19829f11ffb7Safresh1    if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) {
1983e0680481Safresh1        return $x->bnan(@r) if $x->is_zero() || $y->is_zero();
19849f11ffb7Safresh1        # result will always be +-inf:
19859f11ffb7Safresh1        # +inf * +/+inf => +inf, -inf * -/-inf => +inf
19869f11ffb7Safresh1        # +inf * -/-inf => -inf, -inf * +/+inf => -inf
1987e0680481Safresh1        return $x->binf(@r) if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
1988e0680481Safresh1        return $x->binf(@r) if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
1989e0680481Safresh1        return $x->binf('-', @r);
19909f11ffb7Safresh1    }
19919f11ffb7Safresh1
1992e0680481Safresh1    return $upgrade->bmul($x, $y, @r) if defined $upgrade;
19939f11ffb7Safresh1
19949f11ffb7Safresh1    # aEb * cEd = (a*c)E(b+d)
1995b46d8ef2Safresh1    $x->{_m} = $LIB->_mul($x->{_m}, $y->{_m});
1996e0680481Safresh1    ($x->{_e}, $x->{_es})
1997e0680481Safresh1      = $LIB -> _sadd($x->{_e}, $x->{_es}, $y->{_e}, $y->{_es});
19989f11ffb7Safresh1
19999f11ffb7Safresh1    $r[3] = $y;                 # no push!
20009f11ffb7Safresh1
20019f11ffb7Safresh1    # adjust sign:
20029f11ffb7Safresh1    $x->{sign} = $x->{sign} ne $y->{sign} ? '-' : '+';
2003e0680481Safresh1    $x = $x->bnorm->round(@r);
2004e0680481Safresh1
2005e0680481Safresh1    return $downgrade -> new($x -> bdstr(), @r)
2006e0680481Safresh1      if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan());
2007e0680481Safresh1    return $x;
20089f11ffb7Safresh1}
20099f11ffb7Safresh1
20109f11ffb7Safresh1sub bmuladd {
20119f11ffb7Safresh1    # multiply two numbers and add the third to the result
20129f11ffb7Safresh1
20139f11ffb7Safresh1    # set up parameters
2014e0680481Safresh1    my ($class, $x, $y, $z, @r)
2015e0680481Safresh1      = ref($_[0]) && ref($_[0]) eq ref($_[1]) && ref($_[1]) eq ref($_[2])
2016e0680481Safresh1      ? (ref($_[0]), @_)
2017e0680481Safresh1      : objectify(3, @_);
20189f11ffb7Safresh1
20199f11ffb7Safresh1    return $x if $x->modify('bmuladd');
20209f11ffb7Safresh1
2021e0680481Safresh1    return $x->bnan(@r) if (($x->{sign} eq $nan) ||
20229f11ffb7Safresh1                            ($y->{sign} eq $nan) ||
20239f11ffb7Safresh1                            ($z->{sign} eq $nan));
20249f11ffb7Safresh1
20259f11ffb7Safresh1    # inf handling
20269f11ffb7Safresh1    if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) {
2027e0680481Safresh1        return $x->bnan(@r) if $x->is_zero() || $y->is_zero();
20289f11ffb7Safresh1        # result will always be +-inf:
20299f11ffb7Safresh1        # +inf * +/+inf => +inf, -inf * -/-inf => +inf
20309f11ffb7Safresh1        # +inf * -/-inf => -inf, -inf * +/+inf => -inf
2031e0680481Safresh1        return $x->binf(@r) if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
2032e0680481Safresh1        return $x->binf(@r) if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
2033e0680481Safresh1        return $x->binf('-', @r);
20349f11ffb7Safresh1    }
20359f11ffb7Safresh1
20369f11ffb7Safresh1    # aEb * cEd = (a*c)E(b+d)
2037b46d8ef2Safresh1    $x->{_m} = $LIB->_mul($x->{_m}, $y->{_m});
2038e0680481Safresh1    ($x->{_e}, $x->{_es})
2039e0680481Safresh1      = $LIB -> _sadd($x->{_e}, $x->{_es}, $y->{_e}, $y->{_es});
20409f11ffb7Safresh1
20419f11ffb7Safresh1    $r[3] = $y;                 # no push!
20429f11ffb7Safresh1
20439f11ffb7Safresh1    # adjust sign:
20449f11ffb7Safresh1    $x->{sign} = $x->{sign} ne $y->{sign} ? '-' : '+';
20459f11ffb7Safresh1
20469f11ffb7Safresh1    # z=inf handling (z=NaN handled above)
2047eac174f2Safresh1    if ($z->{sign} =~ /^[+-]inf$/) {
2048eac174f2Safresh1        $x->{sign} = $z->{sign};
2049e0680481Safresh1        return $downgrade -> new($x -> bdstr(), @r) if defined $downgrade;
2050e0680481Safresh1        return $x -> round(@r);
2051eac174f2Safresh1    }
20529f11ffb7Safresh1
20539f11ffb7Safresh1    # take lower of the two e's and adapt m1 to it to match m2
20549f11ffb7Safresh1    my $e = $z->{_e};
2055b46d8ef2Safresh1    $e = $LIB->_zero() if !defined $e; # if no BFLOAT?
2056b46d8ef2Safresh1    $e = $LIB->_copy($e);              # make copy (didn't do it yet)
20579f11ffb7Safresh1
20589f11ffb7Safresh1    my $es;
20599f11ffb7Safresh1
2060e0680481Safresh1    ($e, $es) = $LIB -> _ssub($e, $z->{_es} || '+', $x->{_e}, $x->{_es});
20619f11ffb7Safresh1
2062b46d8ef2Safresh1    my $add = $LIB->_copy($z->{_m});
20639f11ffb7Safresh1
20649f11ffb7Safresh1    if ($es eq '-')             # < 0
2065b8851fccSafresh1    {
2066b46d8ef2Safresh1        $x->{_m} = $LIB->_lsft($x->{_m}, $e, 10);
2067e0680481Safresh1        ($x->{_e}, $x->{_es}) = $LIB -> _sadd($x->{_e}, $x->{_es}, $e, $es);
2068b46d8ef2Safresh1    } elsif (!$LIB->_is_zero($e)) # > 0
20699f11ffb7Safresh1    {
2070b46d8ef2Safresh1        $add = $LIB->_lsft($add, $e, 10);
20719f11ffb7Safresh1    }
20729f11ffb7Safresh1    # else: both e are the same, so just leave them
20739f11ffb7Safresh1
20749f11ffb7Safresh1    if ($x->{sign} eq $z->{sign}) {
20759f11ffb7Safresh1        # add
2076b46d8ef2Safresh1        $x->{_m} = $LIB->_add($x->{_m}, $add);
20779f11ffb7Safresh1    } else {
20789f11ffb7Safresh1        ($x->{_m}, $x->{sign}) =
2079e0680481Safresh1          $LIB -> _sadd($x->{_m}, $x->{sign}, $add, $z->{sign});
20809f11ffb7Safresh1    }
20819f11ffb7Safresh1
20829f11ffb7Safresh1    # delete trailing zeros, then round
2083e0680481Safresh1    $x = $x->bnorm()->round(@r);
2084e0680481Safresh1
2085e0680481Safresh1    return $downgrade -> new($x -> bdstr(), @r)
2086e0680481Safresh1      if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan());
2087e0680481Safresh1    return $x;
20889f11ffb7Safresh1}
20899f11ffb7Safresh1
20909f11ffb7Safresh1sub bdiv {
20919f11ffb7Safresh1    # (dividend: BFLOAT or num_str, divisor: BFLOAT or num_str) return
20929f11ffb7Safresh1    # (BFLOAT, BFLOAT) (quo, rem) or BFLOAT (only quo)
20939f11ffb7Safresh1
20949f11ffb7Safresh1    # set up parameters
2095e0680481Safresh1    my ($class, $x, $y, @r) = (ref($_[0]), @_);
20969f11ffb7Safresh1    # objectify is costly, so avoid it
20979f11ffb7Safresh1    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
2098e0680481Safresh1        ($class, $x, $y, @r) = objectify(2, @_);
20999f11ffb7Safresh1    }
21009f11ffb7Safresh1
21019f11ffb7Safresh1    return $x if $x->modify('bdiv');
21029f11ffb7Safresh1
21039f11ffb7Safresh1    my $wantarray = wantarray;  # call only once
21049f11ffb7Safresh1
21059f11ffb7Safresh1    # At least one argument is NaN. This is handled the same way as in
21069f11ffb7Safresh1    # Math::BigInt -> bdiv().
21079f11ffb7Safresh1
21089f11ffb7Safresh1    if ($x -> is_nan() || $y -> is_nan()) {
2109e0680481Safresh1        return $wantarray ? ($x -> bnan(@r), $class -> bnan(@r))
2110e0680481Safresh1                          : $x -> bnan(@r);
21119f11ffb7Safresh1    }
21129f11ffb7Safresh1
21139f11ffb7Safresh1    # Divide by zero and modulo zero. This is handled the same way as in
21149f11ffb7Safresh1    # Math::BigInt -> bdiv(). See the comment in the code for Math::BigInt ->
21159f11ffb7Safresh1    # bdiv() for further details.
21169f11ffb7Safresh1
21179f11ffb7Safresh1    if ($y -> is_zero()) {
21189f11ffb7Safresh1        my ($quo, $rem);
21199f11ffb7Safresh1        if ($wantarray) {
2120e0680481Safresh1            $rem = $x -> copy() -> round(@r);
2121e0680481Safresh1            $rem = $downgrade -> new($rem, @r)
2122e0680481Safresh1              if defined($downgrade) && $rem -> is_int();
21239f11ffb7Safresh1        }
21249f11ffb7Safresh1        if ($x -> is_zero()) {
2125e0680481Safresh1            $quo = $x -> bnan(@r);
21269f11ffb7Safresh1        } else {
2127e0680481Safresh1            $quo = $x -> binf($x -> {sign}, @r);
21289f11ffb7Safresh1        }
21299f11ffb7Safresh1        return $wantarray ? ($quo, $rem) : $quo;
21309f11ffb7Safresh1    }
21319f11ffb7Safresh1
21329f11ffb7Safresh1    # Numerator (dividend) is +/-inf. This is handled the same way as in
21339f11ffb7Safresh1    # Math::BigInt -> bdiv(). See the comment in the code for Math::BigInt ->
21349f11ffb7Safresh1    # bdiv() for further details.
21359f11ffb7Safresh1
21369f11ffb7Safresh1    if ($x -> is_inf()) {
21379f11ffb7Safresh1        my ($quo, $rem);
2138e0680481Safresh1        $rem = $class -> bnan(@r) if $wantarray;
21399f11ffb7Safresh1        if ($y -> is_inf()) {
2140e0680481Safresh1            $quo = $x -> bnan(@r);
21419f11ffb7Safresh1        } else {
21429f11ffb7Safresh1            my $sign = $x -> bcmp(0) == $y -> bcmp(0) ? '+' : '-';
2143e0680481Safresh1            $quo = $x -> binf($sign, @r);
21449f11ffb7Safresh1        }
21459f11ffb7Safresh1        return $wantarray ? ($quo, $rem) : $quo;
21469f11ffb7Safresh1    }
21479f11ffb7Safresh1
21489f11ffb7Safresh1    # Denominator (divisor) is +/-inf. This is handled the same way as in
21499f11ffb7Safresh1    # Math::BigInt -> bdiv(), with one exception: In scalar context,
21509f11ffb7Safresh1    # Math::BigFloat does true division (although rounded), not floored division
21519f11ffb7Safresh1    # (F-division), so a finite number divided by +/-inf is always zero. See the
21529f11ffb7Safresh1    # comment in the code for Math::BigInt -> bdiv() for further details.
21539f11ffb7Safresh1
21549f11ffb7Safresh1    if ($y -> is_inf()) {
21559f11ffb7Safresh1        my ($quo, $rem);
21569f11ffb7Safresh1        if ($wantarray) {
21579f11ffb7Safresh1            if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) {
2158e0680481Safresh1                $rem = $x -> copy() -> round(@r);
2159e0680481Safresh1                $rem = $downgrade -> new($rem, @r)
2160e0680481Safresh1                  if defined($downgrade) && $rem -> is_int();
2161e0680481Safresh1                $quo = $x -> bzero(@r);
21629f11ffb7Safresh1            } else {
2163e0680481Safresh1                $rem = $class -> binf($y -> {sign}, @r);
2164e0680481Safresh1                $quo = $x -> bone('-', @r);
21659f11ffb7Safresh1            }
21669f11ffb7Safresh1            return ($quo, $rem);
21679f11ffb7Safresh1        } else {
21689f11ffb7Safresh1            if ($y -> is_inf()) {
21699f11ffb7Safresh1                if ($x -> is_nan() || $x -> is_inf()) {
2170e0680481Safresh1                    return $x -> bnan(@r);
21719f11ffb7Safresh1                } else {
2172e0680481Safresh1                    return $x -> bzero(@r);
21739f11ffb7Safresh1                }
21749f11ffb7Safresh1            }
21759f11ffb7Safresh1        }
21769f11ffb7Safresh1    }
21779f11ffb7Safresh1
21789f11ffb7Safresh1    # At this point, both the numerator and denominator are finite numbers, and
21799f11ffb7Safresh1    # the denominator (divisor) is non-zero.
21809f11ffb7Safresh1
21819f11ffb7Safresh1    # x == 0?
2182e0680481Safresh1    if ($x->is_zero()) {
2183e0680481Safresh1        my ($quo, $rem);
2184e0680481Safresh1        $quo = $x->round(@r);
2185e0680481Safresh1        $quo = $downgrade -> new($quo, @r)
2186e0680481Safresh1          if defined($downgrade) && $quo -> is_int();
2187e0680481Safresh1        if ($wantarray) {
2188e0680481Safresh1            $rem = $class -> bzero(@r);
2189e0680481Safresh1            return $quo, $rem;
2190e0680481Safresh1        }
2191e0680481Safresh1        return $quo;
2192e0680481Safresh1    }
2193e0680481Safresh1
2194e0680481Safresh1    # Division might return a value that we can not represent exactly, so
2195e0680481Safresh1    # upgrade, if upgrading is enabled.
2196e0680481Safresh1
2197e0680481Safresh1    return $upgrade -> bdiv($x, $y, @r)
2198e0680481Safresh1      if defined($upgrade) && !wantarray && !$LIB -> _is_one($y -> {_m});
21999f11ffb7Safresh1
22009f11ffb7Safresh1    # we need to limit the accuracy to protect against overflow
22019f11ffb7Safresh1    my $fallback = 0;
22029f11ffb7Safresh1    my (@params, $scale);
2203e0680481Safresh1    ($x, @params) = $x->_find_round_parameters($r[0], $r[1], $r[2], $y);
22049f11ffb7Safresh1
2205e0680481Safresh1    return $x -> round(@r) if $x->is_nan();  # error in _find_round_parameters?
22069f11ffb7Safresh1
22079f11ffb7Safresh1    # no rounding at all, so must use fallback
22089f11ffb7Safresh1    if (scalar @params == 0) {
22099f11ffb7Safresh1        # simulate old behaviour
22109f11ffb7Safresh1        $params[0] = $class->div_scale(); # and round to it as accuracy
22119f11ffb7Safresh1        $scale = $params[0]+4;            # at least four more for proper round
2212e0680481Safresh1        $params[2] = $r[2];               # round mode by caller or undef
22139f11ffb7Safresh1        $fallback = 1;                    # to clear a/p afterwards
22149f11ffb7Safresh1    } else {
22159f11ffb7Safresh1        # the 4 below is empirical, and there might be cases where it is not
22169f11ffb7Safresh1        # enough...
22179f11ffb7Safresh1        $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
22189f11ffb7Safresh1    }
22199f11ffb7Safresh1
22209f11ffb7Safresh1    my $rem;
22219f11ffb7Safresh1    $rem = $class -> bzero() if wantarray;
22229f11ffb7Safresh1
22239f11ffb7Safresh1    $y = $class->new($y) unless $y->isa('Math::BigFloat');
22249f11ffb7Safresh1
2225e0680481Safresh1    my $lx = $LIB -> _len($x->{_m});
2226e0680481Safresh1    my $ly = $LIB -> _len($y->{_m});
22279f11ffb7Safresh1    $scale = $lx if $lx > $scale;
22289f11ffb7Safresh1    $scale = $ly if $ly > $scale;
22299f11ffb7Safresh1    my $diff = $ly - $lx;
22309f11ffb7Safresh1    $scale += $diff if $diff > 0; # if lx << ly, but not if ly << lx!
22319f11ffb7Safresh1
22329f11ffb7Safresh1    # check that $y is not 1 nor -1 and cache the result:
2233b46d8ef2Safresh1    my $y_not_one = !($LIB->_is_zero($y->{_e}) && $LIB->_is_one($y->{_m}));
22349f11ffb7Safresh1
22359f11ffb7Safresh1    # flipping the sign of $y will also flip the sign of $x for the special
22369f11ffb7Safresh1    # case of $x->bsub($x); so we can catch it below:
22379f11ffb7Safresh1    my $xsign = $x->{sign};
22389f11ffb7Safresh1    $y->{sign} =~ tr/+-/-+/;
22399f11ffb7Safresh1
22409f11ffb7Safresh1    if ($xsign ne $x->{sign}) {
22419f11ffb7Safresh1        # special case of $x /= $x results in 1
2242e0680481Safresh1        $x = $x->bone();        # "fixes" also sign of $y, since $x is $y
22439f11ffb7Safresh1    } else {
22449f11ffb7Safresh1        # correct $y's sign again
22459f11ffb7Safresh1        $y->{sign} =~ tr/+-/-+/;
22469f11ffb7Safresh1        # continue with normal div code:
22479f11ffb7Safresh1
2248e0680481Safresh1        # make copy of $x in case of list context for later remainder
2249e0680481Safresh1        # calculation
22509f11ffb7Safresh1        if (wantarray && $y_not_one) {
22519f11ffb7Safresh1            $rem = $x->copy();
22529f11ffb7Safresh1        }
22539f11ffb7Safresh1
22549f11ffb7Safresh1        $x->{sign} = $x->{sign} ne $y->sign() ? '-' : '+';
22559f11ffb7Safresh1
22569f11ffb7Safresh1        # check for / +-1 (+/- 1E0)
22579f11ffb7Safresh1        if ($y_not_one) {
2258e0680481Safresh1            # promote Math::BigInt and its subclasses (except when already a
2259e0680481Safresh1            # Math::BigFloat)
22609f11ffb7Safresh1            $y = $class->new($y) unless $y->isa('Math::BigFloat');
22619f11ffb7Safresh1
22629f11ffb7Safresh1            # calculate the result to $scale digits and then round it
22639f11ffb7Safresh1            # a * 10 ** b / c * 10 ** d => a/c * 10 ** (b-d)
2264b46d8ef2Safresh1            $x->{_m} = $LIB->_lsft($x->{_m}, $LIB->_new($scale), 10);
2265b46d8ef2Safresh1            $x->{_m} = $LIB->_div($x->{_m}, $y->{_m}); # a/c
22669f11ffb7Safresh1
22679f11ffb7Safresh1            # correct exponent of $x
2268e0680481Safresh1            ($x->{_e}, $x->{_es})
2269e0680481Safresh1              = $LIB -> _ssub($x->{_e}, $x->{_es}, $y->{_e}, $y->{_es});
22709f11ffb7Safresh1            # correct for 10**scale
2271e0680481Safresh1            ($x->{_e}, $x->{_es})
2272e0680481Safresh1              = $LIB -> _ssub($x->{_e}, $x->{_es}, $LIB->_new($scale), '+');
2273e0680481Safresh1            $x = $x->bnorm();   # remove trailing 0's
22749f11ffb7Safresh1        }
22759f11ffb7Safresh1    }                           # end else $x != $y
22769f11ffb7Safresh1
22779f11ffb7Safresh1    # shortcut to not run through _find_round_parameters again
22789f11ffb7Safresh1    if (defined $params[0]) {
2279*3d61058aSafresh1        $x->{accuracy} = undef;               # clear before round
2280e0680481Safresh1        $x = $x->bround($params[0], $params[2]); # then round accordingly
22819f11ffb7Safresh1    } else {
2282*3d61058aSafresh1        $x->{precision} = undef;               # clear before round
2283e0680481Safresh1        $x = $x->bfround($params[1], $params[2]); # then round accordingly
22849f11ffb7Safresh1    }
22859f11ffb7Safresh1    if ($fallback) {
22869f11ffb7Safresh1        # clear a/p after round, since user did not request it
2287*3d61058aSafresh1        $x->{accuracy} = undef;
2288*3d61058aSafresh1        $x->{precision} = undef;
22899f11ffb7Safresh1    }
22909f11ffb7Safresh1
22919f11ffb7Safresh1    if (wantarray) {
22929f11ffb7Safresh1        if ($y_not_one) {
2293e0680481Safresh1            $x = $x -> bfloor();
2294e0680481Safresh1            $rem = $rem->bmod($y, @params); # copy already done
22959f11ffb7Safresh1        }
22969f11ffb7Safresh1        if ($fallback) {
22979f11ffb7Safresh1            # clear a/p after round, since user did not request it
2298*3d61058aSafresh1            $rem->{accuracy} = undef;
2299*3d61058aSafresh1            $rem->{precision} = undef;
23009f11ffb7Safresh1        }
2301e0680481Safresh1        $x = $downgrade -> new($x -> bdstr(), @r)
2302eac174f2Safresh1          if defined($downgrade) && $x -> is_int();
2303e0680481Safresh1        $rem = $downgrade -> new($rem -> bdstr(), @r)
2304eac174f2Safresh1          if defined($downgrade) && $rem -> is_int();
23059f11ffb7Safresh1        return ($x, $rem);
23069f11ffb7Safresh1    }
2307eac174f2Safresh1
2308e0680481Safresh1    $x = $downgrade -> new($x, @r)
2309e0680481Safresh1      if defined($downgrade) && $x -> is_int();
2310e0680481Safresh1    $x;         # rounding already done above
23119f11ffb7Safresh1}
23129f11ffb7Safresh1
23139f11ffb7Safresh1sub bmod {
23149f11ffb7Safresh1    # (dividend: BFLOAT or num_str, divisor: BFLOAT or num_str) return remainder
23159f11ffb7Safresh1
23169f11ffb7Safresh1    # set up parameters
2317e0680481Safresh1    my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
2318e0680481Safresh1                            ? (ref($_[0]), @_)
2319e0680481Safresh1                            : objectify(2, @_);
23209f11ffb7Safresh1
23219f11ffb7Safresh1    return $x if $x->modify('bmod');
23229f11ffb7Safresh1
23239f11ffb7Safresh1    # At least one argument is NaN. This is handled the same way as in
23249f11ffb7Safresh1    # Math::BigInt -> bmod().
23259f11ffb7Safresh1
2326e0680481Safresh1    return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan();
23279f11ffb7Safresh1
23289f11ffb7Safresh1    # Modulo zero. This is handled the same way as in Math::BigInt -> bmod().
23299f11ffb7Safresh1
23309f11ffb7Safresh1    if ($y -> is_zero()) {
2331e0680481Safresh1        return $x -> round(@r);
23329f11ffb7Safresh1    }
23339f11ffb7Safresh1
23349f11ffb7Safresh1    # Numerator (dividend) is +/-inf. This is handled the same way as in
23359f11ffb7Safresh1    # Math::BigInt -> bmod().
23369f11ffb7Safresh1
23379f11ffb7Safresh1    if ($x -> is_inf()) {
2338e0680481Safresh1        return $x -> bnan(@r);
23399f11ffb7Safresh1    }
23409f11ffb7Safresh1
23419f11ffb7Safresh1    # Denominator (divisor) is +/-inf. This is handled the same way as in
23429f11ffb7Safresh1    # Math::BigInt -> bmod().
23439f11ffb7Safresh1
23449f11ffb7Safresh1    if ($y -> is_inf()) {
23459f11ffb7Safresh1        if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) {
2346e0680481Safresh1            return $x -> round(@r);
23479f11ffb7Safresh1        } else {
2348e0680481Safresh1            return $x -> binf($y -> sign(), @r);
23499f11ffb7Safresh1        }
23509f11ffb7Safresh1    }
23519f11ffb7Safresh1
2352e0680481Safresh1    return $x->bzero(@r) if $x->is_zero()
23539f11ffb7Safresh1      || ($x->is_int() &&
23549f11ffb7Safresh1          # check that $y == +1 or $y == -1:
2355b46d8ef2Safresh1          ($LIB->_is_zero($y->{_e}) && $LIB->_is_one($y->{_m})));
23569f11ffb7Safresh1
23579f11ffb7Safresh1    my $cmp = $x->bacmp($y);    # equal or $x < $y?
23589f11ffb7Safresh1    if ($cmp == 0) {            # $x == $y => result 0
2359e0680481Safresh1        return $x -> bzero(@r);
23609f11ffb7Safresh1    }
23619f11ffb7Safresh1
23629f11ffb7Safresh1    # only $y of the operands negative?
23639f11ffb7Safresh1    my $neg = $x->{sign} ne $y->{sign} ? 1 : 0;
23649f11ffb7Safresh1
23659f11ffb7Safresh1    $x->{sign} = $y->{sign};     # calc sign first
23669f11ffb7Safresh1    if ($cmp < 0 && $neg == 0) { # $x < $y => result $x
2367e0680481Safresh1        return $x -> round(@r);
23689f11ffb7Safresh1    }
23699f11ffb7Safresh1
2370b46d8ef2Safresh1    my $ym = $LIB->_copy($y->{_m});
23719f11ffb7Safresh1
23729f11ffb7Safresh1    # 2e1 => 20
2373b46d8ef2Safresh1    $ym = $LIB->_lsft($ym, $y->{_e}, 10)
2374b46d8ef2Safresh1      if $y->{_es} eq '+' && !$LIB->_is_zero($y->{_e});
23759f11ffb7Safresh1
23769f11ffb7Safresh1    # if $y has digits after dot
23779f11ffb7Safresh1    my $shifty = 0;             # correct _e of $x by this
23789f11ffb7Safresh1    if ($y->{_es} eq '-')       # has digits after dot
23799f11ffb7Safresh1    {
23809f11ffb7Safresh1        # 123 % 2.5 => 1230 % 25 => 5 => 0.5
2381b46d8ef2Safresh1        $shifty = $LIB->_num($y->{_e});  # no more digits after dot
2382e0680481Safresh1        # 123 => 1230, $y->{_m} is already 25
2383e0680481Safresh1        $x->{_m} = $LIB->_lsft($x->{_m}, $y->{_e}, 10);
23849f11ffb7Safresh1    }
23859f11ffb7Safresh1    # $ym is now mantissa of $y based on exponent 0
23869f11ffb7Safresh1
23879f11ffb7Safresh1    my $shiftx = 0;             # correct _e of $x by this
23889f11ffb7Safresh1    if ($x->{_es} eq '-')       # has digits after dot
23899f11ffb7Safresh1    {
23909f11ffb7Safresh1        # 123.4 % 20 => 1234 % 200
2391b46d8ef2Safresh1        $shiftx = $LIB->_num($x->{_e}); # no more digits after dot
2392b46d8ef2Safresh1        $ym = $LIB->_lsft($ym, $x->{_e}, 10); # 123 => 1230
23939f11ffb7Safresh1    }
23949f11ffb7Safresh1    # 123e1 % 20 => 1230 % 20
2395b46d8ef2Safresh1    if ($x->{_es} eq '+' && !$LIB->_is_zero($x->{_e})) {
2396b46d8ef2Safresh1        $x->{_m} = $LIB->_lsft($x->{_m}, $x->{_e}, 10); # es => '+' here
23979f11ffb7Safresh1    }
23989f11ffb7Safresh1
2399b46d8ef2Safresh1    $x->{_e} = $LIB->_new($shiftx);
2400b8851fccSafresh1    $x->{_es} = '+';
24019f11ffb7Safresh1    $x->{_es} = '-' if $shiftx != 0 || $shifty != 0;
2402b46d8ef2Safresh1    $x->{_e} = $LIB->_add($x->{_e}, $LIB->_new($shifty)) if $shifty != 0;
24039f11ffb7Safresh1
24049f11ffb7Safresh1    # now mantissas are equalized, exponent of $x is adjusted, so calc result
24059f11ffb7Safresh1
2406b46d8ef2Safresh1    $x->{_m} = $LIB->_mod($x->{_m}, $ym);
24079f11ffb7Safresh1
2408b46d8ef2Safresh1    $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # fix sign for -0
2409e0680481Safresh1    $x = $x->bnorm();
24109f11ffb7Safresh1
2411e0680481Safresh1    # if one of them negative => correct in place
2412e0680481Safresh1    if ($neg != 0 && ! $x -> is_zero()) {
24139f11ffb7Safresh1        my $r = $y - $x;
24149f11ffb7Safresh1        $x->{_m} = $r->{_m};
24159f11ffb7Safresh1        $x->{_e} = $r->{_e};
24169f11ffb7Safresh1        $x->{_es} = $r->{_es};
2417b46d8ef2Safresh1        $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # fix sign for -0
2418e0680481Safresh1        $x = $x->bnorm();
2419b8851fccSafresh1    }
2420b8851fccSafresh1
2421e0680481Safresh1    $x = $x->round($r[0], $r[1], $r[2], $y);
2422e0680481Safresh1    return $downgrade -> new($x -> bdstr(), @r)
2423e0680481Safresh1      if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan());
2424e0680481Safresh1    return $x;
2425b8851fccSafresh1}
2426b8851fccSafresh1
24279f11ffb7Safresh1sub bmodpow {
24289f11ffb7Safresh1    # takes a very large number to a very large exponent in a given very
24299f11ffb7Safresh1    # large modulus, quickly, thanks to binary exponentiation. Supports
24309f11ffb7Safresh1    # negative exponents.
2431e0680481Safresh1    my ($class, $num, $exp, $mod, @r)
2432e0680481Safresh1      = ref($_[0]) && ref($_[0]) eq ref($_[1]) && ref($_[1]) eq ref($_[2])
2433e0680481Safresh1      ? (ref($_[0]), @_)
2434e0680481Safresh1      : objectify(3, @_);
24359f11ffb7Safresh1
24369f11ffb7Safresh1    return $num if $num->modify('bmodpow');
24379f11ffb7Safresh1
2438e0680481Safresh1    return $num -> bnan(@r)
2439e0680481Safresh1      if $mod->is_nan() || $exp->is_nan() || $mod->is_nan();
2440e0680481Safresh1
24419f11ffb7Safresh1    # check modulus for valid values
2442e0680481Safresh1    return $num->bnan(@r) if $mod->{sign} ne '+' || $mod->is_zero();
24439f11ffb7Safresh1
24449f11ffb7Safresh1    # check exponent for valid values
24459f11ffb7Safresh1    if ($exp->{sign} =~ /\w/) {
24469f11ffb7Safresh1        # i.e., if it's NaN, +inf, or -inf...
2447e0680481Safresh1        return $num->bnan(@r);
2448b8851fccSafresh1    }
2449b8851fccSafresh1
2450e0680481Safresh1    $num = $num->bmodinv($mod, @r) if $exp->{sign} eq '-';
2451b8851fccSafresh1
24529f11ffb7Safresh1    # check num for valid values (also NaN if there was no inverse but $exp < 0)
2453e0680481Safresh1    return $num->bnan(@r) if $num->{sign} !~ /^[+-]$/;
2454b8851fccSafresh1
24559f11ffb7Safresh1    # $mod is positive, sign on $exp is ignored, result also positive
24569f11ffb7Safresh1
24579f11ffb7Safresh1    # XXX TODO: speed it up when all three numbers are integers
2458e0680481Safresh1    $num = $num->bpow($exp)->bmod($mod);
2459e0680481Safresh1
2460e0680481Safresh1    return $downgrade -> new($num -> bdstr(), @r) if defined($downgrade)
2461e0680481Safresh1      && ($num->is_int() || $num->is_inf() || $num->is_nan());
2462e0680481Safresh1    return $num -> round(@r);
24639f11ffb7Safresh1}
24649f11ffb7Safresh1
24659f11ffb7Safresh1sub bpow {
24669f11ffb7Safresh1    # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT
24679f11ffb7Safresh1    # compute power of two numbers, second arg is used as integer
24689f11ffb7Safresh1    # modifies first argument
24699f11ffb7Safresh1
24709f11ffb7Safresh1    # set up parameters
24719f11ffb7Safresh1    my ($class, $x, $y, $a, $p, $r) = (ref($_[0]), @_);
24729f11ffb7Safresh1    # objectify is costly, so avoid it
24739f11ffb7Safresh1    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
24749f11ffb7Safresh1        ($class, $x, $y, $a, $p, $r) = objectify(2, @_);
24759f11ffb7Safresh1    }
24769f11ffb7Safresh1
24779f11ffb7Safresh1    return $x if $x -> modify('bpow');
24789f11ffb7Safresh1
2479b46d8ef2Safresh1    # $x and/or $y is a NaN
2480b46d8ef2Safresh1    return $x -> bnan() if $x -> is_nan() || $y -> is_nan();
2481b46d8ef2Safresh1
2482b46d8ef2Safresh1    # $x and/or $y is a +/-Inf
2483b46d8ef2Safresh1    if ($x -> is_inf("-")) {
2484b46d8ef2Safresh1        return $x -> bzero()   if $y -> is_negative();
2485b46d8ef2Safresh1        return $x -> bnan()    if $y -> is_zero();
2486b46d8ef2Safresh1        return $x            if $y -> is_odd();
2487b46d8ef2Safresh1        return $x -> bneg();
2488b46d8ef2Safresh1    } elsif ($x -> is_inf("+")) {
2489b46d8ef2Safresh1        return $x -> bzero()   if $y -> is_negative();
2490b46d8ef2Safresh1        return $x -> bnan()    if $y -> is_zero();
2491b46d8ef2Safresh1        return $x;
2492b46d8ef2Safresh1    } elsif ($y -> is_inf("-")) {
2493b46d8ef2Safresh1        return $x -> bnan()    if $x -> is_one("-");
2494b46d8ef2Safresh1        return $x -> binf("+") if $x > -1 && $x < 1;
2495b46d8ef2Safresh1        return $x -> bone()    if $x -> is_one("+");
2496b46d8ef2Safresh1        return $x -> bzero();
2497b46d8ef2Safresh1    } elsif ($y -> is_inf("+")) {
2498b46d8ef2Safresh1        return $x -> bnan()    if $x -> is_one("-");
2499b46d8ef2Safresh1        return $x -> bzero()   if $x > -1 && $x < 1;
2500b46d8ef2Safresh1        return $x -> bone()    if $x -> is_one("+");
2501b46d8ef2Safresh1        return $x -> binf("+");
2502b46d8ef2Safresh1    }
2503b46d8ef2Safresh1
2504eac174f2Safresh1    if ($x -> is_zero()) {
2505eac174f2Safresh1        return $x -> bone() if $y -> is_zero();
2506eac174f2Safresh1        return $x -> binf() if $y -> is_negative();
2507eac174f2Safresh1        return $x;
2508eac174f2Safresh1    }
25099f11ffb7Safresh1
2510eac174f2Safresh1    # We don't support complex numbers, so upgrade or return NaN.
25119f11ffb7Safresh1
2512eac174f2Safresh1    if ($x -> is_negative() && !$y -> is_int()) {
2513e0680481Safresh1        return $upgrade -> bpow($x, $y, $a, $p, $r) if defined $upgrade;
2514eac174f2Safresh1        return $x -> bnan();
2515eac174f2Safresh1    }
25169f11ffb7Safresh1
2517eac174f2Safresh1    if ($x -> is_one("+") || $y -> is_one()) {
2518eac174f2Safresh1        return $x;
2519eac174f2Safresh1    }
25209f11ffb7Safresh1
2521b46d8ef2Safresh1    if ($x -> is_one("-")) {
2522eac174f2Safresh1        return $x if $y -> is_odd();
2523eac174f2Safresh1        return $x -> bneg();
25249f11ffb7Safresh1    }
2525eac174f2Safresh1
2526eac174f2Safresh1    return $x -> _pow($y, $a, $p, $r) if !$y -> is_int();
2527eac174f2Safresh1
2528eac174f2Safresh1    my $y1 = $y -> as_int()->{value}; # make MBI part
25299f11ffb7Safresh1
25309f11ffb7Safresh1    my $new_sign = '+';
2531b46d8ef2Safresh1    $new_sign = $LIB -> _is_odd($y1) ? '-' : '+' if $x->{sign} ne '+';
25329f11ffb7Safresh1
25339f11ffb7Safresh1    # calculate $x->{_m} ** $y and $x->{_e} * $y separately (faster)
2534b46d8ef2Safresh1    $x->{_m} = $LIB -> _pow($x->{_m}, $y1);
2535b46d8ef2Safresh1    $x->{_e} = $LIB -> _mul($x->{_e}, $y1);
25369f11ffb7Safresh1
25379f11ffb7Safresh1    $x->{sign} = $new_sign;
2538e0680481Safresh1    $x = $x -> bnorm();
2539eac174f2Safresh1
2540eac174f2Safresh1    # x ** (-y) = 1 / (x ** y)
2541eac174f2Safresh1
25429f11ffb7Safresh1    if ($y->{sign} eq '-') {
25439f11ffb7Safresh1        # modify $x in place!
2544eac174f2Safresh1        my $z = $x -> copy();
2545e0680481Safresh1        $x = $x -> bone();
2546eac174f2Safresh1        # round in one go (might ignore y's A!)
2547eac174f2Safresh1        return scalar $x -> bdiv($z, $a, $p, $r);
25489f11ffb7Safresh1    }
2549eac174f2Safresh1
2550e0680481Safresh1    $x = $x -> round($a, $p, $r, $y);
2551e0680481Safresh1
2552e0680481Safresh1    return $downgrade -> new($x)
2553e0680481Safresh1      if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan());
2554e0680481Safresh1    return $x;
25559f11ffb7Safresh1}
25569f11ffb7Safresh1
2557*3d61058aSafresh1sub binv {
2558*3d61058aSafresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
2559*3d61058aSafresh1
2560*3d61058aSafresh1    return $x if $x->modify('binv');
2561*3d61058aSafresh1
2562*3d61058aSafresh1    my $inv = $class -> bdiv($class -> bone(), $x, @r);
2563*3d61058aSafresh1
2564*3d61058aSafresh1    return $downgrade -> new($inv, @r) if defined($downgrade)
2565*3d61058aSafresh1      && ($inv -> is_int() || $inv -> is_inf() || $inv -> is_nan());
2566*3d61058aSafresh1
2567*3d61058aSafresh1    for my $key (qw/ sign _m _es _e /) {
2568*3d61058aSafresh1        $x -> {$key} = $inv -> {$key};
2569*3d61058aSafresh1    }
2570*3d61058aSafresh1
2571*3d61058aSafresh1    $x;
2572*3d61058aSafresh1}
2573*3d61058aSafresh1
25749f11ffb7Safresh1sub blog {
25759f11ffb7Safresh1    # Return the logarithm of the operand. If a second operand is defined, that
25769f11ffb7Safresh1    # value is used as the base, otherwise the base is assumed to be Euler's
25779f11ffb7Safresh1    # constant.
25789f11ffb7Safresh1
2579e0680481Safresh1    my ($class, $x, $base, @r);
25809f11ffb7Safresh1
2581e0680481Safresh1    # Only objectify the base if it is defined, since an undefined base, as in
2582*3d61058aSafresh1    # $x->blog() or $x->blog(undef) signals that the base is Euler's number =
2583*3d61058aSafresh1    # 2.718281828...
25849f11ffb7Safresh1
25859f11ffb7Safresh1    if (!ref($_[0]) && $_[0] =~ /^[A-Za-z]|::/) {
25869f11ffb7Safresh1        # E.g., Math::BigFloat->blog(256, 2)
2587e0680481Safresh1        ($class, $x, $base, @r) =
25889f11ffb7Safresh1          defined $_[2] ? objectify(2, @_) : objectify(1, @_);
25899f11ffb7Safresh1    } else {
2590*3d61058aSafresh1        # E.g., $x->blog(2) or the deprecated Math::BigFloat::blog(256, 2)
2591e0680481Safresh1        ($class, $x, $base, @r) =
25929f11ffb7Safresh1          defined $_[1] ? objectify(2, @_) : objectify(1, @_);
25939f11ffb7Safresh1    }
2594b8851fccSafresh1
2595b8851fccSafresh1    return $x if $x->modify('blog');
2596b8851fccSafresh1
2597*3d61058aSafresh1    # Handle all exception cases and all trivial cases. I have used Wolfram
2598*3d61058aSafresh1    # Alpha (http://www.wolframalpha.com) as the reference for these cases.
2599*3d61058aSafresh1
2600e0680481Safresh1    return $x -> bnan(@r) if $x -> is_nan();
2601e0680481Safresh1
2602*3d61058aSafresh1    if (defined $base) {
2603*3d61058aSafresh1        $base = $class -> new($base)
2604*3d61058aSafresh1          unless defined(blessed($base)) && $base -> isa(__PACKAGE__);
2605*3d61058aSafresh1        if ($base -> is_nan() || $base -> is_one()) {
2606*3d61058aSafresh1            return $x -> bnan(@r);
2607*3d61058aSafresh1        } elsif ($base -> is_inf() || $base -> is_zero()) {
2608*3d61058aSafresh1            return $x -> bnan(@r) if $x -> is_inf() || $x -> is_zero();
2609*3d61058aSafresh1            return $x -> bzero(@r);
2610*3d61058aSafresh1        } elsif ($base -> is_negative()) {              # -inf < base < 0
2611*3d61058aSafresh1            return $x -> bzero(@r) if $x -> is_one();   #     x = 1
2612*3d61058aSafresh1            return $x -> bone('+', @r)  if $x == $base; #     x = base
2613*3d61058aSafresh1            # we can't handle these cases, so upgrade, if we can
2614*3d61058aSafresh1            return $upgrade -> blog($x, $base, @r) if defined $upgrade;
2615*3d61058aSafresh1            return $x -> bnan(@r);
2616*3d61058aSafresh1        }
2617*3d61058aSafresh1        return $x -> bone(@r) if $x == $base;       # 0 < base && 0 < x < inf
2618*3d61058aSafresh1    }
2619*3d61058aSafresh1
2620*3d61058aSafresh1    if ($x -> is_inf()) {                       # x = +/-inf
2621*3d61058aSafresh1        my $sign = defined($base) && $base < 1 ? '-' : '+';
2622*3d61058aSafresh1        return $x -> binf($sign, @r);
2623*3d61058aSafresh1    } elsif ($x -> is_neg()) {                  # -inf < x < 0
2624*3d61058aSafresh1        return $upgrade -> blog($x, $base, @r) if defined $upgrade;
2625*3d61058aSafresh1        return $x -> bnan(@r);
2626*3d61058aSafresh1    } elsif ($x -> is_one()) {                  # x = 1
2627*3d61058aSafresh1        return $x -> bzero(@r);
2628*3d61058aSafresh1    } elsif ($x -> is_zero()) {                 # x = 0
2629*3d61058aSafresh1        my $sign = defined($base) && $base < 1 ? '+' : '-';
2630*3d61058aSafresh1        return $x -> binf($sign, @r);
2631*3d61058aSafresh1    }
2632b8851fccSafresh1
2633b8851fccSafresh1    # we need to limit the accuracy to protect against overflow
2634b8851fccSafresh1    my $fallback = 0;
2635b8851fccSafresh1    my ($scale, @params);
2636e0680481Safresh1    ($x, @params) = $x->_find_round_parameters(@r);
2637b8851fccSafresh1
2638b8851fccSafresh1    # no rounding at all, so must use fallback
26399f11ffb7Safresh1    if (scalar @params == 0) {
2640b8851fccSafresh1        # simulate old behaviour
26419f11ffb7Safresh1        $params[0] = $class->div_scale(); # and round to it as accuracy
2642b8851fccSafresh1        $params[1] = undef;               # P = undef
2643b8851fccSafresh1        $scale = $params[0]+4;            # at least four more for proper round
2644e0680481Safresh1        $params[2] = $r[2];               # round mode by caller or undef
2645b8851fccSafresh1        $fallback = 1;                    # to clear a/p afterwards
26469f11ffb7Safresh1    } else {
2647b8851fccSafresh1        # the 4 below is empirical, and there might be cases where it is not
2648b8851fccSafresh1        # enough...
2649b8851fccSafresh1        $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
2650b8851fccSafresh1    }
2651b8851fccSafresh1
2652*3d61058aSafresh1    # When user set globals, they would interfere with our calculation, so
2653*3d61058aSafresh1    # disable them and later re-enable them.
2654*3d61058aSafresh1
2655*3d61058aSafresh1    my $ab = $class -> accuracy();
2656*3d61058aSafresh1    my $pb = $class -> precision();
2657*3d61058aSafresh1    $class -> accuracy(undef);
2658*3d61058aSafresh1    $class -> precision(undef);
2659*3d61058aSafresh1
2660*3d61058aSafresh1    # Disabling upgrading and downgrading is no longer necessary to avoid an
2661*3d61058aSafresh1    # infinite recursion, but it avoids unnecessary upgrading and downgrading in
2662*3d61058aSafresh1    # the intermediate computations.
2663*3d61058aSafresh1
2664*3d61058aSafresh1    my $upg = $class -> upgrade();
2665*3d61058aSafresh1    my $dng = $class -> downgrade();
2666*3d61058aSafresh1    $class -> upgrade(undef);
2667*3d61058aSafresh1    $class -> downgrade(undef);
2668*3d61058aSafresh1
2669*3d61058aSafresh1    # We also need to disable any set A or P on $x (_find_round_parameters took
2670*3d61058aSafresh1    # them already into account), since these would interfere, too.
2671*3d61058aSafresh1
2672*3d61058aSafresh1    $x->{accuracy} = undef;
2673*3d61058aSafresh1    $x->{precision} = undef;
2674*3d61058aSafresh1
2675b8851fccSafresh1    my $done = 0;
2676b8851fccSafresh1
2677*3d61058aSafresh1    # If both $x and $base are integers, try to calculate an integer result
2678*3d61058aSafresh1    # first. This is very fast, and if the exact result was found, we are done.
2679b46d8ef2Safresh1
2680e0680481Safresh1    if (defined($base) && $base -> is_int() && $x -> is_int()) {
2681e0680481Safresh1        my $x_lib = $LIB -> _new($x -> bdstr());
2682e0680481Safresh1        my $b_lib = $LIB -> _new($base -> bdstr());
2683e0680481Safresh1        ($x_lib, my $exact) = $LIB -> _log_int($x_lib, $b_lib);
2684e0680481Safresh1        if ($exact) {
2685e0680481Safresh1            $x->{_m} = $x_lib;
2686e0680481Safresh1            $x->{_e} = $LIB -> _zero();
2687e0680481Safresh1            $x = $x -> bnorm();
2688b8851fccSafresh1            $done = 1;
2689b8851fccSafresh1        }
2690b8851fccSafresh1    }
2691b8851fccSafresh1
2692*3d61058aSafresh1    # If the integer result was not accurate, compute the natural logarithm
2693*3d61058aSafresh1    # log($x) (using reduction by 10 and possibly also by 2), and if a
2694*3d61058aSafresh1    # different base was requested, convert the result with log($x)/log($base).
2695*3d61058aSafresh1
2696e0680481Safresh1    unless ($done) {
2697e0680481Safresh1        $x = $x -> _log_10($scale);
26989f11ffb7Safresh1        if (defined $base) {
2699b46d8ef2Safresh1            # log_b(x) = ln(x) / ln(b), so compute ln(b)
2700b46d8ef2Safresh1            my $base_log_e = $base -> copy() -> _log_10($scale);
2701e0680481Safresh1            $x = $x -> bdiv($base_log_e, $scale);
2702b8851fccSafresh1        }
2703b8851fccSafresh1    }
2704b8851fccSafresh1
2705b8851fccSafresh1    # shortcut to not run through _find_round_parameters again
2706*3d61058aSafresh1
27079f11ffb7Safresh1    if (defined $params[0]) {
2708e0680481Safresh1        $x = $x -> bround($params[0], $params[2]); # then round accordingly
27099f11ffb7Safresh1    } else {
2710e0680481Safresh1        $x = $x -> bfround($params[1], $params[2]); # then round accordingly
2711b8851fccSafresh1    }
27129f11ffb7Safresh1    if ($fallback) {
2713b8851fccSafresh1        # clear a/p after round, since user did not request it
2714*3d61058aSafresh1        $x->{accuracy} = undef;
2715*3d61058aSafresh1        $x->{precision} = undef;
2716b8851fccSafresh1    }
2717*3d61058aSafresh1
2718*3d61058aSafresh1    # Restore globals. We need to do it like this, because setting one
2719*3d61058aSafresh1    # undefines the other.
2720*3d61058aSafresh1
2721*3d61058aSafresh1    if (defined $ab) {
2722*3d61058aSafresh1        $class -> accuracy($ab);
2723*3d61058aSafresh1    } else {
2724*3d61058aSafresh1        $class -> precision($pb);
2725*3d61058aSafresh1    }
2726*3d61058aSafresh1
2727*3d61058aSafresh1    $class -> upgrade($upg);
2728*3d61058aSafresh1    $class -> downgrade($dng);
2729b8851fccSafresh1
2730e0680481Safresh1    return $downgrade -> new($x -> bdstr(), @r)
2731e0680481Safresh1      if defined($downgrade) && $x -> is_int();
2732e0680481Safresh1    return $x;
2733b8851fccSafresh1}
2734b8851fccSafresh1
27359f11ffb7Safresh1sub bexp {
2736b8851fccSafresh1    # Calculate e ** X (Euler's number to the power of X)
2737e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
2738b8851fccSafresh1
2739b8851fccSafresh1    return $x if $x -> modify('bexp');
2740b8851fccSafresh1
2741e0680481Safresh1    return $x -> bnan(@r)  if $x -> is_nan();
2742e0680481Safresh1    return $x -> binf(@r)  if $x->{sign} eq '+inf';
2743e0680481Safresh1    return $x -> bzero(@r) if $x->{sign} eq '-inf';
2744b8851fccSafresh1
2745*3d61058aSafresh1    # Get the rounding parameters, if any.
2746*3d61058aSafresh1
2747b8851fccSafresh1    my $fallback = 0;
2748b8851fccSafresh1    my ($scale, @params);
2749e0680481Safresh1    ($x, @params) = $x -> _find_round_parameters(@r);
2750b8851fccSafresh1
2751*3d61058aSafresh1    # Error in _find_round_parameters?
2752*3d61058aSafresh1
2753e0680481Safresh1    return $x -> bnan(@r) if $x->{sign} eq 'NaN';
2754b8851fccSafresh1
2755*3d61058aSafresh1    return $x -> bone(@r) if $x -> is_zero();
2756*3d61058aSafresh1
2757*3d61058aSafresh1    # If no rounding parameters are give, use fallback.
2758*3d61058aSafresh1
2759*3d61058aSafresh1    if (!@params) {
2760*3d61058aSafresh1        $params[0] = $class -> div_scale();     # fallback accuracy
2761*3d61058aSafresh1        $params[1] = undef;                     # no precision
2762*3d61058aSafresh1        $params[2] = $r[2];                     # rounding mode
2763*3d61058aSafresh1        $scale = $params[0];
2764b8851fccSafresh1        $fallback = 1;                          # to clear a/p afterwards
27659f11ffb7Safresh1    } else {
2766*3d61058aSafresh1        if (defined($params[0])) {
2767*3d61058aSafresh1            $scale = $params[0];
2768*3d61058aSafresh1        } else {
2769*3d61058aSafresh1            # We perform the computations below using accuracy only, not
2770*3d61058aSafresh1            # precision, so when precision is given, we need to "convert" this
2771*3d61058aSafresh1            # to accuracy. To do that, we need to know, at least approximately,
2772*3d61058aSafresh1            # how many digits there will be in the final result.
2773*3d61058aSafresh1            #
2774*3d61058aSafresh1            #   log10(exp($x)) = log(exp($x)) / log(10) = $x / log(10)
2775*3d61058aSafresh1
2776*3d61058aSafresh1            #$scale = 1 + int(log($ms) / log(10) + $es) - $params[1];
2777*3d61058aSafresh1            my $ndig = $x -> numify() / log(10);
2778*3d61058aSafresh1            $scale = 1 + int($ndig) - $params[1];
2779*3d61058aSafresh1        }
2780b8851fccSafresh1    }
2781b8851fccSafresh1
2782*3d61058aSafresh1    # Add extra digits to reduce the consequence of round-off errors in the
2783*3d61058aSafresh1    # intermediate computations.
2784*3d61058aSafresh1
2785*3d61058aSafresh1    $scale += 4;
2786b8851fccSafresh1
27879f11ffb7Safresh1    if (!$x -> isa('Math::BigFloat')) {
2788b8851fccSafresh1        $x = Math::BigFloat -> new($x);
27899f11ffb7Safresh1        $class = ref($x);
2790b8851fccSafresh1    }
2791b8851fccSafresh1
2792*3d61058aSafresh1    # When user set globals, they would interfere with our calculation, so
2793*3d61058aSafresh1    # disable them and later re-enable them.
2794*3d61058aSafresh1
2795*3d61058aSafresh1    my $ab = $class -> accuracy();
2796*3d61058aSafresh1    my $pb = $class -> precision();
2797*3d61058aSafresh1    $class -> accuracy(undef);
2798*3d61058aSafresh1    $class -> precision(undef);
2799e0680481Safresh1
2800e0680481Safresh1    # Disabling upgrading and downgrading is no longer necessary to avoid an
2801e0680481Safresh1    # infinite recursion, but it avoids unnecessary upgrading and downgrading in
2802e0680481Safresh1    # the intermediate computations.
2803e0680481Safresh1
2804*3d61058aSafresh1    my $upg = $class -> upgrade();
2805*3d61058aSafresh1    my $dng = $class -> downgrade();
2806*3d61058aSafresh1    $class -> upgrade(undef);
2807*3d61058aSafresh1    $class -> downgrade(undef);
2808b8851fccSafresh1
2809*3d61058aSafresh1    # We also need to disable any set A or P on $x (_find_round_parameters took
2810*3d61058aSafresh1    # them already into account), since these would interfere, too.
2811*3d61058aSafresh1
2812*3d61058aSafresh1    $x->{accuracy} = undef;
2813*3d61058aSafresh1    $x->{precision} = undef;
2814*3d61058aSafresh1
2815*3d61058aSafresh1    my $x_orig = $x -> copy();
2816b8851fccSafresh1
2817b8851fccSafresh1    # We use the following Taylor series:
2818b8851fccSafresh1
2819b8851fccSafresh1    #           x    x^2   x^3   x^4
2820b8851fccSafresh1    #  e = 1 + --- + --- + --- + --- ...
2821b8851fccSafresh1    #           1!    2!    3!    4!
2822b8851fccSafresh1
2823b8851fccSafresh1    # The difference for each term is X and N, which would result in:
2824b8851fccSafresh1    # 2 copy, 2 mul, 2 add, 1 inc, 1 div operations per term
2825b8851fccSafresh1
2826b8851fccSafresh1    # But it is faster to compute exp(1) and then raising it to the
2827b8851fccSafresh1    # given power, esp. if $x is really big and an integer because:
2828b8851fccSafresh1
2829b8851fccSafresh1    #  * The numerator is always 1, making the computation faster
2830b8851fccSafresh1    #  * the series converges faster in the case of x == 1
2831b8851fccSafresh1    #  * We can also easily check when we have reached our limit: when the
2832b8851fccSafresh1    #    term to be added is smaller than "1E$scale", we can stop - f.i.
2833b8851fccSafresh1    #    scale == 5, and we have 1/40320, then we stop since 1/40320 < 1E-5.
2834b8851fccSafresh1    #  * we can compute the *exact* result by simulating bigrat math:
2835b8851fccSafresh1
2836b8851fccSafresh1    #  1   1    gcd(3, 4) = 1    1*24 + 1*6    5
2837b8851fccSafresh1    #  - + -                  = ---------- =  --
2838b8851fccSafresh1    #  6   24                      6*24       24
2839b8851fccSafresh1
2840b8851fccSafresh1    # We do not compute the gcd() here, but simple do:
2841b8851fccSafresh1    #  1   1    1*24 + 1*6   30
2842b8851fccSafresh1    #  - + -  = --------- =  --
2843b8851fccSafresh1    #  6   24       6*24     144
2844b8851fccSafresh1
2845b8851fccSafresh1    # In general:
2846b8851fccSafresh1    #  a   c    a*d + c*b         and note that c is always 1 and d = (b*f)
2847b8851fccSafresh1    #  - + -  = ---------
2848b8851fccSafresh1    #  b   d       b*d
2849b8851fccSafresh1
2850b8851fccSafresh1    # This leads to:         which can be reduced by b to:
2851b8851fccSafresh1    #  a   1     a*b*f + b    a*f + 1
2852b8851fccSafresh1    #  - + -   = --------- =  -------
2853b8851fccSafresh1    #  b   b*f     b*b*f        b*f
2854b8851fccSafresh1
2855b8851fccSafresh1    # The first terms in the series are:
2856b8851fccSafresh1
2857b8851fccSafresh1    # 1     1    1    1    1    1     1     1     13700
2858b8851fccSafresh1    # -- + -- + -- + -- + -- + --- + --- + ---- = -----
2859b8851fccSafresh1    # 1     1    2    6   24   120   720   5040   5040
2860b8851fccSafresh1
2861b46d8ef2Safresh1    # Note that we cannot simply reduce 13700/5040 to 685/252, but must keep
2862b46d8ef2Safresh1    # the numerator and the denominator!
2863b8851fccSafresh1
28649f11ffb7Safresh1    if ($scale <= 75) {
2865b8851fccSafresh1        # set $x directly from a cached string form
2866b46d8ef2Safresh1        $x->{_m} = $LIB->_new("2718281828459045235360287471352662497757" .
2867b46d8ef2Safresh1                              "2470936999595749669676277240766303535476");
2868b8851fccSafresh1        $x->{sign} = '+';
2869b8851fccSafresh1        $x->{_es} = '-';
2870b46d8ef2Safresh1        $x->{_e} = $LIB->_new(79);
28719f11ffb7Safresh1    } else {
2872b8851fccSafresh1        # compute A and B so that e = A / B.
2873b8851fccSafresh1
2874e0680481Safresh1        # After some terms we end up with this, so we use it as a starting
2875e0680481Safresh1        # point:
2876b46d8ef2Safresh1        my $A = $LIB->_new("9093339520860578540197197" .
2877b46d8ef2Safresh1                           "0164779391644753259799242");
2878b46d8ef2Safresh1        my $F = $LIB->_new(42);
28799f11ffb7Safresh1        my $step = 42;
2880b8851fccSafresh1
2881*3d61058aSafresh1        # Compute number of steps needed to get $A and $B sufficiently large.
2882*3d61058aSafresh1
2883b8851fccSafresh1        my $steps = _len_to_steps($scale - 4);
2884b8851fccSafresh1        #    print STDERR "# Doing $steps steps for ", $scale-4, " digits\n";
2885*3d61058aSafresh1
28869f11ffb7Safresh1        while ($step++ <= $steps) {
2887b8851fccSafresh1            # calculate $a * $f + 1
2888b46d8ef2Safresh1            $A = $LIB -> _mul($A, $F);
2889b46d8ef2Safresh1            $A = $LIB -> _inc($A);
2890b8851fccSafresh1            # increment f
2891b46d8ef2Safresh1            $F = $LIB -> _inc($F);
2892b8851fccSafresh1        }
2893e0680481Safresh1
2894e0680481Safresh1        # Compute $B as factorial of $steps (this is faster than doing it
2895e0680481Safresh1        # manually)
2896b46d8ef2Safresh1        my $B = $LIB->_fac($LIB->_new($steps));
2897b8851fccSafresh1
2898b46d8ef2Safresh1        #  print "A ", $LIB->_str($A), "\nB ", $LIB->_str($B), "\n";
2899b8851fccSafresh1
2900b8851fccSafresh1        # compute A/B with $scale digits in the result (truncate, not round)
2901b46d8ef2Safresh1        $A = $LIB->_lsft($A, $LIB->_new($scale), 10);
2902b46d8ef2Safresh1        $A = $LIB->_div($A, $B);
2903b8851fccSafresh1
2904b8851fccSafresh1        $x->{_m} = $A;
2905b8851fccSafresh1        $x->{sign} = '+';
2906b8851fccSafresh1        $x->{_es} = '-';
2907b46d8ef2Safresh1        $x->{_e} = $LIB->_new($scale);
2908b8851fccSafresh1    }
2909b8851fccSafresh1
2910*3d61058aSafresh1    # Now $x contains now an estimate of e, with some additional digits.
2911*3d61058aSafresh1
2912*3d61058aSafresh1    if ($x_orig -> is_one()) {
2913*3d61058aSafresh1
2914b8851fccSafresh1        # else just round the already computed result
2915*3d61058aSafresh1
2916*3d61058aSafresh1        $x->{accuracy} = undef;
2917*3d61058aSafresh1        $x->{precision} = undef;
2918*3d61058aSafresh1
2919b8851fccSafresh1        # shortcut to not run through _find_round_parameters again
2920*3d61058aSafresh1
29219f11ffb7Safresh1        if (defined $params[0]) {
2922e0680481Safresh1            $x = $x -> bround($params[0], $params[2]); # then round accordingly
29239f11ffb7Safresh1        } else {
2924e0680481Safresh1            $x = $x -> bfround($params[1], $params[2]); # then round accordingly
2925b8851fccSafresh1        }
2926*3d61058aSafresh1
2927*3d61058aSafresh1    } else {
2928*3d61058aSafresh1
2929*3d61058aSafresh1        # Use the fact exp(x) = exp(x/n)**n. In our case, n = 2**i for some
2930*3d61058aSafresh1        # integer i. We use this to compute exp(y) where y = x / (2**i) and
2931*3d61058aSafresh1        # 1 <= |y| < 2.
2932*3d61058aSafresh1        #
2933*3d61058aSafresh1        # The code below is similar to the code found in to_ieee754().
2934*3d61058aSafresh1
2935*3d61058aSafresh1        # We need to find the base 2 exponent. First make an estimate of the
2936*3d61058aSafresh1        # base 2 exponent, before adjusting it below. We could skip this
2937*3d61058aSafresh1        # estimation and go straight to the while-loops below, but the loops
2938*3d61058aSafresh1        # are slow, especially when the final exponent is far from zero and
2939*3d61058aSafresh1        # even more so if the number of digits is large. This initial
2940*3d61058aSafresh1        # estimation speeds up the computation dramatically.
2941*3d61058aSafresh1        #
2942*3d61058aSafresh1        #   log2($m * 10**$e) = log10($m + 10**$e) * log(10)/log(2)
2943*3d61058aSafresh1        #                     = (log10($m) + $e) * log(10)/log(2)
2944*3d61058aSafresh1        #                     = (log($m)/log(10) + $e) * log(10)/log(2)
2945*3d61058aSafresh1
2946*3d61058aSafresh1        my ($m, $e) = $x_orig -> nparts();
2947*3d61058aSafresh1        my $ms = $m -> numify();
2948*3d61058aSafresh1        my $es = $e -> numify();
2949*3d61058aSafresh1
2950*3d61058aSafresh1        # We start off by initializing the exponent to zero and the mantissa to
2951*3d61058aSafresh1        # the input value. Then we increase the mantissa and decrease the
2952*3d61058aSafresh1        # exponent, or vice versa, until the mantissa is in the desired range
2953*3d61058aSafresh1        # or we hit one of the limits for the exponent.
2954*3d61058aSafresh1
2955*3d61058aSafresh1        my $mant = $x_orig -> copy() -> babs();
2956*3d61058aSafresh1        my $expo;
2957*3d61058aSafresh1
2958*3d61058aSafresh1        my $one  = $class -> bone();
2959*3d61058aSafresh1        my $two  = $class -> new("2");
2960*3d61058aSafresh1        my $half = $class -> new("0.5");
2961*3d61058aSafresh1
2962*3d61058aSafresh1        my $expo_est = (log(abs($ms))/log(10) + $es) * log(10)/log(2);
2963*3d61058aSafresh1        $expo_est = int($expo_est);
2964*3d61058aSafresh1
2965*3d61058aSafresh1        # Don't multiply by a number raised to a negative exponent. This will
2966*3d61058aSafresh1        # cause a division, whose result is truncated to some fixed number of
2967*3d61058aSafresh1        # digits. Instead, multiply by the inverse number raised to a positive
2968*3d61058aSafresh1        # exponent.
2969*3d61058aSafresh1
2970*3d61058aSafresh1        $expo = $class -> new($expo_est);
2971*3d61058aSafresh1        if ($expo_est > 0) {
2972*3d61058aSafresh1            $mant = $mant -> bmul($half -> copy() -> bpow($expo));
2973*3d61058aSafresh1        } elsif ($expo_est < 0) {
2974*3d61058aSafresh1            my $expo_abs = $expo -> copy() -> bneg();
2975*3d61058aSafresh1            $mant = $mant -> bmul($two -> copy() -> bpow($expo_abs));
2976b8851fccSafresh1        }
2977*3d61058aSafresh1
2978*3d61058aSafresh1        # Final adjustment of the estimate above.
2979*3d61058aSafresh1
2980*3d61058aSafresh1        while ($mant -> bcmp($two) >= 0) {      # $mant <= $two
2981*3d61058aSafresh1            $mant = $mant -> bmul($half);
2982*3d61058aSafresh1            $expo = $expo -> binc();
2983*3d61058aSafresh1        }
2984*3d61058aSafresh1
2985*3d61058aSafresh1        while ($mant -> bcmp($one) < 0) {       # $mant > $one
2986*3d61058aSafresh1            $mant = $mant -> bmul($two);
2987*3d61058aSafresh1            $expo = $expo -> bdec();
2988*3d61058aSafresh1        }
2989*3d61058aSafresh1
2990*3d61058aSafresh1        # Because of the upscaling, we need some additional digits.
2991*3d61058aSafresh1
2992*3d61058aSafresh1        my $rescale = int($scale + abs($expo) * log(2) / log(10) + 1);
2993*3d61058aSafresh1        $rescale = 4 if $rescale < 4;
2994*3d61058aSafresh1
2995*3d61058aSafresh1        $x = $x -> bpow($mant, $rescale);
2996*3d61058aSafresh1        my $pow2 = $two -> bpow($expo, $rescale);
2997*3d61058aSafresh1        $pow2 -> bneg() if $x_orig -> is_negative();
2998*3d61058aSafresh1
2999*3d61058aSafresh1        # The bpow() below fails with the GMP and GMPz libraries if abs($pow2)
3000*3d61058aSafresh1        # >= 2**30 = 1073741824. With the Pari library, it fails already when
3001*3d61058aSafresh1        # abs($pow) >= 2**13 = 8192. With the Calc library, it is rediculously
3002*3d61058aSafresh1        # slow when abs($pow2) is large. Fixme?
3003*3d61058aSafresh1
3004*3d61058aSafresh1        croak "cannot compute bexp(); input value is too large"
3005*3d61058aSafresh1          if $pow2 -> copy() -> babs() -> bcmp("1073741824") >= 0;
3006*3d61058aSafresh1
3007*3d61058aSafresh1        $x = $x -> bpow($pow2, $rescale);
3008*3d61058aSafresh1
3009*3d61058aSafresh1        # Rounding parameters given as arguments currently don't override
3010*3d61058aSafresh1        # instance variables, so accuracy (which is set in the computations
3011*3d61058aSafresh1        # above) must be undefined before rounding. Fixme.
3012*3d61058aSafresh1
3013*3d61058aSafresh1        $x->{accuracy} = undef;
3014*3d61058aSafresh1        $x -> round(@params);
3015*3d61058aSafresh1    }
3016*3d61058aSafresh1
30179f11ffb7Safresh1    if ($fallback) {
3018b8851fccSafresh1        # clear a/p after round, since user did not request it
3019*3d61058aSafresh1        $x->{accuracy} = undef;
3020*3d61058aSafresh1        $x->{precision} = undef;
3021b8851fccSafresh1    }
3022b8851fccSafresh1
3023*3d61058aSafresh1    # Restore globals. We need to do it like this, because setting one
3024*3d61058aSafresh1    # undefines the other.
3025*3d61058aSafresh1
3026*3d61058aSafresh1    if (defined $ab) {
3027*3d61058aSafresh1        $class -> accuracy($ab);
3028*3d61058aSafresh1    } else {
3029*3d61058aSafresh1        $class -> precision($pb);
3030*3d61058aSafresh1    }
3031*3d61058aSafresh1
3032*3d61058aSafresh1    $class -> upgrade($upg);
3033*3d61058aSafresh1    $class -> downgrade($dng);
3034*3d61058aSafresh1
3035*3d61058aSafresh1    # If downgrading, remember to preserve the relevant instance parameters.
3036*3d61058aSafresh1    # There should be a more elegant way to do this. Fixme.
3037*3d61058aSafresh1
3038*3d61058aSafresh1    if ($downgrade && $x -> is_int()) {
3039*3d61058aSafresh1        @r = ($x->{accuracy}, $x->{_r});
3040*3d61058aSafresh1        my $tmp = $downgrade -> new($x, @r);
3041*3d61058aSafresh1        %$x = %$tmp;
3042*3d61058aSafresh1        return bless $x, $downgrade;
3043*3d61058aSafresh1    }
3044*3d61058aSafresh1
3045e0680481Safresh1    $x;
3046b8851fccSafresh1}
3047b8851fccSafresh1
3048*3d61058aSafresh1sub bilog2 {
3049*3d61058aSafresh1    croak "Method ", (caller(0))[3], "() not implemented yet";
3050*3d61058aSafresh1}
3051*3d61058aSafresh1
3052*3d61058aSafresh1sub bilog10 {
3053*3d61058aSafresh1    croak "Method ", (caller(0))[3], "() not implemented yet";
3054*3d61058aSafresh1}
3055*3d61058aSafresh1
3056*3d61058aSafresh1sub bclog2 {
3057*3d61058aSafresh1    croak "Method ", (caller(0))[3], "() not implemented yet";
3058*3d61058aSafresh1}
3059*3d61058aSafresh1
3060*3d61058aSafresh1sub bclog10 {
3061*3d61058aSafresh1    croak "Method ", (caller(0))[3], "() not implemented yet";
3062*3d61058aSafresh1}
3063*3d61058aSafresh1
30649f11ffb7Safresh1sub bnok {
30659f11ffb7Safresh1    # Calculate n over k (binomial coefficient or "choose" function) as integer.
30669f11ffb7Safresh1    # set up parameters
3067e0680481Safresh1    my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
3068e0680481Safresh1                            ? (ref($_[0]), @_)
3069e0680481Safresh1                            : objectify(2, @_);
30709f11ffb7Safresh1
3071e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
30729f11ffb7Safresh1
30739f11ffb7Safresh1    return $x if $x->modify('bnok');
30749f11ffb7Safresh1
30759f11ffb7Safresh1    return $x->bnan() if $x->is_nan() || $y->is_nan();
3076b46d8ef2Safresh1    return $x->bnan() if (($x->is_finite() && !$x->is_int()) ||
3077b46d8ef2Safresh1                          ($y->is_finite() && !$y->is_int()));
30789f11ffb7Safresh1
3079b46d8ef2Safresh1    my $xint = Math::BigInt -> new($x -> bsstr());
3080b46d8ef2Safresh1    my $yint = Math::BigInt -> new($y -> bsstr());
3081e0680481Safresh1    $xint = $xint -> bnok($yint);
3082e0680481Safresh1
3083e0680481Safresh1    return $xint if defined $downgrade;
3084e0680481Safresh1
3085b46d8ef2Safresh1    my $xflt = Math::BigFloat -> new($xint);
30869f11ffb7Safresh1
3087b46d8ef2Safresh1    $x->{_m}   = $xflt->{_m};
3088b46d8ef2Safresh1    $x->{_e}   = $xflt->{_e};
3089b46d8ef2Safresh1    $x->{_es}  = $xflt->{_es};
3090b46d8ef2Safresh1    $x->{sign} = $xflt->{sign};
3091b46d8ef2Safresh1
3092b46d8ef2Safresh1    return $x;
30939f11ffb7Safresh1}
30949f11ffb7Safresh1
30959f11ffb7Safresh1sub bsin {
30969f11ffb7Safresh1    # Calculate a sinus of x.
30979f11ffb7Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
30989f11ffb7Safresh1
3099*3d61058aSafresh1    # First we apply range reduction to x. This is because if x is large, the
3100*3d61058aSafresh1    # Taylor series converges slowly and requires higher accuracy in the
3101*3d61058aSafresh1    # intermediate computation. The Taylor series is:
3102*3d61058aSafresh1    #
3103*3d61058aSafresh1    #                 x^3   x^5   x^7   x^9
3104*3d61058aSafresh1    #    sin(x) = x - --- + --- - --- + --- ...
31059f11ffb7Safresh1    #                  3!    5!    7!    9!
31069f11ffb7Safresh1
3107e0680481Safresh1    return $x if $x -> modify('bsin');
3108e0680481Safresh1
3109e0680481Safresh1    return $x -> bzero(@r) if $x -> is_zero();
3110e0680481Safresh1    return $x -> bnan(@r)  if $x -> is_nan() || $x -> is_inf();
3111e0680481Safresh1
3112*3d61058aSafresh1    # Get the rounding parameters, if any.
3113*3d61058aSafresh1
31149f11ffb7Safresh1    my $fallback = 0;
31159f11ffb7Safresh1    my ($scale, @params);
31169f11ffb7Safresh1    ($x, @params) = $x -> _find_round_parameters(@r);
31179f11ffb7Safresh1
3118*3d61058aSafresh1    # Error in _find_round_parameters?
3119*3d61058aSafresh1
3120e0680481Safresh1    return $x -> bnan(@r) if $x -> is_nan();
31219f11ffb7Safresh1
3122*3d61058aSafresh1    # If no rounding parameters are given, use fallback.
3123*3d61058aSafresh1
3124*3d61058aSafresh1    if (!@params) {
3125*3d61058aSafresh1        $params[0] = $class -> div_scale();     # fallback accuracy
3126*3d61058aSafresh1        $params[1] = undef;                     # no precision
3127*3d61058aSafresh1        $params[2] = $r[2];                     # rounding mode
3128*3d61058aSafresh1        $scale = $params[0];
31299f11ffb7Safresh1        $fallback = 1;                          # to clear a/p afterwards
31309f11ffb7Safresh1    } else {
3131*3d61058aSafresh1        if (defined($params[0])) {
3132*3d61058aSafresh1            $scale = $params[0];
3133*3d61058aSafresh1        } else {
3134*3d61058aSafresh1            # We perform the computations below using accuracy only, not
3135*3d61058aSafresh1            # precision, so when precision is given, we need to "convert" this
3136*3d61058aSafresh1            # to accuracy.
3137*3d61058aSafresh1            $scale = 1 - $params[1];
3138*3d61058aSafresh1        }
31399f11ffb7Safresh1    }
31409f11ffb7Safresh1
3141*3d61058aSafresh1    # Add more digits to the scale if the magnitude of $x is large.
3142*3d61058aSafresh1
3143*3d61058aSafresh1    my ($m, $e) = $x -> nparts();
3144*3d61058aSafresh1    $scale += $e if $x >= 10;
3145*3d61058aSafresh1    $scale = 4 if $scale < 4;
3146*3d61058aSafresh1
3147*3d61058aSafresh1    # When user set globals, they would interfere with our calculation, so
31489f11ffb7Safresh1    # disable them and later re-enable them
3149*3d61058aSafresh1
3150*3d61058aSafresh1    my $ab = $class -> accuracy();
3151*3d61058aSafresh1    my $pb = $class -> precision();
3152*3d61058aSafresh1    $class -> accuracy(undef);
3153*3d61058aSafresh1    $class -> precision(undef);
3154e0680481Safresh1
3155e0680481Safresh1    # Disabling upgrading and downgrading is no longer necessary to avoid an
3156e0680481Safresh1    # infinite recursion, but it avoids unnecessary upgrading and downgrading in
3157e0680481Safresh1    # the intermediate computations.
3158e0680481Safresh1
3159*3d61058aSafresh1    my $upg = $class -> upgrade();
3160*3d61058aSafresh1    my $dng = $class -> downgrade();
3161*3d61058aSafresh1    $class -> upgrade(undef);
3162*3d61058aSafresh1    $class -> downgrade(undef);
31639f11ffb7Safresh1
3164*3d61058aSafresh1    # We also need to disable any set A or P on $x (_find_round_parameters took
3165*3d61058aSafresh1    # them already into account), since these would interfere, too.
31669f11ffb7Safresh1
3167*3d61058aSafresh1    $x->{accuracy} = undef;
3168*3d61058aSafresh1    $x->{precision} = undef;
3169*3d61058aSafresh1
3170*3d61058aSafresh1    my $sin_prev;       # the previous approximation of sin(x)
3171*3d61058aSafresh1    my $sin;            # the current approximation of sin(x)
3172*3d61058aSafresh1
3173e0680481Safresh1    while (1) {
31749f11ffb7Safresh1
3175*3d61058aSafresh1        # Compute constants to the current scale.
3176*3d61058aSafresh1
3177*3d61058aSafresh1        my $pi     = $class -> bpi($scale);         # ��
3178*3d61058aSafresh1        my $twopi  = $pi -> copy() -> bmul("2");    # 2��
3179*3d61058aSafresh1        my $halfpi = $pi -> copy() -> bmul("0.5");  # ��/2
3180*3d61058aSafresh1
3181*3d61058aSafresh1        # Use the fact that sin(-x) = -sin(x) to reduce the range to the
3182*3d61058aSafresh1        # interval to [0,∞).
3183*3d61058aSafresh1
3184*3d61058aSafresh1        my $xsgn = $x < 0 ? -1 : 1;
3185*3d61058aSafresh1        my $x = $x -> copy() -> babs();
3186*3d61058aSafresh1
3187*3d61058aSafresh1        # Use the fact that sin(2��x) = sin(x) to reduce the range to the
3188*3d61058aSafresh1        # interval to [0, 2��).
3189*3d61058aSafresh1
3190*3d61058aSafresh1        $x = $x -> bmod($twopi, $scale);
3191*3d61058aSafresh1
3192*3d61058aSafresh1        # Use the fact that sin(x+��) = -sin(x) to reduce the range to the
3193*3d61058aSafresh1        # interval to [0,��).
3194*3d61058aSafresh1
3195*3d61058aSafresh1        if ($x -> bcmp($pi) > 0) {
3196*3d61058aSafresh1            $xsgn = -$xsgn;
3197*3d61058aSafresh1            $x = $x -> bsub($pi);
31989f11ffb7Safresh1        }
31999f11ffb7Safresh1
3200*3d61058aSafresh1        # Use the fact that sin(��-x) = sin(x) to reduce the range to the
3201*3d61058aSafresh1        # interval [0,��/2).
3202*3d61058aSafresh1
3203*3d61058aSafresh1        if ($x -> bcmp($halfpi) > 0) {
3204*3d61058aSafresh1            $x = $x -> bsub($pi) -> bneg();     # �� - x
32059f11ffb7Safresh1        }
3206*3d61058aSafresh1
3207*3d61058aSafresh1        my $tol = $class -> new("1E-". ($scale-1));
3208*3d61058aSafresh1
3209*3d61058aSafresh1        my $xsq  = $x -> copy() -> bmul($x, $scale) -> bneg();
3210*3d61058aSafresh1        my $term = $x -> copy();
3211*3d61058aSafresh1        my $fac  = $class -> bone();
3212*3d61058aSafresh1        my $n    = $class -> bone();
3213*3d61058aSafresh1
3214*3d61058aSafresh1        $sin = $x -> copy();    # initialize sin(x) to the first term
3215*3d61058aSafresh1
3216*3d61058aSafresh1        while (1) {
3217*3d61058aSafresh1            $n -> binc();
3218*3d61058aSafresh1            $fac = $n -> copy();
3219*3d61058aSafresh1            $n -> binc();
3220*3d61058aSafresh1            $fac -> bmul($n);
3221*3d61058aSafresh1
3222*3d61058aSafresh1            $term -> bmul($xsq, $scale) -> bdiv($fac, $scale);
3223*3d61058aSafresh1
3224*3d61058aSafresh1            $sin -> badd($term, $scale);
3225*3d61058aSafresh1            last if $term -> copy() -> babs() -> bcmp($tol) < 0;
3226*3d61058aSafresh1        }
3227*3d61058aSafresh1
3228*3d61058aSafresh1        $sin -> bneg() if $xsgn < 0;
3229*3d61058aSafresh1
3230*3d61058aSafresh1        # Rounding parameters given as arguments currently don't override
3231*3d61058aSafresh1        # instance variables, so accuracy (which is set in the computations
3232*3d61058aSafresh1        # above) must be undefined before rounding. Fixme.
3233*3d61058aSafresh1
3234*3d61058aSafresh1        $sin->{accuracy} = undef;
3235*3d61058aSafresh1        $sin -> round(@params);
3236*3d61058aSafresh1
3237*3d61058aSafresh1        # Compare the current approximation of sin(x) with the previous one,
3238*3d61058aSafresh1        # and if they are identical, we're done.
3239*3d61058aSafresh1
3240*3d61058aSafresh1        if (defined $sin_prev) {
3241*3d61058aSafresh1            last if $sin -> bcmp($sin_prev) == 0;
3242*3d61058aSafresh1        }
3243*3d61058aSafresh1
3244*3d61058aSafresh1        # If the current approximation of sin(x) is different from the previous
3245*3d61058aSafresh1        # approximation, double the scale (accuracy) and retry.
3246*3d61058aSafresh1
3247*3d61058aSafresh1        $sin_prev = $sin;
3248*3d61058aSafresh1        $scale *= 2;
3249*3d61058aSafresh1    }
3250*3d61058aSafresh1
3251*3d61058aSafresh1    # Assign the result to the invocand.
3252*3d61058aSafresh1
3253*3d61058aSafresh1    %$x = %$sin;
3254*3d61058aSafresh1
32559f11ffb7Safresh1    if ($fallback) {
32569f11ffb7Safresh1        # clear a/p after round, since user did not request it
3257*3d61058aSafresh1        $x->{accuracy} = undef;
3258*3d61058aSafresh1        $x->{precision} = undef;
32599f11ffb7Safresh1    }
3260e0680481Safresh1
3261*3d61058aSafresh1    # Restore globals. We need to do it like this, because setting one
3262*3d61058aSafresh1    # undefines the other.
3263*3d61058aSafresh1
3264*3d61058aSafresh1    if (defined $ab) {
3265*3d61058aSafresh1        $class -> accuracy($ab);
3266*3d61058aSafresh1    } else {
3267*3d61058aSafresh1        $class -> precision($pb);
3268*3d61058aSafresh1    }
3269*3d61058aSafresh1
3270*3d61058aSafresh1    $class -> upgrade($upg);
3271*3d61058aSafresh1    $class -> downgrade($dng);
3272*3d61058aSafresh1
3273*3d61058aSafresh1    # If downgrading, remember to preserve the relevant instance parameters.
3274*3d61058aSafresh1    # There should be a more elegant way to do this. Fixme.
3275*3d61058aSafresh1
3276*3d61058aSafresh1    if ($downgrade && $x -> is_int()) {
3277*3d61058aSafresh1        @r = ($x->{accuracy}, $x->{_r});
3278*3d61058aSafresh1        my $tmp = $downgrade -> new($x, @r);
3279*3d61058aSafresh1        %$x = %$tmp;
3280*3d61058aSafresh1        return bless $x, $downgrade;
3281*3d61058aSafresh1    }
3282*3d61058aSafresh1
32839f11ffb7Safresh1    $x;
32849f11ffb7Safresh1}
32859f11ffb7Safresh1
32869f11ffb7Safresh1sub bcos {
32879f11ffb7Safresh1    # Calculate a cosinus of x.
32889f11ffb7Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
32899f11ffb7Safresh1
32909f11ffb7Safresh1    # Taylor:      x^2   x^4   x^6   x^8
32919f11ffb7Safresh1    #    cos = 1 - --- + --- - --- + --- ...
32929f11ffb7Safresh1    #               2!    4!    6!    8!
32939f11ffb7Safresh1
32949f11ffb7Safresh1    # we need to limit the accuracy to protect against overflow
32959f11ffb7Safresh1    my $fallback = 0;
32969f11ffb7Safresh1    my ($scale, @params);
32979f11ffb7Safresh1    ($x, @params) = $x->_find_round_parameters(@r);
32989f11ffb7Safresh1
32999f11ffb7Safresh1    #         constant object       or error in _find_round_parameters?
33009f11ffb7Safresh1    return $x if $x->modify('bcos') || $x->is_nan();
3301eac174f2Safresh1    return $x->bnan()   if $x->is_inf();
33029f11ffb7Safresh1    return $x->bone(@r) if $x->is_zero();
33039f11ffb7Safresh1
33049f11ffb7Safresh1    # no rounding at all, so must use fallback
33059f11ffb7Safresh1    if (scalar @params == 0) {
33069f11ffb7Safresh1        # simulate old behaviour
33079f11ffb7Safresh1        $params[0] = $class->div_scale(); # and round to it as accuracy
33089f11ffb7Safresh1        $params[1] = undef;               # disable P
33099f11ffb7Safresh1        $scale = $params[0]+4;            # at least four more for proper round
33109f11ffb7Safresh1        $params[2] = $r[2];               # round mode by caller or undef
33119f11ffb7Safresh1        $fallback = 1;                    # to clear a/p afterwards
33129f11ffb7Safresh1    } else {
33139f11ffb7Safresh1        # the 4 below is empirical, and there might be cases where it is not
33149f11ffb7Safresh1        # enough...
33159f11ffb7Safresh1        $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
33169f11ffb7Safresh1    }
33179f11ffb7Safresh1
3318*3d61058aSafresh1    # When user set globals, they would interfere with our calculation, so
3319*3d61058aSafresh1    # disable them and later re-enable them.
3320*3d61058aSafresh1
3321*3d61058aSafresh1    my $ab = $class -> accuracy();
3322*3d61058aSafresh1    my $pb = $class -> precision();
3323*3d61058aSafresh1    $class -> accuracy(undef);
3324*3d61058aSafresh1    $class -> precision(undef);
3325*3d61058aSafresh1
3326*3d61058aSafresh1    # Disabling upgrading and downgrading is no longer necessary to avoid an
3327*3d61058aSafresh1    # infinite recursion, but it avoids unnecessary upgrading and downgrading in
3328*3d61058aSafresh1    # the intermediate computations.
3329*3d61058aSafresh1
3330*3d61058aSafresh1    my $upg = $class -> upgrade();
3331*3d61058aSafresh1    my $dng = $class -> downgrade();
3332*3d61058aSafresh1    $class -> upgrade(undef);
3333*3d61058aSafresh1    $class -> downgrade(undef);
3334*3d61058aSafresh1
3335*3d61058aSafresh1    # We also need to disable any set A or P on $x (_find_round_parameters took
3336*3d61058aSafresh1    # them already into account), since these would interfere, too.
3337*3d61058aSafresh1
3338*3d61058aSafresh1    $x->{accuracy} = undef;
3339*3d61058aSafresh1    $x->{precision} = undef;
33409f11ffb7Safresh1
33419f11ffb7Safresh1    my $over = $x * $x;         # X ^ 2
33429f11ffb7Safresh1    my $x2 = $over->copy();     # X ^ 2; difference between terms
33439f11ffb7Safresh1    my $sign = 1;               # start with -=
33449f11ffb7Safresh1    my $below = $class->new(2);
33459f11ffb7Safresh1    my $factorial = $class->new(3);
3346e0680481Safresh1    $x = $x->bone();
3347*3d61058aSafresh1    $x->{accuracy} = undef;
3348*3d61058aSafresh1    $x->{precision} = undef;
33499f11ffb7Safresh1
33509f11ffb7Safresh1    my $limit = $class->new("1E-". ($scale-1));
33519f11ffb7Safresh1    #my $steps = 0;
33529f11ffb7Safresh1    while (3 < 5) {
33539f11ffb7Safresh1        # we calculate the next term, and add it to the last
33549f11ffb7Safresh1        # when the next term is below our limit, it won't affect the outcome
33559f11ffb7Safresh1        # anymore, so we stop:
33569f11ffb7Safresh1        my $next = $over->copy()->bdiv($below, $scale);
33579f11ffb7Safresh1        last if $next->bacmp($limit) <= 0;
33589f11ffb7Safresh1
33599f11ffb7Safresh1        if ($sign == 0) {
3360e0680481Safresh1            $x = $x->badd($next);
33619f11ffb7Safresh1        } else {
3362e0680481Safresh1            $x = $x->bsub($next);
33639f11ffb7Safresh1        }
33649f11ffb7Safresh1        $sign = 1-$sign;        # alternate
33659f11ffb7Safresh1        # calculate things for the next term
3366e0680481Safresh1        $over = $over->bmul($x2);                       # $x*$x
3367e0680481Safresh1        $below = $below->bmul($factorial);              # n*(n+1)
3368e0680481Safresh1        $factorial = $factorial -> binc();
3369e0680481Safresh1        $below = $below->bmul($factorial);              # n*(n+1)
3370e0680481Safresh1        $factorial = $factorial -> binc();
33719f11ffb7Safresh1    }
33729f11ffb7Safresh1
33739f11ffb7Safresh1    # shortcut to not run through _find_round_parameters again
33749f11ffb7Safresh1    if (defined $params[0]) {
3375e0680481Safresh1        $x = $x->bround($params[0], $params[2]); # then round accordingly
33769f11ffb7Safresh1    } else {
3377e0680481Safresh1        $x = $x->bfround($params[1], $params[2]); # then round accordingly
33789f11ffb7Safresh1    }
33799f11ffb7Safresh1    if ($fallback) {
33809f11ffb7Safresh1        # clear a/p after round, since user did not request it
3381*3d61058aSafresh1        $x->{accuracy} = undef;
3382*3d61058aSafresh1        $x->{precision} = undef;
33839f11ffb7Safresh1    }
3384*3d61058aSafresh1
3385*3d61058aSafresh1    # Restore globals. We need to do it like this, because setting one
3386*3d61058aSafresh1    # undefines the other.
3387*3d61058aSafresh1
3388*3d61058aSafresh1    if (defined $ab) {
3389*3d61058aSafresh1        $class -> accuracy($ab);
3390*3d61058aSafresh1    } else {
3391*3d61058aSafresh1        $class -> precision($pb);
3392*3d61058aSafresh1    }
3393*3d61058aSafresh1
3394*3d61058aSafresh1    $class -> upgrade($upg);
3395*3d61058aSafresh1    $class -> downgrade($dng);
3396e0680481Safresh1
3397e0680481Safresh1    return $downgrade -> new($x -> bdstr(), @r)
3398e0680481Safresh1      if defined($downgrade) && $x -> is_int();
33999f11ffb7Safresh1    $x;
34009f11ffb7Safresh1}
34019f11ffb7Safresh1
34029f11ffb7Safresh1sub batan {
34039f11ffb7Safresh1    # Calculate a arcus tangens of x.
3404e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
34059f11ffb7Safresh1
34069f11ffb7Safresh1    # taylor:       x^3   x^5   x^7   x^9
34079f11ffb7Safresh1    #    atan = x - --- + --- - --- + --- ...
34089f11ffb7Safresh1    #                3     5     7     9
34099f11ffb7Safresh1
3410e0680481Safresh1    return $x if $x->modify('batan');
3411e0680481Safresh1
3412e0680481Safresh1    return $x -> bnan(@r) if $x->is_nan();
3413e0680481Safresh1
34149f11ffb7Safresh1    # We need to limit the accuracy to protect against overflow.
34159f11ffb7Safresh1
34169f11ffb7Safresh1    my $fallback = 0;
34179f11ffb7Safresh1    my ($scale, @params);
3418e0680481Safresh1    ($x, @params) = $x->_find_round_parameters(@r);
34199f11ffb7Safresh1
3420e0680481Safresh1    # Error in _find_round_parameters?
34219f11ffb7Safresh1
3422e0680481Safresh1    return $x -> bnan(@r) if $x->is_nan();
34239f11ffb7Safresh1
3424e0680481Safresh1    if ($x->{sign} =~ /^[+-]inf\z/) {
34259f11ffb7Safresh1        # +inf result is PI/2
34269f11ffb7Safresh1        # -inf result is -PI/2
34279f11ffb7Safresh1        # calculate PI/2
34289f11ffb7Safresh1        my $pi = $class->bpi(@r);
3429e0680481Safresh1        # modify $x in place
3430e0680481Safresh1        $x->{_m} = $pi->{_m};
3431e0680481Safresh1        $x->{_e} = $pi->{_e};
3432e0680481Safresh1        $x->{_es} = $pi->{_es};
34339f11ffb7Safresh1        # -y => -PI/2, +y => PI/2
3434e0680481Safresh1        $x->{sign} = substr($x->{sign}, 0, 1); # "+inf" => "+"
3435e0680481Safresh1        $x -> {_m} = $LIB->_div($x->{_m}, $LIB->_new(2));
3436e0680481Safresh1        return $x;
34379f11ffb7Safresh1    }
34389f11ffb7Safresh1
3439e0680481Safresh1    return $x->bzero(@r) if $x->is_zero();
34409f11ffb7Safresh1
34419f11ffb7Safresh1    # no rounding at all, so must use fallback
34429f11ffb7Safresh1    if (scalar @params == 0) {
34439f11ffb7Safresh1        # simulate old behaviour
34449f11ffb7Safresh1        $params[0] = $class->div_scale(); # and round to it as accuracy
34459f11ffb7Safresh1        $params[1] = undef;               # disable P
34469f11ffb7Safresh1        $scale = $params[0]+4;            # at least four more for proper round
34479f11ffb7Safresh1        $params[2] = $r[2];               # round mode by caller or undef
34489f11ffb7Safresh1        $fallback = 1;                    # to clear a/p afterwards
34499f11ffb7Safresh1    } else {
34509f11ffb7Safresh1        # the 4 below is empirical, and there might be cases where it is not
34519f11ffb7Safresh1        # enough...
34529f11ffb7Safresh1        $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
34539f11ffb7Safresh1    }
34549f11ffb7Safresh1
34559f11ffb7Safresh1    # 1 or -1 => PI/4
34569f11ffb7Safresh1    # inlined is_one() && is_one('-')
3457e0680481Safresh1    if ($LIB->_is_one($x->{_m}) && $LIB->_is_zero($x->{_e})) {
34589f11ffb7Safresh1        my $pi = $class->bpi($scale - 3);
3459e0680481Safresh1        # modify $x in place
3460e0680481Safresh1        $x->{_m} = $pi->{_m};
3461e0680481Safresh1        $x->{_e} = $pi->{_e};
3462e0680481Safresh1        $x->{_es} = $pi->{_es};
3463e0680481Safresh1        # leave the sign of $x alone (+1 => +PI/4, -1 => -PI/4)
3464e0680481Safresh1        $x->{_m} = $LIB->_div($x->{_m}, $LIB->_new(4));
3465e0680481Safresh1        return $x;
34669f11ffb7Safresh1    }
34679f11ffb7Safresh1
34689f11ffb7Safresh1    # This series is only valid if -1 < x < 1, so for other x we need to
34699f11ffb7Safresh1    # calculate PI/2 - atan(1/x):
34709f11ffb7Safresh1    my $pi = undef;
3471e0680481Safresh1    if ($x->bacmp($x->copy()->bone) >= 0) {
34729f11ffb7Safresh1        # calculate PI/2
34739f11ffb7Safresh1        $pi = $class->bpi($scale - 3);
3474b46d8ef2Safresh1        $pi->{_m} = $LIB->_div($pi->{_m}, $LIB->_new(2));
3475e0680481Safresh1        # calculate 1/$x:
3476e0680481Safresh1        my $x_copy = $x->copy();
3477e0680481Safresh1        # modify $x in place
3478e0680481Safresh1        $x = $x->bone();
3479e0680481Safresh1        $x = $x->bdiv($x_copy, $scale);
34809f11ffb7Safresh1    }
34819f11ffb7Safresh1
34829f11ffb7Safresh1    my $fmul = 1;
3483b46d8ef2Safresh1    foreach (0 .. int($scale / 20)) {
34849f11ffb7Safresh1        $fmul *= 2;
3485e0680481Safresh1        $x = $x->bdiv($x->copy()->bmul($x)->binc()->bsqrt($scale + 4)->binc(),
3486e0680481Safresh1                      $scale + 4);
34879f11ffb7Safresh1    }
34889f11ffb7Safresh1
34899f11ffb7Safresh1    # When user set globals, they would interfere with our calculation, so
34909f11ffb7Safresh1    # disable them and later re-enable them.
3491*3d61058aSafresh1
3492*3d61058aSafresh1    my $ab = $class -> accuracy();
3493*3d61058aSafresh1    my $pb = $class -> precision();
3494*3d61058aSafresh1    $class -> accuracy(undef);
3495*3d61058aSafresh1    $class -> precision(undef);
34969f11ffb7Safresh1
3497e0680481Safresh1    # Disabling upgrading and downgrading is no longer necessary to avoid an
3498e0680481Safresh1    # infinite recursion, but it avoids unnecessary upgrading and downgrading in
3499e0680481Safresh1    # the intermediate computations.
3500e0680481Safresh1
3501*3d61058aSafresh1    my $upg = $class -> upgrade();
3502*3d61058aSafresh1    my $dng = $class -> downgrade();
3503*3d61058aSafresh1    $class -> upgrade(undef);
3504*3d61058aSafresh1    $class -> downgrade(undef);
3505*3d61058aSafresh1
3506*3d61058aSafresh1    # We also need to disable any set A or P on $x (_find_round_parameters took
3507*3d61058aSafresh1    # them already into account), since these would interfere, too.
3508*3d61058aSafresh1
3509*3d61058aSafresh1    $x->{accuracy} = undef;
3510*3d61058aSafresh1    $x->{precision} = undef;
3511e0680481Safresh1
3512e0680481Safresh1    my $over = $x * $x;   # X ^ 2
3513e0680481Safresh1    my $x2 = $over->copy();  # X ^ 2; difference between terms
3514e0680481Safresh1    $over = $over->bmul($x);         # X ^ 3 as starting value
35159f11ffb7Safresh1    my $sign = 1;               # start with -=
35169f11ffb7Safresh1    my $below = $class->new(3);
35179f11ffb7Safresh1    my $two = $class->new(2);
3518*3d61058aSafresh1    $x->{accuracy} = undef;
3519*3d61058aSafresh1    $x->{precision} = undef;
35209f11ffb7Safresh1
35219f11ffb7Safresh1    my $limit = $class->new("1E-". ($scale-1));
35229f11ffb7Safresh1    #my $steps = 0;
35239f11ffb7Safresh1    while (1) {
35249f11ffb7Safresh1        # We calculate the next term, and add it to the last. When the next
35259f11ffb7Safresh1        # term is below our limit, it won't affect the outcome anymore, so we
35269f11ffb7Safresh1        # stop:
35279f11ffb7Safresh1        my $next = $over->copy()->bdiv($below, $scale);
35289f11ffb7Safresh1        last if $next->bacmp($limit) <= 0;
35299f11ffb7Safresh1
35309f11ffb7Safresh1        if ($sign == 0) {
3531e0680481Safresh1            $x = $x->badd($next);
35329f11ffb7Safresh1        } else {
3533e0680481Safresh1            $x = $x->bsub($next);
35349f11ffb7Safresh1        }
35359f11ffb7Safresh1        $sign = 1-$sign;        # alternatex
35369f11ffb7Safresh1        # calculate things for the next term
3537e0680481Safresh1        $over = $over->bmul($x2);    # $x*$x
3538e0680481Safresh1        $below = $below->badd($two);     # n += 2
35399f11ffb7Safresh1    }
3540e0680481Safresh1    $x = $x->bmul($fmul);
35419f11ffb7Safresh1
35429f11ffb7Safresh1    if (defined $pi) {
3543e0680481Safresh1        my $x_copy = $x->copy();
3544e0680481Safresh1        # modify $x in place
3545e0680481Safresh1        $x->{_m} = $pi->{_m};
3546e0680481Safresh1        $x->{_e} = $pi->{_e};
3547e0680481Safresh1        $x->{_es} = $pi->{_es};
3548e0680481Safresh1        # PI/2 - $x
3549e0680481Safresh1        $x = $x->bsub($x_copy);
35509f11ffb7Safresh1    }
35519f11ffb7Safresh1
35529f11ffb7Safresh1    # Shortcut to not run through _find_round_parameters again.
35539f11ffb7Safresh1    if (defined $params[0]) {
3554e0680481Safresh1        $x = $x->bround($params[0], $params[2]); # then round accordingly
35559f11ffb7Safresh1    } else {
3556e0680481Safresh1        $x = $x->bfround($params[1], $params[2]); # then round accordingly
35579f11ffb7Safresh1    }
35589f11ffb7Safresh1    if ($fallback) {
35599f11ffb7Safresh1        # Clear a/p after round, since user did not request it.
3560*3d61058aSafresh1        $x->{accuracy} = undef;
3561*3d61058aSafresh1        $x->{precision} = undef;
35629f11ffb7Safresh1    }
35639f11ffb7Safresh1
3564*3d61058aSafresh1    # Restore globals. We need to do it like this, because setting one
3565*3d61058aSafresh1    # undefines the other.
3566*3d61058aSafresh1
3567*3d61058aSafresh1    if (defined $ab) {
3568*3d61058aSafresh1        $class -> accuracy($ab);
3569*3d61058aSafresh1    } else {
3570*3d61058aSafresh1        $class -> precision($pb);
3571*3d61058aSafresh1    }
3572*3d61058aSafresh1
3573*3d61058aSafresh1    $class -> upgrade($upg);
3574*3d61058aSafresh1    $class -> downgrade($dng);
3575e0680481Safresh1
3576e0680481Safresh1    return $downgrade -> new($x -> bdstr(), @r)
3577e0680481Safresh1      if defined($downgrade) && ($x -> is_int() || $x -> is_inf());
3578e0680481Safresh1    $x;
35799f11ffb7Safresh1}
35809f11ffb7Safresh1
35819f11ffb7Safresh1sub batan2 {
35829f11ffb7Safresh1    # $y -> batan2($x) returns the arcus tangens of $y / $x.
35839f11ffb7Safresh1
35849f11ffb7Safresh1    # Set up parameters.
3585e0680481Safresh1    my ($class, $y, $x, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
3586e0680481Safresh1                            ? (ref($_[0]), @_)
3587e0680481Safresh1                            : objectify(2, @_);
35889f11ffb7Safresh1
35899f11ffb7Safresh1    # Quick exit if $y is read-only.
35909f11ffb7Safresh1    return $y if $y -> modify('batan2');
35919f11ffb7Safresh1
35929f11ffb7Safresh1    # Handle all NaN cases.
35939f11ffb7Safresh1    return $y -> bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
35949f11ffb7Safresh1
35959f11ffb7Safresh1    # We need to limit the accuracy to protect against overflow.
35969f11ffb7Safresh1    my $fallback = 0;
35979f11ffb7Safresh1    my ($scale, @params);
35989f11ffb7Safresh1    ($y, @params) = $y -> _find_round_parameters(@r);
35999f11ffb7Safresh1
36009f11ffb7Safresh1    # Error in _find_round_parameters?
36019f11ffb7Safresh1    return $y if $y->is_nan();
36029f11ffb7Safresh1
36039f11ffb7Safresh1    # No rounding at all, so must use fallback.
36049f11ffb7Safresh1    if (scalar @params == 0) {
36059f11ffb7Safresh1        # Simulate old behaviour
36069f11ffb7Safresh1        $params[0] = $class -> div_scale(); # and round to it as accuracy
36079f11ffb7Safresh1        $params[1] = undef;                 # disable P
36089f11ffb7Safresh1        $scale = $params[0] + 4; # at least four more for proper round
36099f11ffb7Safresh1        $params[2] = $r[2];      # round mode by caller or undef
36109f11ffb7Safresh1        $fallback = 1;           # to clear a/p afterwards
36119f11ffb7Safresh1    } else {
36129f11ffb7Safresh1        # The 4 below is empirical, and there might be cases where it is not
36139f11ffb7Safresh1        # enough ...
36149f11ffb7Safresh1        $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
36159f11ffb7Safresh1    }
36169f11ffb7Safresh1
36179f11ffb7Safresh1    if ($x -> is_inf("+")) {                          # x = inf
36189f11ffb7Safresh1        if ($y -> is_inf("+")) {                      #    y = inf
3619e0680481Safresh1            $y = $y -> bpi($scale) -> bmul("0.25");   #       pi/4
36209f11ffb7Safresh1        } elsif ($y -> is_inf("-")) {                 #    y = -inf
3621e0680481Safresh1            $y = $y -> bpi($scale) -> bmul("-0.25");  #       -pi/4
36229f11ffb7Safresh1        } else {                                      #    -inf < y < inf
36239f11ffb7Safresh1            return $y -> bzero(@r);                   #       0
36249f11ffb7Safresh1        }
36259f11ffb7Safresh1    } elsif ($x -> is_inf("-")) {                     # x = -inf
36269f11ffb7Safresh1        if ($y -> is_inf("+")) {                      #    y = inf
3627e0680481Safresh1            $y = $y -> bpi($scale) -> bmul("0.75");   #       3/4 pi
36289f11ffb7Safresh1        } elsif ($y -> is_inf("-")) {                 #    y = -inf
3629e0680481Safresh1            $y = $y -> bpi($scale) -> bmul("-0.75");  #       -3/4 pi
36309f11ffb7Safresh1        } elsif ($y >= 0) {                           #    y >= 0
3631e0680481Safresh1            $y = $y -> bpi($scale);                   #       pi
36329f11ffb7Safresh1        } else {                                      #    y < 0
3633e0680481Safresh1            $y = $y -> bpi($scale) -> bneg();         #       -pi
36349f11ffb7Safresh1        }
36359f11ffb7Safresh1    } elsif ($x > 0) {                                    # 0 < x < inf
36369f11ffb7Safresh1        if ($y -> is_inf("+")) {                          #    y = inf
3637e0680481Safresh1            $y = $y -> bpi($scale) -> bmul("0.5");        #       pi/2
36389f11ffb7Safresh1        } elsif ($y -> is_inf("-")) {                     #    y = -inf
3639e0680481Safresh1            $y = $y -> bpi($scale) -> bmul("-0.5");       #       -pi/2
36409f11ffb7Safresh1        } else {                                          #   -inf < y < inf
3641e0680481Safresh1            $y = $y -> bdiv($x, $scale) -> batan($scale); #       atan(y/x)
36429f11ffb7Safresh1        }
36439f11ffb7Safresh1    } elsif ($x < 0) {                                # -inf < x < 0
36449f11ffb7Safresh1        my $pi = $class -> bpi($scale);
36459f11ffb7Safresh1        if ($y >= 0) {                                #    y >= 0
3646e0680481Safresh1            $y = $y -> bdiv($x, $scale) -> batan()    #       atan(y/x) + pi
36479f11ffb7Safresh1               -> badd($pi);
36489f11ffb7Safresh1        } else {                                      #    y < 0
3649e0680481Safresh1            $y = $y -> bdiv($x, $scale) -> batan()    #       atan(y/x) - pi
36509f11ffb7Safresh1               -> bsub($pi);
36519f11ffb7Safresh1        }
36529f11ffb7Safresh1    } else {                                          # x = 0
36539f11ffb7Safresh1        if ($y > 0) {                                 #    y > 0
3654e0680481Safresh1            $y = $y -> bpi($scale) -> bmul("0.5");    #       pi/2
36559f11ffb7Safresh1        } elsif ($y < 0) {                            #    y < 0
3656e0680481Safresh1            $y = $y -> bpi($scale) -> bmul("-0.5");   #       -pi/2
36579f11ffb7Safresh1        } else {                                      #    y = 0
36589f11ffb7Safresh1            return $y -> bzero(@r);                   #       0
36599f11ffb7Safresh1        }
36609f11ffb7Safresh1    }
36619f11ffb7Safresh1
3662e0680481Safresh1    $y = $y -> round(@r);
36639f11ffb7Safresh1
36649f11ffb7Safresh1    if ($fallback) {
3665*3d61058aSafresh1        $y->{accuracy} = undef;
3666*3d61058aSafresh1        $y->{precision} = undef;
36679f11ffb7Safresh1    }
36689f11ffb7Safresh1
36699f11ffb7Safresh1    return $y;
36709f11ffb7Safresh1}
36719f11ffb7Safresh1
36729f11ffb7Safresh1sub bsqrt {
36739f11ffb7Safresh1    # calculate square root
3674e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
36759f11ffb7Safresh1
36769f11ffb7Safresh1    return $x if $x->modify('bsqrt');
36779f11ffb7Safresh1
3678e0680481Safresh1    # Handle trivial cases.
3679e0680481Safresh1
3680e0680481Safresh1    return $x -> bnan(@r)      if $x->is_nan();
3681e0680481Safresh1    return $x -> binf("+", @r) if $x->{sign} eq '+inf';
3682e0680481Safresh1    return $x -> round(@r)     if $x->is_zero() || $x->is_one();
3683e0680481Safresh1
3684e0680481Safresh1    # We don't support complex numbers.
3685e0680481Safresh1
3686e0680481Safresh1    if ($x -> is_neg()) {
3687e0680481Safresh1        return $upgrade -> bsqrt($x, @r) if defined($upgrade);
3688e0680481Safresh1        return $x -> bnan(@r);
3689e0680481Safresh1    }
36909f11ffb7Safresh1
36919f11ffb7Safresh1    # we need to limit the accuracy to protect against overflow
36929f11ffb7Safresh1    my $fallback = 0;
36939f11ffb7Safresh1    my (@params, $scale);
3694e0680481Safresh1    ($x, @params) = $x->_find_round_parameters(@r);
36959f11ffb7Safresh1
3696e0680481Safresh1    # error in _find_round_parameters?
3697e0680481Safresh1    return $x -> bnan(@r) if $x->is_nan();
36989f11ffb7Safresh1
36999f11ffb7Safresh1    # no rounding at all, so must use fallback
37009f11ffb7Safresh1    if (scalar @params == 0) {
37019f11ffb7Safresh1        # simulate old behaviour
37029f11ffb7Safresh1        $params[0] = $class->div_scale(); # and round to it as accuracy
37039f11ffb7Safresh1        $scale = $params[0]+4;            # at least four more for proper round
3704e0680481Safresh1        $params[2] = $r[2];               # round mode by caller or undef
37059f11ffb7Safresh1        $fallback = 1;                    # to clear a/p afterwards
37069f11ffb7Safresh1    } else {
37079f11ffb7Safresh1        # the 4 below is empirical, and there might be cases where it is not
37089f11ffb7Safresh1        # enough...
37099f11ffb7Safresh1        $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
37109f11ffb7Safresh1    }
37119f11ffb7Safresh1
3712*3d61058aSafresh1    # Shift the significand left or right to get the desired number of digits,
3713*3d61058aSafresh1    # which is 2*$scale with possibly one extra digit to ensure that the
3714*3d61058aSafresh1    # exponent is an even number.
3715e0680481Safresh1
3716*3d61058aSafresh1    my $l = $LIB -> _len($x->{_m});
3717*3d61058aSafresh1    my $n = 2 * $scale - $l;                    # how much should we shift?
3718*3d61058aSafresh1    $n++ if ($l % 2 xor $LIB -> _is_odd($x->{_e}));
3719*3d61058aSafresh1    my ($na, $ns) = $n < 0 ? (abs($n), "-") : ($n, "+");
3720*3d61058aSafresh1    $na = $LIB -> _new($na);
3721e0680481Safresh1
3722*3d61058aSafresh1    $x->{_m} = $ns eq "+" ? $LIB -> _lsft($x->{_m}, $na, 10)
3723*3d61058aSafresh1                          : $LIB -> _rsft($x->{_m}, $na, 10);
37249f11ffb7Safresh1
3725*3d61058aSafresh1    $x->{_m} = $LIB -> _sqrt($x->{_m});
37269f11ffb7Safresh1
3727*3d61058aSafresh1    # Adjust the exponent by the amount that we shifted the significand. The
3728*3d61058aSafresh1    # square root of the exponent is simply half of it: sqrt(10^(2*a)) = 10^a.
37299f11ffb7Safresh1
3730*3d61058aSafresh1    ($x->{_e}, $x->{_es}) = $LIB -> _ssub($x->{_e}, $x->{_es}, $na, $ns);
3731*3d61058aSafresh1    $x->{_e} = $LIB -> _div($x->{_e}, $LIB -> _new("2"));
37329f11ffb7Safresh1
3733*3d61058aSafresh1    # Normalize to get rid of any trailing zeros in the significand.
37349f11ffb7Safresh1
3735*3d61058aSafresh1    $x -> bnorm();
37369f11ffb7Safresh1
37379f11ffb7Safresh1    # shortcut to not run through _find_round_parameters again
37389f11ffb7Safresh1    if (defined $params[0]) {
3739e0680481Safresh1        $x = $x->bround($params[0], $params[2]); # then round accordingly
37409f11ffb7Safresh1    } else {
3741e0680481Safresh1        $x = $x->bfround($params[1], $params[2]); # then round accordingly
37429f11ffb7Safresh1    }
3743*3d61058aSafresh1
37449f11ffb7Safresh1    if ($fallback) {
37459f11ffb7Safresh1        # clear a/p after round, since user did not request it
3746*3d61058aSafresh1        $x->{accuracy} = undef;
3747*3d61058aSafresh1        $x->{precision} = undef;
37489f11ffb7Safresh1    }
3749e0680481Safresh1
3750*3d61058aSafresh1    return $downgrade -> new($x, @r)
3751*3d61058aSafresh1      if defined($downgrade) && $x -> is_int();
37529f11ffb7Safresh1    $x;
37539f11ffb7Safresh1}
37549f11ffb7Safresh1
37559f11ffb7Safresh1sub broot {
37569f11ffb7Safresh1    # calculate $y'th root of $x
37579f11ffb7Safresh1
37589f11ffb7Safresh1    # set up parameters
3759e0680481Safresh1    my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
3760e0680481Safresh1                            ? (ref($_[0]), @_)
3761e0680481Safresh1                            : objectify(2, @_);
37629f11ffb7Safresh1
37639f11ffb7Safresh1    return $x if $x->modify('broot');
37649f11ffb7Safresh1
3765e0680481Safresh1    # Handle trivial cases.
3766e0680481Safresh1
3767e0680481Safresh1    return $x -> bnan(@r) if $x->is_nan() || $y->is_nan();
3768e0680481Safresh1
3769e0680481Safresh1    if ($x -> is_neg()) {
3770e0680481Safresh1        # -27 ** (1/3) = -3
3771e0680481Safresh1        return $x -> broot($y -> copy() -> bneg(), @r) -> bneg()
3772e0680481Safresh1          if $x -> is_int() && $y -> is_int() && $y -> is_neg();
3773e0680481Safresh1        return $upgrade -> broot($x, $y, @r) if defined $upgrade;
3774e0680481Safresh1        return $x -> bnan(@r);
3775e0680481Safresh1    }
3776e0680481Safresh1
37779f11ffb7Safresh1    # NaN handling: $x ** 1/0, x or y NaN, or y inf/-inf or y == 0
37789f11ffb7Safresh1    return $x->bnan() if $x->{sign} !~ /^\+/ || $y->is_zero() ||
37799f11ffb7Safresh1      $y->{sign} !~ /^\+$/;
37809f11ffb7Safresh1
37819f11ffb7Safresh1    return $x if $x->is_zero() || $x->is_one() || $x->is_inf() || $y->is_one();
37829f11ffb7Safresh1
37839f11ffb7Safresh1    # we need to limit the accuracy to protect against overflow
37849f11ffb7Safresh1    my $fallback = 0;
37859f11ffb7Safresh1    my (@params, $scale);
3786e0680481Safresh1    ($x, @params) = $x->_find_round_parameters(@r);
37879f11ffb7Safresh1
37889f11ffb7Safresh1    return $x if $x->is_nan();  # error in _find_round_parameters?
37899f11ffb7Safresh1
37909f11ffb7Safresh1    # no rounding at all, so must use fallback
37919f11ffb7Safresh1    if (scalar @params == 0) {
37929f11ffb7Safresh1        # simulate old behaviour
37939f11ffb7Safresh1        $params[0] = $class->div_scale(); # and round to it as accuracy
37949f11ffb7Safresh1        $scale = $params[0]+4;            # at least four more for proper round
3795e0680481Safresh1        $params[2] = $r[2];               # round mode by caller or undef
37969f11ffb7Safresh1        $fallback = 1;                    # to clear a/p afterwards
37979f11ffb7Safresh1    } else {
37989f11ffb7Safresh1        # the 4 below is empirical, and there might be cases where it is not
37999f11ffb7Safresh1        # enough...
38009f11ffb7Safresh1        $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
38019f11ffb7Safresh1    }
38029f11ffb7Safresh1
3803*3d61058aSafresh1    # When user set globals, they would interfere with our calculation, so
3804*3d61058aSafresh1    # disable them and later re-enable them.
3805*3d61058aSafresh1
3806*3d61058aSafresh1    my $ab = $class -> accuracy();
3807*3d61058aSafresh1    my $pb = $class -> precision();
3808*3d61058aSafresh1    $class -> accuracy(undef);
3809*3d61058aSafresh1    $class -> precision(undef);
3810e0680481Safresh1
3811e0680481Safresh1    # Disabling upgrading and downgrading is no longer necessary to avoid an
3812e0680481Safresh1    # infinite recursion, but it avoids unnecessary upgrading and downgrading in
3813e0680481Safresh1    # the intermediate computations.
3814e0680481Safresh1
3815*3d61058aSafresh1    my $upg = $class -> upgrade();
3816*3d61058aSafresh1    my $dng = $class -> downgrade();
3817*3d61058aSafresh1    $class -> upgrade(undef);
3818*3d61058aSafresh1    $class -> downgrade(undef);
3819*3d61058aSafresh1
3820*3d61058aSafresh1    # We also need to disable any set A or P on $x (_find_round_parameters took
3821*3d61058aSafresh1    # them already into account), since these would interfere, too.
3822*3d61058aSafresh1
3823*3d61058aSafresh1    $x->{accuracy} = undef;
3824*3d61058aSafresh1    $x->{precision} = undef;
38259f11ffb7Safresh1
38269f11ffb7Safresh1    # remember sign and make $x positive, since -4 ** (1/2) => -2
38279f11ffb7Safresh1    my $sign = 0;
38289f11ffb7Safresh1    $sign = 1 if $x->{sign} eq '-';
38299f11ffb7Safresh1    $x->{sign} = '+';
38309f11ffb7Safresh1
38319f11ffb7Safresh1    my $is_two = 0;
38329f11ffb7Safresh1    if ($y->isa('Math::BigFloat')) {
3833e0680481Safresh1        $is_two = $y->{sign} eq '+' && $LIB->_is_two($y->{_m})
3834e0680481Safresh1                    && $LIB->_is_zero($y->{_e});
38359f11ffb7Safresh1    } else {
3836e0680481Safresh1        $is_two = $y == 2;
38379f11ffb7Safresh1    }
38389f11ffb7Safresh1
38399f11ffb7Safresh1    # normal square root if $y == 2:
38409f11ffb7Safresh1    if ($is_two) {
3841e0680481Safresh1        $x = $x->bsqrt($scale+4);
38429f11ffb7Safresh1    } elsif ($y->is_one('-')) {
38439f11ffb7Safresh1        # $x ** -1 => 1/$x
38449f11ffb7Safresh1        my $u = $class->bone()->bdiv($x, $scale);
38459f11ffb7Safresh1        # copy private parts over
38469f11ffb7Safresh1        $x->{_m} = $u->{_m};
38479f11ffb7Safresh1        $x->{_e} = $u->{_e};
38489f11ffb7Safresh1        $x->{_es} = $u->{_es};
38499f11ffb7Safresh1    } else {
38509f11ffb7Safresh1        # calculate the broot() as integer result first, and if it fits, return
38519f11ffb7Safresh1        # it rightaway (but only if $x and $y are integer):
38529f11ffb7Safresh1
38539f11ffb7Safresh1        my $done = 0;           # not yet
38549f11ffb7Safresh1        if ($y->is_int() && $x->is_int()) {
3855b46d8ef2Safresh1            my $i = $LIB->_copy($x->{_m});
3856b46d8ef2Safresh1            $i = $LIB->_lsft($i, $x->{_e}, 10) unless $LIB->_is_zero($x->{_e});
38579f11ffb7Safresh1            my $int = Math::BigInt->bzero();
38589f11ffb7Safresh1            $int->{value} = $i;
3859e0680481Safresh1            $int = $int->broot($y->as_number());
38609f11ffb7Safresh1            # if ($exact)
38619f11ffb7Safresh1            if ($int->copy()->bpow($y) == $x) {
38629f11ffb7Safresh1                # found result, return it
38639f11ffb7Safresh1                $x->{_m} = $int->{value};
3864b46d8ef2Safresh1                $x->{_e} = $LIB->_zero();
38659f11ffb7Safresh1                $x->{_es} = '+';
3866e0680481Safresh1                $x = $x->bnorm();
38679f11ffb7Safresh1                $done = 1;
38689f11ffb7Safresh1            }
38699f11ffb7Safresh1        }
38709f11ffb7Safresh1        if ($done == 0) {
38719f11ffb7Safresh1            my $u = $class->bone()->bdiv($y, $scale+4);
3872*3d61058aSafresh1            $u->{accuracy} = undef;
3873*3d61058aSafresh1            $u->{precision} = undef;
3874e0680481Safresh1            $x = $x->bpow($u, $scale+4);            # el cheapo
38759f11ffb7Safresh1        }
38769f11ffb7Safresh1    }
3877e0680481Safresh1    $x = $x->bneg() if $sign == 1;
38789f11ffb7Safresh1
38799f11ffb7Safresh1    # shortcut to not run through _find_round_parameters again
38809f11ffb7Safresh1    if (defined $params[0]) {
3881e0680481Safresh1        $x = $x->bround($params[0], $params[2]); # then round accordingly
38829f11ffb7Safresh1    } else {
3883e0680481Safresh1        $x = $x->bfround($params[1], $params[2]); # then round accordingly
38849f11ffb7Safresh1    }
38859f11ffb7Safresh1    if ($fallback) {
38869f11ffb7Safresh1        # clear a/p after round, since user did not request it
3887*3d61058aSafresh1        $x->{accuracy} = undef;
3888*3d61058aSafresh1        $x->{precision} = undef;
38899f11ffb7Safresh1    }
3890*3d61058aSafresh1
3891*3d61058aSafresh1    # Restore globals. We need to do it like this, because setting one
3892*3d61058aSafresh1    # undefines the other.
3893*3d61058aSafresh1
3894*3d61058aSafresh1    if (defined $ab) {
3895*3d61058aSafresh1        $class -> accuracy($ab);
3896*3d61058aSafresh1    } else {
3897*3d61058aSafresh1        $class -> precision($pb);
3898*3d61058aSafresh1    }
3899*3d61058aSafresh1
3900*3d61058aSafresh1    $class -> upgrade($upg);
3901*3d61058aSafresh1    $class -> downgrade($dng);
3902e0680481Safresh1
3903e0680481Safresh1    return $downgrade -> new($x -> bdstr(), @r)
3904e0680481Safresh1      if defined($downgrade) && ($x -> is_int() || $x -> is_inf());
39059f11ffb7Safresh1    $x;
39069f11ffb7Safresh1}
39079f11ffb7Safresh1
39089f11ffb7Safresh1sub bfac {
39099f11ffb7Safresh1    # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT
39109f11ffb7Safresh1    # compute factorial number, modifies first argument
39119f11ffb7Safresh1
39129f11ffb7Safresh1    # set up parameters
3913e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
39149f11ffb7Safresh1
39159f11ffb7Safresh1    # inf => inf
3916e0680481Safresh1    return $x if $x->modify('bfac');
39179f11ffb7Safresh1
3918e0680481Safresh1    return $x -> bnan(@r)      if $x->is_nan()  || $x->is_inf("-");
3919e0680481Safresh1    return $x -> binf("+", @r) if $x->is_inf("+");
3920e0680481Safresh1    return $x -> bone(@r)      if $x->is_zero() || $x->is_one();
3921e0680481Safresh1
3922e0680481Safresh1    if ($x -> is_neg() || !$x -> is_int()) {
3923e0680481Safresh1        return $upgrade -> bfac($x, @r) if defined($upgrade);
3924e0680481Safresh1        return $x -> bnan(@r);
3925e0680481Safresh1    }
39269f11ffb7Safresh1
3927b46d8ef2Safresh1    if (! $LIB->_is_zero($x->{_e})) {
3928b46d8ef2Safresh1        $x->{_m} = $LIB->_lsft($x->{_m}, $x->{_e}, 10); # change 12e1 to 120e0
3929b46d8ef2Safresh1        $x->{_e} = $LIB->_zero();           # normalize
39309f11ffb7Safresh1        $x->{_es} = '+';
39319f11ffb7Safresh1    }
3932b46d8ef2Safresh1    $x->{_m} = $LIB->_fac($x->{_m});       # calculate factorial
3933e0680481Safresh1
3934e0680481Safresh1    $x = $x->bnorm()->round(@r);     # norm again and round result
3935e0680481Safresh1
3936e0680481Safresh1    return $downgrade -> new($x -> bdstr(), @r) if defined($downgrade)
3937e0680481Safresh1      && ($x -> is_int() || $x -> is_inf());
3938e0680481Safresh1    $x;
39399f11ffb7Safresh1}
39409f11ffb7Safresh1
39419f11ffb7Safresh1sub bdfac {
39429f11ffb7Safresh1    # compute double factorial
39439f11ffb7Safresh1
39449f11ffb7Safresh1    # set up parameters
3945e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
39469f11ffb7Safresh1
3947e0680481Safresh1    return $x if $x->modify('bdfac');
39489f11ffb7Safresh1
3949e0680481Safresh1    return $x -> bnan(@r)      if $x->is_nan()  || $x->is_inf("-");
3950e0680481Safresh1    return $x -> binf("+", @r) if $x->is_inf("+");
3951e0680481Safresh1
3952e0680481Safresh1    if ($x <= -2 || !$x -> is_int()) {
3953e0680481Safresh1        return $upgrade -> bdfac($x, @r) if defined($upgrade);
3954e0680481Safresh1        return $x -> bnan(@r);
3955e0680481Safresh1    }
3956e0680481Safresh1
3957eac174f2Safresh1    return $x->bone() if $x <= 1;
39589f11ffb7Safresh1
3959b46d8ef2Safresh1    croak("bdfac() requires a newer version of the $LIB library.")
3960b46d8ef2Safresh1        unless $LIB->can('_dfac');
39619f11ffb7Safresh1
3962b46d8ef2Safresh1    if (! $LIB->_is_zero($x->{_e})) {
3963b46d8ef2Safresh1        $x->{_m} = $LIB->_lsft($x->{_m}, $x->{_e}, 10); # change 12e1 to 120e0
3964b46d8ef2Safresh1        $x->{_e} = $LIB->_zero();           # normalize
39659f11ffb7Safresh1        $x->{_es} = '+';
39669f11ffb7Safresh1    }
3967b46d8ef2Safresh1    $x->{_m} = $LIB->_dfac($x->{_m});       # calculate factorial
3968e0680481Safresh1
3969e0680481Safresh1    $x = $x->bnorm()->round(@r);     # norm again and round result
3970e0680481Safresh1
3971e0680481Safresh1    return $downgrade -> new($x -> bdstr(), @r)
3972e0680481Safresh1      if defined($downgrade) && $x -> is_int();
3973e0680481Safresh1    return $x;
39749f11ffb7Safresh1}
39759f11ffb7Safresh1
3976eac174f2Safresh1sub btfac {
3977eac174f2Safresh1    # compute triple factorial
3978eac174f2Safresh1
3979eac174f2Safresh1    # set up parameters
3980e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
3981eac174f2Safresh1
3982e0680481Safresh1    return $x if $x->modify('btfac');
3983eac174f2Safresh1
3984e0680481Safresh1    return $x -> bnan(@r)      if $x->is_nan()  || $x->is_inf("-");
3985e0680481Safresh1    return $x -> binf("+", @r) if $x->is_inf("+");
3986e0680481Safresh1
3987e0680481Safresh1    if ($x <= -3 || !$x -> is_int()) {
3988e0680481Safresh1        return $upgrade -> btfac($x, @r) if defined($upgrade);
3989e0680481Safresh1        return $x -> bnan(@r);
3990e0680481Safresh1    }
3991eac174f2Safresh1
3992eac174f2Safresh1    my $k = $class -> new("3");
3993e0680481Safresh1    return $x->bnan(@r) if $x <= -$k;
3994eac174f2Safresh1
3995eac174f2Safresh1    my $one = $class -> bone();
3996e0680481Safresh1    return $x->bone(@r) if $x <= $one;
3997eac174f2Safresh1
3998eac174f2Safresh1    my $f = $x -> copy();
3999eac174f2Safresh1    while ($f -> bsub($k) > $one) {
4000e0680481Safresh1        $x = $x -> bmul($f);
4001eac174f2Safresh1    }
4002e0680481Safresh1
4003e0680481Safresh1    $x = $x->round(@r);
4004e0680481Safresh1
4005e0680481Safresh1    return $downgrade -> new($x -> bdstr(), @r)
4006e0680481Safresh1      if defined($downgrade) && $x -> is_int();
4007e0680481Safresh1    return $x;
4008eac174f2Safresh1}
4009eac174f2Safresh1
4010eac174f2Safresh1sub bmfac {
4011e0680481Safresh1    my ($class, $x, $k, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
4012e0680481Safresh1                            ? (ref($_[0]), @_)
4013e0680481Safresh1                            : objectify(2, @_);
4014eac174f2Safresh1
4015e0680481Safresh1    return $x if $x->modify('bmfac');
4016eac174f2Safresh1
4017e0680481Safresh1    return $x -> bnan(@r) if $x->is_nan() || $x->is_inf("-") || !$k->is_pos();
4018e0680481Safresh1    return $x -> binf("+", @r) if $x->is_inf("+");
4019eac174f2Safresh1
4020e0680481Safresh1    if ($x <= -$k || !$x -> is_int() ||
4021e0680481Safresh1        ($k -> is_finite() && !$k -> is_int()))
4022e0680481Safresh1    {
4023e0680481Safresh1        return $upgrade -> bmfac($x, $k, @r) if defined($upgrade);
4024e0680481Safresh1        return $x -> bnan(@r);
4025e0680481Safresh1    }
4026eac174f2Safresh1
4027eac174f2Safresh1    my $one = $class -> bone();
4028e0680481Safresh1    return $x->bone(@r) if $x <= $one;
4029eac174f2Safresh1
4030eac174f2Safresh1    my $f = $x -> copy();
4031eac174f2Safresh1    while ($f -> bsub($k) > $one) {
4032e0680481Safresh1        $x = $x -> bmul($f);
4033eac174f2Safresh1    }
4034e0680481Safresh1
4035e0680481Safresh1    $x = $x->round(@r);
4036e0680481Safresh1
4037e0680481Safresh1    return $downgrade -> new($x -> bdstr(), @r)
4038e0680481Safresh1      if defined($downgrade) && $x -> is_int();
4039e0680481Safresh1    return $x;
4040eac174f2Safresh1}
4041eac174f2Safresh1
40429f11ffb7Safresh1sub blsft {
4043*3d61058aSafresh1    # shift left by $y in base $b, i.e., multiply by $b ** $y
40449f11ffb7Safresh1
40459f11ffb7Safresh1    # set up parameters
4046e0680481Safresh1    my ($class, $x, $y, $b, @r)
4047e0680481Safresh1      = ref($_[0]) && ref($_[0]) eq ref($_[1]) && ref($_[1]) eq ref($_[2])
4048e0680481Safresh1      ? (ref($_[0]), @_)
4049e0680481Safresh1      : objectify(2, @_);
40509f11ffb7Safresh1
40519f11ffb7Safresh1    return $x if $x -> modify('blsft');
4052e0680481Safresh1
4053e0680481Safresh1    return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan();
40549f11ffb7Safresh1
40559f11ffb7Safresh1    $b = 2 if !defined $b;
4056*3d61058aSafresh1    $b = $class -> new($b)
4057*3d61058aSafresh1      unless defined(blessed($b)) && $b -> isa(__PACKAGE__);
4058e0680481Safresh1    return $x -> bnan(@r) if $b -> is_nan();
40599f11ffb7Safresh1
4060e0680481Safresh1    # There needs to be more checking for special cases here. Fixme!
40619f11ffb7Safresh1
40629f11ffb7Safresh1    # shift by a negative amount?
40639f11ffb7Safresh1    return $x -> brsft($y -> copy() -> babs(), $b) if $y -> {sign} =~ /^-/;
40649f11ffb7Safresh1
4065e0680481Safresh1    $x = $x -> bmul($b -> bpow($y), $r[0], $r[1], $r[2], $y);
4066e0680481Safresh1
4067e0680481Safresh1    return $downgrade -> new($x -> bdstr(), @r) if defined($downgrade)
4068e0680481Safresh1      && ($x -> is_int() || $x -> is_inf() || $x -> is_nan());
4069e0680481Safresh1    return $x;
40709f11ffb7Safresh1}
40719f11ffb7Safresh1
40729f11ffb7Safresh1sub brsft {
4073*3d61058aSafresh1    # shift right by $y in base $b, i.e., divide by $b ** $y
40749f11ffb7Safresh1
40759f11ffb7Safresh1    # set up parameters
4076e0680481Safresh1    my ($class, $x, $y, $b, @r)
4077e0680481Safresh1      = ref($_[0]) && ref($_[0]) eq ref($_[1]) && ref($_[1]) eq ref($_[2])
4078e0680481Safresh1      ? (ref($_[0]), @_)
4079e0680481Safresh1      : objectify(2, @_);
40809f11ffb7Safresh1
40819f11ffb7Safresh1    return $x if $x -> modify('brsft');
4082e0680481Safresh1
4083e0680481Safresh1    return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan();
4084e0680481Safresh1
4085e0680481Safresh1    # There needs to be more checking for special cases here. Fixme!
40869f11ffb7Safresh1
40879f11ffb7Safresh1    $b = 2 if !defined $b;
4088*3d61058aSafresh1    $b = $class -> new($b)
4089*3d61058aSafresh1      unless defined(blessed($b)) && $b -> isa(__PACKAGE__);
4090e0680481Safresh1    return $x -> bnan(@r) if $b -> is_nan();
40919f11ffb7Safresh1
40929f11ffb7Safresh1    # shift by a negative amount?
40939f11ffb7Safresh1    return $x -> blsft($y -> copy() -> babs(), $b) if $y -> {sign} =~ /^-/;
40949f11ffb7Safresh1
4095e0680481Safresh1    # call bdiv()
4096e0680481Safresh1    $x = $x -> bdiv($b -> bpow($y), $r[0], $r[1], $r[2], $y);
4097e0680481Safresh1
4098e0680481Safresh1    return $downgrade -> new($x -> bdstr(), @r) if defined($downgrade)
4099e0680481Safresh1      && ($x -> is_int() || $x -> is_inf() || $x -> is_nan());
4100e0680481Safresh1    return $x;
41019f11ffb7Safresh1}
41029f11ffb7Safresh1
41039f11ffb7Safresh1###############################################################################
41049f11ffb7Safresh1# Bitwise methods
41059f11ffb7Safresh1###############################################################################
41069f11ffb7Safresh1
4107*3d61058aSafresh1# Bitwise left shift.
4108*3d61058aSafresh1
4109*3d61058aSafresh1sub bblsft {
4110*3d61058aSafresh1    # We don't call objectify(), because the bitwise methods should not
4111*3d61058aSafresh1    # upgrade/downgrade, even when upgrading/downgrading is enabled.
4112*3d61058aSafresh1
4113*3d61058aSafresh1    my ($class, $x, $y, @r) = ref($_[0]) ? (ref($_[0]), @_) : @_;
4114*3d61058aSafresh1
4115*3d61058aSafresh1    my $xint = Math::BigInt -> bblsft($x, $y, @r);
4116*3d61058aSafresh1
4117*3d61058aSafresh1    # Temporarily disable downgrading.
4118*3d61058aSafresh1
4119*3d61058aSafresh1    my $dng = $class -> downgrade();
4120*3d61058aSafresh1    $class -> downgrade(undef);
4121*3d61058aSafresh1
4122*3d61058aSafresh1    # convert to our class without downgrading.
4123*3d61058aSafresh1
4124*3d61058aSafresh1    my $xflt = $class -> new($xint);
4125*3d61058aSafresh1
4126*3d61058aSafresh1    # Reset downgrading.
4127*3d61058aSafresh1
4128*3d61058aSafresh1    $class -> downgrade($dng);
4129*3d61058aSafresh1
4130*3d61058aSafresh1    # If we are called as a class method, the first operand might not be an
4131*3d61058aSafresh1    # object of this class, so check.
4132*3d61058aSafresh1
4133*3d61058aSafresh1    if (defined(blessed($x)) && $x -> isa(__PACKAGE__)) {
4134*3d61058aSafresh1        $x -> {sign} = $xflt -> {sign};
4135*3d61058aSafresh1        $x -> {_m}   = $xflt -> {_m};
4136*3d61058aSafresh1        $x -> {_es}  = $xflt -> {_es};
4137*3d61058aSafresh1        $x -> {_e}   = $xflt -> {_e};
4138*3d61058aSafresh1    } else {
4139*3d61058aSafresh1        $x = $xflt;
4140*3d61058aSafresh1    }
4141*3d61058aSafresh1
4142*3d61058aSafresh1    # Now we might downgrade.
4143*3d61058aSafresh1
4144*3d61058aSafresh1    return $downgrade -> new($x) if defined($downgrade);
4145*3d61058aSafresh1    $x -> round(@r);
4146*3d61058aSafresh1}
4147*3d61058aSafresh1
4148*3d61058aSafresh1# Bitwise right shift.
4149*3d61058aSafresh1
4150*3d61058aSafresh1sub bbrsft {
4151*3d61058aSafresh1    # We don't call objectify(), because the bitwise methods should not
4152*3d61058aSafresh1    # upgrade/downgrade, even when upgrading/downgrading is enabled.
4153*3d61058aSafresh1
4154*3d61058aSafresh1    my ($class, $x, $y, @r) = ref($_[0]) ? (ref($_[0]), @_) : @_;
4155*3d61058aSafresh1
4156*3d61058aSafresh1    my $xint = Math::BigInt -> bbrsft($x, $y, @r);
4157*3d61058aSafresh1
4158*3d61058aSafresh1    # Temporarily disable downgrading.
4159*3d61058aSafresh1
4160*3d61058aSafresh1    my $dng = $class -> downgrade();
4161*3d61058aSafresh1    $class -> downgrade(undef);
4162*3d61058aSafresh1
4163*3d61058aSafresh1    # Convert to our class without downgrading.
4164*3d61058aSafresh1
4165*3d61058aSafresh1    my $xflt = $class -> new($xint);
4166*3d61058aSafresh1
4167*3d61058aSafresh1    # Reset downgrading.
4168*3d61058aSafresh1
4169*3d61058aSafresh1    $class -> downgrade($dng);
4170*3d61058aSafresh1
4171*3d61058aSafresh1    # If we are called as a class method, the first operand might not be an
4172*3d61058aSafresh1    # object of this class, so check.
4173*3d61058aSafresh1
4174*3d61058aSafresh1    if (defined(blessed($x)) && $x -> isa(__PACKAGE__)) {
4175*3d61058aSafresh1        $x -> {sign} = $xflt -> {sign};
4176*3d61058aSafresh1        $x -> {_m}   = $xflt -> {_m};
4177*3d61058aSafresh1        $x -> {_es}  = $xflt -> {_es};
4178*3d61058aSafresh1        $x -> {_e}   = $xflt -> {_e};
4179*3d61058aSafresh1    } else {
4180*3d61058aSafresh1        $x = $xflt;
4181*3d61058aSafresh1    }
4182*3d61058aSafresh1
4183*3d61058aSafresh1    # Now we might downgrade.
4184*3d61058aSafresh1
4185*3d61058aSafresh1    return $downgrade -> new($x) if defined($downgrade);
4186*3d61058aSafresh1    $x -> round(@r);
4187*3d61058aSafresh1}
4188*3d61058aSafresh1
41899f11ffb7Safresh1sub band {
4190e0680481Safresh1    my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
4191e0680481Safresh1                            ? (ref($_[0]), @_)
4192e0680481Safresh1                            : objectify(2, @_);
41939f11ffb7Safresh1
41949f11ffb7Safresh1    return if $x -> modify('band');
41959f11ffb7Safresh1
4196e0680481Safresh1    return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan();
41979f11ffb7Safresh1
4198*3d61058aSafresh1    my $xint = $x -> as_int();          # to Math::BigInt
4199*3d61058aSafresh1    my $yint = $y -> as_int();          # to Math::BigInt
42009f11ffb7Safresh1
4201*3d61058aSafresh1    $xint = $xint -> band($yint);
4202e0680481Safresh1
4203*3d61058aSafresh1    return $xint -> round(@r) if defined $downgrade;
4204*3d61058aSafresh1
4205*3d61058aSafresh1    my $xflt = $class -> new($xint);    # back to Math::BigFloat
4206*3d61058aSafresh1    $x -> {sign} = $xflt -> {sign};
4207*3d61058aSafresh1    $x -> {_m}   = $xflt -> {_m};
4208*3d61058aSafresh1    $x -> {_es}  = $xflt -> {_es};
4209*3d61058aSafresh1    $x -> {_e}   = $xflt -> {_e};
42109f11ffb7Safresh1
42119f11ffb7Safresh1    return $x -> round(@r);
42129f11ffb7Safresh1}
42139f11ffb7Safresh1
42149f11ffb7Safresh1sub bior {
4215e0680481Safresh1    my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
4216e0680481Safresh1                            ? (ref($_[0]), @_)
4217e0680481Safresh1                            : objectify(2, @_);
42189f11ffb7Safresh1
42199f11ffb7Safresh1    return if $x -> modify('bior');
42209f11ffb7Safresh1
4221e0680481Safresh1    return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan();
42229f11ffb7Safresh1
4223*3d61058aSafresh1    my $xint = $x -> as_int();          # to Math::BigInt
4224*3d61058aSafresh1    my $yint = $y -> as_int();          # to Math::BigInt
42259f11ffb7Safresh1
4226*3d61058aSafresh1    $xint = $xint -> bior($yint);
4227e0680481Safresh1
4228*3d61058aSafresh1    return $xint -> round(@r) if defined $downgrade;
4229*3d61058aSafresh1
4230*3d61058aSafresh1    my $xflt = $class -> new($xint);    # back to Math::BigFloat
4231*3d61058aSafresh1    $x -> {sign} = $xflt -> {sign};
4232*3d61058aSafresh1    $x -> {_m}   = $xflt -> {_m};
4233*3d61058aSafresh1    $x -> {_es}  = $xflt -> {_es};
4234*3d61058aSafresh1    $x -> {_e}   = $xflt -> {_e};
42359f11ffb7Safresh1
42369f11ffb7Safresh1    return $x -> round(@r);
42379f11ffb7Safresh1}
42389f11ffb7Safresh1
42399f11ffb7Safresh1sub bxor {
4240e0680481Safresh1    my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
4241e0680481Safresh1                            ? (ref($_[0]), @_)
4242e0680481Safresh1                            : objectify(2, @_);
42439f11ffb7Safresh1
42449f11ffb7Safresh1    return if $x -> modify('bxor');
42459f11ffb7Safresh1
4246e0680481Safresh1    return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan();
42479f11ffb7Safresh1
4248*3d61058aSafresh1    my $xint = $x -> as_int();          # to Math::BigInt
4249*3d61058aSafresh1    my $yint = $y -> as_int();          # to Math::BigInt
42509f11ffb7Safresh1
4251*3d61058aSafresh1    $xint = $xint -> bxor($yint);
4252e0680481Safresh1
4253*3d61058aSafresh1    return $xint -> round(@r) if defined $downgrade;
4254*3d61058aSafresh1
4255*3d61058aSafresh1    my $xflt = $class -> new($xint);    # back to Math::BigFloat
4256*3d61058aSafresh1    $x -> {sign} = $xflt -> {sign};
4257*3d61058aSafresh1    $x -> {_m}   = $xflt -> {_m};
4258*3d61058aSafresh1    $x -> {_es}  = $xflt -> {_es};
4259*3d61058aSafresh1    $x -> {_e}   = $xflt -> {_e};
42609f11ffb7Safresh1
42619f11ffb7Safresh1    return $x -> round(@r);
42629f11ffb7Safresh1}
42639f11ffb7Safresh1
42649f11ffb7Safresh1sub bnot {
4265e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
42669f11ffb7Safresh1
42679f11ffb7Safresh1    return if $x -> modify('bnot');
42689f11ffb7Safresh1
4269e0680481Safresh1    return $x -> bnan(@r) if $x -> is_nan();
42709f11ffb7Safresh1
4271*3d61058aSafresh1    my $xint = $x -> as_int();          # to Math::BigInt
4272*3d61058aSafresh1    $xint = $xint -> bnot();
42739f11ffb7Safresh1
4274*3d61058aSafresh1    return $xint -> round(@r) if defined $downgrade;
4275e0680481Safresh1
4276*3d61058aSafresh1    my $xflt = $class -> new($xint);    # back to Math::BigFloat
4277*3d61058aSafresh1    $x -> {sign} = $xflt -> {sign};
4278*3d61058aSafresh1    $x -> {_m}   = $xflt -> {_m};
4279*3d61058aSafresh1    $x -> {_es}  = $xflt -> {_es};
4280*3d61058aSafresh1    $x -> {_e}   = $xflt -> {_e};
42819f11ffb7Safresh1
42829f11ffb7Safresh1    return $x -> round(@r);
42839f11ffb7Safresh1}
42849f11ffb7Safresh1
42859f11ffb7Safresh1###############################################################################
42869f11ffb7Safresh1# Rounding methods
42879f11ffb7Safresh1###############################################################################
42889f11ffb7Safresh1
42899f11ffb7Safresh1sub bround {
42909f11ffb7Safresh1    # accuracy: preserve $N digits, and overwrite the rest with 0's
42919f11ffb7Safresh1
4292e0680481Safresh1    my ($class, $x, @a) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
4293e0680481Safresh1
4294e0680481Safresh1    if (($a[0] || 0) < 0) {
4295b46d8ef2Safresh1        croak('bround() needs positive accuracy');
42969f11ffb7Safresh1    }
42979f11ffb7Safresh1
4298eac174f2Safresh1    return $x if $x->modify('bround');
42999f11ffb7Safresh1
4300e0680481Safresh1    my ($scale, $mode) = $x->_scale_a(@a);
4301eac174f2Safresh1    if (!defined $scale) {         # no-op
4302eac174f2Safresh1        return $downgrade -> new($x) if defined($downgrade)
4303eac174f2Safresh1          && ($x->is_int() || $x->is_inf() || $x->is_nan());
4304eac174f2Safresh1        return $x;
4305eac174f2Safresh1    }
4306eac174f2Safresh1
4307*3d61058aSafresh1    # Scale is now either $x->{accuracy}, $accuracy, or the input argument. Test
4308eac174f2Safresh1    # whether $x already has lower accuracy, do nothing in this case but do
4309eac174f2Safresh1    # round if the accuracy is the same, since a math operation might want to
4310eac174f2Safresh1    # round a number with A=5 to 5 digits afterwards again
4311eac174f2Safresh1
4312*3d61058aSafresh1    if (defined $x->{accuracy} && $x->{accuracy} < $scale) {
4313eac174f2Safresh1        return $downgrade -> new($x) if defined($downgrade)
4314eac174f2Safresh1          && ($x->is_int() || $x->is_inf() || $x->is_nan());
4315eac174f2Safresh1        return $x;
4316eac174f2Safresh1    }
43179f11ffb7Safresh1
43189f11ffb7Safresh1    # scale < 0 makes no sense
43199f11ffb7Safresh1    # scale == 0 => keep all digits
43209f11ffb7Safresh1    # never round a +-inf, NaN
4321eac174f2Safresh1
4322eac174f2Safresh1    if ($scale <= 0 || $x->{sign} !~ /^[+-]$/) {
4323eac174f2Safresh1        return $downgrade -> new($x) if defined($downgrade)
4324eac174f2Safresh1          && ($x->is_int() || $x->is_inf() || $x->is_nan());
4325eac174f2Safresh1        return $x;
4326eac174f2Safresh1    }
43279f11ffb7Safresh1
43289f11ffb7Safresh1    # 1: never round a 0
43299f11ffb7Safresh1    # 2: if we should keep more digits than the mantissa has, do nothing
4330b46d8ef2Safresh1    if ($x->is_zero() || $LIB->_len($x->{_m}) <= $scale) {
4331*3d61058aSafresh1        $x->{accuracy} = $scale if !defined $x->{accuracy} || $x->{accuracy} > $scale;
4332eac174f2Safresh1        return $downgrade -> new($x) if defined($downgrade)
4333eac174f2Safresh1          && ($x->is_int() || $x->is_inf() || $x->is_nan());
43349f11ffb7Safresh1        return $x;
43359f11ffb7Safresh1    }
43369f11ffb7Safresh1
43379f11ffb7Safresh1    # pass sign to bround for '+inf' and '-inf' rounding modes
43389f11ffb7Safresh1    my $m = bless { sign => $x->{sign}, value => $x->{_m} }, 'Math::BigInt';
43399f11ffb7Safresh1
4340e0680481Safresh1    $m = $m->bround($scale, $mode);     # round mantissa
43419f11ffb7Safresh1    $x->{_m} = $m->{value};             # get our mantissa back
4342*3d61058aSafresh1    $x->{accuracy} = $scale;                  # remember rounding
4343*3d61058aSafresh1    $x->{precision} = undef;                   # and clear P
4344eac174f2Safresh1
4345eac174f2Safresh1    # bnorm() downgrades if necessary, so no need to check whether to downgrade.
43469f11ffb7Safresh1    $x->bnorm();                # del trailing zeros gen. by bround()
43479f11ffb7Safresh1}
43489f11ffb7Safresh1
43499f11ffb7Safresh1sub bfround {
43509f11ffb7Safresh1    # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
43519f11ffb7Safresh1    # $n == 0 means round to integer
43529f11ffb7Safresh1    # expects and returns normalized numbers!
4353e0680481Safresh1
4354e0680481Safresh1    my ($class, $x, @p) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
43559f11ffb7Safresh1
4356eac174f2Safresh1    return $x if $x->modify('bfround'); # no-op
43579f11ffb7Safresh1
4358e0680481Safresh1    my ($scale, $mode) = $x->_scale_p(@p);
4359eac174f2Safresh1    if (!defined $scale) {
4360eac174f2Safresh1        return $downgrade -> new($x) if defined($downgrade)
4361eac174f2Safresh1          && ($x->is_int() || $x->is_inf() || $x->is_nan());
43629f11ffb7Safresh1        return $x;
43639f11ffb7Safresh1    }
4364eac174f2Safresh1
4365eac174f2Safresh1    # never round a 0, +-inf, NaN
4366eac174f2Safresh1
4367eac174f2Safresh1    if ($x->is_zero()) {
4368*3d61058aSafresh1        $x->{precision} = $scale if !defined $x->{precision} || $x->{precision} < $scale; # -3 < -2
4369eac174f2Safresh1        return $downgrade -> new($x) if defined($downgrade)
4370eac174f2Safresh1          && ($x->is_int() || $x->is_inf() || $x->is_nan());
4371eac174f2Safresh1        return $x;
4372eac174f2Safresh1    }
4373eac174f2Safresh1
4374eac174f2Safresh1    if ($x->{sign} !~ /^[+-]$/) {
4375eac174f2Safresh1        return $downgrade -> new($x) if defined($downgrade)
4376eac174f2Safresh1          && ($x->is_int() || $x->is_inf() || $x->is_nan());
4377eac174f2Safresh1        return $x;
4378eac174f2Safresh1    }
43799f11ffb7Safresh1
43809f11ffb7Safresh1    # don't round if x already has lower precision
4381*3d61058aSafresh1    if (defined $x->{precision} && $x->{precision} < 0 && $scale < $x->{precision}) {
4382eac174f2Safresh1        return $downgrade -> new($x) if defined($downgrade)
4383eac174f2Safresh1          && ($x->is_int() || $x->is_inf() || $x->is_nan());
4384eac174f2Safresh1        return $x;
4385eac174f2Safresh1    }
43869f11ffb7Safresh1
4387*3d61058aSafresh1    $x->{precision} = $scale;          # remember round in any case
4388*3d61058aSafresh1    $x->{accuracy} = undef;           # and clear A
43899f11ffb7Safresh1    if ($scale < 0) {
43909f11ffb7Safresh1        # round right from the '.'
43919f11ffb7Safresh1
4392eac174f2Safresh1        if ($x->{_es} eq '+') { # e >= 0 => nothing to round
4393eac174f2Safresh1            return $downgrade -> new($x) if defined($downgrade)
4394eac174f2Safresh1              && ($x->is_int() || $x->is_inf() || $x->is_nan());
4395eac174f2Safresh1            return $x;
4396eac174f2Safresh1        }
43979f11ffb7Safresh1
43989f11ffb7Safresh1        $scale = -$scale;           # positive for simplicity
4399b46d8ef2Safresh1        my $len = $LIB->_len($x->{_m}); # length of mantissa
44009f11ffb7Safresh1
44019f11ffb7Safresh1        # the following poses a restriction on _e, but if _e is bigger than a
44029f11ffb7Safresh1        # scalar, you got other problems (memory etc) anyway
4403b46d8ef2Safresh1        my $dad = -(0+ ($x->{_es}.$LIB->_num($x->{_e}))); # digits after dot
44049f11ffb7Safresh1        my $zad = 0;                                      # zeros after dot
44059f11ffb7Safresh1        $zad = $dad - $len if (-$dad < -$len); # for 0.00..00xxx style
44069f11ffb7Safresh1
44079f11ffb7Safresh1        # print "scale $scale dad $dad zad $zad len $len\n";
44089f11ffb7Safresh1        # number  bsstr   len zad dad
44099f11ffb7Safresh1        # 0.123   123e-3    3   0 3
44109f11ffb7Safresh1        # 0.0123  123e-4    3   1 4
44119f11ffb7Safresh1        # 0.001   1e-3      1   2 3
44129f11ffb7Safresh1        # 1.23    123e-2    3   0 2
44139f11ffb7Safresh1        # 1.2345  12345e-4  5   0 4
44149f11ffb7Safresh1
44159f11ffb7Safresh1        # do not round after/right of the $dad
4416eac174f2Safresh1
4417eac174f2Safresh1        if ($scale > $dad) { # 0.123, scale >= 3 => exit
4418eac174f2Safresh1            return $downgrade -> new($x) if defined($downgrade)
4419eac174f2Safresh1              && ($x->is_int() || $x->is_inf() || $x->is_nan());
4420eac174f2Safresh1            return $x;
4421eac174f2Safresh1        }
44229f11ffb7Safresh1
44239f11ffb7Safresh1        # round to zero if rounding inside the $zad, but not for last zero like:
4424e0680481Safresh1        # 0.0065, scale -2, round last '0' with following '65' (scale == zad
4425e0680481Safresh1        # case)
4426eac174f2Safresh1        if ($scale < $zad) {
4427eac174f2Safresh1            return $downgrade -> new($x) if defined($downgrade)
4428eac174f2Safresh1              && ($x->is_int() || $x->is_inf() || $x->is_nan());
4429eac174f2Safresh1            return $x->bzero();
4430eac174f2Safresh1        }
4431eac174f2Safresh1
4432eac174f2Safresh1        if ($scale == $zad) {    # for 0.006, scale -3 and trunc
44339f11ffb7Safresh1            $scale = -$len;
44349f11ffb7Safresh1        } else {
44359f11ffb7Safresh1            # adjust round-point to be inside mantissa
44369f11ffb7Safresh1            if ($zad != 0) {
44379f11ffb7Safresh1                $scale = $scale-$zad;
44389f11ffb7Safresh1            } else {
44399f11ffb7Safresh1                my $dbd = $len - $dad;
44409f11ffb7Safresh1                $dbd = 0 if $dbd < 0; # digits before dot
44419f11ffb7Safresh1                $scale = $dbd+$scale;
44429f11ffb7Safresh1            }
44439f11ffb7Safresh1        }
44449f11ffb7Safresh1    } else {
44459f11ffb7Safresh1        # round left from the '.'
44469f11ffb7Safresh1
44479f11ffb7Safresh1        # 123 => 100 means length(123) = 3 - $scale (2) => 1
44489f11ffb7Safresh1
4449b46d8ef2Safresh1        my $dbt = $LIB->_len($x->{_m});
44509f11ffb7Safresh1        # digits before dot
4451b46d8ef2Safresh1        my $dbd = $dbt + ($x->{_es} . $LIB->_num($x->{_e}));
44529f11ffb7Safresh1        # should be the same, so treat it as this
44539f11ffb7Safresh1        $scale = 1 if $scale == 0;
44549f11ffb7Safresh1        # shortcut if already integer
4455eac174f2Safresh1        if ($scale == 1 && $dbt <= $dbd) {
4456eac174f2Safresh1            return $downgrade -> new($x) if defined($downgrade)
4457eac174f2Safresh1              && ($x->is_int() || $x->is_inf() || $x->is_nan());
4458eac174f2Safresh1            return $x;
4459eac174f2Safresh1        }
44609f11ffb7Safresh1        # maximum digits before dot
44619f11ffb7Safresh1        ++$dbd;
44629f11ffb7Safresh1
44639f11ffb7Safresh1        if ($scale > $dbd) {
44649f11ffb7Safresh1            # not enough digits before dot, so round to zero
4465eac174f2Safresh1            return $downgrade -> new($x) if defined($downgrade);
44669f11ffb7Safresh1            return $x->bzero;
44679f11ffb7Safresh1        } elsif ($scale == $dbd) {
44689f11ffb7Safresh1            # maximum
44699f11ffb7Safresh1            $scale = -$dbt;
44709f11ffb7Safresh1        } else {
44719f11ffb7Safresh1            $scale = $dbd - $scale;
44729f11ffb7Safresh1        }
44739f11ffb7Safresh1    }
4474eac174f2Safresh1
44759f11ffb7Safresh1    # pass sign to bround for rounding modes '+inf' and '-inf'
44769f11ffb7Safresh1    my $m = bless { sign => $x->{sign}, value => $x->{_m} }, 'Math::BigInt';
4477e0680481Safresh1    $m = $m->bround($scale, $mode);
44789f11ffb7Safresh1    $x->{_m} = $m->{value};     # get our mantissa back
4479eac174f2Safresh1
4480eac174f2Safresh1    # bnorm() downgrades if necessary, so no need to check whether to downgrade.
44819f11ffb7Safresh1    $x->bnorm();
44829f11ffb7Safresh1}
44839f11ffb7Safresh1
44849f11ffb7Safresh1sub bfloor {
44859f11ffb7Safresh1    # round towards minus infinity
4486eac174f2Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
44879f11ffb7Safresh1
44889f11ffb7Safresh1    return $x if $x->modify('bfloor');
44899f11ffb7Safresh1
4490e0680481Safresh1    return $x -> bnan(@r) if $x -> is_nan();
4491e0680481Safresh1
4492eac174f2Safresh1    if ($x->{sign} =~ /^[+-]$/) {
4493eac174f2Safresh1        # if $x has digits after dot, remove them
44949f11ffb7Safresh1        if ($x->{_es} eq '-') {
4495eac174f2Safresh1            $x->{_m} = $LIB->_rsft($x->{_m}, $x->{_e}, 10);
4496eac174f2Safresh1            $x->{_e} = $LIB->_zero();
4497eac174f2Safresh1            $x->{_es} = '+';
4498eac174f2Safresh1            # increment if negative
4499eac174f2Safresh1            $x->{_m} = $LIB->_inc($x->{_m}) if $x->{sign} eq '-';
45009f11ffb7Safresh1        }
4501e0680481Safresh1        $x = $x->round(@r);
4502eac174f2Safresh1    }
4503e0680481Safresh1    return $downgrade -> new($x -> bdstr(), @r) if defined($downgrade);
4504eac174f2Safresh1    return $x;
45059f11ffb7Safresh1}
45069f11ffb7Safresh1
45079f11ffb7Safresh1sub bceil {
45089f11ffb7Safresh1    # round towards plus infinity
4509eac174f2Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
45109f11ffb7Safresh1
45119f11ffb7Safresh1    return $x if $x->modify('bceil');
45129f11ffb7Safresh1
4513e0680481Safresh1    return $x -> bnan(@r) if $x -> is_nan();
4514e0680481Safresh1
4515eac174f2Safresh1    # if $x has digits after dot, remove them
4516eac174f2Safresh1    if ($x->{sign} =~ /^[+-]$/) {
45179f11ffb7Safresh1        if ($x->{_es} eq '-') {
4518eac174f2Safresh1            $x->{_m} = $LIB->_rsft($x->{_m}, $x->{_e}, 10);
4519eac174f2Safresh1            $x->{_e} = $LIB->_zero();
4520eac174f2Safresh1            $x->{_es} = '+';
45219f11ffb7Safresh1            if ($x->{sign} eq '+') {
4522b46d8ef2Safresh1                $x->{_m} = $LIB->_inc($x->{_m});        # increment if positive
45239f11ffb7Safresh1            } else {
4524b46d8ef2Safresh1                $x->{sign} = '+' if $LIB->_is_zero($x->{_m});   # avoid -0
45259f11ffb7Safresh1            }
45269f11ffb7Safresh1        }
4527e0680481Safresh1        $x = $x->round(@r);
4528eac174f2Safresh1    }
4529eac174f2Safresh1
4530e0680481Safresh1    return $downgrade -> new($x -> bdstr(), @r) if defined($downgrade);
4531eac174f2Safresh1    return $x;
45329f11ffb7Safresh1}
45339f11ffb7Safresh1
45349f11ffb7Safresh1sub bint {
45359f11ffb7Safresh1    # round towards zero
4536eac174f2Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
45379f11ffb7Safresh1
45389f11ffb7Safresh1    return $x if $x->modify('bint');
45399f11ffb7Safresh1
4540e0680481Safresh1    return $x -> bnan(@r) if $x -> is_nan();
4541e0680481Safresh1
4542eac174f2Safresh1    if ($x->{sign} =~ /^[+-]$/) {
45439f11ffb7Safresh1        # if $x has digits after the decimal point
45449f11ffb7Safresh1        if ($x->{_es} eq '-') {
4545e0680481Safresh1            $x->{_m} = $LIB->_rsft($x->{_m}, $x->{_e}, 10); # remove frac part
4546b46d8ef2Safresh1            $x->{_e} = $LIB->_zero();                       # truncate/normalize
45479f11ffb7Safresh1            $x->{_es} = '+';                                # abs e
4548b46d8ef2Safresh1            $x->{sign} = '+' if $LIB->_is_zero($x->{_m});   # avoid -0
45499f11ffb7Safresh1        }
4550e0680481Safresh1        $x = $x->round(@r);
4551eac174f2Safresh1    }
4552eac174f2Safresh1
4553e0680481Safresh1    return $downgrade -> new($x -> bdstr(), @r) if defined($downgrade);
4554eac174f2Safresh1    return $x;
45559f11ffb7Safresh1}
45569f11ffb7Safresh1
45579f11ffb7Safresh1###############################################################################
45589f11ffb7Safresh1# Other mathematical methods
45599f11ffb7Safresh1###############################################################################
45609f11ffb7Safresh1
45619f11ffb7Safresh1sub bgcd {
45629f11ffb7Safresh1    # (BINT or num_str, BINT or num_str) return BINT
45639f11ffb7Safresh1    # does not modify arguments, but returns new object
45649f11ffb7Safresh1
4565e0680481Safresh1    # Class::method(...) -> Class->method(...)
4566e0680481Safresh1    unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
4567e0680481Safresh1                   $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
4568e0680481Safresh1    {
4569e0680481Safresh1        #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
4570e0680481Safresh1        #  " use is as a method instead";
4571e0680481Safresh1        unshift @_, __PACKAGE__;
4572e0680481Safresh1    }
45739f11ffb7Safresh1
45749f11ffb7Safresh1    my ($class, @args) = objectify(0, @_);
45759f11ffb7Safresh1
45769f11ffb7Safresh1    my $x = shift @args;
4577*3d61058aSafresh1    $x = defined(blessed($x)) && $x -> isa(__PACKAGE__) ? $x -> copy()
4578*3d61058aSafresh1                                                        : $class -> new($x);
45799f11ffb7Safresh1    return $class->bnan() unless $x -> is_int();
45809f11ffb7Safresh1
45819f11ffb7Safresh1    while (@args) {
45829f11ffb7Safresh1        my $y = shift @args;
4583*3d61058aSafresh1        $y = $class->new($y)
4584*3d61058aSafresh1          unless defined(blessed($y)) && $y -> isa(__PACKAGE__);
45859f11ffb7Safresh1        return $class->bnan() unless $y -> is_int();
45869f11ffb7Safresh1
45879f11ffb7Safresh1        # greatest common divisor
45889f11ffb7Safresh1        while (! $y->is_zero()) {
45899f11ffb7Safresh1            ($x, $y) = ($y->copy(), $x->copy()->bmod($y));
45909f11ffb7Safresh1        }
45919f11ffb7Safresh1
45929f11ffb7Safresh1        last if $x -> is_one();
45939f11ffb7Safresh1    }
4594e0680481Safresh1    $x = $x -> babs();
4595e0680481Safresh1
4596e0680481Safresh1    return $downgrade -> new($x)
4597e0680481Safresh1      if defined $downgrade && $x->is_int();
4598e0680481Safresh1    return $x;
45999f11ffb7Safresh1}
46009f11ffb7Safresh1
46019f11ffb7Safresh1sub blcm {
46029f11ffb7Safresh1    # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT
46039f11ffb7Safresh1    # does not modify arguments, but returns new object
46049f11ffb7Safresh1    # Least Common Multiple
46059f11ffb7Safresh1
4606e0680481Safresh1    # Class::method(...) -> Class->method(...)
4607e0680481Safresh1    unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
4608e0680481Safresh1                   $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
4609e0680481Safresh1    {
4610e0680481Safresh1        #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
4611e0680481Safresh1        #  " use is as a method instead";
4612e0680481Safresh1        unshift @_, __PACKAGE__;
4613e0680481Safresh1    }
46149f11ffb7Safresh1
46159f11ffb7Safresh1    my ($class, @args) = objectify(0, @_);
46169f11ffb7Safresh1
46179f11ffb7Safresh1    my $x = shift @args;
4618*3d61058aSafresh1    $x = defined(blessed($x)) && $x -> isa(__PACKAGE__) ? $x -> copy()
4619*3d61058aSafresh1                                                        : $class -> new($x);
46209f11ffb7Safresh1    return $class->bnan() if $x->{sign} !~ /^[+-]$/;    # x NaN?
46219f11ffb7Safresh1
46229f11ffb7Safresh1    while (@args) {
46239f11ffb7Safresh1        my $y = shift @args;
4624*3d61058aSafresh1        $y = $class -> new($y)
4625*3d61058aSafresh1          unless defined(blessed($y)) && $y -> isa(__PACKAGE__);
46269f11ffb7Safresh1        return $x->bnan() unless $y -> is_int();
46279f11ffb7Safresh1        my $gcd = $x -> bgcd($y);
4628e0680481Safresh1        $x = $x -> bdiv($gcd) -> bmul($y);
46299f11ffb7Safresh1    }
46309f11ffb7Safresh1
4631e0680481Safresh1    $x = $x -> babs();
4632e0680481Safresh1
4633e0680481Safresh1    return $downgrade -> new($x)
4634e0680481Safresh1      if defined $downgrade && $x->is_int();
4635e0680481Safresh1    return $x;
46369f11ffb7Safresh1}
46379f11ffb7Safresh1
46389f11ffb7Safresh1###############################################################################
46399f11ffb7Safresh1# Object property methods
46409f11ffb7Safresh1###############################################################################
46419f11ffb7Safresh1
46429f11ffb7Safresh1sub length {
4643e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
4644e0680481Safresh1
4645e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
46469f11ffb7Safresh1
4647b46d8ef2Safresh1    return 1 if $LIB->_is_zero($x->{_m});
46489f11ffb7Safresh1
4649b46d8ef2Safresh1    my $len = $LIB->_len($x->{_m});
4650b46d8ef2Safresh1    $len += $LIB->_num($x->{_e}) if $x->{_es} eq '+';
46519f11ffb7Safresh1    if (wantarray()) {
46529f11ffb7Safresh1        my $t = 0;
4653b46d8ef2Safresh1        $t = $LIB->_num($x->{_e}) if $x->{_es} eq '-';
46549f11ffb7Safresh1        return ($len, $t);
46559f11ffb7Safresh1    }
46569f11ffb7Safresh1    $len;
46579f11ffb7Safresh1}
46589f11ffb7Safresh1
46599f11ffb7Safresh1sub mantissa {
46609f11ffb7Safresh1    # return a copy of the mantissa
4661e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
4662e0680481Safresh1
4663e0680481Safresh1    # The following line causes a lot of noise in the test suits for
4664e0680481Safresh1    # the Math-BigRat and bignum distributions. Fixme!
4665e0680481Safresh1    #carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
4666e0680481Safresh1
4667e0680481Safresh1    return $x -> bnan(@r) if $x -> is_nan();
46689f11ffb7Safresh1
46699f11ffb7Safresh1    if ($x->{sign} !~ /^[+-]$/) {
46709f11ffb7Safresh1        my $s = $x->{sign};
467156d68f1eSafresh1        $s =~ s/^\+//;
46729f11ffb7Safresh1        return Math::BigInt->new($s, undef, undef); # -inf, +inf => +inf
46739f11ffb7Safresh1    }
4674b46d8ef2Safresh1    my $m = Math::BigInt->new($LIB->_str($x->{_m}), undef, undef);
4675e0680481Safresh1    $m = $m->bneg() if $x->{sign} eq '-';
46769f11ffb7Safresh1    $m;
46779f11ffb7Safresh1}
46789f11ffb7Safresh1
46799f11ffb7Safresh1sub exponent {
46809f11ffb7Safresh1    # return a copy of the exponent
4681e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
4682e0680481Safresh1
4683e0680481Safresh1    # The following line causes a lot of noise in the test suits for
4684e0680481Safresh1    # the Math-BigRat and bignum distributions. Fixme!
4685e0680481Safresh1    #carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
4686e0680481Safresh1
4687e0680481Safresh1    return $x -> bnan(@r) if $x -> is_nan();
46889f11ffb7Safresh1
46899f11ffb7Safresh1    if ($x->{sign} !~ /^[+-]$/) {
46909f11ffb7Safresh1        my $s = $x->{sign};
46919f11ffb7Safresh1        $s =~ s/^[+-]//;
46929f11ffb7Safresh1        return Math::BigInt->new($s, undef, undef); # -inf, +inf => +inf
46939f11ffb7Safresh1    }
4694b46d8ef2Safresh1    Math::BigInt->new($x->{_es} . $LIB->_str($x->{_e}), undef, undef);
46959f11ffb7Safresh1}
46969f11ffb7Safresh1
46979f11ffb7Safresh1sub parts {
46989f11ffb7Safresh1    # return a copy of both the exponent and the mantissa
4699e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
4700e0680481Safresh1
4701e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
47029f11ffb7Safresh1
47039f11ffb7Safresh1    if ($x->{sign} !~ /^[+-]$/) {
47049f11ffb7Safresh1        my $s = $x->{sign};
470556d68f1eSafresh1        $s =~ s/^\+//;
47069f11ffb7Safresh1        my $se = $s;
470756d68f1eSafresh1        $se =~ s/^-//;
4708e0680481Safresh1        # +inf => inf and -inf, +inf => inf
4709e0680481Safresh1        return ($class->new($s), $class->new($se));
47109f11ffb7Safresh1    }
47119f11ffb7Safresh1    my $m = Math::BigInt->bzero();
4712b46d8ef2Safresh1    $m->{value} = $LIB->_copy($x->{_m});
4713e0680481Safresh1    $m = $m->bneg() if $x->{sign} eq '-';
4714b46d8ef2Safresh1    ($m, Math::BigInt->new($x->{_es} . $LIB->_num($x->{_e})));
47159f11ffb7Safresh1}
47169f11ffb7Safresh1
4717e0680481Safresh1# Parts used for scientific notation with significand/mantissa and exponent as
4718e0680481Safresh1# integers. E.g., "12345.6789" is returned as "123456789" (mantissa) and "-4"
4719e0680481Safresh1# (exponent).
47209f11ffb7Safresh1
4721e0680481Safresh1sub sparts {
4722e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
4723e0680481Safresh1
4724e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
47259f11ffb7Safresh1
47269f11ffb7Safresh1    # Not-a-number.
47279f11ffb7Safresh1
4728e0680481Safresh1    if ($x -> is_nan()) {
4729e0680481Safresh1        my $mant = $class -> bnan();            # mantissa
47309f11ffb7Safresh1        return $mant unless wantarray;          # scalar context
47319f11ffb7Safresh1        my $expo = $class -> bnan();            # exponent
47329f11ffb7Safresh1        return ($mant, $expo);                  # list context
47339f11ffb7Safresh1    }
47349f11ffb7Safresh1
47359f11ffb7Safresh1    # Infinity.
47369f11ffb7Safresh1
4737e0680481Safresh1    if ($x -> is_inf()) {
4738e0680481Safresh1        my $mant = $class -> binf($x->{sign});  # mantissa
47399f11ffb7Safresh1        return $mant unless wantarray;          # scalar context
47409f11ffb7Safresh1        my $expo = $class -> binf('+');         # exponent
47419f11ffb7Safresh1        return ($mant, $expo);                  # list context
47429f11ffb7Safresh1    }
47439f11ffb7Safresh1
47449f11ffb7Safresh1    # Finite number.
47459f11ffb7Safresh1
4746*3d61058aSafresh1    my $mant = $class -> new($x);
4747e0680481Safresh1    $mant->{_es} = '+';
4748e0680481Safresh1    $mant->{_e}  = $LIB->_zero();
4749e0680481Safresh1    $mant = $downgrade -> new($mant) if defined $downgrade;
47509f11ffb7Safresh1    return $mant unless wantarray;
47519f11ffb7Safresh1
4752*3d61058aSafresh1    my $expo = $class -> new($x -> {_es} . $LIB->_str($x -> {_e}));
4753e0680481Safresh1    $expo = $downgrade -> new($expo) if defined $downgrade;
47549f11ffb7Safresh1    return ($mant, $expo);
47559f11ffb7Safresh1}
47569f11ffb7Safresh1
4757e0680481Safresh1# Parts used for normalized notation with significand/mantissa as either 0 or a
4758e0680481Safresh1# number in the semi-open interval [1,10). E.g., "12345.6789" is returned as
4759e0680481Safresh1# "1.23456789" and "4".
4760e0680481Safresh1
47619f11ffb7Safresh1sub nparts {
4762e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
47639f11ffb7Safresh1
4764e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
47659f11ffb7Safresh1
4766e0680481Safresh1    # Not-a-number and Infinity.
47679f11ffb7Safresh1
4768e0680481Safresh1    return $x -> sparts() if $x -> is_nan() || $x -> is_inf();
47699f11ffb7Safresh1
47709f11ffb7Safresh1    # Finite number.
47719f11ffb7Safresh1
4772e0680481Safresh1    my ($mant, $expo) = $x -> sparts();
47739f11ffb7Safresh1
47749f11ffb7Safresh1    if ($mant -> bcmp(0)) {
47759f11ffb7Safresh1        my ($ndigtot, $ndigfrac) = $mant -> length();
47769f11ffb7Safresh1        my $expo10adj = $ndigtot - $ndigfrac - 1;
47779f11ffb7Safresh1
4778e0680481Safresh1        if ($expo10adj > 0) {          # if mantissa is not an integer
4779e0680481Safresh1            $mant = $mant -> brsft($expo10adj, 10);
47809f11ffb7Safresh1            return $mant unless wantarray;
4781e0680481Safresh1            $expo = $expo -> badd($expo10adj);
47829f11ffb7Safresh1            return ($mant, $expo);
47839f11ffb7Safresh1        }
47849f11ffb7Safresh1    }
47859f11ffb7Safresh1
47869f11ffb7Safresh1    return $mant unless wantarray;
47879f11ffb7Safresh1    return ($mant, $expo);
47889f11ffb7Safresh1}
47899f11ffb7Safresh1
4790e0680481Safresh1# Parts used for engineering notation with significand/mantissa as either 0 or a
4791e0680481Safresh1# number in the semi-open interval [1,1000) and the exponent is a multiple of 3.
4792e0680481Safresh1# E.g., "12345.6789" is returned as "12.3456789" and "3".
4793e0680481Safresh1
47949f11ffb7Safresh1sub eparts {
4795e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
47969f11ffb7Safresh1
4797e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
47989f11ffb7Safresh1
47999f11ffb7Safresh1    # Not-a-number and Infinity.
48009f11ffb7Safresh1
4801e0680481Safresh1    return $x -> sparts() if $x -> is_nan() || $x -> is_inf();
48029f11ffb7Safresh1
48039f11ffb7Safresh1    # Finite number.
48049f11ffb7Safresh1
4805e0680481Safresh1    my ($mant, $expo) = $x -> nparts();
48069f11ffb7Safresh1
48079f11ffb7Safresh1    my $c = $expo -> copy() -> bmod(3);
4808e0680481Safresh1    $mant = $mant -> blsft($c, 10);
48099f11ffb7Safresh1    return $mant unless wantarray;
48109f11ffb7Safresh1
4811e0680481Safresh1    $expo = $expo -> bsub($c);
48129f11ffb7Safresh1    return ($mant, $expo);
48139f11ffb7Safresh1}
48149f11ffb7Safresh1
4815e0680481Safresh1# Parts used for decimal notation, e.g., "12345.6789" is returned as "12345"
4816e0680481Safresh1# (integer part) and "0.6789" (fraction part).
4817e0680481Safresh1
48189f11ffb7Safresh1sub dparts {
4819e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
48209f11ffb7Safresh1
4821e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
48229f11ffb7Safresh1
4823e0680481Safresh1    # Not-a-number.
48249f11ffb7Safresh1
4825e0680481Safresh1    if ($x -> is_nan()) {
4826e0680481Safresh1        my $int = $class -> bnan();
4827e0680481Safresh1        return $int unless wantarray;
4828e0680481Safresh1        my $frc = $class -> bzero();    # or NaN?
4829e0680481Safresh1        return ($int, $frc);
4830e0680481Safresh1    }
4831e0680481Safresh1
4832e0680481Safresh1    # Infinity.
4833e0680481Safresh1
4834e0680481Safresh1    if ($x -> is_inf()) {
4835e0680481Safresh1        my $int = $class -> binf($x->{sign});
48369f11ffb7Safresh1        return $int unless wantarray;
48379f11ffb7Safresh1        my $frc = $class -> bzero();
48389f11ffb7Safresh1        return ($int, $frc);
48399f11ffb7Safresh1    }
48409f11ffb7Safresh1
4841e0680481Safresh1    # Finite number.
48429f11ffb7Safresh1
4843e0680481Safresh1    my $int = $x -> copy();
4844e0680481Safresh1    my $frc;
48459f11ffb7Safresh1
4846e0680481Safresh1    # If the input is an integer.
4847e0680481Safresh1
4848e0680481Safresh1    if ($int->{_es} eq '+') {
4849e0680481Safresh1        $frc = $class -> bzero();
4850e0680481Safresh1    }
4851e0680481Safresh1
4852e0680481Safresh1    # If the input has a fraction part
4853e0680481Safresh1
4854e0680481Safresh1    else {
4855b46d8ef2Safresh1        $int->{_m} = $LIB -> _rsft($int->{_m}, $int->{_e}, 10);
4856b46d8ef2Safresh1        $int->{_e} = $LIB -> _zero();
48579f11ffb7Safresh1        $int->{_es} = '+';
4858b46d8ef2Safresh1        $int->{sign} = '+' if $LIB->_is_zero($int->{_m});   # avoid -0
48599f11ffb7Safresh1        return $int unless wantarray;
4860e0680481Safresh1        $frc = $x -> copy() -> bsub($int);
48619f11ffb7Safresh1        return ($int, $frc);
48629f11ffb7Safresh1    }
48639f11ffb7Safresh1
4864e0680481Safresh1    $int = $downgrade -> new($int) if defined $downgrade;
48659f11ffb7Safresh1    return $int unless wantarray;
4866e0680481Safresh1    return $int, $frc;
48679f11ffb7Safresh1}
48689f11ffb7Safresh1
4869e0680481Safresh1# Fractional parts with the numerator and denominator as integers. E.g.,
4870e0680481Safresh1# "123.4375" is returned as "1975" and "16".
4871e0680481Safresh1
4872eac174f2Safresh1sub fparts {
4873e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
4874eac174f2Safresh1
4875e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
4876eac174f2Safresh1
4877e0680481Safresh1    # NaN => NaN/NaN
4878eac174f2Safresh1
4879e0680481Safresh1    if ($x -> is_nan()) {
4880e0680481Safresh1        return $class -> bnan() unless wantarray;
4881e0680481Safresh1        return $class -> bnan(), $class -> bnan();
4882eac174f2Safresh1    }
4883eac174f2Safresh1
4884e0680481Safresh1    # ±Inf => ±Inf/1
4885e0680481Safresh1
4886e0680481Safresh1    if ($x -> is_inf()) {
4887e0680481Safresh1        my $numer = $class -> binf($x->{sign});
4888e0680481Safresh1        return $numer unless wantarray;
4889e0680481Safresh1        my $denom = $class -> bone();
4890e0680481Safresh1        return $numer, $denom;
4891eac174f2Safresh1    }
4892eac174f2Safresh1
4893e0680481Safresh1    # Finite number.
4894e0680481Safresh1
4895e0680481Safresh1    # If we get here, we know that the output is an integer.
4896e0680481Safresh1
4897e0680481Safresh1    $class = $downgrade if defined $downgrade;
4898e0680481Safresh1
4899e0680481Safresh1    my @flt_parts = ($x->{sign}, $x->{_m}, $x->{_es}, $x->{_e});
4900e0680481Safresh1    my @rat_parts = $class -> _flt_lib_parts_to_rat_lib_parts(@flt_parts);
4901e0680481Safresh1    my $num = $class -> new($LIB -> _str($rat_parts[1]));
4902e0680481Safresh1    my $den = $class -> new($LIB -> _str($rat_parts[2]));
4903e0680481Safresh1    $num = $num -> bneg() if $rat_parts[0] eq "-";
4904e0680481Safresh1    return $num unless wantarray;
4905e0680481Safresh1    return $num, $den;
4906eac174f2Safresh1}
4907e0680481Safresh1
4908e0680481Safresh1# Given "123.4375", returns "1975", since "123.4375" is "1975/16".
4909eac174f2Safresh1
4910eac174f2Safresh1sub numerator {
4911e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
4912eac174f2Safresh1
4913e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
4914eac174f2Safresh1
4915eac174f2Safresh1    return $class -> bnan()             if $x -> is_nan();
4916eac174f2Safresh1    return $class -> binf($x -> sign()) if $x -> is_inf();
4917eac174f2Safresh1    return $class -> bzero()            if $x -> is_zero();
4918eac174f2Safresh1
4919e0680481Safresh1    # If we get here, we know that the output is an integer.
4920e0680481Safresh1
4921e0680481Safresh1    $class = $downgrade if defined $downgrade;
4922e0680481Safresh1
4923eac174f2Safresh1    if ($x -> {_es} eq '-') {                   # exponent < 0
4924eac174f2Safresh1        my $numer_lib = $LIB -> _copy($x -> {_m});
4925eac174f2Safresh1        my $denom_lib = $LIB -> _1ex($x -> {_e});
4926eac174f2Safresh1        my $gcd_lib = $LIB -> _gcd($LIB -> _copy($numer_lib), $denom_lib);
4927eac174f2Safresh1        $numer_lib = $LIB -> _div($numer_lib, $gcd_lib);
4928eac174f2Safresh1        return $class -> new($x -> {sign} . $LIB -> _str($numer_lib));
4929eac174f2Safresh1    }
4930eac174f2Safresh1
4931eac174f2Safresh1    elsif (! $LIB -> _is_zero($x -> {_e})) {    # exponent > 0
4932eac174f2Safresh1        my $numer_lib = $LIB -> _copy($x -> {_m});
4933eac174f2Safresh1        $numer_lib = $LIB -> _lsft($numer_lib, $x -> {_e}, 10);
4934eac174f2Safresh1        return $class -> new($x -> {sign} . $LIB -> _str($numer_lib));
4935eac174f2Safresh1    }
4936eac174f2Safresh1
4937eac174f2Safresh1    else {                                      # exponent = 0
4938eac174f2Safresh1        return $class -> new($x -> {sign} . $LIB -> _str($x -> {_m}));
4939eac174f2Safresh1    }
4940eac174f2Safresh1}
4941eac174f2Safresh1
4942e0680481Safresh1# Given "123.4375", returns "16", since "123.4375" is "1975/16".
4943eac174f2Safresh1
4944e0680481Safresh1sub denominator {
4945e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
4946e0680481Safresh1
4947e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
4948eac174f2Safresh1
4949eac174f2Safresh1    return $class -> bnan() if $x -> is_nan();
4950eac174f2Safresh1
4951e0680481Safresh1    # If we get here, we know that the output is an integer.
4952e0680481Safresh1
4953e0680481Safresh1    $class = $downgrade if defined $downgrade;
4954e0680481Safresh1
4955eac174f2Safresh1    if ($x -> {_es} eq '-') {                   # exponent < 0
4956eac174f2Safresh1        my $numer_lib = $LIB -> _copy($x -> {_m});
4957eac174f2Safresh1        my $denom_lib = $LIB -> _1ex($x -> {_e});
4958eac174f2Safresh1        my $gcd_lib = $LIB -> _gcd($LIB -> _copy($numer_lib), $denom_lib);
4959eac174f2Safresh1        $denom_lib = $LIB -> _div($denom_lib, $gcd_lib);
4960eac174f2Safresh1        return $class -> new($LIB -> _str($denom_lib));
4961eac174f2Safresh1    }
4962eac174f2Safresh1
4963eac174f2Safresh1    else {                                      # exponent >= 0
4964eac174f2Safresh1        return $class -> bone();
4965eac174f2Safresh1    }
4966eac174f2Safresh1}
4967eac174f2Safresh1
49689f11ffb7Safresh1###############################################################################
49699f11ffb7Safresh1# String conversion methods
49709f11ffb7Safresh1###############################################################################
49719f11ffb7Safresh1
49729f11ffb7Safresh1sub bstr {
49739f11ffb7Safresh1    # (ref to BFLOAT or num_str) return num_str
49749f11ffb7Safresh1    # Convert number from internal format to (non-scientific) string format.
49759f11ffb7Safresh1    # internal format is always normalized (no leading zeros, "-0" => "+0")
4976e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
49779f11ffb7Safresh1
4978e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
4979e0680481Safresh1
4980e0680481Safresh1    # Inf and NaN
4981e0680481Safresh1
4982e0680481Safresh1    if ($x->{sign} ne '+' && $x->{sign} ne '-') {
49839f11ffb7Safresh1        return $x->{sign} unless $x->{sign} eq '+inf';  # -inf, NaN
49849f11ffb7Safresh1        return 'inf';                                   # +inf
49859f11ffb7Safresh1    }
49869f11ffb7Safresh1
4987e0680481Safresh1    # Finite number
4988e0680481Safresh1
49899f11ffb7Safresh1    my $es = '0';
49909f11ffb7Safresh1    my $len = 1;
49919f11ffb7Safresh1    my $cad = 0;
49929f11ffb7Safresh1    my $dot = '.';
49939f11ffb7Safresh1
49949f11ffb7Safresh1    # $x is zero?
4995b46d8ef2Safresh1    my $not_zero = !($x->{sign} eq '+' && $LIB->_is_zero($x->{_m}));
49969f11ffb7Safresh1    if ($not_zero) {
4997b46d8ef2Safresh1        $es = $LIB->_str($x->{_m});
49989f11ffb7Safresh1        $len = CORE::length($es);
4999b46d8ef2Safresh1        my $e = $LIB->_num($x->{_e});
50009f11ffb7Safresh1        $e = -$e if $x->{_es} eq '-';
50019f11ffb7Safresh1        if ($e < 0) {
50029f11ffb7Safresh1            $dot = '';
50039f11ffb7Safresh1            # if _e is bigger than a scalar, the following will blow your memory
50049f11ffb7Safresh1            if ($e <= -$len) {
50059f11ffb7Safresh1                my $r = abs($e) - $len;
50069f11ffb7Safresh1                $es = '0.'. ('0' x $r) . $es;
50079f11ffb7Safresh1                $cad = -($len+$r);
50089f11ffb7Safresh1            } else {
50099f11ffb7Safresh1                substr($es, $e, 0) = '.';
5010b46d8ef2Safresh1                $cad = $LIB->_num($x->{_e});
50119f11ffb7Safresh1                $cad = -$cad if $x->{_es} eq '-';
50129f11ffb7Safresh1            }
50139f11ffb7Safresh1        } elsif ($e > 0) {
50149f11ffb7Safresh1            # expand with zeros
50159f11ffb7Safresh1            $es .= '0' x $e;
50169f11ffb7Safresh1            $len += $e;
50179f11ffb7Safresh1            $cad = 0;
50189f11ffb7Safresh1        }
50199f11ffb7Safresh1    }                           # if not zero
50209f11ffb7Safresh1
50219f11ffb7Safresh1    $es = '-'.$es if $x->{sign} eq '-';
50229f11ffb7Safresh1    # if set accuracy or precision, pad with zeros on the right side
5023*3d61058aSafresh1    if ((defined $x->{accuracy}) && ($not_zero)) {
50249f11ffb7Safresh1        # 123400 => 6, 0.1234 => 4, 0.001234 => 4
5025*3d61058aSafresh1        my $zeros = $x->{accuracy} - $cad; # cad == 0 => 12340
5026*3d61058aSafresh1        $zeros = $x->{accuracy} - $len if $cad != $len;
50279f11ffb7Safresh1        $es .= $dot.'0' x $zeros if $zeros > 0;
5028*3d61058aSafresh1    } elsif ((($x->{precision} || 0) < 0)) {
50299f11ffb7Safresh1        # 123400 => 6, 0.1234 => 4, 0.001234 => 6
5030*3d61058aSafresh1        my $zeros = -$x->{precision} + $cad;
50319f11ffb7Safresh1        $es .= $dot.'0' x $zeros if $zeros > 0;
50329f11ffb7Safresh1    }
50339f11ffb7Safresh1    $es;
50349f11ffb7Safresh1}
50359f11ffb7Safresh1
5036e0680481Safresh1# Decimal notation, e.g., "12345.6789" (no exponent).
50379f11ffb7Safresh1
50389f11ffb7Safresh1sub bdstr {
5039e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
5040e0680481Safresh1
5041e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
5042e0680481Safresh1
5043e0680481Safresh1    # Inf and NaN
50449f11ffb7Safresh1
50459f11ffb7Safresh1    if ($x->{sign} ne '+' && $x->{sign} ne '-') {
50469f11ffb7Safresh1        return $x->{sign} unless $x->{sign} eq '+inf';  # -inf, NaN
50479f11ffb7Safresh1        return 'inf';                                   # +inf
50489f11ffb7Safresh1    }
50499f11ffb7Safresh1
5050e0680481Safresh1    # Upgrade?
5051e0680481Safresh1
5052e0680481Safresh1    return $upgrade -> bdstr($x, @r)
5053*3d61058aSafresh1      if defined($upgrade) && !$x -> isa(__PACKAGE__);
5054e0680481Safresh1
5055e0680481Safresh1    # Finite number
5056e0680481Safresh1
5057b46d8ef2Safresh1    my $mant = $LIB->_str($x->{_m});
5058e0680481Safresh1    my $esgn = $x->{_es};
5059e0680481Safresh1    my $eabs = $LIB -> _num($x->{_e});
5060e0680481Safresh1
5061e0680481Safresh1    my $uintmax = ~0;
50629f11ffb7Safresh1
50639f11ffb7Safresh1    my $str = $mant;
5064e0680481Safresh1    if ($esgn eq '+') {
5065e0680481Safresh1
5066e0680481Safresh1        croak("The absolute value of the exponent is too large")
5067e0680481Safresh1          if $eabs > $uintmax;
5068e0680481Safresh1
5069e0680481Safresh1        $str .= "0" x $eabs;
5070e0680481Safresh1
50719f11ffb7Safresh1    } else {
5072e0680481Safresh1        my $mlen = CORE::length($mant);
5073e0680481Safresh1        my $c = $mlen - $eabs;
5074e0680481Safresh1
5075e0680481Safresh1        my $intmax = ($uintmax - 1) / 2;
5076e0680481Safresh1        croak("The absolute value of the exponent is too large")
5077e0680481Safresh1          if (1 - $c) > $intmax;
5078e0680481Safresh1
50799f11ffb7Safresh1        $str = "0" x (1 - $c) . $str if $c <= 0;
5080e0680481Safresh1        substr($str, -$eabs, 0) = '.';
50819f11ffb7Safresh1    }
50829f11ffb7Safresh1
5083e0680481Safresh1    return $x->{sign} eq '-' ? '-' . $str : $str;
50849f11ffb7Safresh1}
50859f11ffb7Safresh1
5086e0680481Safresh1# Scientific notation with significand/mantissa and exponent as integers, e.g.,
5087e0680481Safresh1# "12345.6789" is written as "123456789e-4".
50889f11ffb7Safresh1
50899f11ffb7Safresh1sub bsstr {
5090e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
5091e0680481Safresh1
5092e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
5093e0680481Safresh1
5094e0680481Safresh1    # Inf and NaN
50959f11ffb7Safresh1
50969f11ffb7Safresh1    if ($x->{sign} ne '+' && $x->{sign} ne '-') {
50979f11ffb7Safresh1        return $x->{sign} unless $x->{sign} eq '+inf';  # -inf, NaN
50989f11ffb7Safresh1        return 'inf';                                   # +inf
50999f11ffb7Safresh1    }
51009f11ffb7Safresh1
5101e0680481Safresh1    # Upgrade?
5102e0680481Safresh1
5103e0680481Safresh1    return $upgrade -> bsstr($x, @r)
5104*3d61058aSafresh1      if defined($upgrade) && !$x -> isa(__PACKAGE__);
5105e0680481Safresh1
5106e0680481Safresh1    # Finite number
5107e0680481Safresh1
5108e0680481Safresh1    ($x->{sign} eq '-' ? '-' : '') . $LIB->_str($x->{_m})
5109e0680481Safresh1      . 'e' . $x->{_es} . $LIB->_str($x->{_e});
51109f11ffb7Safresh1}
51119f11ffb7Safresh1
51129f11ffb7Safresh1# Normalized notation, e.g., "12345.6789" is written as "1.23456789e+4".
51139f11ffb7Safresh1
51149f11ffb7Safresh1sub bnstr {
5115e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
5116e0680481Safresh1
5117e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
5118e0680481Safresh1
5119e0680481Safresh1    # Inf and NaN
51209f11ffb7Safresh1
51219f11ffb7Safresh1    if ($x->{sign} ne '+' && $x->{sign} ne '-') {
51229f11ffb7Safresh1        return $x->{sign} unless $x->{sign} eq '+inf';  # -inf, NaN
51239f11ffb7Safresh1        return 'inf';                                   # +inf
51249f11ffb7Safresh1    }
51259f11ffb7Safresh1
5126e0680481Safresh1    # Upgrade?
51279f11ffb7Safresh1
5128e0680481Safresh1    return $upgrade -> bnstr($x, @r)
5129*3d61058aSafresh1      if defined($upgrade) && !$x -> isa(__PACKAGE__);
51309f11ffb7Safresh1
5131e0680481Safresh1    # Finite number
5132e0680481Safresh1
5133e0680481Safresh1    my $str = $x->{sign} eq '-' ? '-' : '';
5134e0680481Safresh1
5135e0680481Safresh1    # Get the mantissa and the length of the mantissa.
5136e0680481Safresh1
5137e0680481Safresh1    my $mant = $LIB->_str($x->{_m});
5138e0680481Safresh1    my $mantlen = CORE::length($mant);
5139e0680481Safresh1
5140e0680481Safresh1    if ($mantlen == 1) {
5141e0680481Safresh1
5142e0680481Safresh1        # Not decimal point when the mantissa has length one, i.e., return the
5143e0680481Safresh1        # number 2 as the string "2", not "2.".
5144e0680481Safresh1
5145e0680481Safresh1        $str .= $mant . 'e' . $x->{_es} . $LIB->_str($x->{_e});
5146e0680481Safresh1
5147e0680481Safresh1    } else {
5148e0680481Safresh1
5149e0680481Safresh1        # Compute new exponent where the original exponent is adjusted by the
5150e0680481Safresh1        # length of the mantissa minus one (because the decimal point is after
5151e0680481Safresh1        # one digit).
5152e0680481Safresh1
5153e0680481Safresh1        my ($eabs, $esgn) = $LIB -> _sadd($LIB -> _copy($x->{_e}), $x->{_es},
5154e0680481Safresh1                                      $LIB -> _new($mantlen - 1), "+");
5155e0680481Safresh1        substr $mant, 1, 0, ".";
5156e0680481Safresh1        $str .= $mant . 'e' . $esgn . $LIB->_str($eabs);
5157e0680481Safresh1
5158e0680481Safresh1    }
5159e0680481Safresh1
5160e0680481Safresh1    return $str;
51619f11ffb7Safresh1}
51629f11ffb7Safresh1
51639f11ffb7Safresh1# Engineering notation, e.g., "12345.6789" is written as "12.3456789e+3".
51649f11ffb7Safresh1
51659f11ffb7Safresh1sub bestr {
5166e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
5167e0680481Safresh1
5168e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
5169e0680481Safresh1
5170e0680481Safresh1    # Inf and NaN
51719f11ffb7Safresh1
51729f11ffb7Safresh1    if ($x->{sign} ne '+' && $x->{sign} ne '-') {
51739f11ffb7Safresh1        return $x->{sign} unless $x->{sign} eq '+inf';  # -inf, NaN
51749f11ffb7Safresh1        return 'inf';                                   # +inf
51759f11ffb7Safresh1    }
51769f11ffb7Safresh1
5177e0680481Safresh1    # Upgrade?
51789f11ffb7Safresh1
5179e0680481Safresh1    return $upgrade -> bestr($x, @r)
5180*3d61058aSafresh1      if defined($upgrade) && !$x -> isa(__PACKAGE__);
51819f11ffb7Safresh1
5182e0680481Safresh1    # Finite number
5183e0680481Safresh1
5184e0680481Safresh1    my $str = $x->{sign} eq '-' ? '-' : '';
5185e0680481Safresh1
5186e0680481Safresh1    # Get the mantissa, the length of the mantissa, and adjust the exponent by
5187e0680481Safresh1    # the length of the mantissa minus 1 (because the dot is after one digit).
5188e0680481Safresh1
5189e0680481Safresh1    my $mant = $LIB->_str($x->{_m});
5190e0680481Safresh1    my $mantlen = CORE::length($mant);
5191e0680481Safresh1    my ($eabs, $esgn) = $LIB -> _sadd($LIB -> _copy($x->{_e}), $x->{_es},
5192e0680481Safresh1                                  $LIB -> _new($mantlen - 1), "+");
5193e0680481Safresh1
5194e0680481Safresh1    my $dotpos = 1;
5195e0680481Safresh1    my $mod = $LIB -> _mod($LIB -> _copy($eabs), $LIB -> _new("3"));
5196e0680481Safresh1    unless ($LIB -> _is_zero($mod)) {
5197e0680481Safresh1        if ($esgn eq '+') {
5198e0680481Safresh1            $eabs = $LIB -> _sub($eabs, $mod);
5199e0680481Safresh1            $dotpos += $LIB -> _num($mod);
5200e0680481Safresh1        } else {
5201e0680481Safresh1            my $delta = $LIB -> _sub($LIB -> _new("3"), $mod);
5202e0680481Safresh1            $eabs = $LIB -> _add($eabs, $delta);
5203e0680481Safresh1            $dotpos += $LIB -> _num($delta);
5204e0680481Safresh1        }
5205e0680481Safresh1    }
5206e0680481Safresh1
5207e0680481Safresh1    if ($dotpos < $mantlen) {
5208e0680481Safresh1        substr $mant, $dotpos, 0, ".";
5209e0680481Safresh1    } elsif ($dotpos > $mantlen) {
5210e0680481Safresh1        $mant .= "0" x ($dotpos - $mantlen);
5211e0680481Safresh1    }
5212e0680481Safresh1
5213e0680481Safresh1    $str .= $mant . 'e' . $esgn . $LIB->_str($eabs);
5214e0680481Safresh1
5215e0680481Safresh1    return $str;
5216e0680481Safresh1}
5217e0680481Safresh1
5218e0680481Safresh1# Fractional notation, e.g., "123.4375" is written as "1975/16".
5219e0680481Safresh1
5220e0680481Safresh1sub bfstr {
5221e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
5222e0680481Safresh1
5223e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
5224e0680481Safresh1
5225e0680481Safresh1    # Inf and NaN
5226e0680481Safresh1
5227e0680481Safresh1    if ($x->{sign} ne '+' && $x->{sign} ne '-') {
5228e0680481Safresh1        return $x->{sign} unless $x->{sign} eq '+inf';  # -inf, NaN
5229e0680481Safresh1        return 'inf';                                   # +inf
5230e0680481Safresh1    }
5231e0680481Safresh1
5232e0680481Safresh1    # Upgrade?
5233e0680481Safresh1
5234e0680481Safresh1    return $upgrade -> bfstr($x, @r)
5235*3d61058aSafresh1      if defined($upgrade) && !$x -> isa(__PACKAGE__);
5236e0680481Safresh1
5237e0680481Safresh1    # Finite number
5238e0680481Safresh1
5239e0680481Safresh1    my $str = $x->{sign} eq '-' ? '-' : '';
5240e0680481Safresh1
5241e0680481Safresh1    if ($x->{_es} eq '+') {
5242e0680481Safresh1        $str .= $LIB -> _str($x->{_m}) . ("0" x $LIB -> _num($x->{_e}));
5243e0680481Safresh1    } else {
5244e0680481Safresh1        my @flt_parts = ($x->{sign}, $x->{_m}, $x->{_es}, $x->{_e});
5245e0680481Safresh1        my @rat_parts = $class -> _flt_lib_parts_to_rat_lib_parts(@flt_parts);
5246e0680481Safresh1        $str = $LIB -> _str($rat_parts[1]) . "/" . $LIB -> _str($rat_parts[2]);
5247e0680481Safresh1        $str = "-" . $str if $rat_parts[0] eq "-";
5248e0680481Safresh1    }
5249e0680481Safresh1
5250e0680481Safresh1    return $str;
52519f11ffb7Safresh1}
52529f11ffb7Safresh1
52539f11ffb7Safresh1sub to_hex {
52549f11ffb7Safresh1    # return number as hexadecimal string (only for integers defined)
5255e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
52569f11ffb7Safresh1
5257e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
52589f11ffb7Safresh1
5259e0680481Safresh1    # Inf and NaN
5260e0680481Safresh1
5261e0680481Safresh1    if ($x->{sign} ne '+' && $x->{sign} ne '-') {
5262e0680481Safresh1        return $x->{sign} unless $x->{sign} eq '+inf';  # -inf, NaN
5263e0680481Safresh1        return 'inf';                                   # +inf
5264e0680481Safresh1    }
5265e0680481Safresh1
5266e0680481Safresh1    # Upgrade?
5267e0680481Safresh1
5268e0680481Safresh1    return $upgrade -> to_hex($x, @r)
5269*3d61058aSafresh1      if defined($upgrade) && !$x -> isa(__PACKAGE__);
5270e0680481Safresh1
5271e0680481Safresh1    # Finite number
5272e0680481Safresh1
52739f11ffb7Safresh1    return '0' if $x->is_zero();
52749f11ffb7Safresh1
52759f11ffb7Safresh1    return $nan if $x->{_es} ne '+';    # how to do 1e-1 in hex?
52769f11ffb7Safresh1
5277b46d8ef2Safresh1    my $z = $LIB->_copy($x->{_m});
5278b46d8ef2Safresh1    if (! $LIB->_is_zero($x->{_e})) {   # > 0
5279b46d8ef2Safresh1        $z = $LIB->_lsft($z, $x->{_e}, 10);
52809f11ffb7Safresh1    }
5281b46d8ef2Safresh1    my $str = $LIB->_to_hex($z);
52829f11ffb7Safresh1    return $x->{sign} eq '-' ? "-$str" : $str;
52839f11ffb7Safresh1}
52849f11ffb7Safresh1
52859f11ffb7Safresh1sub to_oct {
52869f11ffb7Safresh1    # return number as octal digit string (only for integers defined)
5287e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
52889f11ffb7Safresh1
5289e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
52909f11ffb7Safresh1
5291e0680481Safresh1    # Inf and NaN
5292e0680481Safresh1
5293e0680481Safresh1    if ($x->{sign} ne '+' && $x->{sign} ne '-') {
5294e0680481Safresh1        return $x->{sign} unless $x->{sign} eq '+inf';  # -inf, NaN
5295e0680481Safresh1        return 'inf';                                   # +inf
5296e0680481Safresh1    }
5297e0680481Safresh1
5298e0680481Safresh1    # Upgrade?
5299e0680481Safresh1
5300*3d61058aSafresh1    return $upgrade -> to_oct($x, @r)
5301*3d61058aSafresh1      if defined($upgrade) && !$x -> isa(__PACKAGE__);
5302e0680481Safresh1
5303e0680481Safresh1    # Finite number
5304e0680481Safresh1
53059f11ffb7Safresh1    return '0' if $x->is_zero();
53069f11ffb7Safresh1
53079f11ffb7Safresh1    return $nan if $x->{_es} ne '+';    # how to do 1e-1 in octal?
53089f11ffb7Safresh1
5309b46d8ef2Safresh1    my $z = $LIB->_copy($x->{_m});
5310b46d8ef2Safresh1    if (! $LIB->_is_zero($x->{_e})) {   # > 0
5311b46d8ef2Safresh1        $z = $LIB->_lsft($z, $x->{_e}, 10);
53129f11ffb7Safresh1    }
5313b46d8ef2Safresh1    my $str = $LIB->_to_oct($z);
53149f11ffb7Safresh1    return $x->{sign} eq '-' ? "-$str" : $str;
53159f11ffb7Safresh1}
53169f11ffb7Safresh1
53179f11ffb7Safresh1sub to_bin {
53189f11ffb7Safresh1    # return number as binary digit string (only for integers defined)
5319e0680481Safresh1    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
53209f11ffb7Safresh1
5321e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
53229f11ffb7Safresh1
5323e0680481Safresh1    # Inf and NaN
5324e0680481Safresh1
5325e0680481Safresh1    if ($x->{sign} ne '+' && $x->{sign} ne '-') {
5326e0680481Safresh1        return $x->{sign} unless $x->{sign} eq '+inf';  # -inf, NaN
5327e0680481Safresh1        return 'inf';                                   # +inf
5328e0680481Safresh1    }
5329e0680481Safresh1
5330e0680481Safresh1    # Upgrade?
5331e0680481Safresh1
5332*3d61058aSafresh1    return $upgrade -> to_bin($x, @r)
5333*3d61058aSafresh1      if defined($upgrade) && !$x -> isa(__PACKAGE__);
5334e0680481Safresh1
5335e0680481Safresh1    # Finite number
5336e0680481Safresh1
53379f11ffb7Safresh1    return '0' if $x->is_zero();
53389f11ffb7Safresh1
53399f11ffb7Safresh1    return $nan if $x->{_es} ne '+';    # how to do 1e-1 in binary?
53409f11ffb7Safresh1
5341b46d8ef2Safresh1    my $z = $LIB->_copy($x->{_m});
5342b46d8ef2Safresh1    if (! $LIB->_is_zero($x->{_e})) {   # > 0
5343b46d8ef2Safresh1        $z = $LIB->_lsft($z, $x->{_e}, 10);
53449f11ffb7Safresh1    }
5345b46d8ef2Safresh1    my $str = $LIB->_to_bin($z);
53469f11ffb7Safresh1    return $x->{sign} eq '-' ? "-$str" : $str;
53479f11ffb7Safresh1}
53489f11ffb7Safresh1
534956d68f1eSafresh1sub to_ieee754 {
5350e0680481Safresh1    my ($class, $x, $format, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
5351e0680481Safresh1
5352e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
535356d68f1eSafresh1
535456d68f1eSafresh1    my $enc;            # significand encoding (applies only to decimal)
535556d68f1eSafresh1    my $k;              # storage width in bits
535656d68f1eSafresh1    my $b;              # base
535756d68f1eSafresh1
535856d68f1eSafresh1    if ($format =~ /^binary(\d+)\z/) {
535956d68f1eSafresh1        $k = $1;
536056d68f1eSafresh1        $b = 2;
536156d68f1eSafresh1    } elsif ($format =~ /^decimal(\d+)(dpd|bcd)?\z/) {
536256d68f1eSafresh1        $k = $1;
536356d68f1eSafresh1        $b = 10;
536456d68f1eSafresh1        $enc = $2 || 'dpd';     # default is dencely-packed decimals (DPD)
536556d68f1eSafresh1    } elsif ($format eq 'half') {
536656d68f1eSafresh1        $k = 16;
536756d68f1eSafresh1        $b = 2;
536856d68f1eSafresh1    } elsif ($format eq 'single') {
536956d68f1eSafresh1        $k = 32;
537056d68f1eSafresh1        $b = 2;
537156d68f1eSafresh1    } elsif ($format eq 'double') {
537256d68f1eSafresh1        $k = 64;
537356d68f1eSafresh1        $b = 2;
537456d68f1eSafresh1    } elsif ($format eq 'quadruple') {
537556d68f1eSafresh1        $k = 128;
537656d68f1eSafresh1        $b = 2;
537756d68f1eSafresh1    } elsif ($format eq 'octuple') {
537856d68f1eSafresh1        $k = 256;
537956d68f1eSafresh1        $b = 2;
538056d68f1eSafresh1    } elsif ($format eq 'sexdecuple') {
538156d68f1eSafresh1        $k = 512;
538256d68f1eSafresh1        $b = 2;
538356d68f1eSafresh1    }
538456d68f1eSafresh1
538556d68f1eSafresh1    if ($b == 2) {
538656d68f1eSafresh1
538756d68f1eSafresh1        # Get the parameters for this format.
538856d68f1eSafresh1
538956d68f1eSafresh1        my $p;                      # precision (in bits)
539056d68f1eSafresh1        my $t;                      # number of bits in significand
539156d68f1eSafresh1        my $w;                      # number of bits in exponent
539256d68f1eSafresh1
539356d68f1eSafresh1        if ($k == 16) {             # binary16 (half-precision)
539456d68f1eSafresh1            $p = 11;
539556d68f1eSafresh1            $t = 10;
539656d68f1eSafresh1            $w =  5;
539756d68f1eSafresh1        } elsif ($k == 32) {        # binary32 (single-precision)
539856d68f1eSafresh1            $p = 24;
539956d68f1eSafresh1            $t = 23;
540056d68f1eSafresh1            $w =  8;
540156d68f1eSafresh1        } elsif ($k == 64) {        # binary64 (double-precision)
540256d68f1eSafresh1            $p = 53;
540356d68f1eSafresh1            $t = 52;
540456d68f1eSafresh1            $w = 11;
540556d68f1eSafresh1        } else {                    # binaryN (quadruple-precition and above)
540656d68f1eSafresh1            if ($k < 128 || $k != 32 * sprintf('%.0f', $k / 32)) {
540756d68f1eSafresh1                croak "Number of bits must be 16, 32, 64, or >= 128 and",
540856d68f1eSafresh1                  " a multiple of 32";
540956d68f1eSafresh1            }
541056d68f1eSafresh1            $p = $k - sprintf('%.0f', 4 * log($k) / log(2)) + 13;
541156d68f1eSafresh1            $t = $p - 1;
541256d68f1eSafresh1            $w = $k - $t - 1;
541356d68f1eSafresh1        }
541456d68f1eSafresh1
541556d68f1eSafresh1        # The maximum exponent, minimum exponent, and exponent bias.
541656d68f1eSafresh1
541756d68f1eSafresh1        my $emax = $class -> new(2) -> bpow($w - 1) -> bdec();
541856d68f1eSafresh1        my $emin = 1 - $emax;
541956d68f1eSafresh1        my $bias = $emax;
542056d68f1eSafresh1
542156d68f1eSafresh1        # Get numerical sign, exponent, and mantissa/significand for bit
542256d68f1eSafresh1        # string.
542356d68f1eSafresh1
542456d68f1eSafresh1        my $sign = 0;
542556d68f1eSafresh1        my $expo;
542656d68f1eSafresh1        my $mant;
542756d68f1eSafresh1
542856d68f1eSafresh1        if ($x -> is_nan()) {                   # nan
542956d68f1eSafresh1            $sign = 1;
543056d68f1eSafresh1            $expo = $emax -> copy() -> binc();
543156d68f1eSafresh1            $mant = $class -> new(2) -> bpow($t - 1);
543256d68f1eSafresh1        } elsif ($x -> is_inf()) {              # inf
543356d68f1eSafresh1            $sign = 1 if $x -> is_neg();
543456d68f1eSafresh1            $expo = $emax -> copy() -> binc();
543556d68f1eSafresh1            $mant = $class -> bzero();
543656d68f1eSafresh1        } elsif ($x -> is_zero()) {             # zero
543756d68f1eSafresh1            $expo = $emin -> copy() -> bdec();
543856d68f1eSafresh1            $mant = $class -> bzero();
543956d68f1eSafresh1        } else {                                # normal and subnormal
544056d68f1eSafresh1
544156d68f1eSafresh1            $sign = 1 if $x -> is_neg();
544256d68f1eSafresh1
544356d68f1eSafresh1            # Now we need to compute the mantissa and exponent in base $b.
544456d68f1eSafresh1
544556d68f1eSafresh1            my $binv = $class -> new("0.5");
544656d68f1eSafresh1            my $b    = $class -> new(2);
544756d68f1eSafresh1            my $one  = $class -> bone();
544856d68f1eSafresh1
544956d68f1eSafresh1            # We start off by initializing the exponent to zero and the
545056d68f1eSafresh1            # mantissa to the input value. Then we increase the mantissa and
545156d68f1eSafresh1            # decrease the exponent, or vice versa, until the mantissa is in
545256d68f1eSafresh1            # the desired range or we hit one of the limits for the exponent.
545356d68f1eSafresh1
545456d68f1eSafresh1            $mant = $x -> copy() -> babs();
545556d68f1eSafresh1
545656d68f1eSafresh1            # We need to find the base 2 exponent. First make an estimate of
545756d68f1eSafresh1            # the base 2 exponent, before adjusting it below. We could skip
545856d68f1eSafresh1            # this estimation and go straight to the while-loops below, but the
545956d68f1eSafresh1            # loops are slow, especially when the final exponent is far from
546056d68f1eSafresh1            # zero and even more so if the number of digits is large. This
546156d68f1eSafresh1            # initial estimation speeds up the computation dramatically.
546256d68f1eSafresh1            #
546356d68f1eSafresh1            #   log2($m * 10**$e) = log10($m + 10**$e) * log(10)/log(2)
546456d68f1eSafresh1            #                     = (log10($m) + $e) * log(10)/log(2)
546556d68f1eSafresh1            #                     = (log($m)/log(10) + $e) * log(10)/log(2)
546656d68f1eSafresh1
546756d68f1eSafresh1            my ($m, $e) = $x -> nparts();
546856d68f1eSafresh1            my $ms = $m -> numify();
546956d68f1eSafresh1            my $es = $e -> numify();
547056d68f1eSafresh1
547156d68f1eSafresh1            my $expo_est = (log(abs($ms))/log(10) + $es) * log(10)/log(2);
547256d68f1eSafresh1            $expo_est = int($expo_est);
547356d68f1eSafresh1
547456d68f1eSafresh1            # Limit the exponent.
547556d68f1eSafresh1
547656d68f1eSafresh1            if ($expo_est > $emax) {
547756d68f1eSafresh1                $expo_est = $emax;
547856d68f1eSafresh1            } elsif ($expo_est < $emin) {
547956d68f1eSafresh1                $expo_est = $emin;
548056d68f1eSafresh1            }
548156d68f1eSafresh1
548256d68f1eSafresh1            # Don't multiply by a number raised to a negative exponent. This
548356d68f1eSafresh1            # will cause a division, whose result is truncated to some fixed
548456d68f1eSafresh1            # number of digits. Instead, multiply by the inverse number raised
548556d68f1eSafresh1            # to a positive exponent.
548656d68f1eSafresh1
548756d68f1eSafresh1            $expo = $class -> new($expo_est);
548856d68f1eSafresh1            if ($expo_est > 0) {
5489e0680481Safresh1                $mant = $mant -> bmul($binv -> copy() -> bpow($expo));
549056d68f1eSafresh1            } elsif ($expo_est < 0) {
549156d68f1eSafresh1                my $expo_abs = $expo -> copy() -> bneg();
5492e0680481Safresh1                $mant = $mant -> bmul($b -> copy() -> bpow($expo_abs));
549356d68f1eSafresh1            }
549456d68f1eSafresh1
5495eac174f2Safresh1            # Final adjustment of the estimate above.
549656d68f1eSafresh1
549756d68f1eSafresh1            while ($mant >= $b && $expo <= $emax) {
5498e0680481Safresh1                $mant = $mant -> bmul($binv);
5499e0680481Safresh1                $expo = $expo -> binc();
550056d68f1eSafresh1            }
550156d68f1eSafresh1
550256d68f1eSafresh1            while ($mant < $one && $expo >= $emin) {
5503e0680481Safresh1                $mant = $mant -> bmul($b);
5504e0680481Safresh1                $expo = $expo -> bdec();
550556d68f1eSafresh1            }
550656d68f1eSafresh1
5507eac174f2Safresh1            # This is when the magnitude is larger than what can be represented
5508eac174f2Safresh1            # in this format. Encode as infinity.
550956d68f1eSafresh1
5510eac174f2Safresh1            if ($expo > $emax) {
551156d68f1eSafresh1                $mant = $class -> bzero();
5512eac174f2Safresh1                $expo = $emax -> copy() -> binc();
5513eac174f2Safresh1            }
5514eac174f2Safresh1
5515eac174f2Safresh1            # This is when the magnitude is so small that the number is encoded
5516eac174f2Safresh1            # as a subnormal number.
5517eac174f2Safresh1            #
5518eac174f2Safresh1            # If the magnitude is smaller than that of the smallest subnormal
5519eac174f2Safresh1            # number, and rounded downwards, it is encoded as zero. This works
5520eac174f2Safresh1            # transparently and does not need to be treated as a special case.
5521eac174f2Safresh1            #
5522eac174f2Safresh1            # If the number is between the largest subnormal number and the
5523eac174f2Safresh1            # smallest normal number, and the value is rounded upwards, the
5524eac174f2Safresh1            # value must be encoded as a normal number. This must be treated as
5525eac174f2Safresh1            # a special case.
5526eac174f2Safresh1
5527eac174f2Safresh1            elsif ($expo < $emin) {
5528eac174f2Safresh1
5529eac174f2Safresh1                # Scale up the mantissa (significand), and round to integer.
5530eac174f2Safresh1
5531eac174f2Safresh1                my $const = $class -> new($b) -> bpow($t - 1);
5532e0680481Safresh1                $mant = $mant -> bmul($const);
5533e0680481Safresh1                $mant = $mant -> bfround(0);
5534eac174f2Safresh1
5535eac174f2Safresh1                # If the mantissa overflowed, encode as the smallest normal
5536eac174f2Safresh1                # number.
5537eac174f2Safresh1
5538eac174f2Safresh1                if ($mant == $const -> bmul($b)) {
5539e0680481Safresh1                    $mant = $mant -> bzero();
5540e0680481Safresh1                    $expo = $expo -> binc();
5541eac174f2Safresh1                }
5542eac174f2Safresh1            }
5543eac174f2Safresh1
5544eac174f2Safresh1            # This is when the magnitude is within the range of what can be
5545eac174f2Safresh1            # encoded as a normal number.
5546eac174f2Safresh1
5547eac174f2Safresh1            else {
5548eac174f2Safresh1
5549eac174f2Safresh1                # Remove implicit leading bit, scale up the mantissa
5550eac174f2Safresh1                # (significand) to an integer, and round.
5551eac174f2Safresh1
5552e0680481Safresh1                $mant = $mant -> bdec();
5553eac174f2Safresh1                my $const = $class -> new($b) -> bpow($t);
5554e0680481Safresh1                $mant = $mant -> bmul($const) -> bfround(0);
5555eac174f2Safresh1
5556eac174f2Safresh1                # If the mantissa overflowed, encode as the next larger value.
5557eac174f2Safresh1                # This works correctly also when the next larger value is
5558eac174f2Safresh1                # infinity.
5559eac174f2Safresh1
5560eac174f2Safresh1                if ($mant == $const) {
5561e0680481Safresh1                    $mant = $mant -> bzero();
5562e0680481Safresh1                    $expo = $expo -> binc();
5563eac174f2Safresh1                }
556456d68f1eSafresh1            }
556556d68f1eSafresh1        }
556656d68f1eSafresh1
5567e0680481Safresh1        $expo = $expo -> badd($bias);           # add bias
556856d68f1eSafresh1
556956d68f1eSafresh1        my $signbit = "$sign";
557056d68f1eSafresh1
557156d68f1eSafresh1        my $mantbits = $mant -> to_bin();
557256d68f1eSafresh1        $mantbits = ("0" x ($t - CORE::length($mantbits))) . $mantbits;
557356d68f1eSafresh1
557456d68f1eSafresh1        my $expobits = $expo -> to_bin();
557556d68f1eSafresh1        $expobits = ("0" x ($w - CORE::length($expobits))) . $expobits;
557656d68f1eSafresh1
557756d68f1eSafresh1        my $bin = $signbit . $expobits . $mantbits;
557856d68f1eSafresh1        return pack "B*", $bin;
557956d68f1eSafresh1    }
558056d68f1eSafresh1
558156d68f1eSafresh1    croak("The format '$format' is not yet supported.");
558256d68f1eSafresh1}
558356d68f1eSafresh1
55849f11ffb7Safresh1sub as_hex {
55859f11ffb7Safresh1    # return number as hexadecimal string (only for integers defined)
55869f11ffb7Safresh1
5587e0680481Safresh1    my (undef, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
5588e0680481Safresh1
5589e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
55909f11ffb7Safresh1
55919f11ffb7Safresh1    return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
55929f11ffb7Safresh1    return '0x0' if $x->is_zero();
55939f11ffb7Safresh1
55949f11ffb7Safresh1    return $nan if $x->{_es} ne '+';    # how to do 1e-1 in hex?
55959f11ffb7Safresh1
5596b46d8ef2Safresh1    my $z = $LIB->_copy($x->{_m});
5597b46d8ef2Safresh1    if (! $LIB->_is_zero($x->{_e})) {   # > 0
5598b46d8ef2Safresh1        $z = $LIB->_lsft($z, $x->{_e}, 10);
55999f11ffb7Safresh1    }
5600b46d8ef2Safresh1    my $str = $LIB->_as_hex($z);
56019f11ffb7Safresh1    return $x->{sign} eq '-' ? "-$str" : $str;
56029f11ffb7Safresh1}
56039f11ffb7Safresh1
56049f11ffb7Safresh1sub as_oct {
56059f11ffb7Safresh1    # return number as octal digit string (only for integers defined)
56069f11ffb7Safresh1
5607e0680481Safresh1    my (undef, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
5608e0680481Safresh1
5609e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
56109f11ffb7Safresh1
56119f11ffb7Safresh1    return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
56129f11ffb7Safresh1    return '00' if $x->is_zero();
56139f11ffb7Safresh1
56149f11ffb7Safresh1    return $nan if $x->{_es} ne '+';    # how to do 1e-1 in octal?
56159f11ffb7Safresh1
5616b46d8ef2Safresh1    my $z = $LIB->_copy($x->{_m});
5617b46d8ef2Safresh1    if (! $LIB->_is_zero($x->{_e})) {   # > 0
5618b46d8ef2Safresh1        $z = $LIB->_lsft($z, $x->{_e}, 10);
56199f11ffb7Safresh1    }
5620b46d8ef2Safresh1    my $str = $LIB->_as_oct($z);
56219f11ffb7Safresh1    return $x->{sign} eq '-' ? "-$str" : $str;
56229f11ffb7Safresh1}
56239f11ffb7Safresh1
56249f11ffb7Safresh1sub as_bin {
56259f11ffb7Safresh1    # return number as binary digit string (only for integers defined)
56269f11ffb7Safresh1
5627e0680481Safresh1    my (undef, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
5628e0680481Safresh1
5629e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
56309f11ffb7Safresh1
56319f11ffb7Safresh1    return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
56329f11ffb7Safresh1    return '0b0' if $x->is_zero();
56339f11ffb7Safresh1
56349f11ffb7Safresh1    return $nan if $x->{_es} ne '+';    # how to do 1e-1 in binary?
56359f11ffb7Safresh1
5636b46d8ef2Safresh1    my $z = $LIB->_copy($x->{_m});
5637b46d8ef2Safresh1    if (! $LIB->_is_zero($x->{_e})) {   # > 0
5638b46d8ef2Safresh1        $z = $LIB->_lsft($z, $x->{_e}, 10);
56399f11ffb7Safresh1    }
5640b46d8ef2Safresh1    my $str = $LIB->_as_bin($z);
56419f11ffb7Safresh1    return $x->{sign} eq '-' ? "-$str" : $str;
56429f11ffb7Safresh1}
56439f11ffb7Safresh1
56449f11ffb7Safresh1sub numify {
56459f11ffb7Safresh1    # Make a Perl scalar number from a Math::BigFloat object.
5646e0680481Safresh1
5647e0680481Safresh1    my (undef, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
5648e0680481Safresh1
5649e0680481Safresh1    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
56509f11ffb7Safresh1
56519f11ffb7Safresh1    if ($x -> is_nan()) {
56529f11ffb7Safresh1        require Math::Complex;
5653eac174f2Safresh1        my $inf = $Math::Complex::Inf;
56549f11ffb7Safresh1        return $inf - $inf;
56559f11ffb7Safresh1    }
56569f11ffb7Safresh1
56579f11ffb7Safresh1    if ($x -> is_inf()) {
56589f11ffb7Safresh1        require Math::Complex;
5659eac174f2Safresh1        my $inf = $Math::Complex::Inf;
56609f11ffb7Safresh1        return $x -> is_negative() ? -$inf : $inf;
56619f11ffb7Safresh1    }
56629f11ffb7Safresh1
56639f11ffb7Safresh1    # Create a string and let Perl's atoi()/atof() handle the rest.
5664e0680481Safresh1
566556d68f1eSafresh1    return 0 + $x -> bnstr();
56669f11ffb7Safresh1}
56679f11ffb7Safresh1
56689f11ffb7Safresh1###############################################################################
56699f11ffb7Safresh1# Private methods and functions.
56709f11ffb7Safresh1###############################################################################
56719f11ffb7Safresh1
56729f11ffb7Safresh1sub import {
56739f11ffb7Safresh1    my $class = shift;
5674eac174f2Safresh1    $IMPORT++;                  # remember we did import()
5675eac174f2Safresh1    my @a;                      # unrecognized arguments
5676eac174f2Safresh1
5677*3d61058aSafresh1    my @import = ();
5678*3d61058aSafresh1
5679eac174f2Safresh1    while (@_) {
5680eac174f2Safresh1        my $param = shift;
5681eac174f2Safresh1
5682eac174f2Safresh1        # Enable overloading of constants.
5683eac174f2Safresh1
5684eac174f2Safresh1        if ($param eq ':constant') {
5685eac174f2Safresh1            overload::constant
5686eac174f2Safresh1
5687eac174f2Safresh1                integer => sub {
5688eac174f2Safresh1                    $class -> new(shift);
5689eac174f2Safresh1                },
5690eac174f2Safresh1
5691eac174f2Safresh1                float   => sub {
5692eac174f2Safresh1                    $class -> new(shift);
5693eac174f2Safresh1                },
5694eac174f2Safresh1
5695eac174f2Safresh1                binary  => sub {
5696eac174f2Safresh1                    # E.g., a literal 0377 shall result in an object whose value
5697eac174f2Safresh1                    # is decimal 255, but new("0377") returns decimal 377.
5698eac174f2Safresh1                    return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/;
5699eac174f2Safresh1                    $class -> new(shift);
5700eac174f2Safresh1                };
5701eac174f2Safresh1            next;
5702eac174f2Safresh1        }
5703eac174f2Safresh1
5704eac174f2Safresh1        # Upgrading.
5705eac174f2Safresh1
5706eac174f2Safresh1        if ($param eq 'upgrade') {
5707eac174f2Safresh1            $class -> upgrade(shift);
5708eac174f2Safresh1            next;
5709eac174f2Safresh1        }
5710eac174f2Safresh1
5711eac174f2Safresh1        # Downgrading.
5712eac174f2Safresh1
5713eac174f2Safresh1        if ($param eq 'downgrade') {
5714eac174f2Safresh1            $class -> downgrade(shift);
5715eac174f2Safresh1            next;
5716eac174f2Safresh1        }
5717eac174f2Safresh1
5718eac174f2Safresh1        # Accuracy.
5719eac174f2Safresh1
5720eac174f2Safresh1        if ($param eq 'accuracy') {
5721eac174f2Safresh1            $class -> accuracy(shift);
5722eac174f2Safresh1            next;
5723eac174f2Safresh1        }
5724eac174f2Safresh1
5725eac174f2Safresh1        # Precision.
5726eac174f2Safresh1
5727eac174f2Safresh1        if ($param eq 'precision') {
5728eac174f2Safresh1            $class -> precision(shift);
5729eac174f2Safresh1            next;
5730eac174f2Safresh1        }
5731eac174f2Safresh1
5732eac174f2Safresh1        # Rounding mode.
5733eac174f2Safresh1
5734eac174f2Safresh1        if ($param eq 'round_mode') {
5735eac174f2Safresh1            $class -> round_mode(shift);
5736eac174f2Safresh1            next;
5737eac174f2Safresh1        }
5738eac174f2Safresh1
5739*3d61058aSafresh1        # Fall-back accuracy.
5740*3d61058aSafresh1
5741*3d61058aSafresh1        if ($param eq 'div_scale') {
5742*3d61058aSafresh1            $class -> div_scale(shift);
5743*3d61058aSafresh1            next;
5744*3d61058aSafresh1        }
5745*3d61058aSafresh1
5746eac174f2Safresh1        # Backend library.
5747eac174f2Safresh1
5748eac174f2Safresh1        if ($param =~ /^(lib|try|only)\z/) {
5749eac174f2Safresh1            push @import, $param;
5750eac174f2Safresh1            push @import, shift() if @_;
5751eac174f2Safresh1            next;
5752eac174f2Safresh1        }
5753eac174f2Safresh1
5754eac174f2Safresh1        if ($param eq 'with') {
57559f11ffb7Safresh1            # alternative class for our private parts()
57569f11ffb7Safresh1            # XXX: no longer supported
5757eac174f2Safresh1            # $LIB = shift() || 'Calc';
5758eac174f2Safresh1            # carp "'with' is no longer supported, use 'lib', 'try', or 'only'";
5759eac174f2Safresh1            shift;
5760eac174f2Safresh1            next;
57619f11ffb7Safresh1        }
57629f11ffb7Safresh1
5763eac174f2Safresh1        # Unrecognized parameter.
57649f11ffb7Safresh1
5765eac174f2Safresh1        push @a, $param;
5766eac174f2Safresh1    }
57679f11ffb7Safresh1
5768eac174f2Safresh1    Math::BigInt -> import(@import);
5769eac174f2Safresh1
5770*3d61058aSafresh1    # find out which library was actually loaded
5771b46d8ef2Safresh1    $LIB = Math::BigInt -> config('lib');
57729f11ffb7Safresh1
5773*3d61058aSafresh1    $class -> SUPER::import(@a);                        # for subclasses
5774*3d61058aSafresh1    $class -> export_to_level(1, $class, @a) if @a;     # need this, too
57759f11ffb7Safresh1}
57769f11ffb7Safresh1
57779f11ffb7Safresh1sub _len_to_steps {
57789f11ffb7Safresh1    # Given D (digits in decimal), compute N so that N! (N factorial) is
57799f11ffb7Safresh1    # at least D digits long. D should be at least 50.
57809f11ffb7Safresh1    my $d = shift;
57819f11ffb7Safresh1
57829f11ffb7Safresh1    # two constants for the Ramanujan estimate of ln(N!)
57839f11ffb7Safresh1    my $lg2 = log(2 * 3.14159265) / 2;
57849f11ffb7Safresh1    my $lg10 = log(10);
57859f11ffb7Safresh1
57869f11ffb7Safresh1    # D = 50 => N => 42, so L = 40 and R = 50
57879f11ffb7Safresh1    my $l = 40;
57889f11ffb7Safresh1    my $r = $d;
57899f11ffb7Safresh1
5790e0680481Safresh1    # Otherwise this does not work under -Mbignum and we do not yet have "no
5791e0680481Safresh1    # bignum;" :(
57929f11ffb7Safresh1    $l = $l->numify if ref($l);
57939f11ffb7Safresh1    $r = $r->numify if ref($r);
57949f11ffb7Safresh1    $lg2 = $lg2->numify if ref($lg2);
57959f11ffb7Safresh1    $lg10 = $lg10->numify if ref($lg10);
57969f11ffb7Safresh1
5797e0680481Safresh1    # binary search for the right value (could this be written as the reverse of
5798e0680481Safresh1    # lg(n!)?)
57999f11ffb7Safresh1    while ($r - $l > 1) {
58009f11ffb7Safresh1        my $n = int(($r - $l) / 2) + $l;
5801e0680481Safresh1        my $ramanujan
5802e0680481Safresh1          = int(($n * log($n) - $n + log($n * (1 + 4*$n*(1+2*$n))) / 6 + $lg2)
5803e0680481Safresh1                / $lg10);
58049f11ffb7Safresh1        $ramanujan > $d ? $r = $n : $l = $n;
58059f11ffb7Safresh1    }
58069f11ffb7Safresh1    $l;
58079f11ffb7Safresh1}
58089f11ffb7Safresh1
58099f11ffb7Safresh1sub _log {
5810b8851fccSafresh1    # internal log function to calculate ln() based on Taylor series.
5811b8851fccSafresh1    # Modifies $x in place.
5812b46d8ef2Safresh1    my ($x, $scale) = @_;
5813b46d8ef2Safresh1    my $class = ref $x;
5814b8851fccSafresh1
5815b8851fccSafresh1    # in case of $x == 1, result is 0
5816b8851fccSafresh1    return $x -> bzero() if $x -> is_one();
5817b8851fccSafresh1
5818b8851fccSafresh1    # XXX TODO: rewrite this in a similar manner to bexp()
5819b8851fccSafresh1
5820b8851fccSafresh1    # http://www.efunda.com/math/taylor_series/logarithmic.cfm?search_string=log
5821b8851fccSafresh1
5822b8851fccSafresh1    # u = x-1, v = x+1
5823b8851fccSafresh1    #              _                               _
5824b8851fccSafresh1    # Taylor:     |    u    1   u^3   1   u^5       |
5825b8851fccSafresh1    # ln (x)  = 2 |   --- + - * --- + - * --- + ... |  x > 0
5826b8851fccSafresh1    #             |_   v    3   v^3   5   v^5      _|
5827b8851fccSafresh1
5828b8851fccSafresh1    # This takes much more steps to calculate the result and is thus not used
5829b8851fccSafresh1    # u = x-1
5830b8851fccSafresh1    #              _                               _
5831b8851fccSafresh1    # Taylor:     |    u    1   u^2   1   u^3       |
5832b8851fccSafresh1    # ln (x)  = 2 |   --- + - * --- + - * --- + ... |  x > 1/2
5833b8851fccSafresh1    #             |_   x    2   x^2   3   x^3      _|
5834b8851fccSafresh1
5835*3d61058aSafresh1    # scale used in intermediate computations
5836*3d61058aSafresh1    my $scaleup = $scale + 4;
5837*3d61058aSafresh1
5838*3d61058aSafresh1    my ($v, $u, $numer, $denom, $factor, $f);
5839b8851fccSafresh1
5840e0680481Safresh1    $v = $x -> copy();
5841e0680481Safresh1    $v = $v -> binc();                  # v = x+1
5842e0680481Safresh1    $x = $x -> bdec();
5843e0680481Safresh1    $u = $x -> copy();                  # u = x-1; x = x-1
5844*3d61058aSafresh1
5845*3d61058aSafresh1    $x = $x -> bdiv($v, $scaleup);        # first term: u/v
5846*3d61058aSafresh1
5847*3d61058aSafresh1    $numer = $u -> copy();              # numerator
5848*3d61058aSafresh1    $denom = $v -> copy();              # denominator
5849*3d61058aSafresh1
5850e0680481Safresh1    $u = $u -> bmul($u);                # u^2
5851e0680481Safresh1    $v = $v -> bmul($v);                # v^2
5852*3d61058aSafresh1
5853*3d61058aSafresh1    $numer = $numer -> bmul($u);        # u^3
5854*3d61058aSafresh1    $denom = $denom -> bmul($v);        # v^3
5855*3d61058aSafresh1
5856e0680481Safresh1    $factor = $class -> new(3);
5857e0680481Safresh1    $f = $class -> new(2);
5858b8851fccSafresh1
5859*3d61058aSafresh1    while (1) {
5860*3d61058aSafresh1        my $next = $numer -> copy() -> bround($scaleup)
5861*3d61058aSafresh1          -> bdiv($denom -> copy() -> bmul($factor) -> bround($scaleup), $scaleup);
5862b46d8ef2Safresh1
5863*3d61058aSafresh1        $next->{accuracy} = undef;
5864*3d61058aSafresh1        $next->{precision} = undef;
5865*3d61058aSafresh1        my $x_prev = $x -> copy();
5866e0680481Safresh1        $x = $x -> badd($next);
5867*3d61058aSafresh1
5868*3d61058aSafresh1        last if $x -> bacmp($x_prev) == 0;
5869*3d61058aSafresh1
5870b8851fccSafresh1        # calculate things for the next term
5871*3d61058aSafresh1        $numer  = $numer -> bmul($u);
5872*3d61058aSafresh1        $denom  = $denom -> bmul($v);
5873e0680481Safresh1        $factor = $factor -> badd($f);
5874b8851fccSafresh1    }
5875*3d61058aSafresh1
5876*3d61058aSafresh1    $x = $x -> bmul($f);             # $x *= 2
5877*3d61058aSafresh1    $x = $x -> bround($scale);
5878b8851fccSafresh1}
5879b8851fccSafresh1
58809f11ffb7Safresh1sub _log_10 {
5881b8851fccSafresh1    # Internal log function based on reducing input to the range of 0.1 .. 9.99
5882b8851fccSafresh1    # and then "correcting" the result to the proper one. Modifies $x in place.
5883b46d8ef2Safresh1    my ($x, $scale) = @_;
5884b46d8ef2Safresh1    my $class = ref $x;
5885b8851fccSafresh1
5886b8851fccSafresh1    # Taking blog() from numbers greater than 10 takes a *very long* time, so we
5887b8851fccSafresh1    # break the computation down into parts based on the observation that:
5888b8851fccSafresh1    #  blog(X*Y) = blog(X) + blog(Y)
5889b8851fccSafresh1    # We set Y here to multiples of 10 so that $x becomes below 1 - the smaller
5890b8851fccSafresh1    # $x is the faster it gets. Since 2*$x takes about 10 times as
5891b8851fccSafresh1    # long, we make it faster by about a factor of 100 by dividing $x by 10.
5892b8851fccSafresh1
5893b8851fccSafresh1    # The same observation is valid for numbers smaller than 0.1, e.g. computing
5894e0680481Safresh1    # log(1) is fastest, and the further away we get from 1, the longer it
5895e0680481Safresh1    # takes. So we also 'break' this down by multiplying $x with 10 and subtract
5896e0680481Safresh1    # the log(10) afterwards to get the correct result.
5897b8851fccSafresh1
5898b8851fccSafresh1    # To get $x even closer to 1, we also divide by 2 and then use log(2) to
5899b8851fccSafresh1    # correct for this. For instance if $x is 2.4, we use the formula:
5900b8851fccSafresh1    #  blog(2.4 * 2) == blog(1.2) + blog(2)
5901b8851fccSafresh1    # and thus calculate only blog(1.2) and blog(2), which is faster in total
5902b8851fccSafresh1    # than calculating blog(2.4).
5903b8851fccSafresh1
5904b8851fccSafresh1    # In addition, the values for blog(2) and blog(10) are cached.
5905b8851fccSafresh1
5906*3d61058aSafresh1    # Calculate the number of digits before the dot, i.e., 1 + floor(log10(x)):
5907*3d61058aSafresh1    #   x = 123      => dbd =  3
5908*3d61058aSafresh1    #   x = 1.23     => dbd =  1
5909*3d61058aSafresh1    #   x = 0.0123   => dbd = -1
5910*3d61058aSafresh1    #   x = 0.000123 => dbd = -3
5911*3d61058aSafresh1    #   etc.
5912b46d8ef2Safresh1
5913b46d8ef2Safresh1    my $dbd = $LIB->_num($x->{_e});
5914b8851fccSafresh1    $dbd = -$dbd if $x->{_es} eq '-';
5915b46d8ef2Safresh1    $dbd += $LIB->_len($x->{_m});
5916b8851fccSafresh1
5917b8851fccSafresh1    # more than one digit (e.g. at least 10), but *not* exactly 10 to avoid
5918b8851fccSafresh1    # infinite recursion
5919b8851fccSafresh1
5920b8851fccSafresh1    my $calc = 1;               # do some calculation?
5921b8851fccSafresh1
5922*3d61058aSafresh1    # No upgrading or downgrading in the intermediate computations.
5923*3d61058aSafresh1
5924*3d61058aSafresh1    my $upg = $class -> upgrade();
5925*3d61058aSafresh1    my $dng = $class -> downgrade();
5926*3d61058aSafresh1    $class -> upgrade(undef);
5927*3d61058aSafresh1    $class -> downgrade(undef);
5928*3d61058aSafresh1
5929b8851fccSafresh1    # disable the shortcut for 10, since we need log(10) and this would recurse
5930b8851fccSafresh1    # infinitely deep
5931b46d8ef2Safresh1    if ($x->{_es} eq '+' &&                     # $x == 10
5932b46d8ef2Safresh1        ($LIB->_is_one($x->{_e}) &&
5933b46d8ef2Safresh1         $LIB->_is_one($x->{_m})))
5934b46d8ef2Safresh1    {
5935b8851fccSafresh1        $dbd = 0;               # disable shortcut
5936b8851fccSafresh1        # we can use the cached value in these cases
59379f11ffb7Safresh1        if ($scale <= $LOG_10_A) {
5938e0680481Safresh1            $x = $x->bzero();
5939e0680481Safresh1            $x = $x->badd($LOG_10); # modify $x in place
5940b8851fccSafresh1            $calc = 0;                      # no need to calc, but round
5941b8851fccSafresh1        }
5942b8851fccSafresh1        # if we can't use the shortcut, we continue normally
59439f11ffb7Safresh1    } else {
5944b8851fccSafresh1        # disable the shortcut for 2, since we maybe have it cached
5945b46d8ef2Safresh1        if (($LIB->_is_zero($x->{_e}) &&        # $x == 2
5946b46d8ef2Safresh1             $LIB->_is_two($x->{_m})))
5947b46d8ef2Safresh1        {
5948b8851fccSafresh1            $dbd = 0;           # disable shortcut
5949b8851fccSafresh1            # we can use the cached value in these cases
59509f11ffb7Safresh1            if ($scale <= $LOG_2_A) {
5951e0680481Safresh1                $x = $x->bzero();
5952e0680481Safresh1                $x = $x->badd($LOG_2); # modify $x in place
5953b8851fccSafresh1                $calc = 0;                     # no need to calc, but round
5954b8851fccSafresh1            }
5955b8851fccSafresh1            # if we can't use the shortcut, we continue normally
5956b8851fccSafresh1        }
5957b8851fccSafresh1    }
5958b8851fccSafresh1
5959b8851fccSafresh1    # if $x = 0.1, we know the result must be 0-log(10)
5960b46d8ef2Safresh1    if ($calc != 0 &&
5961b46d8ef2Safresh1        ($x->{_es} eq '-' &&                    # $x == 0.1
5962b46d8ef2Safresh1         ($LIB->_is_one($x->{_e}) &&
5963b46d8ef2Safresh1          $LIB->_is_one($x->{_m}))))
5964b46d8ef2Safresh1    {
5965b8851fccSafresh1        $dbd = 0;               # disable shortcut
5966b8851fccSafresh1        # we can use the cached value in these cases
59679f11ffb7Safresh1        if ($scale <= $LOG_10_A) {
5968e0680481Safresh1            $x = $x->bzero();
5969e0680481Safresh1            $x = $x->bsub($LOG_10);
5970b8851fccSafresh1            $calc = 0;          # no need to calc, but round
5971b8851fccSafresh1        }
5972b8851fccSafresh1    }
5973b8851fccSafresh1
5974b46d8ef2Safresh1    return $x if $calc == 0;    # already have the result
5975b8851fccSafresh1
5976b8851fccSafresh1    # default: these correction factors are undef and thus not used
5977b8851fccSafresh1    my $l_10;                   # value of ln(10) to A of $scale
5978b8851fccSafresh1    my $l_2;                    # value of ln(2) to A of $scale
5979b8851fccSafresh1
59809f11ffb7Safresh1    my $two = $class->new(2);
5981b8851fccSafresh1
5982b8851fccSafresh1    # $x == 2 => 1, $x == 13 => 2, $x == 0.1 => 0, $x == 0.01 => -1
5983b8851fccSafresh1    # so don't do this shortcut for 1 or 0
59849f11ffb7Safresh1    if (($dbd > 1) || ($dbd < 0)) {
5985b8851fccSafresh1        # convert our cached value to an object if not already (avoid doing this
5986b8851fccSafresh1        # at import() time, since not everybody needs this)
59879f11ffb7Safresh1        $LOG_10 = $class->new($LOG_10, undef, undef) unless ref $LOG_10;
5988b8851fccSafresh1
5989e0680481Safresh1        # got more than one digit before the dot, or more than one zero after
5990e0680481Safresh1        # the dot, so do:
5991b8851fccSafresh1        #  log(123)    == log(1.23) + log(10) * 2
5992b8851fccSafresh1        #  log(0.0123) == log(1.23) - log(10) * 2
5993b8851fccSafresh1
59949f11ffb7Safresh1        if ($scale <= $LOG_10_A) {
5995b8851fccSafresh1            # use cached value
5996b8851fccSafresh1            $l_10 = $LOG_10->copy(); # copy for mul
59979f11ffb7Safresh1        } else {
5998b8851fccSafresh1            # else: slower, compute and cache result
5999e0680481Safresh1
6000b8851fccSafresh1            # shorten the time to calculate log(10) based on the following:
6001b8851fccSafresh1            # log(1.25 * 8) = log(1.25) + log(8)
6002b8851fccSafresh1            #               = log(1.25) + log(2) + log(2) + log(2)
6003b8851fccSafresh1
6004b8851fccSafresh1            # first get $l_2 (and possible compute and cache log(2))
60059f11ffb7Safresh1            $LOG_2 = $class->new($LOG_2, undef, undef) unless ref $LOG_2;
60069f11ffb7Safresh1            if ($scale <= $LOG_2_A) {
6007b8851fccSafresh1                # use cached value
6008b8851fccSafresh1                $l_2 = $LOG_2->copy(); # copy() for the mul below
60099f11ffb7Safresh1            } else {
6010b8851fccSafresh1                # else: slower, compute and cache result
60119f11ffb7Safresh1                $l_2 = $two->copy();
6012e0680481Safresh1                $l_2 = $l_2->_log($scale); # scale+4, actually
6013b8851fccSafresh1                $LOG_2 = $l_2->copy(); # cache the result for later
6014b8851fccSafresh1                # the copy() is for mul below
6015b8851fccSafresh1                $LOG_2_A = $scale;
6016b8851fccSafresh1            }
6017b8851fccSafresh1
6018b8851fccSafresh1            # now calculate log(1.25):
60199f11ffb7Safresh1            $l_10 = $class->new('1.25');
6020e0680481Safresh1            $l_10 = $l_10->_log($scale); # scale+4, actually
6021b8851fccSafresh1
6022b8851fccSafresh1            # log(1.25) + log(2) + log(2) + log(2):
6023e0680481Safresh1            $l_10 = $l_10->badd($l_2);
6024e0680481Safresh1            $l_10 = $l_10->badd($l_2);
6025e0680481Safresh1            $l_10 = $l_10->badd($l_2);
6026b8851fccSafresh1            $LOG_10 = $l_10->copy(); # cache the result for later
6027b8851fccSafresh1            # the copy() is for mul below
6028b8851fccSafresh1            $LOG_10_A = $scale;
6029b8851fccSafresh1        }
6030b8851fccSafresh1        $dbd-- if ($dbd > 1);       # 20 => dbd=2, so make it dbd=1
6031e0680481Safresh1        $l_10 = $l_10->bmul($class->new($dbd)); # log(10) * (digits_before_dot-1)
6032b8851fccSafresh1        my $dbd_sign = '+';
60339f11ffb7Safresh1        if ($dbd < 0) {
6034b8851fccSafresh1            $dbd = -$dbd;
6035b8851fccSafresh1            $dbd_sign = '-';
6036b8851fccSafresh1        }
6037b8851fccSafresh1        ($x->{_e}, $x->{_es}) =
6038e0680481Safresh1          $LIB -> _ssub($x->{_e}, $x->{_es}, $LIB->_new($dbd), $dbd_sign);
6039b8851fccSafresh1    }
6040b8851fccSafresh1
6041b8851fccSafresh1    # Now: 0.1 <= $x < 10 (and possible correction in l_10)
6042b8851fccSafresh1
6043b8851fccSafresh1    ### Since $x in the range 0.5 .. 1.5 is MUCH faster, we do a repeated div
6044b8851fccSafresh1    ### or mul by 2 (maximum times 3, since x < 10 and x > 0.1)
6045b8851fccSafresh1
60469f11ffb7Safresh1    $HALF = $class->new($HALF) unless ref($HALF);
6047b8851fccSafresh1
6048b8851fccSafresh1    my $twos = 0;               # default: none (0 times)
60499f11ffb7Safresh1    while ($x->bacmp($HALF) <= 0) { # X <= 0.5
60509f11ffb7Safresh1        $twos--;
6051e0680481Safresh1        $x = $x->bmul($two);
6052b8851fccSafresh1    }
60539f11ffb7Safresh1    while ($x->bacmp($two) >= 0) { # X >= 2
60549f11ffb7Safresh1        $twos++;
6055e0680481Safresh1        $x = $x->bdiv($two, $scale+4); # keep all digits
6056b8851fccSafresh1    }
6057e0680481Safresh1    $x = $x->bround($scale+4);
6058b8851fccSafresh1    # $twos > 0 => did mul 2, < 0 => did div 2 (but we never did both)
6059b8851fccSafresh1    # So calculate correction factor based on ln(2):
60609f11ffb7Safresh1    if ($twos != 0) {
60619f11ffb7Safresh1        $LOG_2 = $class->new($LOG_2, undef, undef) unless ref $LOG_2;
60629f11ffb7Safresh1        if ($scale <= $LOG_2_A) {
6063b8851fccSafresh1            # use cached value
6064b8851fccSafresh1            $l_2 = $LOG_2->copy(); # copy() for the mul below
60659f11ffb7Safresh1        } else {
6066b8851fccSafresh1            # else: slower, compute and cache result
60679f11ffb7Safresh1            $l_2 = $two->copy();
6068e0680481Safresh1            $l_2 = $l_2->_log($scale); # scale+4, actually
6069b8851fccSafresh1            $LOG_2 = $l_2->copy(); # cache the result for later
6070b8851fccSafresh1            # the copy() is for mul below
6071b8851fccSafresh1            $LOG_2_A = $scale;
6072b8851fccSafresh1        }
6073e0680481Safresh1        $l_2 = $l_2->bmul($twos);      # * -2 => subtract, * 2 => add
60749f11ffb7Safresh1    } else {
6075b8851fccSafresh1        undef $l_2;
6076b8851fccSafresh1    }
6077b8851fccSafresh1
6078e0680481Safresh1    $x = $x->_log($scale);       # need to do the "normal" way
6079e0680481Safresh1    $x = $x->badd($l_10) if defined $l_10; # correct it by ln(10)
6080e0680481Safresh1    $x = $x->badd($l_2) if defined $l_2;   # and maybe by ln(2)
6081b8851fccSafresh1
6082*3d61058aSafresh1    # Restore globals
6083*3d61058aSafresh1
6084*3d61058aSafresh1    $class -> upgrade($upg);
6085*3d61058aSafresh1    $class -> downgrade($dng);
6086*3d61058aSafresh1
6087b8851fccSafresh1    # all done, $x contains now the result
6088b8851fccSafresh1    $x;
6089b8851fccSafresh1}
6090b8851fccSafresh1
60919f11ffb7Safresh1sub _pow {
6092b8851fccSafresh1    # Calculate a power where $y is a non-integer, like 2 ** 0.3
6093b8851fccSafresh1    my ($x, $y, @r) = @_;
60949f11ffb7Safresh1    my $class = ref($x);
6095b8851fccSafresh1
6096b8851fccSafresh1    # if $y == 0.5, it is sqrt($x)
60979f11ffb7Safresh1    $HALF = $class->new($HALF) unless ref($HALF);
6098b8851fccSafresh1    return $x->bsqrt(@r, $y) if $y->bcmp($HALF) == 0;
6099b8851fccSafresh1
6100b8851fccSafresh1    # Using:
6101b8851fccSafresh1    # a ** x == e ** (x * ln a)
6102b8851fccSafresh1
6103b8851fccSafresh1    # u = y * ln x
6104b8851fccSafresh1    #                _                         _
6105b8851fccSafresh1    # Taylor:       |   u    u^2    u^3         |
6106b8851fccSafresh1    # x ** y  = 1 + |  --- + --- + ----- + ...  |
6107b8851fccSafresh1    #               |_  1    1*2   1*2*3       _|
6108b8851fccSafresh1
6109b8851fccSafresh1    # we need to limit the accuracy to protect against overflow
6110b8851fccSafresh1    my $fallback = 0;
6111b8851fccSafresh1    my ($scale, @params);
6112b8851fccSafresh1    ($x, @params) = $x->_find_round_parameters(@r);
6113b8851fccSafresh1
6114b8851fccSafresh1    return $x if $x->is_nan();  # error in _find_round_parameters?
6115b8851fccSafresh1
6116b8851fccSafresh1    # no rounding at all, so must use fallback
6117b8851fccSafresh1    if (scalar @params == 0) {
6118b8851fccSafresh1        # simulate old behaviour
6119b8851fccSafresh1        $params[0] = $class->div_scale(); # and round to it as accuracy
6120b8851fccSafresh1        $params[1] = undef;               # disable P
6121b8851fccSafresh1        $scale = $params[0]+4;            # at least four more for proper round
6122b8851fccSafresh1        $params[2] = $r[2];               # round mode by caller or undef
6123b8851fccSafresh1        $fallback = 1;                    # to clear a/p afterwards
6124b8851fccSafresh1    } else {
6125b8851fccSafresh1        # the 4 below is empirical, and there might be cases where it is not
6126b8851fccSafresh1        # enough...
6127b8851fccSafresh1        $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
6128b8851fccSafresh1    }
6129b8851fccSafresh1
6130*3d61058aSafresh1    # When user set globals, they would interfere with our calculation, so
6131*3d61058aSafresh1    # disable them and later re-enable them.
6132*3d61058aSafresh1
6133*3d61058aSafresh1    my $ab = $class -> accuracy();
6134*3d61058aSafresh1    my $pb = $class -> precision();
6135*3d61058aSafresh1    $class -> accuracy(undef);
6136*3d61058aSafresh1    $class -> precision(undef);
6137e0680481Safresh1
6138e0680481Safresh1    # Disabling upgrading and downgrading is no longer necessary to avoid an
6139e0680481Safresh1    # infinite recursion, but it avoids unnecessary upgrading and downgrading in
6140e0680481Safresh1    # the intermediate computations.
6141e0680481Safresh1
6142*3d61058aSafresh1    my $upg = $class -> upgrade();
6143*3d61058aSafresh1    my $dng = $class -> downgrade();
6144*3d61058aSafresh1    $class -> upgrade(undef);
6145*3d61058aSafresh1    $class -> downgrade(undef);
6146*3d61058aSafresh1
6147*3d61058aSafresh1    # We also need to disable any set A or P on $x (_find_round_parameters took
6148*3d61058aSafresh1    # them already into account), since these would interfere, too.
6149*3d61058aSafresh1
6150*3d61058aSafresh1    $x->{accuracy} = undef;
6151*3d61058aSafresh1    $x->{precision} = undef;
6152b8851fccSafresh1
61539f11ffb7Safresh1    my ($limit, $v, $u, $below, $factor, $next, $over);
6154b8851fccSafresh1
61559f11ffb7Safresh1    $u = $x->copy()->blog(undef, $scale)->bmul($y);
61569f11ffb7Safresh1    my $do_invert = ($u->{sign} eq '-');
6157e0680481Safresh1    $u = $u->bneg()  if $do_invert;
61589f11ffb7Safresh1    $v = $class->bone();        # 1
61599f11ffb7Safresh1    $factor = $class->new(2);   # 2
6160e0680481Safresh1    $x = $x->bone();                 # first term: 1
61619f11ffb7Safresh1
61629f11ffb7Safresh1    $below = $v->copy();
61639f11ffb7Safresh1    $over = $u->copy();
61649f11ffb7Safresh1
61659f11ffb7Safresh1    $limit = $class->new("1E-". ($scale-1));
61669f11ffb7Safresh1    while (3 < 5) {
61679f11ffb7Safresh1        # we calculate the next term, and add it to the last
61689f11ffb7Safresh1        # when the next term is below our limit, it won't affect the outcome
61699f11ffb7Safresh1        # anymore, so we stop:
61709f11ffb7Safresh1        $next = $over->copy()->bdiv($below, $scale);
6171b8851fccSafresh1        last if $next->bacmp($limit) <= 0;
6172e0680481Safresh1        $x = $x->badd($next);
6173b8851fccSafresh1        # calculate things for the next term
61749f11ffb7Safresh1        $over *= $u;
61759f11ffb7Safresh1        $below *= $factor;
6176e0680481Safresh1        $factor = $factor->binc();
6177b8851fccSafresh1
61789f11ffb7Safresh1        last if $x->{sign} !~ /^[-+]$/;
6179b8851fccSafresh1    }
6180b8851fccSafresh1
61819f11ffb7Safresh1    if ($do_invert) {
61829f11ffb7Safresh1        my $x_copy = $x->copy();
6183e0680481Safresh1        $x = $x->bone->bdiv($x_copy, $scale);
61849f11ffb7Safresh1    }
61859f11ffb7Safresh1
61869f11ffb7Safresh1    # shortcut to not run through _find_round_parameters again
6187b8851fccSafresh1    if (defined $params[0]) {
6188e0680481Safresh1        $x = $x->bround($params[0], $params[2]); # then round accordingly
6189b8851fccSafresh1    } else {
6190e0680481Safresh1        $x = $x->bfround($params[1], $params[2]); # then round accordingly
6191b8851fccSafresh1    }
6192b8851fccSafresh1    if ($fallback) {
61939f11ffb7Safresh1        # clear a/p after round, since user did not request it
6194*3d61058aSafresh1        $x->{accuracy} = undef;
6195*3d61058aSafresh1        $x->{precision} = undef;
6196b8851fccSafresh1    }
6197*3d61058aSafresh1
6198*3d61058aSafresh1    # Restore globals. We need to do it like this, because setting one
6199*3d61058aSafresh1    # undefines the other.
6200*3d61058aSafresh1
6201*3d61058aSafresh1    if (defined $ab) {
6202*3d61058aSafresh1        $class -> accuracy($ab);
6203*3d61058aSafresh1    } else {
6204*3d61058aSafresh1        $class -> precision($pb);
6205*3d61058aSafresh1    }
6206*3d61058aSafresh1
6207*3d61058aSafresh1    $class -> upgrade($upg);
6208*3d61058aSafresh1    $class -> downgrade($dng);
6209*3d61058aSafresh1
62109f11ffb7Safresh1    $x;
6211b8851fccSafresh1}
6212b8851fccSafresh1
6213e0680481Safresh1# These functions are only provided for backwards compabibility so that old
6214e0680481Safresh1# version of Math::BigRat etc. don't complain about missing them.
6215e0680481Safresh1
6216e0680481Safresh1sub _e_add {
6217e0680481Safresh1    my ($x, $y, $xs, $ys) = @_;
6218e0680481Safresh1    return $LIB -> _sadd($x, $xs, $y, $ys);
6219e0680481Safresh1}
6220e0680481Safresh1
6221e0680481Safresh1sub _e_sub {
6222e0680481Safresh1    my ($x, $y, $xs, $ys) = @_;
6223e0680481Safresh1    return $LIB -> _ssub($x, $xs, $y, $ys);
6224e0680481Safresh1}
6225e0680481Safresh1
6226b8851fccSafresh11;
6227b8851fccSafresh1
6228b8851fccSafresh1__END__
6229b8851fccSafresh1
6230b8851fccSafresh1=pod
6231b8851fccSafresh1
6232b8851fccSafresh1=head1 NAME
6233b8851fccSafresh1
6234eac174f2Safresh1Math::BigFloat - arbitrary size floating point math package
6235b8851fccSafresh1
6236b8851fccSafresh1=head1 SYNOPSIS
6237b8851fccSafresh1
6238b8851fccSafresh1  use Math::BigFloat;
6239b8851fccSafresh1
62409f11ffb7Safresh1  # Configuration methods (may be used as class methods and instance methods)
6241b8851fccSafresh1
62429f11ffb7Safresh1  Math::BigFloat->accuracy();     # get class accuracy
62439f11ffb7Safresh1  Math::BigFloat->accuracy($n);   # set class accuracy
62449f11ffb7Safresh1  Math::BigFloat->precision();    # get class precision
62459f11ffb7Safresh1  Math::BigFloat->precision($n);  # set class precision
62469f11ffb7Safresh1  Math::BigFloat->round_mode();   # get class rounding mode
62479f11ffb7Safresh1  Math::BigFloat->round_mode($m); # set global round mode, must be one of
62489f11ffb7Safresh1                                  # 'even', 'odd', '+inf', '-inf', 'zero',
62499f11ffb7Safresh1                                  # 'trunc', or 'common'
6250b46d8ef2Safresh1  Math::BigFloat->config("lib");  # name of backend math library
6251b8851fccSafresh1
62529f11ffb7Safresh1  # Constructor methods (when the class methods below are used as instance
62539f11ffb7Safresh1  # methods, the value is assigned the invocand)
6254b8851fccSafresh1
62559f11ffb7Safresh1  $x = Math::BigFloat->new($str);               # defaults to 0
62569f11ffb7Safresh1  $x = Math::BigFloat->new('0x123');            # from hexadecimal
6257eac174f2Safresh1  $x = Math::BigFloat->new('0o377');            # from octal
62589f11ffb7Safresh1  $x = Math::BigFloat->new('0b101');            # from binary
62599f11ffb7Safresh1  $x = Math::BigFloat->from_hex('0xc.afep+3');  # from hex
62609f11ffb7Safresh1  $x = Math::BigFloat->from_hex('cafe');        # ditto
62619f11ffb7Safresh1  $x = Math::BigFloat->from_oct('1.3267p-4');   # from octal
6262eac174f2Safresh1  $x = Math::BigFloat->from_oct('01.3267p-4');  # ditto
6263eac174f2Safresh1  $x = Math::BigFloat->from_oct('0o1.3267p-4'); # ditto
62649f11ffb7Safresh1  $x = Math::BigFloat->from_oct('0377');        # ditto
62659f11ffb7Safresh1  $x = Math::BigFloat->from_bin('0b1.1001p-4'); # from binary
62669f11ffb7Safresh1  $x = Math::BigFloat->from_bin('0101');        # ditto
626756d68f1eSafresh1  $x = Math::BigFloat->from_ieee754($b, "binary64");  # from IEEE-754 bytes
62689f11ffb7Safresh1  $x = Math::BigFloat->bzero();                 # create a +0
62699f11ffb7Safresh1  $x = Math::BigFloat->bone();                  # create a +1
62709f11ffb7Safresh1  $x = Math::BigFloat->bone('-');               # create a -1
62719f11ffb7Safresh1  $x = Math::BigFloat->binf();                  # create a +inf
62729f11ffb7Safresh1  $x = Math::BigFloat->binf('-');               # create a -inf
62739f11ffb7Safresh1  $x = Math::BigFloat->bnan();                  # create a Not-A-Number
62749f11ffb7Safresh1  $x = Math::BigFloat->bpi();                   # returns pi
6275b8851fccSafresh1
62769f11ffb7Safresh1  $y = $x->copy();        # make a copy (unlike $y = $x)
62779f11ffb7Safresh1  $y = $x->as_int();      # return as BigInt
6278e0680481Safresh1  $y = $x->as_float();    # return as a Math::BigFloat
6279e0680481Safresh1  $y = $x->as_rat();      # return as a Math::BigRat
6280b8851fccSafresh1
62819f11ffb7Safresh1  # Boolean methods (these don't modify the invocand)
6282b8851fccSafresh1
62839f11ffb7Safresh1  $x->is_zero();          # if $x is 0
62849f11ffb7Safresh1  $x->is_one();           # if $x is +1
62859f11ffb7Safresh1  $x->is_one("+");        # ditto
62869f11ffb7Safresh1  $x->is_one("-");        # if $x is -1
62879f11ffb7Safresh1  $x->is_inf();           # if $x is +inf or -inf
62889f11ffb7Safresh1  $x->is_inf("+");        # if $x is +inf
62899f11ffb7Safresh1  $x->is_inf("-");        # if $x is -inf
62909f11ffb7Safresh1  $x->is_nan();           # if $x is NaN
6291b8851fccSafresh1
62929f11ffb7Safresh1  $x->is_positive();      # if $x > 0
62939f11ffb7Safresh1  $x->is_pos();           # ditto
62949f11ffb7Safresh1  $x->is_negative();      # if $x < 0
62959f11ffb7Safresh1  $x->is_neg();           # ditto
6296b8851fccSafresh1
62979f11ffb7Safresh1  $x->is_odd();           # if $x is odd
62989f11ffb7Safresh1  $x->is_even();          # if $x is even
62999f11ffb7Safresh1  $x->is_int();           # if $x is an integer
63009f11ffb7Safresh1
63019f11ffb7Safresh1  # Comparison methods
63029f11ffb7Safresh1
63039f11ffb7Safresh1  $x->bcmp($y);           # compare numbers (undef, < 0, == 0, > 0)
63049f11ffb7Safresh1  $x->bacmp($y);          # compare absolutely (undef, < 0, == 0, > 0)
63059f11ffb7Safresh1  $x->beq($y);            # true if and only if $x == $y
63069f11ffb7Safresh1  $x->bne($y);            # true if and only if $x != $y
63079f11ffb7Safresh1  $x->blt($y);            # true if and only if $x < $y
63089f11ffb7Safresh1  $x->ble($y);            # true if and only if $x <= $y
63099f11ffb7Safresh1  $x->bgt($y);            # true if and only if $x > $y
63109f11ffb7Safresh1  $x->bge($y);            # true if and only if $x >= $y
63119f11ffb7Safresh1
63129f11ffb7Safresh1  # Arithmetic methods
6313b8851fccSafresh1
6314b8851fccSafresh1  $x->bneg();             # negation
6315b8851fccSafresh1  $x->babs();             # absolute value
63169f11ffb7Safresh1  $x->bsgn();             # sign function (-1, 0, 1, or NaN)
6317b8851fccSafresh1  $x->bnorm();            # normalize (no-op)
63189f11ffb7Safresh1  $x->binc();             # increment $x by 1
63199f11ffb7Safresh1  $x->bdec();             # decrement $x by 1
6320b8851fccSafresh1  $x->badd($y);           # addition (add $y to $x)
6321b8851fccSafresh1  $x->bsub($y);           # subtraction (subtract $y from $x)
6322b8851fccSafresh1  $x->bmul($y);           # multiplication (multiply $x by $y)
63239f11ffb7Safresh1  $x->bmuladd($y,$z);     # $x = $x * $y + $z
63249f11ffb7Safresh1  $x->bdiv($y);           # division (floored), set $x to quotient
6325b8851fccSafresh1                          # return (quo,rem) or quo if scalar
63269f11ffb7Safresh1  $x->btdiv($y);          # division (truncated), set $x to quotient
63279f11ffb7Safresh1                          # return (quo,rem) or quo if scalar
63289f11ffb7Safresh1  $x->bmod($y);           # modulus (x % y)
63299f11ffb7Safresh1  $x->btmod($y);          # modulus (truncated)
63309f11ffb7Safresh1  $x->bmodinv($mod);      # modular multiplicative inverse
63319f11ffb7Safresh1  $x->bmodpow($y,$mod);   # modular exponentiation (($x ** $y) % $mod)
63329f11ffb7Safresh1  $x->bpow($y);           # power of arguments (x ** y)
6333b8851fccSafresh1  $x->blog();             # logarithm of $x to base e (Euler's number)
63349f11ffb7Safresh1  $x->blog($base);        # logarithm of $x to base $base (e.g., base 2)
6335b8851fccSafresh1  $x->bexp();             # calculate e ** $x where e is Euler's number
63369f11ffb7Safresh1  $x->bnok($y);           # x over y (binomial coefficient n over k)
63379f11ffb7Safresh1  $x->bsin();             # sine
63389f11ffb7Safresh1  $x->bcos();             # cosine
63399f11ffb7Safresh1  $x->batan();            # inverse tangent
63409f11ffb7Safresh1  $x->batan2($y);         # two-argument inverse tangent
6341b46d8ef2Safresh1  $x->bsqrt();            # calculate square root
6342b8851fccSafresh1  $x->broot($y);          # $y'th root of $x (e.g. $y == 3 => cubic root)
6343b8851fccSafresh1  $x->bfac();             # factorial of $x (1*2*3*4*..$x)
6344b8851fccSafresh1
63459f11ffb7Safresh1  $x->blsft($n);          # left shift $n places in base 2
63469f11ffb7Safresh1  $x->blsft($n,$b);       # left shift $n places in base $b
63479f11ffb7Safresh1                          # returns (quo,rem) or quo (scalar context)
63489f11ffb7Safresh1  $x->brsft($n);          # right shift $n places in base 2
63499f11ffb7Safresh1  $x->brsft($n,$b);       # right shift $n places in base $b
63509f11ffb7Safresh1                          # returns (quo,rem) or quo (scalar context)
6351b8851fccSafresh1
63529f11ffb7Safresh1  # Bitwise methods
63539f11ffb7Safresh1
6354*3d61058aSafresh1  $x->bblsft($y);         # bitwise left shift
6355*3d61058aSafresh1  $x->bbrsft($y);         # bitwise right shift
63569f11ffb7Safresh1  $x->band($y);           # bitwise and
63579f11ffb7Safresh1  $x->bior($y);           # bitwise inclusive or
63589f11ffb7Safresh1  $x->bxor($y);           # bitwise exclusive or
63599f11ffb7Safresh1  $x->bnot();             # bitwise not (two's complement)
63609f11ffb7Safresh1
63619f11ffb7Safresh1  # Rounding methods
63629f11ffb7Safresh1  $x->round($A,$P,$mode); # round to accuracy or precision using
63639f11ffb7Safresh1                          # rounding mode $mode
63649f11ffb7Safresh1  $x->bround($n);         # accuracy: preserve $n digits
63659f11ffb7Safresh1  $x->bfround($n);        # $n > 0: round to $nth digit left of dec. point
63669f11ffb7Safresh1                          # $n < 0: round to $nth digit right of dec. point
63679f11ffb7Safresh1  $x->bfloor();           # round towards minus infinity
63689f11ffb7Safresh1  $x->bceil();            # round towards plus infinity
6369b8851fccSafresh1  $x->bint();             # round towards zero
6370b8851fccSafresh1
63719f11ffb7Safresh1  # Other mathematical methods
6372b8851fccSafresh1
63739f11ffb7Safresh1  $x->bgcd($y);            # greatest common divisor
63749f11ffb7Safresh1  $x->blcm($y);            # least common multiple
6375b8851fccSafresh1
63769f11ffb7Safresh1  # Object property methods (do not modify the invocand)
6377b8851fccSafresh1
63789f11ffb7Safresh1  $x->sign();              # the sign, either +, - or NaN
63799f11ffb7Safresh1  $x->digit($n);           # the nth digit, counting from the right
63809f11ffb7Safresh1  $x->digit(-$n);          # the nth digit, counting from the left
63819f11ffb7Safresh1  $x->length();            # return number of digits in number
63829f11ffb7Safresh1  ($xl,$f) = $x->length(); # length of number and length of fraction
63839f11ffb7Safresh1                           # part, latter is always 0 digits long
63849f11ffb7Safresh1                           # for Math::BigInt objects
63859f11ffb7Safresh1  $x->mantissa();          # return (signed) mantissa as BigInt
6386b8851fccSafresh1  $x->exponent();          # return exponent as BigInt
6387b8851fccSafresh1  $x->parts();             # return (mantissa,exponent) as BigInt
63889f11ffb7Safresh1  $x->sparts();            # mantissa and exponent (as integers)
63899f11ffb7Safresh1  $x->nparts();            # mantissa and exponent (normalised)
63909f11ffb7Safresh1  $x->eparts();            # mantissa and exponent (engineering notation)
63919f11ffb7Safresh1  $x->dparts();            # integer and fraction part
6392eac174f2Safresh1  $x->fparts();            # numerator and denominator
6393eac174f2Safresh1  $x->numerator();         # numerator
6394eac174f2Safresh1  $x->denominator();       # denominator
6395b8851fccSafresh1
63969f11ffb7Safresh1  # Conversion methods (do not modify the invocand)
6397b8851fccSafresh1
63989f11ffb7Safresh1  $x->bstr();         # decimal notation, possibly zero padded
63999f11ffb7Safresh1  $x->bsstr();        # string in scientific notation with integers
64009f11ffb7Safresh1  $x->bnstr();        # string in normalized notation
64019f11ffb7Safresh1  $x->bestr();        # string in engineering notation
64029f11ffb7Safresh1  $x->bdstr();        # string in decimal notation
6403e0680481Safresh1  $x->bfstr();        # string in fractional notation
6404e0680481Safresh1
64059f11ffb7Safresh1  $x->as_hex();       # as signed hexadecimal string with prefixed 0x
64069f11ffb7Safresh1  $x->as_bin();       # as signed binary string with prefixed 0b
64079f11ffb7Safresh1  $x->as_oct();       # as signed octal string with prefixed 0
640856d68f1eSafresh1  $x->to_ieee754($format); # to bytes encoded according to IEEE 754-2008
6409b8851fccSafresh1
64109f11ffb7Safresh1  # Other conversion methods
64119f11ffb7Safresh1
64129f11ffb7Safresh1  $x->numify();           # return as scalar (might overflow or underflow)
6413b8851fccSafresh1
6414b8851fccSafresh1=head1 DESCRIPTION
6415b8851fccSafresh1
64169f11ffb7Safresh1Math::BigFloat provides support for arbitrary precision floating point.
64179f11ffb7Safresh1Overloading is also provided for Perl operators.
64189f11ffb7Safresh1
6419b8851fccSafresh1All operators (including basic math operations) are overloaded if you
6420b8851fccSafresh1declare your big floating point numbers as
6421b8851fccSafresh1
64229f11ffb7Safresh1  $x = Math::BigFloat -> new('12_3.456_789_123_456_789E-2');
6423b8851fccSafresh1
6424b8851fccSafresh1Operations with overloaded operators preserve the arguments, which is
6425b8851fccSafresh1exactly what you expect.
6426b8851fccSafresh1
6427b8851fccSafresh1=head2 Input
6428b8851fccSafresh1
64299f11ffb7Safresh1Input values to these routines may be any scalar number or string that looks
6430eac174f2Safresh1like a number. Anything that is accepted by Perl as a literal numeric constant
6431eac174f2Safresh1should be accepted by this module.
6432b8851fccSafresh1
6433b8851fccSafresh1=over
6434b8851fccSafresh1
6435b8851fccSafresh1=item *
6436b8851fccSafresh1
64379f11ffb7Safresh1Leading and trailing whitespace is ignored.
6438b8851fccSafresh1
6439b8851fccSafresh1=item *
6440b8851fccSafresh1
6441eac174f2Safresh1Leading zeros are ignored, except for floating point numbers with a binary
6442eac174f2Safresh1exponent, in which case the number is interpreted as an octal floating point
6443eac174f2Safresh1number. For example, "01.4p+0" gives 1.5, "00.4p+0" gives 0.5, but "0.4p+0"
6444eac174f2Safresh1gives a NaN. And while "0377" gives 255, "0377p0" gives 255.
6445b8851fccSafresh1
6446b8851fccSafresh1=item *
6447b8851fccSafresh1
6448eac174f2Safresh1If the string has a "0x" or "0X" prefix, it is interpreted as a hexadecimal
6449eac174f2Safresh1number.
6450b8851fccSafresh1
6451b8851fccSafresh1=item *
6452b8851fccSafresh1
6453eac174f2Safresh1If the string has a "0o" or "0O" prefix, it is interpreted as an octal number. A
6454eac174f2Safresh1floating point literal with a "0" prefix is also interpreted as an octal number.
64559f11ffb7Safresh1
64569f11ffb7Safresh1=item *
64579f11ffb7Safresh1
6458eac174f2Safresh1If the string has a "0b" or "0B" prefix, it is interpreted as a binary number.
64599f11ffb7Safresh1
64609f11ffb7Safresh1=item *
64619f11ffb7Safresh1
6462eac174f2Safresh1Underline characters are allowed in the same way as they are allowed in literal
6463eac174f2Safresh1numerical constants.
64649f11ffb7Safresh1
64659f11ffb7Safresh1=item *
64669f11ffb7Safresh1
64679f11ffb7Safresh1If the string can not be interpreted, NaN is returned.
6468b8851fccSafresh1
6469eac174f2Safresh1=item *
6470b8851fccSafresh1
6471eac174f2Safresh1For hexadecimal, octal, and binary floating point numbers, the exponent must be
6472eac174f2Safresh1separated from the significand (mantissa) by the letter "p" or "P", not "e" or
6473eac174f2Safresh1"E" as with decimal numbers.
6474eac174f2Safresh1
6475eac174f2Safresh1=back
6476b8851fccSafresh1
64779f11ffb7Safresh1Some examples of valid string input
6478b8851fccSafresh1
64799f11ffb7Safresh1    Input string                Resulting value
6480eac174f2Safresh1
64819f11ffb7Safresh1    123                         123
64829f11ffb7Safresh1    1.23e2                      123
64839f11ffb7Safresh1    12300e-2                    123
6484eac174f2Safresh1
64859f11ffb7Safresh1    67_538_754                  67538754
64869f11ffb7Safresh1    -4_5_6.7_8_9e+0_1_0         -4567890000000
6487eac174f2Safresh1
6488eac174f2Safresh1    0x13a                       314
6489eac174f2Safresh1    0x13ap0                     314
6490eac174f2Safresh1    0x1.3ap+8                   314
6491eac174f2Safresh1    0x0.00013ap+24              314
6492eac174f2Safresh1    0x13a000p-12                314
6493eac174f2Safresh1
6494eac174f2Safresh1    0o472                       314
6495eac174f2Safresh1    0o1.164p+8                  314
6496eac174f2Safresh1    0o0.0001164p+20             314
6497eac174f2Safresh1    0o1164000p-10               314
6498eac174f2Safresh1
6499eac174f2Safresh1    0472                        472     Note!
6500eac174f2Safresh1    01.164p+8                   314
6501eac174f2Safresh1    00.0001164p+20              314
6502eac174f2Safresh1    01164000p-10                314
6503eac174f2Safresh1
6504eac174f2Safresh1    0b100111010                 314
6505eac174f2Safresh1    0b1.0011101p+8              314
6506eac174f2Safresh1    0b0.00010011101p+12         314
6507eac174f2Safresh1    0b100111010000p-3           314
6508eac174f2Safresh1
65099f11ffb7Safresh1    0x1.921fb5p+1               3.14159262180328369140625e+0
6510eac174f2Safresh1    0o1.2677025p1               2.71828174591064453125
6511eac174f2Safresh1    01.2677025p1                2.71828174591064453125
65129f11ffb7Safresh1    0b1.1001p-4                 9.765625e-2
6513b8851fccSafresh1
6514b8851fccSafresh1=head2 Output
6515b8851fccSafresh1
65169f11ffb7Safresh1Output values are usually Math::BigFloat objects.
6517b8851fccSafresh1
65189f11ffb7Safresh1Boolean operators C<is_zero()>, C<is_one()>, C<is_inf()>, etc. return true or
65199f11ffb7Safresh1false.
6520b8851fccSafresh1
65219f11ffb7Safresh1Comparison operators C<bcmp()> and C<bacmp()>) return -1, 0, 1, or
65229f11ffb7Safresh1undef.
6523b8851fccSafresh1
6524b8851fccSafresh1=head1 METHODS
6525b8851fccSafresh1
6526b8851fccSafresh1Math::BigFloat supports all methods that Math::BigInt supports, except it
65279f11ffb7Safresh1calculates non-integer results when possible. Please see L<Math::BigInt> for a
65289f11ffb7Safresh1full description of each method. Below are just the most important differences:
65299f11ffb7Safresh1
65309f11ffb7Safresh1=head2 Configuration methods
6531b8851fccSafresh1
6532b8851fccSafresh1=over
6533b8851fccSafresh1
6534b8851fccSafresh1=item accuracy()
6535b8851fccSafresh1
6536b8851fccSafresh1    $x->accuracy(5);           # local for $x
6537b8851fccSafresh1    CLASS->accuracy(5);        # global for all members of CLASS
6538b8851fccSafresh1                               # Note: This also applies to new()!
6539b8851fccSafresh1
6540b8851fccSafresh1    $A = $x->accuracy();       # read out accuracy that affects $x
6541b8851fccSafresh1    $A = CLASS->accuracy();    # read out global accuracy
6542b8851fccSafresh1
6543b8851fccSafresh1Set or get the global or local accuracy, aka how many significant digits the
6544b8851fccSafresh1results have. If you set a global accuracy, then this also applies to new()!
6545b8851fccSafresh1
6546b8851fccSafresh1Warning! The accuracy I<sticks>, e.g. once you created a number under the
6547b8851fccSafresh1influence of C<< CLASS->accuracy($A) >>, all results from math operations with
6548b8851fccSafresh1that number will also be rounded.
6549b8851fccSafresh1
6550b8851fccSafresh1In most cases, you should probably round the results explicitly using one of
65519f11ffb7Safresh1L<Math::BigInt/round()>, L<Math::BigInt/bround()> or L<Math::BigInt/bfround()>
65529f11ffb7Safresh1or by passing the desired accuracy to the math operation as additional
65539f11ffb7Safresh1parameter:
6554b8851fccSafresh1
6555b8851fccSafresh1    my $x = Math::BigInt->new(30000);
6556b8851fccSafresh1    my $y = Math::BigInt->new(7);
6557b8851fccSafresh1    print scalar $x->copy()->bdiv($y, 2);           # print 4300
6558b8851fccSafresh1    print scalar $x->copy()->bdiv($y)->bround(2);   # print 4300
6559b8851fccSafresh1
6560b8851fccSafresh1=item precision()
6561b8851fccSafresh1
6562b8851fccSafresh1    $x->precision(-2);        # local for $x, round at the second
6563b8851fccSafresh1                              # digit right of the dot
6564b8851fccSafresh1    $x->precision(2);         # ditto, round at the second digit
6565b8851fccSafresh1                              # left of the dot
6566b8851fccSafresh1
6567b8851fccSafresh1    CLASS->precision(5);      # Global for all members of CLASS
6568b8851fccSafresh1                              # This also applies to new()!
6569b8851fccSafresh1    CLASS->precision(-5);     # ditto
6570b8851fccSafresh1
6571b8851fccSafresh1    $P = CLASS->precision();  # read out global precision
6572b8851fccSafresh1    $P = $x->precision();     # read out precision that affects $x
6573b8851fccSafresh1
6574b8851fccSafresh1Note: You probably want to use L</accuracy()> instead. With L</accuracy()> you
6575b8851fccSafresh1set the number of digits each result should have, with L</precision()> you
6576b8851fccSafresh1set the place where to round!
6577b8851fccSafresh1
65789f11ffb7Safresh1=back
65799f11ffb7Safresh1
65809f11ffb7Safresh1=head2 Constructor methods
65819f11ffb7Safresh1
65829f11ffb7Safresh1=over
65839f11ffb7Safresh1
65849f11ffb7Safresh1=item from_hex()
65859f11ffb7Safresh1
65869f11ffb7Safresh1    $x -> from_hex("0x1.921fb54442d18p+1");
65879f11ffb7Safresh1    $x = Math::BigFloat -> from_hex("0x1.921fb54442d18p+1");
65889f11ffb7Safresh1
65899f11ffb7Safresh1Interpret input as a hexadecimal string.A prefix ("0x", "x", ignoring case) is
65909f11ffb7Safresh1optional. A single underscore character ("_") may be placed between any two
65919f11ffb7Safresh1digits. If the input is invalid, a NaN is returned. The exponent is in base 2
65929f11ffb7Safresh1using decimal digits.
65939f11ffb7Safresh1
65949f11ffb7Safresh1If called as an instance method, the value is assigned to the invocand.
65959f11ffb7Safresh1
65969f11ffb7Safresh1=item from_oct()
65979f11ffb7Safresh1
65989f11ffb7Safresh1    $x -> from_oct("1.3267p-4");
65999f11ffb7Safresh1    $x = Math::BigFloat -> from_oct("1.3267p-4");
66009f11ffb7Safresh1
66019f11ffb7Safresh1Interpret input as an octal string. A single underscore character ("_") may be
66029f11ffb7Safresh1placed between any two digits. If the input is invalid, a NaN is returned. The
66039f11ffb7Safresh1exponent is in base 2 using decimal digits.
66049f11ffb7Safresh1
66059f11ffb7Safresh1If called as an instance method, the value is assigned to the invocand.
66069f11ffb7Safresh1
66079f11ffb7Safresh1=item from_bin()
66089f11ffb7Safresh1
66099f11ffb7Safresh1    $x -> from_bin("0b1.1001p-4");
66109f11ffb7Safresh1    $x = Math::BigFloat -> from_bin("0b1.1001p-4");
66119f11ffb7Safresh1
66129f11ffb7Safresh1Interpret input as a hexadecimal string. A prefix ("0b" or "b", ignoring case)
66139f11ffb7Safresh1is optional. A single underscore character ("_") may be placed between any two
66149f11ffb7Safresh1digits. If the input is invalid, a NaN is returned. The exponent is in base 2
66159f11ffb7Safresh1using decimal digits.
66169f11ffb7Safresh1
66179f11ffb7Safresh1If called as an instance method, the value is assigned to the invocand.
66189f11ffb7Safresh1
661956d68f1eSafresh1=item from_ieee754()
662056d68f1eSafresh1
662156d68f1eSafresh1Interpret the input as a value encoded as described in IEEE754-2008.  The input
662256d68f1eSafresh1can be given as a byte string, hex string or binary string. The input is
662356d68f1eSafresh1assumed to be in big-endian byte-order.
662456d68f1eSafresh1
662556d68f1eSafresh1        # both $dbl and $mbf are 3.141592...
662656d68f1eSafresh1        $bytes = "\x40\x09\x21\xfb\x54\x44\x2d\x18";
662756d68f1eSafresh1        $dbl = unpack "d>", $bytes;
662856d68f1eSafresh1        $mbf = Math::BigFloat -> from_ieee754($bytes, "binary64");
662956d68f1eSafresh1
66309f11ffb7Safresh1=item bpi()
66319f11ffb7Safresh1
66329f11ffb7Safresh1    print Math::BigFloat->bpi(100), "\n";
66339f11ffb7Safresh1
66349f11ffb7Safresh1Calculate PI to N digits (including the 3 before the dot). The result is
66359f11ffb7Safresh1rounded according to the current rounding mode, which defaults to "even".
66369f11ffb7Safresh1
66379f11ffb7Safresh1This method was added in v1.87 of Math::BigInt (June 2007).
66389f11ffb7Safresh1
66399f11ffb7Safresh1=back
66409f11ffb7Safresh1
66419f11ffb7Safresh1=head2 Arithmetic methods
66429f11ffb7Safresh1
66439f11ffb7Safresh1=over
66449f11ffb7Safresh1
66459f11ffb7Safresh1=item bmuladd()
66469f11ffb7Safresh1
66479f11ffb7Safresh1    $x->bmuladd($y,$z);
66489f11ffb7Safresh1
66499f11ffb7Safresh1Multiply $x by $y, and then add $z to the result.
66509f11ffb7Safresh1
66519f11ffb7Safresh1This method was added in v1.87 of Math::BigInt (June 2007).
66529f11ffb7Safresh1
6653*3d61058aSafresh1=item binv()
6654*3d61058aSafresh1
6655*3d61058aSafresh1    $x->binv();
6656*3d61058aSafresh1
6657*3d61058aSafresh1Invert the value of $x, i.e., compute 1/$x.
6658*3d61058aSafresh1
6659b8851fccSafresh1=item bdiv()
6660b8851fccSafresh1
6661b8851fccSafresh1    $q = $x->bdiv($y);
6662b8851fccSafresh1    ($q, $r) = $x->bdiv($y);
6663b8851fccSafresh1
6664b8851fccSafresh1In scalar context, divides $x by $y and returns the result to the given or
6665b8851fccSafresh1default accuracy/precision. In list context, does floored division
6666b8851fccSafresh1(F-division), returning an integer $q and a remainder $r so that $x = $q * $y +
6667b46d8ef2Safresh1$r. The remainer (modulo) is equal to what is returned by C<< $x->bmod($y) >>.
6668b8851fccSafresh1
6669b8851fccSafresh1=item bmod()
6670b8851fccSafresh1
6671b8851fccSafresh1    $x->bmod($y);
6672b8851fccSafresh1
6673b8851fccSafresh1Returns $x modulo $y. When $x is finite, and $y is finite and non-zero, the
6674b8851fccSafresh1result is identical to the remainder after floored division (F-division). If,
6675b8851fccSafresh1in addition, both $x and $y are integers, the result is identical to the result
6676b8851fccSafresh1from Perl's % operator.
6677b8851fccSafresh1
6678b8851fccSafresh1=item bexp()
6679b8851fccSafresh1
6680b8851fccSafresh1    $x->bexp($accuracy);            # calculate e ** X
6681b8851fccSafresh1
6682b8851fccSafresh1Calculates the expression C<e ** $x> where C<e> is Euler's number.
6683b8851fccSafresh1
6684b8851fccSafresh1This method was added in v1.82 of Math::BigInt (April 2007).
6685b8851fccSafresh1
6686b8851fccSafresh1=item bnok()
6687b8851fccSafresh1
6688b8851fccSafresh1    $x->bnok($y);   # x over y (binomial coefficient n over k)
6689b8851fccSafresh1
6690b8851fccSafresh1Calculates the binomial coefficient n over k, also called the "choose"
6691b8851fccSafresh1function. The result is equivalent to:
6692b8851fccSafresh1
6693b8851fccSafresh1    ( n )      n!
6694b8851fccSafresh1    | - |  = -------
6695b8851fccSafresh1    ( k )    k!(n-k)!
6696b8851fccSafresh1
6697b8851fccSafresh1This method was added in v1.84 of Math::BigInt (April 2007).
6698b8851fccSafresh1
66999f11ffb7Safresh1=item bsin()
6700b8851fccSafresh1
67019f11ffb7Safresh1    my $x = Math::BigFloat->new(1);
67029f11ffb7Safresh1    print $x->bsin(100), "\n";
6703b8851fccSafresh1
67049f11ffb7Safresh1Calculate the sinus of $x, modifying $x in place.
6705b8851fccSafresh1
6706b8851fccSafresh1This method was added in v1.87 of Math::BigInt (June 2007).
6707b8851fccSafresh1
6708b8851fccSafresh1=item bcos()
6709b8851fccSafresh1
6710b8851fccSafresh1    my $x = Math::BigFloat->new(1);
6711b8851fccSafresh1    print $x->bcos(100), "\n";
6712b8851fccSafresh1
6713b8851fccSafresh1Calculate the cosinus of $x, modifying $x in place.
6714b8851fccSafresh1
6715b8851fccSafresh1This method was added in v1.87 of Math::BigInt (June 2007).
6716b8851fccSafresh1
67179f11ffb7Safresh1=item batan()
6718b8851fccSafresh1
6719b8851fccSafresh1    my $x = Math::BigFloat->new(1);
67209f11ffb7Safresh1    print $x->batan(100), "\n";
6721b8851fccSafresh1
67229f11ffb7Safresh1Calculate the arcus tanges of $x, modifying $x in place. See also L</batan2()>.
6723b8851fccSafresh1
6724b8851fccSafresh1This method was added in v1.87 of Math::BigInt (June 2007).
6725b8851fccSafresh1
6726b8851fccSafresh1=item batan2()
6727b8851fccSafresh1
6728b8851fccSafresh1    my $y = Math::BigFloat->new(2);
6729b8851fccSafresh1    my $x = Math::BigFloat->new(3);
6730b8851fccSafresh1    print $y->batan2($x), "\n";
6731b8851fccSafresh1
6732b8851fccSafresh1Calculate the arcus tanges of C<$y> divided by C<$x>, modifying $y in place.
6733b8851fccSafresh1See also L</batan()>.
6734b8851fccSafresh1
6735b8851fccSafresh1This method was added in v1.87 of Math::BigInt (June 2007).
6736b8851fccSafresh1
6737b8851fccSafresh1=item as_float()
6738b8851fccSafresh1
6739b8851fccSafresh1This method is called when Math::BigFloat encounters an object it doesn't know
6740b8851fccSafresh1how to handle. For instance, assume $x is a Math::BigFloat, or subclass
6741b8851fccSafresh1thereof, and $y is defined, but not a Math::BigFloat, or subclass thereof. If
6742b8851fccSafresh1you do
6743b8851fccSafresh1
6744b8851fccSafresh1    $x -> badd($y);
6745b8851fccSafresh1
6746b8851fccSafresh1$y needs to be converted into an object that $x can deal with. This is done by
6747b8851fccSafresh1first checking if $y is something that $x might be upgraded to. If that is the
6748b8851fccSafresh1case, no further attempts are made. The next is to see if $y supports the
6749b8851fccSafresh1method C<as_float()>. The method C<as_float()> is expected to return either an
6750b8851fccSafresh1object that has the same class as $x, a subclass thereof, or a string that
6751b8851fccSafresh1C<ref($x)-E<gt>new()> can parse to create an object.
6752b8851fccSafresh1
6753b8851fccSafresh1In Math::BigFloat, C<as_float()> has the same effect as C<copy()>.
6754b8851fccSafresh1
675556d68f1eSafresh1=item to_ieee754()
675656d68f1eSafresh1
675756d68f1eSafresh1Encodes the invocand as a byte string in the given format as specified in IEEE
675856d68f1eSafresh1754-2008. Note that the encoded value is the nearest possible representation of
675956d68f1eSafresh1the value. This value might not be exactly the same as the value in the
676056d68f1eSafresh1invocand.
676156d68f1eSafresh1
676256d68f1eSafresh1    # $x = 3.1415926535897932385
676356d68f1eSafresh1    $x = Math::BigFloat -> bpi(30);
676456d68f1eSafresh1
676556d68f1eSafresh1    $b = $x -> to_ieee754("binary64");  # encode as 8 bytes
676656d68f1eSafresh1    $h = unpack "H*", $b;               # "400921fb54442d18"
676756d68f1eSafresh1
676856d68f1eSafresh1    # 3.141592653589793115997963...
676956d68f1eSafresh1    $y = Math::BigFloat -> from_ieee754($h, "binary64");
677056d68f1eSafresh1
677156d68f1eSafresh1All binary formats in IEEE 754-2008 are accepted. For convenience, som aliases
677256d68f1eSafresh1are recognized: "half" for "binary16", "single" for "binary32", "double" for
677356d68f1eSafresh1"binary64", "quadruple" for "binary128", "octuple" for "binary256", and
677456d68f1eSafresh1"sexdecuple" for "binary512".
677556d68f1eSafresh1
677656d68f1eSafresh1See also L<https://en.wikipedia.org/wiki/IEEE_754>.
677756d68f1eSafresh1
67789f11ffb7Safresh1=back
6779b8851fccSafresh1
67809f11ffb7Safresh1=head2 ACCURACY AND PRECISION
6781b8851fccSafresh1
67829f11ffb7Safresh1See also: L<Rounding|/Rounding>.
6783b8851fccSafresh1
67849f11ffb7Safresh1Math::BigFloat supports both precision (rounding to a certain place before or
67859f11ffb7Safresh1after the dot) and accuracy (rounding to a certain number of digits). For a
67869f11ffb7Safresh1full documentation, examples and tips on these topics please see the large
67879f11ffb7Safresh1section about rounding in L<Math::BigInt>.
6788b8851fccSafresh1
67899f11ffb7Safresh1Since things like C<sqrt(2)> or C<1 / 3> must presented with a limited
67909f11ffb7Safresh1accuracy lest a operation consumes all resources, each operation produces
67919f11ffb7Safresh1no more than the requested number of digits.
6792b8851fccSafresh1
67939f11ffb7Safresh1If there is no global precision or accuracy set, B<and> the operation in
67949f11ffb7Safresh1question was not called with a requested precision or accuracy, B<and> the
67959f11ffb7Safresh1input $x has no accuracy or precision set, then a fallback parameter will
67969f11ffb7Safresh1be used. For historical reasons, it is called C<div_scale> and can be accessed
67979f11ffb7Safresh1via:
6798b8851fccSafresh1
67999f11ffb7Safresh1    $d = Math::BigFloat->div_scale();       # query
68009f11ffb7Safresh1    Math::BigFloat->div_scale($n);          # set to $n digits
6801b8851fccSafresh1
68029f11ffb7Safresh1The default value for C<div_scale> is 40.
6803b8851fccSafresh1
68049f11ffb7Safresh1In case the result of one operation has more digits than specified,
68059f11ffb7Safresh1it is rounded. The rounding mode taken is either the default mode, or the one
68069f11ffb7Safresh1supplied to the operation after the I<scale>:
6807b8851fccSafresh1
68089f11ffb7Safresh1    $x = Math::BigFloat->new(2);
68099f11ffb7Safresh1    Math::BigFloat->accuracy(5);              # 5 digits max
68109f11ffb7Safresh1    $y = $x->copy()->bdiv(3);                 # gives 0.66667
68119f11ffb7Safresh1    $y = $x->copy()->bdiv(3,6);               # gives 0.666667
68129f11ffb7Safresh1    $y = $x->copy()->bdiv(3,6,undef,'odd');   # gives 0.666667
68139f11ffb7Safresh1    Math::BigFloat->round_mode('zero');
68149f11ffb7Safresh1    $y = $x->copy()->bdiv(3,6);               # will also give 0.666667
6815b8851fccSafresh1
6816e0680481Safresh1Note that C<< Math::BigFloat->accuracy() >> and
6817e0680481Safresh1C<< Math::BigFloat->precision() >> set the global variables, and thus B<any>
6818e0680481Safresh1newly created number will be subject to the global rounding B<immediately>. This
6819e0680481Safresh1means that in the examples above, the C<3> as argument to C<bdiv()> will also
6820e0680481Safresh1get an accuracy of B<5>.
6821b8851fccSafresh1
68229f11ffb7Safresh1It is less confusing to either calculate the result fully, and afterwards
68239f11ffb7Safresh1round it explicitly, or use the additional parameters to the math
68249f11ffb7Safresh1functions like so:
68259f11ffb7Safresh1
68269f11ffb7Safresh1    use Math::BigFloat;
68279f11ffb7Safresh1    $x = Math::BigFloat->new(2);
68289f11ffb7Safresh1    $y = $x->copy()->bdiv(3);
68299f11ffb7Safresh1    print $y->bround(5),"\n";               # gives 0.66667
68309f11ffb7Safresh1
68319f11ffb7Safresh1    or
68329f11ffb7Safresh1
68339f11ffb7Safresh1    use Math::BigFloat;
68349f11ffb7Safresh1    $x = Math::BigFloat->new(2);
68359f11ffb7Safresh1    $y = $x->copy()->bdiv(3,5);             # gives 0.66667
68369f11ffb7Safresh1    print "$y\n";
68379f11ffb7Safresh1
68389f11ffb7Safresh1=head2 Rounding
68399f11ffb7Safresh1
68409f11ffb7Safresh1=over
68419f11ffb7Safresh1
68429f11ffb7Safresh1=item bfround ( +$scale )
68439f11ffb7Safresh1
68449f11ffb7Safresh1Rounds to the $scale'th place left from the '.', counting from the dot.
68459f11ffb7Safresh1The first digit is numbered 1.
68469f11ffb7Safresh1
68479f11ffb7Safresh1=item bfround ( -$scale )
68489f11ffb7Safresh1
68499f11ffb7Safresh1Rounds to the $scale'th place right from the '.', counting from the dot.
68509f11ffb7Safresh1
68519f11ffb7Safresh1=item bfround ( 0 )
68529f11ffb7Safresh1
68539f11ffb7Safresh1Rounds to an integer.
68549f11ffb7Safresh1
68559f11ffb7Safresh1=item bround  ( +$scale )
68569f11ffb7Safresh1
68579f11ffb7Safresh1Preserves accuracy to $scale digits from the left (aka significant digits) and
68589f11ffb7Safresh1pads the rest with zeros. If the number is between 1 and -1, the significant
68599f11ffb7Safresh1digits count from the first non-zero after the '.'
68609f11ffb7Safresh1
68619f11ffb7Safresh1=item bround  ( -$scale ) and bround ( 0 )
68629f11ffb7Safresh1
68639f11ffb7Safresh1These are effectively no-ops.
6864b8851fccSafresh1
6865b8851fccSafresh1=back
6866b8851fccSafresh1
68679f11ffb7Safresh1All rounding functions take as a second parameter a rounding mode from one of
68689f11ffb7Safresh1the following: 'even', 'odd', '+inf', '-inf', 'zero', 'trunc' or 'common'.
68699f11ffb7Safresh1
68709f11ffb7Safresh1The default rounding mode is 'even'. By using
68719f11ffb7Safresh1C<< Math::BigFloat->round_mode($round_mode); >> you can get and set the default
68729f11ffb7Safresh1mode for subsequent rounding. The usage of C<$Math::BigFloat::$round_mode> is
68739f11ffb7Safresh1no longer supported.
68749f11ffb7Safresh1The second parameter to the round functions then overrides the default
68759f11ffb7Safresh1temporarily.
68769f11ffb7Safresh1
68779f11ffb7Safresh1The C<as_number()> function returns a BigInt from a Math::BigFloat. It uses
68789f11ffb7Safresh1'trunc' as rounding mode to make it equivalent to:
68799f11ffb7Safresh1
68809f11ffb7Safresh1    $x = 2.5;
68819f11ffb7Safresh1    $y = int($x) + 2;
68829f11ffb7Safresh1
68839f11ffb7Safresh1You can override this by passing the desired rounding mode as parameter to
68849f11ffb7Safresh1C<as_number()>:
68859f11ffb7Safresh1
68869f11ffb7Safresh1    $x = Math::BigFloat->new(2.5);
68879f11ffb7Safresh1    $y = $x->as_number('odd');      # $y = 3
68889f11ffb7Safresh1
6889eac174f2Safresh1=head1 NUMERIC LITERALS
6890b8851fccSafresh1
6891eac174f2Safresh1After C<use Math::BigFloat ':constant'> all numeric literals in the given scope
6892eac174f2Safresh1are converted to C<Math::BigFloat> objects. This conversion happens at compile
6893eac174f2Safresh1time.
6894b8851fccSafresh1
6895eac174f2Safresh1For example,
6896b8851fccSafresh1
6897eac174f2Safresh1    perl -MMath::BigFloat=:constant -le 'print 2e-150'
6898b8851fccSafresh1
6899eac174f2Safresh1prints the exact value of C<2e-150>. Note that without conversion of constants
6900eac174f2Safresh1the expression C<2e-150> is calculated using Perl scalars, which leads to an
6901eac174f2Safresh1inaccuracte result.
6902b8851fccSafresh1
6903eac174f2Safresh1Note that strings are not affected, so that
6904eac174f2Safresh1
6905eac174f2Safresh1    use Math::BigFloat qw/:constant/;
6906eac174f2Safresh1
6907eac174f2Safresh1    $y = "1234567890123456789012345678901234567890"
6908eac174f2Safresh1            + "123456789123456789";
6909eac174f2Safresh1
6910eac174f2Safresh1does not give you what you expect. You need an explicit Math::BigFloat->new()
6911eac174f2Safresh1around at least one of the operands. You should also quote large constants to
6912eac174f2Safresh1prevent loss of precision:
6913eac174f2Safresh1
6914eac174f2Safresh1    use Math::BigFloat;
6915eac174f2Safresh1
6916eac174f2Safresh1    $x = Math::BigFloat->new("1234567889123456789123456789123456789");
6917eac174f2Safresh1
6918eac174f2Safresh1Without the quotes Perl converts the large number to a floating point constant
6919eac174f2Safresh1at compile time, and then converts the result to a Math::BigFloat object at
6920eac174f2Safresh1runtime, which results in an inaccurate result.
6921eac174f2Safresh1
6922eac174f2Safresh1=head2 Hexadecimal, octal, and binary floating point literals
6923eac174f2Safresh1
6924eac174f2Safresh1Perl (and this module) accepts hexadecimal, octal, and binary floating point
6925eac174f2Safresh1literals, but use them with care with Perl versions before v5.32.0, because some
6926eac174f2Safresh1versions of Perl silently give the wrong result. Below are some examples of
6927eac174f2Safresh1different ways to write the number decimal 314.
6928eac174f2Safresh1
6929eac174f2Safresh1Hexadecimal floating point literals:
6930eac174f2Safresh1
6931eac174f2Safresh1    0x1.3ap+8         0X1.3AP+8
6932eac174f2Safresh1    0x1.3ap8          0X1.3AP8
6933eac174f2Safresh1    0x13a0p-4         0X13A0P-4
6934eac174f2Safresh1
6935eac174f2Safresh1Octal floating point literals (with "0" prefix):
6936eac174f2Safresh1
6937eac174f2Safresh1    01.164p+8         01.164P+8
6938eac174f2Safresh1    01.164p8          01.164P8
6939eac174f2Safresh1    011640p-4         011640P-4
6940eac174f2Safresh1
6941eac174f2Safresh1Octal floating point literals (with "0o" prefix) (requires v5.34.0):
6942eac174f2Safresh1
6943eac174f2Safresh1    0o1.164p+8        0O1.164P+8
6944eac174f2Safresh1    0o1.164p8         0O1.164P8
6945eac174f2Safresh1    0o11640p-4        0O11640P-4
6946eac174f2Safresh1
6947eac174f2Safresh1Binary floating point literals:
6948eac174f2Safresh1
6949eac174f2Safresh1    0b1.0011101p+8    0B1.0011101P+8
6950eac174f2Safresh1    0b1.0011101p8     0B1.0011101P8
6951eac174f2Safresh1    0b10011101000p-2  0B10011101000P-2
6952b8851fccSafresh1
6953b8851fccSafresh1=head2 Math library
6954b8851fccSafresh1
6955b8851fccSafresh1Math with the numbers is done (by default) by a module called
6956b8851fccSafresh1Math::BigInt::Calc. This is equivalent to saying:
6957b8851fccSafresh1
6958eac174f2Safresh1    use Math::BigFloat lib => "Calc";
6959b8851fccSafresh1
6960b8851fccSafresh1You can change this by using:
6961b8851fccSafresh1
6962eac174f2Safresh1    use Math::BigFloat lib => "GMP";
6963b8851fccSafresh1
6964eac174f2Safresh1B<Note>: General purpose packages should not be explicit about the library to
6965eac174f2Safresh1use; let the script author decide which is best.
6966b8851fccSafresh1
6967b8851fccSafresh1Note: The keyword 'lib' will warn when the requested library could not be
6968b8851fccSafresh1loaded. To suppress the warning use 'try' instead:
6969b8851fccSafresh1
6970eac174f2Safresh1    use Math::BigFloat try => "GMP";
6971b8851fccSafresh1
6972eac174f2Safresh1If your script works with huge numbers and Calc is too slow for them, you can
6973eac174f2Safresh1also for the loading of one of these libraries and if none of them can be used,
6974eac174f2Safresh1the code will die:
6975b8851fccSafresh1
6976eac174f2Safresh1    use Math::BigFloat only => "GMP,Pari";
6977b8851fccSafresh1
6978eac174f2Safresh1The following would first try to find Math::BigInt::Foo, then Math::BigInt::Bar,
6979eac174f2Safresh1and when this also fails, revert to Math::BigInt::Calc:
6980b8851fccSafresh1
6981eac174f2Safresh1    use Math::BigFloat lib => "Foo,Math::BigInt::Bar";
6982b8851fccSafresh1
6983b8851fccSafresh1See the respective low-level library documentation for further details.
6984b8851fccSafresh1
6985eac174f2Safresh1See L<Math::BigInt> for more details about using a different low-level library.
6986b8851fccSafresh1
6987b8851fccSafresh1=head1 EXPORTS
6988b8851fccSafresh1
6989e0680481Safresh1C<Math::BigFloat> exports nothing by default, but can export the C<bpi()>
6990e0680481Safresh1method:
6991b8851fccSafresh1
6992b8851fccSafresh1    use Math::BigFloat qw/bpi/;
6993b8851fccSafresh1
6994b8851fccSafresh1    print bpi(10), "\n";
6995b8851fccSafresh1
6996b8851fccSafresh1=over
6997b8851fccSafresh1
6998b8851fccSafresh1=item stringify, bstr()
6999b8851fccSafresh1
7000b8851fccSafresh1Both stringify and bstr() now drop the leading '+'. The old code would return
7001b8851fccSafresh1'+1.23', the new returns '1.23'. See the documentation in L<Math::BigInt> for
7002b8851fccSafresh1reasoning and details.
7003b8851fccSafresh1
7004b8851fccSafresh1=item brsft()
7005b8851fccSafresh1
7006b8851fccSafresh1The following will probably not print what you expect:
7007b8851fccSafresh1
7008b8851fccSafresh1    my $c = Math::BigFloat->new('3.14159');
7009b8851fccSafresh1    print $c->brsft(3,10),"\n";     # prints 0.00314153.1415
7010b8851fccSafresh1
7011b8851fccSafresh1It prints both quotient and remainder, since print calls C<brsft()> in list
7012b8851fccSafresh1context. Also, C<< $c->brsft() >> will modify $c, so be careful.
7013b8851fccSafresh1You probably want to use
7014b8851fccSafresh1
7015b8851fccSafresh1    print scalar $c->copy()->brsft(3,10),"\n";
7016b8851fccSafresh1    # or if you really want to modify $c
7017b8851fccSafresh1    print scalar $c->brsft(3,10),"\n";
7018b8851fccSafresh1
7019b8851fccSafresh1instead.
7020b8851fccSafresh1
7021b8851fccSafresh1=item Modifying and =
7022b8851fccSafresh1
7023b8851fccSafresh1Beware of:
7024b8851fccSafresh1
7025b8851fccSafresh1    $x = Math::BigFloat->new(5);
7026b8851fccSafresh1    $y = $x;
7027b8851fccSafresh1
7028b8851fccSafresh1It will not do what you think, e.g. making a copy of $x. Instead it just makes
7029b8851fccSafresh1a second reference to the B<same> object and stores it in $y. Thus anything
7030b8851fccSafresh1that modifies $x will modify $y (except overloaded math operators), and vice
7031b8851fccSafresh1versa. See L<Math::BigInt> for details and how to avoid that.
7032b8851fccSafresh1
7033b8851fccSafresh1=item precision() vs. accuracy()
7034b8851fccSafresh1
7035b8851fccSafresh1A common pitfall is to use L</precision()> when you want to round a result to
7036b8851fccSafresh1a certain number of digits:
7037b8851fccSafresh1
7038b8851fccSafresh1    use Math::BigFloat;
7039b8851fccSafresh1
7040b8851fccSafresh1    Math::BigFloat->precision(4);           # does not do what you
7041b8851fccSafresh1                                            # think it does
7042b8851fccSafresh1    my $x = Math::BigFloat->new(12345);     # rounds $x to "12000"!
7043b8851fccSafresh1    print "$x\n";                           # print "12000"
7044b8851fccSafresh1    my $y = Math::BigFloat->new(3);         # rounds $y to "0"!
7045b8851fccSafresh1    print "$y\n";                           # print "0"
7046b8851fccSafresh1    $z = $x / $y;                           # 12000 / 0 => NaN!
7047b8851fccSafresh1    print "$z\n";
7048b8851fccSafresh1    print $z->precision(),"\n";             # 4
7049b8851fccSafresh1
7050e0680481Safresh1Replacing L</precision()> with L</accuracy()> is probably not what you want,
7051e0680481Safresh1either:
7052b8851fccSafresh1
7053b8851fccSafresh1    use Math::BigFloat;
7054b8851fccSafresh1
7055b8851fccSafresh1    Math::BigFloat->accuracy(4);          # enables global rounding:
7056b8851fccSafresh1    my $x = Math::BigFloat->new(123456);  # rounded immediately
7057b8851fccSafresh1                                          #   to "12350"
7058b8851fccSafresh1    print "$x\n";                         # print "123500"
7059b8851fccSafresh1    my $y = Math::BigFloat->new(3);       # rounded to "3
7060b8851fccSafresh1    print "$y\n";                         # print "3"
7061b8851fccSafresh1    print $z = $x->copy()->bdiv($y),"\n"; # 41170
7062b8851fccSafresh1    print $z->accuracy(),"\n";            # 4
7063b8851fccSafresh1
7064b8851fccSafresh1What you want to use instead is:
7065b8851fccSafresh1
7066b8851fccSafresh1    use Math::BigFloat;
7067b8851fccSafresh1
7068b8851fccSafresh1    my $x = Math::BigFloat->new(123456);    # no rounding
7069b8851fccSafresh1    print "$x\n";                           # print "123456"
7070b8851fccSafresh1    my $y = Math::BigFloat->new(3);         # no rounding
7071b8851fccSafresh1    print "$y\n";                           # print "3"
7072b8851fccSafresh1    print $z = $x->copy()->bdiv($y,4),"\n"; # 41150
7073b8851fccSafresh1    print $z->accuracy(),"\n";              # undef
7074b8851fccSafresh1
7075b8851fccSafresh1In addition to computing what you expected, the last example also does B<not>
7076b8851fccSafresh1"taint" the result with an accuracy or precision setting, which would
7077b8851fccSafresh1influence any further operation.
7078b8851fccSafresh1
7079b8851fccSafresh1=back
7080b8851fccSafresh1
7081b8851fccSafresh1=head1 BUGS
7082b8851fccSafresh1
7083b8851fccSafresh1Please report any bugs or feature requests to
7084b8851fccSafresh1C<bug-math-bigint at rt.cpan.org>, or through the web interface at
7085eac174f2Safresh1L<https://rt.cpan.org/Ticket/Create.html?Queue=Math-BigInt> (requires login).
7086b8851fccSafresh1We will be notified, and then you'll automatically be notified of progress on
7087b8851fccSafresh1your bug as I make changes.
7088b8851fccSafresh1
7089b8851fccSafresh1=head1 SUPPORT
7090b8851fccSafresh1
7091b8851fccSafresh1You can find documentation for this module with the perldoc command.
7092b8851fccSafresh1
7093b8851fccSafresh1    perldoc Math::BigFloat
7094b8851fccSafresh1
7095b8851fccSafresh1You can also look for information at:
7096b8851fccSafresh1
7097b8851fccSafresh1=over 4
7098b8851fccSafresh1
7099eac174f2Safresh1=item * GitHub
7100eac174f2Safresh1
7101eac174f2Safresh1L<https://github.com/pjacklam/p5-Math-BigInt>
7102eac174f2Safresh1
7103b8851fccSafresh1=item * RT: CPAN's request tracker
7104b8851fccSafresh1
7105eac174f2Safresh1L<https://rt.cpan.org/Dist/Display.html?Name=Math-BigInt>
7106b8851fccSafresh1
710756d68f1eSafresh1=item * MetaCPAN
7108b8851fccSafresh1
710956d68f1eSafresh1L<https://metacpan.org/release/Math-BigInt>
7110b8851fccSafresh1
7111b8851fccSafresh1=item * CPAN Testers Matrix
7112b8851fccSafresh1
7113b8851fccSafresh1L<http://matrix.cpantesters.org/?dist=Math-BigInt>
7114b8851fccSafresh1
7115b8851fccSafresh1=back
7116b8851fccSafresh1
7117b8851fccSafresh1=head1 LICENSE
7118b8851fccSafresh1
7119b8851fccSafresh1This program is free software; you may redistribute it and/or modify it under
7120b8851fccSafresh1the same terms as Perl itself.
7121b8851fccSafresh1
7122b8851fccSafresh1=head1 SEE ALSO
7123b8851fccSafresh1
7124*3d61058aSafresh1L<Math::BigInt> and L<Math::BigRat> as well as the backend libraries
7125*3d61058aSafresh1L<Math::BigInt::FastCalc>, L<Math::BigInt::GMP>, and L<Math::BigInt::Pari>,
7126*3d61058aSafresh1L<Math::BigInt::GMPz>, and L<Math::BigInt::BitVect>.
7127b8851fccSafresh1
7128*3d61058aSafresh1The pragmas L<bigint>, L<bigfloat>, and L<bigrat> might also be of interest. In
7129*3d61058aSafresh1addition there is the L<bignum> pragma which does upgrading and downgrading.
7130b8851fccSafresh1
7131b8851fccSafresh1=head1 AUTHORS
7132b8851fccSafresh1
7133b8851fccSafresh1=over 4
7134b8851fccSafresh1
7135b8851fccSafresh1=item *
7136b8851fccSafresh1
7137b8851fccSafresh1Mark Biggar, overloaded interface by Ilya Zakharevich, 1996-2001.
7138b8851fccSafresh1
7139b8851fccSafresh1=item *
7140b8851fccSafresh1
7141b8851fccSafresh1Completely rewritten by Tels L<http://bloodgate.com> in 2001-2008.
7142b8851fccSafresh1
7143b8851fccSafresh1=item *
7144b8851fccSafresh1
71459f11ffb7Safresh1Florian Ragwitz E<lt>flora@cpan.orgE<gt>, 2010.
7146b8851fccSafresh1
7147b8851fccSafresh1=item *
7148b8851fccSafresh1
7149eac174f2Safresh1Peter John Acklam E<lt>pjacklam@gmail.comE<gt>, 2011-.
7150b8851fccSafresh1
7151b8851fccSafresh1=back
7152b8851fccSafresh1
7153b8851fccSafresh1=cut
7154