This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Reflow ‘Having no space’ in perldiag
[perl5.git] / dist / Math-BigInt / lib / Math / BigInt.pm
CommitLineData
13a12e00
JH
1package Math::BigInt;
2
3#
4# "Mike had an infinite amount to do and a negative amount of time in which
5# to do it." - Before and After
6#
7
58cde26e 8# The following hash values are used:
9681bfa6 9# value: unsigned int with actual value (as a Math::BigInt::Calc or similar)
58cde26e
JH
10# sign : +,-,NaN,+inf,-inf
11# _a : accuracy
12# _p : precision
0716bf9b 13# _f : flags, used by MBF to flag parts of a float as untouchable
b4f14daa 14
574bacfe
JH
15# Remember not to take shortcuts ala $xs = $x->{value}; $CALC->foo($xs); since
16# underlying lib might change the reference!
17
58cde26e 18my $class = "Math::BigInt";
0d71d61a 19use 5.006002;
58cde26e 20
db2e1fb3 21$VERSION = '1.991';
b68b7ab1 22
233f7bc0
T
23@ISA = qw(Exporter);
24@EXPORT_OK = qw(objectify bgcd blcm);
b68b7ab1 25
b282a552
T
26# _trap_inf and _trap_nan are internal and should never be accessed from the
27# outside
28use vars qw/$round_mode $accuracy $precision $div_scale $rnd_mode
29 $upgrade $downgrade $_trap_nan $_trap_inf/;
58cde26e
JH
30use strict;
31
32# Inside overload, the first arg is always an object. If the original code had
df0693ed 33# it reversed (like $x = 2 * $y), then the third parameter is true.
091c87b1
T
34# In some cases (like add, $x = $x + 2 is the same as $x = 2 + $x) this makes
35# no difference, but in some cases it does.
58cde26e
JH
36
37# For overloaded ops with only one argument we simple use $_[0]->copy() to
38# preserve the argument.
39
40# Thus inheritance of overload operators becomes possible and transparent for
41# our subclasses without the need to repeat the entire overload section there.
a0d0e21e 42
a5f75d66 43use overload
58cde26e
JH
44'=' => sub { $_[0]->copy(); },
45
58cde26e
JH
46# some shortcuts for speed (assumes that reversed order of arguments is routed
47# to normal '+' and we thus can always modify first arg. If this is changed,
48# this breaks and must be adjusted.)
49'+=' => sub { $_[0]->badd($_[1]); },
50'-=' => sub { $_[0]->bsub($_[1]); },
51'*=' => sub { $_[0]->bmul($_[1]); },
52'/=' => sub { scalar $_[0]->bdiv($_[1]); },
027dc388
JH
53'%=' => sub { $_[0]->bmod($_[1]); },
54'^=' => sub { $_[0]->bxor($_[1]); },
55'&=' => sub { $_[0]->band($_[1]); },
56'|=' => sub { $_[0]->bior($_[1]); },
58cde26e 57
b68b7ab1 58'**=' => sub { $_[0]->bpow($_[1]); },
2d2b2744
T
59'<<=' => sub { $_[0]->blsft($_[1]); },
60'>>=' => sub { $_[0]->brsft($_[1]); },
61
b3abae2a 62# not supported by Perl yet
027dc388
JH
63'..' => \&_pointpoint,
64
a0ac753d 65'<=>' => sub { my $rc = $_[2] ?
bd05a461 66 ref($_[0])->bcmp($_[1],$_[0]) :
a0ac753d
T
67 $_[0]->bcmp($_[1]);
68 $rc = 1 unless defined $rc;
69 $rc <=> 0;
70 },
71# we need '>=' to get things like "1 >= NaN" right:
72'>=' => sub { my $rc = $_[2] ?
73 ref($_[0])->bcmp($_[1],$_[0]) :
74 $_[0]->bcmp($_[1]);
75 # if there was a NaN involved, return false
76 return '' unless defined $rc;
77 $rc >= 0;
78 },
027dc388 79'cmp' => sub {
58cde26e 80 $_[2] ?
b3abae2a
JH
81 "$_[1]" cmp $_[0]->bstr() :
82 $_[0]->bstr() cmp "$_[1]" },
58cde26e 83
60a1aa19
T
84'cos' => sub { $_[0]->copy->bcos(); },
85'sin' => sub { $_[0]->copy->bsin(); },
a87115f0 86'atan2' => sub { $_[2] ?
20e2035c
T
87 ref($_[0])->new($_[1])->batan2($_[0]) :
88 $_[0]->copy()->batan2($_[1]) },
091c87b1 89
b68b7ab1
T
90# are not yet overloadable
91#'hex' => sub { print "hex"; $_[0]; },
92#'oct' => sub { print "oct"; $_[0]; },
93
a0ac753d
T
94# log(N) is log(N, e), where e is Euler's number
95'log' => sub { $_[0]->copy()->blog($_[1], undef); },
7d193e39 96'exp' => sub { $_[0]->copy()->bexp($_[1]); },
58cde26e
JH
97'int' => sub { $_[0]->copy(); },
98'neg' => sub { $_[0]->copy()->bneg(); },
99'abs' => sub { $_[0]->copy()->babs(); },
b3abae2a 100'sqrt' => sub { $_[0]->copy()->bsqrt(); },
58cde26e
JH
101'~' => sub { $_[0]->copy()->bnot(); },
102
12fc2493 103# for subtract it's a bit tricky to not modify b: b-a => -a+b
091c87b1 104'-' => sub { my $c = $_[0]->copy; $_[2] ?
a87115f0
RGS
105 $c->bneg()->badd( $_[1]) :
106 $c->bsub( $_[1]) },
091c87b1
T
107'+' => sub { $_[0]->copy()->badd($_[1]); },
108'*' => sub { $_[0]->copy()->bmul($_[1]); },
109
110'/' => sub {
111 $_[2] ? ref($_[0])->new($_[1])->bdiv($_[0]) : $_[0]->copy->bdiv($_[1]);
112 },
113'%' => sub {
114 $_[2] ? ref($_[0])->new($_[1])->bmod($_[0]) : $_[0]->copy->bmod($_[1]);
115 },
116'**' => sub {
117 $_[2] ? ref($_[0])->new($_[1])->bpow($_[0]) : $_[0]->copy->bpow($_[1]);
118 },
119'<<' => sub {
120 $_[2] ? ref($_[0])->new($_[1])->blsft($_[0]) : $_[0]->copy->blsft($_[1]);
121 },
122'>>' => sub {
123 $_[2] ? ref($_[0])->new($_[1])->brsft($_[0]) : $_[0]->copy->brsft($_[1]);
124 },
125'&' => sub {
126 $_[2] ? ref($_[0])->new($_[1])->band($_[0]) : $_[0]->copy->band($_[1]);
127 },
128'|' => sub {
129 $_[2] ? ref($_[0])->new($_[1])->bior($_[0]) : $_[0]->copy->bior($_[1]);
130 },
131'^' => sub {
132 $_[2] ? ref($_[0])->new($_[1])->bxor($_[0]) : $_[0]->copy->bxor($_[1]);
133 },
134
135# can modify arg of ++ and --, so avoid a copy() for speed, but don't
136# use $_[0]->bone(), it would modify $_[0] to be 1!
58cde26e
JH
137'++' => sub { $_[0]->binc() },
138'--' => sub { $_[0]->bdec() },
139
140# if overloaded, O(1) instead of O(N) and twice as fast for small numbers
141'bool' => sub {
142 # this kludge is needed for perl prior 5.6.0 since returning 0 here fails :-/
091c87b1 143 # v5.6.1 dumps on this: return !$_[0]->is_zero() || undef; :-(
3a427a11
RGS
144 my $t = undef;
145 $t = 1 if !$_[0]->is_zero();
b3abae2a 146 $t;
58cde26e 147 },
a0d0e21e 148
027dc388
JH
149# the original qw() does not work with the TIESCALAR below, why?
150# Order of arguments unsignificant
151'""' => sub { $_[0]->bstr(); },
152'0+' => sub { $_[0]->numify(); }
a5f75d66 153;
a0d0e21e 154
58cde26e
JH
155##############################################################################
156# global constants, flags and accessory
157
b68b7ab1
T
158# These vars are public, but their direct usage is not recommended, use the
159# accessor methods instead
0716bf9b 160
7b29e1e6 161$round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero', 'trunc' or 'common'
ee15d750
JH
162$accuracy = undef;
163$precision = undef;
164$div_scale = 40;
58cde26e 165
b3abae2a
JH
166$upgrade = undef; # default is no upgrade
167$downgrade = undef; # default is no downgrade
168
b68b7ab1 169# These are internally, and not to be used from the outside at all
990fb837
RGS
170
171$_trap_nan = 0; # are NaNs ok? set w/ config()
172$_trap_inf = 0; # are infs ok? set w/ config()
173my $nan = 'NaN'; # constants for easier life
174
233f7bc0
T
175my $CALC = 'Math::BigInt::FastCalc'; # module to do the low level math
176 # default is FastCalc.pm
990fb837
RGS
177my $IMPORT = 0; # was import() called yet?
178 # used to make require work
9b924220
RGS
179my %WARN; # warn only once for low-level libs
180my %CAN; # cache for $CALC->can(...)
b68b7ab1 181my %CALLBACKS; # callbacks to notify on lib loads
b282a552 182my $EMU_LIB = 'Math/BigInt/CalcEmu.pm'; # emulate low-level math
b282a552 183
027dc388
JH
184##############################################################################
185# the old code had $rnd_mode, so we need to support it, too
186
187$rnd_mode = 'even';
188sub TIESCALAR { my ($class) = @_; bless \$round_mode, $class; }
189sub FETCH { return $round_mode; }
190sub STORE { $rnd_mode = $_[0]->round_mode($_[1]); }
191
b282a552
T
192BEGIN
193 {
194 # tie to enable $rnd_mode to work transparently
195 tie $rnd_mode, 'Math::BigInt';
196
197 # set up some handy alias names
198 *as_int = \&as_number;
199 *is_pos = \&is_positive;
200 *is_neg = \&is_negative;
201 }
027dc388
JH
202
203##############################################################################
204
58cde26e
JH
205sub round_mode
206 {
ee15d750 207 no strict 'refs';
58cde26e 208 # make Class->round_mode() work
ee15d750
JH
209 my $self = shift;
210 my $class = ref($self) || $self || __PACKAGE__;
58cde26e
JH
211 if (defined $_[0])
212 {
213 my $m = shift;
7b29e1e6 214 if ($m !~ /^(even|odd|\+inf|\-inf|zero|trunc|common)$/)
990fb837
RGS
215 {
216 require Carp; Carp::croak ("Unknown round mode '$m'");
217 }
b3abae2a 218 return ${"${class}::round_mode"} = $m;
58cde26e 219 }
990fb837 220 ${"${class}::round_mode"};
ee15d750
JH
221 }
222
b3abae2a
JH
223sub upgrade
224 {
225 no strict 'refs';
28df3e88 226 # make Class->upgrade() work
b3abae2a
JH
227 my $self = shift;
228 my $class = ref($self) || $self || __PACKAGE__;
9393ace2
JH
229 # need to set new value?
230 if (@_ > 0)
b3abae2a 231 {
b68b7ab1 232 return ${"${class}::upgrade"} = $_[0];
b3abae2a 233 }
990fb837 234 ${"${class}::upgrade"};
b3abae2a
JH
235 }
236
28df3e88
JH
237sub downgrade
238 {
239 no strict 'refs';
240 # make Class->downgrade() work
241 my $self = shift;
242 my $class = ref($self) || $self || __PACKAGE__;
9393ace2
JH
243 # need to set new value?
244 if (@_ > 0)
28df3e88 245 {
b68b7ab1 246 return ${"${class}::downgrade"} = $_[0];
28df3e88 247 }
990fb837 248 ${"${class}::downgrade"};
28df3e88
JH
249 }
250
ee15d750
JH
251sub div_scale
252 {
253 no strict 'refs';
990fb837 254 # make Class->div_scale() work
ee15d750
JH
255 my $self = shift;
256 my $class = ref($self) || $self || __PACKAGE__;
257 if (defined $_[0])
258 {
990fb837
RGS
259 if ($_[0] < 0)
260 {
261 require Carp; Carp::croak ('div_scale must be greater than zero');
262 }
b68b7ab1 263 ${"${class}::div_scale"} = $_[0];
ee15d750 264 }
990fb837 265 ${"${class}::div_scale"};
58cde26e
JH
266 }
267
268sub accuracy
269 {
ee15d750
JH
270 # $x->accuracy($a); ref($x) $a
271 # $x->accuracy(); ref($x)
272 # Class->accuracy(); class
273 # Class->accuracy($a); class $a
58cde26e 274
ee15d750
JH
275 my $x = shift;
276 my $class = ref($x) || $x || __PACKAGE__;
58cde26e 277
ee15d750
JH
278 no strict 'refs';
279 # need to set new value?
58cde26e
JH
280 if (@_ > 0)
281 {
ee15d750 282 my $a = shift;
990fb837
RGS
283 # convert objects to scalars to avoid deep recursion. If object doesn't
284 # have numify(), then hopefully it will have overloading for int() and
285 # boolean test without wandering into a deep recursion path...
286 $a = $a->numify() if ref($a) && $a->can('numify');
287
288 if (defined $a)
289 {
290 # also croak on non-numerical
291 if (!$a || $a <= 0)
292 {
293 require Carp;
d5351619 294 Carp::croak ('Argument to accuracy must be greater than zero');
990fb837
RGS
295 }
296 if (int($a) != $a)
297 {
d5351619
T
298 require Carp;
299 Carp::croak ('Argument to accuracy must be an integer');
990fb837
RGS
300 }
301 }
ee15d750
JH
302 if (ref($x))
303 {
304 # $object->accuracy() or fallback to global
ef9466ea
T
305 $x->bround($a) if $a; # not for undef, 0
306 $x->{_a} = $a; # set/overwrite, even if not rounded
307 delete $x->{_p}; # clear P
990fb837 308 $a = ${"${class}::accuracy"} unless defined $a; # proper return value
ee15d750
JH
309 }
310 else
311 {
ef9466ea
T
312 ${"${class}::accuracy"} = $a; # set global A
313 ${"${class}::precision"} = undef; # clear global P
ee15d750 314 }
ef9466ea 315 return $a; # shortcut
ee15d750
JH
316 }
317
b68b7ab1 318 my $a;
f9a08e12 319 # $object->accuracy() or fallback to global
b68b7ab1 320 $a = $x->{_a} if ref($x);
f9a08e12 321 # but don't return global undef, when $x's accuracy is 0!
b68b7ab1
T
322 $a = ${"${class}::accuracy"} if !defined $a;
323 $a;
990fb837 324 }
58cde26e
JH
325
326sub precision
327 {
ee15d750
JH
328 # $x->precision($p); ref($x) $p
329 # $x->precision(); ref($x)
330 # Class->precision(); class
331 # Class->precision($p); class $p
58cde26e 332
ee15d750
JH
333 my $x = shift;
334 my $class = ref($x) || $x || __PACKAGE__;
58cde26e 335
ee15d750 336 no strict 'refs';
58cde26e
JH
337 if (@_ > 0)
338 {
ee15d750 339 my $p = shift;
990fb837
RGS
340 # convert objects to scalars to avoid deep recursion. If object doesn't
341 # have numify(), then hopefully it will have overloading for int() and
342 # boolean test without wandering into a deep recursion path...
343 $p = $p->numify() if ref($p) && $p->can('numify');
344 if ((defined $p) && (int($p) != $p))
345 {
346 require Carp; Carp::croak ('Argument to precision must be an integer');
347 }
ee15d750
JH
348 if (ref($x))
349 {
350 # $object->precision() or fallback to global
ef9466ea
T
351 $x->bfround($p) if $p; # not for undef, 0
352 $x->{_p} = $p; # set/overwrite, even if not rounded
353 delete $x->{_a}; # clear A
990fb837 354 $p = ${"${class}::precision"} unless defined $p; # proper return value
ee15d750
JH
355 }
356 else
357 {
ef9466ea
T
358 ${"${class}::precision"} = $p; # set global P
359 ${"${class}::accuracy"} = undef; # clear global A
ee15d750 360 }
ef9466ea 361 return $p; # shortcut
58cde26e 362 }
ee15d750 363
b68b7ab1 364 my $p;
f9a08e12 365 # $object->precision() or fallback to global
b68b7ab1 366 $p = $x->{_p} if ref($x);
f9a08e12 367 # but don't return global undef, when $x's precision is 0!
b68b7ab1
T
368 $p = ${"${class}::precision"} if !defined $p;
369 $p;
990fb837 370 }
58cde26e 371
b3abae2a
JH
372sub config
373 {
990fb837 374 # return (or set) configuration data as hash ref
b3abae2a
JH
375 my $class = shift || 'Math::BigInt';
376
377 no strict 'refs';
2ebb273f 378 if (@_ > 1 || (@_ == 1 && (ref($_[0]) eq 'HASH')))
990fb837
RGS
379 {
380 # try to set given options as arguments from hash
381
382 my $args = $_[0];
383 if (ref($args) ne 'HASH')
384 {
385 $args = { @_ };
386 }
387 # these values can be "set"
388 my $set_args = {};
389 foreach my $key (
390 qw/trap_inf trap_nan
391 upgrade downgrade precision accuracy round_mode div_scale/
392 )
393 {
394 $set_args->{$key} = $args->{$key} if exists $args->{$key};
395 delete $args->{$key};
396 }
397 if (keys %$args > 0)
398 {
399 require Carp;
400 Carp::croak ("Illegal key(s) '",
401 join("','",keys %$args),"' passed to $class\->config()");
402 }
403 foreach my $key (keys %$set_args)
404 {
405 if ($key =~ /^trap_(inf|nan)\z/)
406 {
407 ${"${class}::_trap_$1"} = ($set_args->{"trap_$1"} ? 1 : 0);
408 next;
409 }
410 # use a call instead of just setting the $variable to check argument
411 $class->$key($set_args->{$key});
412 }
413 }
414
415 # now return actual configuration
416
b3abae2a 417 my $cfg = {
990fb837
RGS
418 lib => $CALC,
419 lib_version => ${"${CALC}::VERSION"},
b3abae2a 420 class => $class,
990fb837
RGS
421 trap_nan => ${"${class}::_trap_nan"},
422 trap_inf => ${"${class}::_trap_inf"},
423 version => ${"${class}::VERSION"},
b3abae2a 424 };
990fb837
RGS
425 foreach my $key (qw/
426 upgrade downgrade precision accuracy round_mode div_scale
427 /)
b3abae2a 428 {
990fb837 429 $cfg->{$key} = ${"${class}::$key"};
b3abae2a 430 };
2ebb273f
T
431 if (@_ == 1 && (ref($_[0]) ne 'HASH'))
432 {
433 # calls of the style config('lib') return just this value
434 return $cfg->{$_[0]};
435 }
b3abae2a
JH
436 $cfg;
437 }
438
58cde26e
JH
439sub _scale_a
440 {
441 # select accuracy parameter based on precedence,
442 # used by bround() and bfround(), may return undef for scale (means no op)
b68b7ab1
T
443 my ($x,$scale,$mode) = @_;
444
445 $scale = $x->{_a} unless defined $scale;
446
447 no strict 'refs';
448 my $class = ref($x);
449
450 $scale = ${ $class . '::accuracy' } unless defined $scale;
451 $mode = ${ $class . '::round_mode' } unless defined $mode;
452
d5351619
T
453 if (defined $scale)
454 {
455 $scale = $scale->can('numify') ? $scale->numify() : "$scale" if ref($scale);
456 $scale = int($scale);
457 }
458
b68b7ab1 459 ($scale,$mode);
58cde26e
JH
460 }
461
462sub _scale_p
463 {
464 # select precision parameter based on precedence,
465 # used by bround() and bfround(), may return undef for scale (means no op)
b68b7ab1
T
466 my ($x,$scale,$mode) = @_;
467
468 $scale = $x->{_p} unless defined $scale;
469
470 no strict 'refs';
471 my $class = ref($x);
472
473 $scale = ${ $class . '::precision' } unless defined $scale;
474 $mode = ${ $class . '::round_mode' } unless defined $mode;
475
d5351619
T
476 if (defined $scale)
477 {
478 $scale = $scale->can('numify') ? $scale->numify() : "$scale" if ref($scale);
479 $scale = int($scale);
480 }
481
b68b7ab1 482 ($scale,$mode);
58cde26e
JH
483 }
484
485##############################################################################
486# constructors
487
488sub copy
489 {
86f0d17a 490 # if two arguments, the first one is the class to "swallow" subclasses
58cde26e
JH
491 if (@_ > 1)
492 {
86f0d17a
T
493 my $self = bless {
494 sign => $_[1]->{sign},
495 value => $CALC->_copy($_[1]->{value}),
496 }, $_[0] if @_ > 1;
497
498 $self->{_a} = $_[1]->{_a} if defined $_[1]->{_a};
499 $self->{_p} = $_[1]->{_p} if defined $_[1]->{_p};
500 return $self;
58cde26e 501 }
58cde26e 502
86f0d17a
T
503 my $self = bless {
504 sign => $_[0]->{sign},
505 value => $CALC->_copy($_[0]->{value}),
506 }, ref($_[0]);
9b924220 507
86f0d17a
T
508 $self->{_a} = $_[0]->{_a} if defined $_[0]->{_a};
509 $self->{_p} = $_[0]->{_p} if defined $_[0]->{_p};
58cde26e
JH
510 $self;
511 }
512
513sub new
514 {
b22b3e31 515 # create a new BigInt object from a string or another BigInt object.
0716bf9b 516 # see hash keys documented at top
58cde26e
JH
517
518 # the argument could be an object, so avoid ||, && etc on it, this would
b22b3e31
PN
519 # cause costly overloaded code to be called. The only allowed ops are
520 # ref() and defined.
58cde26e 521
61f5c3f5 522 my ($class,$wanted,$a,$p,$r) = @_;
58cde26e 523
61f5c3f5
T
524 # avoid numify-calls by not using || on $wanted!
525 return $class->bzero($a,$p) if !defined $wanted; # default to 0
9393ace2
JH
526 return $class->copy($wanted,$a,$p,$r)
527 if ref($wanted) && $wanted->isa($class); # MBI or subclass
58cde26e 528
61f5c3f5
T
529 $class->import() if $IMPORT == 0; # make require work
530
9393ace2
JH
531 my $self = bless {}, $class;
532
533 # shortcut for "normal" numbers
739c8b3a 534 if ((!ref $wanted) && ($wanted =~ /^([+-]?)[1-9][0-9]*\z/))
9393ace2
JH
535 {
536 $self->{sign} = $1 || '+';
9b924220 537
9393ace2
JH
538 if ($wanted =~ /^[+-]/)
539 {
56d9de68 540 # remove sign without touching wanted to make it work with constants
9b924220
RGS
541 my $t = $wanted; $t =~ s/^[+-]//;
542 $self->{value} = $CALC->_new($t);
543 }
544 else
545 {
546 $self->{value} = $CALC->_new($wanted);
9393ace2 547 }
9393ace2
JH
548 no strict 'refs';
549 if ( (defined $a) || (defined $p)
550 || (defined ${"${class}::precision"})
551 || (defined ${"${class}::accuracy"})
552 )
553 {
554 $self->round($a,$p,$r) unless (@_ == 4 && !defined $a && !defined $p);
555 }
556 return $self;
557 }
558
58cde26e 559 # handle '+inf', '-inf' first
233f7bc0 560 if ($wanted =~ /^[+-]?inf\z/)
58cde26e 561 {
233f7bc0
T
562 $self->{sign} = $wanted; # set a default sign for bstr()
563 return $self->binf($wanted);
58cde26e
JH
564 }
565 # split str in m mantissa, e exponent, i integer, f fraction, v value, s sign
9b924220 566 my ($mis,$miv,$mfv,$es,$ev) = _split($wanted);
58cde26e
JH
567 if (!ref $mis)
568 {
990fb837
RGS
569 if ($_trap_nan)
570 {
571 require Carp; Carp::croak("$wanted is not a number in $class");
572 }
0716bf9b 573 $self->{value} = $CALC->_zero();
58cde26e
JH
574 $self->{sign} = $nan;
575 return $self;
576 }
574bacfe
JH
577 if (!ref $miv)
578 {
579 # _from_hex or _from_bin
580 $self->{value} = $mis->{value};
581 $self->{sign} = $mis->{sign};
582 return $self; # throw away $mis
583 }
58cde26e
JH
584 # make integer from mantissa by adjusting exp, then convert to bigint
585 $self->{sign} = $$mis; # store sign
0716bf9b 586 $self->{value} = $CALC->_zero(); # for all the NaN cases
58cde26e
JH
587 my $e = int("$$es$$ev"); # exponent (avoid recursion)
588 if ($e > 0)
589 {
590 my $diff = $e - CORE::length($$mfv);
591 if ($diff < 0) # Not integer
592 {
990fb837
RGS
593 if ($_trap_nan)
594 {
595 require Carp; Carp::croak("$wanted not an integer in $class");
596 }
58cde26e 597 #print "NOI 1\n";
b3abae2a 598 return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
58cde26e
JH
599 $self->{sign} = $nan;
600 }
601 else # diff >= 0
602 {
603 # adjust fraction and add it to value
990fb837 604 #print "diff > 0 $$miv\n";
58cde26e
JH
605 $$miv = $$miv . ($$mfv . '0' x $diff);
606 }
607 }
608 else
609 {
610 if ($$mfv ne '') # e <= 0
611 {
612 # fraction and negative/zero E => NOI
990fb837
RGS
613 if ($_trap_nan)
614 {
615 require Carp; Carp::croak("$wanted not an integer in $class");
616 }
58cde26e 617 #print "NOI 2 \$\$mfv '$$mfv'\n";
b3abae2a 618 return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
58cde26e
JH
619 $self->{sign} = $nan;
620 }
621 elsif ($e < 0)
622 {
623 # xE-y, and empty mfv
624 #print "xE-y\n";
625 $e = abs($e);
626 if ($$miv !~ s/0{$e}$//) # can strip so many zero's?
627 {
990fb837
RGS
628 if ($_trap_nan)
629 {
630 require Carp; Carp::croak("$wanted not an integer in $class");
631 }
58cde26e 632 #print "NOI 3\n";
b3abae2a 633 return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
58cde26e
JH
634 $self->{sign} = $nan;
635 }
636 }
637 }
638 $self->{sign} = '+' if $$miv eq '0'; # normalize -0 => +0
9b924220 639 $self->{value} = $CALC->_new($$miv) if $self->{sign} =~ /^[+-]$/;
0716bf9b 640 # if any of the globals is set, use them to round and store them inside $self
61f5c3f5
T
641 # do not round for new($x,undef,undef) since that is used by MBF to signal
642 # no rounding
643 $self->round($a,$p,$r) unless @_ == 4 && !defined $a && !defined $p;
9393ace2 644 $self;
58cde26e
JH
645 }
646
58cde26e
JH
647sub bnan
648 {
649 # create a bigint 'NaN', if given a BigInt, set it to 'NaN'
b4f14daa 650 my $self = shift;
58cde26e
JH
651 $self = $class if !defined $self;
652 if (!ref($self))
653 {
654 my $c = $self; $self = {}; bless $self, $c;
655 }
990fb837
RGS
656 no strict 'refs';
657 if (${"${class}::_trap_nan"})
658 {
659 require Carp;
660 Carp::croak ("Tried to set $self to NaN in $class\::bnan()");
661 }
61f5c3f5 662 $self->import() if $IMPORT == 0; # make require work
58cde26e 663 return if $self->modify('bnan');
13a12e00
JH
664 if ($self->can('_bnan'))
665 {
666 # use subclass to initialize
667 $self->_bnan();
668 }
669 else
670 {
671 # otherwise do our own thing
672 $self->{value} = $CALC->_zero();
673 }
58cde26e 674 $self->{sign} = $nan;
394e6ffb 675 delete $self->{_a}; delete $self->{_p}; # rounding NaN is silly
ef9466ea 676 $self;
b4f14daa 677 }
58cde26e
JH
678
679sub binf
680 {
681 # create a bigint '+-inf', if given a BigInt, set it to '+-inf'
682 # the sign is either '+', or if given, used from there
683 my $self = shift;
56b9c951 684 my $sign = shift; $sign = '+' if !defined $sign || $sign !~ /^-(inf)?$/;
58cde26e
JH
685 $self = $class if !defined $self;
686 if (!ref($self))
687 {
688 my $c = $self; $self = {}; bless $self, $c;
689 }
990fb837
RGS
690 no strict 'refs';
691 if (${"${class}::_trap_inf"})
692 {
693 require Carp;
233f7bc0 694 Carp::croak ("Tried to set $self to +-inf in $class\::binf()");
990fb837 695 }
61f5c3f5 696 $self->import() if $IMPORT == 0; # make require work
58cde26e 697 return if $self->modify('binf');
13a12e00
JH
698 if ($self->can('_binf'))
699 {
700 # use subclass to initialize
701 $self->_binf();
702 }
703 else
704 {
705 # otherwise do our own thing
706 $self->{value} = $CALC->_zero();
707 }
56b9c951
JH
708 $sign = $sign . 'inf' if $sign !~ /inf$/; # - => -inf
709 $self->{sign} = $sign;
394e6ffb 710 ($self->{_a},$self->{_p}) = @_; # take over requested rounding
ef9466ea 711 $self;
58cde26e
JH
712 }
713
714sub bzero
715 {
716 # create a bigint '+0', if given a BigInt, set it to 0
717 my $self = shift;
12fc2493 718 $self = __PACKAGE__ if !defined $self;
0716bf9b 719
58cde26e
JH
720 if (!ref($self))
721 {
722 my $c = $self; $self = {}; bless $self, $c;
723 }
61f5c3f5 724 $self->import() if $IMPORT == 0; # make require work
58cde26e 725 return if $self->modify('bzero');
990fb837 726
13a12e00
JH
727 if ($self->can('_bzero'))
728 {
729 # use subclass to initialize
730 $self->_bzero();
731 }
732 else
733 {
734 # otherwise do our own thing
735 $self->{value} = $CALC->_zero();
736 }
58cde26e 737 $self->{sign} = '+';
61f5c3f5
T
738 if (@_ > 0)
739 {
f9a08e12
JH
740 if (@_ > 3)
741 {
742 # call like: $x->bzero($a,$p,$r,$y);
743 ($self,$self->{_a},$self->{_p}) = $self->_find_round_parameters(@_);
744 }
745 else
746 {
747 $self->{_a} = $_[0]
748 if ( (!defined $self->{_a}) || (defined $_[0] && $_[0] > $self->{_a}));
749 $self->{_p} = $_[1]
750 if ( (!defined $self->{_p}) || (defined $_[1] && $_[1] > $self->{_p}));
751 }
61f5c3f5 752 }
f9a08e12 753 $self;
58cde26e
JH
754 }
755
574bacfe
JH
756sub bone
757 {
758 # create a bigint '+1' (or -1 if given sign '-'),
3c4b39be 759 # if given a BigInt, set it to +1 or -1, respectively
574bacfe
JH
760 my $self = shift;
761 my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-';
762 $self = $class if !defined $self;
990fb837 763
574bacfe
JH
764 if (!ref($self))
765 {
766 my $c = $self; $self = {}; bless $self, $c;
767 }
61f5c3f5 768 $self->import() if $IMPORT == 0; # make require work
574bacfe 769 return if $self->modify('bone');
13a12e00
JH
770
771 if ($self->can('_bone'))
772 {
773 # use subclass to initialize
774 $self->_bone();
775 }
776 else
777 {
778 # otherwise do our own thing
779 $self->{value} = $CALC->_one();
780 }
574bacfe 781 $self->{sign} = $sign;
61f5c3f5
T
782 if (@_ > 0)
783 {
f9a08e12
JH
784 if (@_ > 3)
785 {
786 # call like: $x->bone($sign,$a,$p,$r,$y);
787 ($self,$self->{_a},$self->{_p}) = $self->_find_round_parameters(@_);
788 }
789 else
790 {
091c87b1 791 # call like: $x->bone($sign,$a,$p,$r);
f9a08e12
JH
792 $self->{_a} = $_[0]
793 if ( (!defined $self->{_a}) || (defined $_[0] && $_[0] > $self->{_a}));
794 $self->{_p} = $_[1]
795 if ( (!defined $self->{_p}) || (defined $_[1] && $_[1] > $self->{_p}));
796 }
61f5c3f5 797 }
f9a08e12 798 $self;
574bacfe
JH
799 }
800
58cde26e 801##############################################################################
9681bfa6 802# string conversion
58cde26e
JH
803
804sub bsstr
805 {
806 # (ref to BFLOAT or num_str ) return num_str
807 # Convert number from internal format to scientific string format.
808 # internal format is always normalized (no leading zeros, "-0E0" => "+0E0")
b68b7ab1 809 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
58cde26e 810
574bacfe
JH
811 if ($x->{sign} !~ /^[+-]$/)
812 {
813 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
814 return 'inf'; # +inf
815 }
58cde26e 816 my ($m,$e) = $x->parts();
b282a552
T
817 #$m->bstr() . 'e+' . $e->bstr(); # e can only be positive in BigInt
818 # 'e+' because E can only be positive in BigInt
9b924220 819 $m->bstr() . 'e+' . $CALC->_str($e->{value});
58cde26e
JH
820 }
821
822sub bstr
823 {
0716bf9b 824 # make a string from bigint object
b68b7ab1 825 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
56b9c951 826
574bacfe
JH
827 if ($x->{sign} !~ /^[+-]$/)
828 {
829 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
830 return 'inf'; # +inf
831 }
0716bf9b 832 my $es = ''; $es = $x->{sign} if $x->{sign} eq '-';
9b924220 833 $es.$CALC->_str($x->{value});
58cde26e
JH
834 }
835
836sub numify
837 {
394e6ffb 838 # Make a "normal" scalar from a BigInt object
58cde26e 839 my $x = shift; $x = $class->new($x) unless ref $x;
56d9de68
T
840
841 return $x->bstr() if $x->{sign} !~ /^[+-]$/;
0716bf9b
JH
842 my $num = $CALC->_num($x->{value});
843 return -$num if $x->{sign} eq '-';
9393ace2 844 $num;
58cde26e
JH
845 }
846
847##############################################################################
848# public stuff (usually prefixed with "b")
849
850sub sign
851 {
9393ace2 852 # return the sign of the number: +/-/-inf/+inf/NaN
b282a552 853 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
ee15d750 854
9393ace2 855 $x->{sign};
58cde26e
JH
856 }
857
ee15d750 858sub _find_round_parameters
58cde26e
JH
859 {
860 # After any operation or when calling round(), the result is rounded by
861 # regarding the A & P from arguments, local parameters, or globals.
61f5c3f5 862
990fb837
RGS
863 # !!!!!!! If you change this, remember to change round(), too! !!!!!!!!!!
864
61f5c3f5
T
865 # This procedure finds the round parameters, but it is for speed reasons
866 # duplicated in round. Otherwise, it is tested by the testsuite and used
867 # by fdiv().
990fb837
RGS
868
869 # returns ($self) or ($self,$a,$p,$r) - sets $self to NaN of both A and P
870 # were requested/defined (locally or globally or both)
61f5c3f5 871
394e6ffb
JH
872 my ($self,$a,$p,$r,@args) = @_;
873 # $a accuracy, if given by caller
874 # $p precision, if given by caller
875 # $r round_mode, if given by caller
876 # @args all 'other' arguments (0 for unary, 1 for binary ops)
58cde26e 877
394e6ffb 878 my $c = ref($self); # find out class of argument(s)
574bacfe 879 no strict 'refs';
574bacfe 880
86b76201 881 # convert to normal scalar for speed and correctness in inner parts
86f0d17a
T
882 $a = $a->can('numify') ? $a->numify() : "$a" if defined $a && ref($a);
883 $p = $p->can('numify') ? $p->numify() : "$p" if defined $p && ref($p);
86b76201 884
58cde26e 885 # now pick $a or $p, but only if we have got "arguments"
61f5c3f5 886 if (!defined $a)
58cde26e 887 {
61f5c3f5 888 foreach ($self,@args)
58cde26e
JH
889 {
890 # take the defined one, or if both defined, the one that is smaller
891 $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
892 }
61f5c3f5
T
893 }
894 if (!defined $p)
ee15d750 895 {
61f5c3f5
T
896 # even if $a is defined, take $p, to signal error for both defined
897 foreach ($self,@args)
898 {
899 # take the defined one, or if both defined, the one that is bigger
900 # -2 > -3, and 3 > 2
901 $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
902 }
ee15d750 903 }
61f5c3f5
T
904 # if still none defined, use globals (#2)
905 $a = ${"$c\::accuracy"} unless defined $a;
906 $p = ${"$c\::precision"} unless defined $p;
990fb837
RGS
907
908 # A == 0 is useless, so undef it to signal no rounding
909 $a = undef if defined $a && $a == 0;
61f5c3f5
T
910
911 # no rounding today?
912 return ($self) unless defined $a || defined $p; # early out
913
914 # set A and set P is an fatal error
990fb837 915 return ($self->bnan()) if defined $a && defined $p; # error
61f5c3f5
T
916
917 $r = ${"$c\::round_mode"} unless defined $r;
7b29e1e6 918 if ($r !~ /^(even|odd|\+inf|\-inf|zero|trunc|common)$/)
990fb837
RGS
919 {
920 require Carp; Carp::croak ("Unknown round mode '$r'");
921 }
922
d5351619
T
923 $a = int($a) if defined $a;
924 $p = int($p) if defined $p;
925
990fb837 926 ($self,$a,$p,$r);
ee15d750
JH
927 }
928
929sub round
930 {
61f5c3f5 931 # Round $self according to given parameters, or given second argument's
ee15d750 932 # parameters or global defaults
ee15d750 933
c4a6f826 934 # for speed reasons, _find_round_parameters is embedded here:
61f5c3f5
T
935
936 my ($self,$a,$p,$r,@args) = @_;
937 # $a accuracy, if given by caller
938 # $p precision, if given by caller
939 # $r round_mode, if given by caller
940 # @args all 'other' arguments (0 for unary, 1 for binary ops)
941
61f5c3f5
T
942 my $c = ref($self); # find out class of argument(s)
943 no strict 'refs';
944
945 # now pick $a or $p, but only if we have got "arguments"
946 if (!defined $a)
58cde26e 947 {
61f5c3f5
T
948 foreach ($self,@args)
949 {
950 # take the defined one, or if both defined, the one that is smaller
951 $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
952 }
58cde26e 953 }
61f5c3f5
T
954 if (!defined $p)
955 {
956 # even if $a is defined, take $p, to signal error for both defined
957 foreach ($self,@args)
958 {
959 # take the defined one, or if both defined, the one that is bigger
960 # -2 > -3, and 3 > 2
961 $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
962 }
963 }
964 # if still none defined, use globals (#2)
965 $a = ${"$c\::accuracy"} unless defined $a;
966 $p = ${"$c\::precision"} unless defined $p;
967
990fb837
RGS
968 # A == 0 is useless, so undef it to signal no rounding
969 $a = undef if defined $a && $a == 0;
970
61f5c3f5
T
971 # no rounding today?
972 return $self unless defined $a || defined $p; # early out
973
974 # set A and set P is an fatal error
975 return $self->bnan() if defined $a && defined $p;
976
977 $r = ${"$c\::round_mode"} unless defined $r;
7b29e1e6 978 if ($r !~ /^(even|odd|\+inf|\-inf|zero|trunc|common)$/)
990fb837 979 {
b282a552 980 require Carp; Carp::croak ("Unknown round mode '$r'");
990fb837 981 }
61f5c3f5
T
982
983 # now round, by calling either fround or ffround:
984 if (defined $a)
985 {
d5351619 986 $self->bround(int($a),$r) if !defined $self->{_a} || $self->{_a} >= $a;
61f5c3f5
T
987 }
988 else # both can't be undefined due to early out
58cde26e 989 {
d5351619 990 $self->bfround(int($p),$r) if !defined $self->{_p} || $self->{_p} <= $p;
58cde26e 991 }
c4a6f826 992 # bround() or bfround() already called bnorm() if nec.
12fc2493 993 $self;
58cde26e
JH
994 }
995
17baacb7 996sub bnorm
58cde26e 997 {
027dc388 998 # (numstr or BINT) return BINT
58cde26e 999 # Normalize number -- no-op here
b282a552 1000 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
b3abae2a 1001 $x;
58cde26e
JH
1002 }
1003
1004sub babs
1005 {
1006 # (BINT or num_str) return BINT
1007 # make number absolute, or return absolute BINT from string
b68b7ab1 1008 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
ee15d750 1009
58cde26e
JH
1010 return $x if $x->modify('babs');
1011 # post-normalized abs for internal use (does nothing for NaN)
1012 $x->{sign} =~ s/^-/+/;
1013 $x;
1014 }
1015
1016sub bneg
1017 {
1018 # (BINT or num_str) return BINT
1019 # negate number or make a negated number from string
b68b7ab1 1020 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
ee15d750 1021
58cde26e 1022 return $x if $x->modify('bneg');
b3abae2a 1023
b68b7ab1
T
1024 # for +0 dont negate (to have always normalized +0). Does nothing for 'NaN'
1025 $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $CALC->_is_zero($x->{value}));
58cde26e
JH
1026 $x;
1027 }
1028
1029sub bcmp
1030 {
1031 # Compares 2 values. Returns one of undef, <0, =0, >0. (suitable for sort)
1032 # (BINT or num_str, BINT or num_str) return cond_code
f9a08e12
JH
1033
1034 # set up parameters
1035 my ($self,$x,$y) = (ref($_[0]),@_);
1036
1037 # objectify is costly, so avoid it
1038 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1039 {
1040 ($self,$x,$y) = objectify(2,@_);
1041 }
0716bf9b 1042
56d9de68
T
1043 return $upgrade->bcmp($x,$y) if defined $upgrade &&
1044 ((!$x->isa($self)) || (!$y->isa($self)));
1045
0716bf9b
JH
1046 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
1047 {
1048 # handle +-inf and NaN
1049 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
574bacfe 1050 return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
0716bf9b
JH
1051 return +1 if $x->{sign} eq '+inf';
1052 return -1 if $x->{sign} eq '-inf';
1053 return -1 if $y->{sign} eq '+inf';
b3abae2a 1054 return +1;
0716bf9b 1055 }
574bacfe
JH
1056 # check sign for speed first
1057 return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y
1058 return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0
1059
f9a08e12
JH
1060 # have same sign, so compare absolute values. Don't make tests for zero here
1061 # because it's actually slower than testin in Calc (especially w/ Pari et al)
1062
dccbb853
JH
1063 # post-normalized compare for internal use (honors signs)
1064 if ($x->{sign} eq '+')
1065 {
56b9c951 1066 # $x and $y both > 0
dccbb853
JH
1067 return $CALC->_acmp($x->{value},$y->{value});
1068 }
1069
56b9c951 1070 # $x && $y both < 0
b282a552 1071 $CALC->_acmp($y->{value},$x->{value}); # swaped acmp (lib returns 0,1,-1)
58cde26e
JH
1072 }
1073
1074sub bacmp
1075 {
1076 # Compares 2 values, ignoring their signs.
1077 # Returns one of undef, <0, =0, >0. (suitable for sort)
1078 # (BINT, BINT) return cond_code
574bacfe 1079
f9a08e12
JH
1080 # set up parameters
1081 my ($self,$x,$y) = (ref($_[0]),@_);
1082 # objectify is costly, so avoid it
1083 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1084 {
1085 ($self,$x,$y) = objectify(2,@_);
1086 }
1087
56d9de68
T
1088 return $upgrade->bacmp($x,$y) if defined $upgrade &&
1089 ((!$x->isa($self)) || (!$y->isa($self)));
1090
574bacfe
JH
1091 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
1092 {
1093 # handle +-inf and NaN
1094 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
1095 return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
ef9466ea
T
1096 return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/;
1097 return -1;
574bacfe 1098 }
b3abae2a 1099 $CALC->_acmp($x->{value},$y->{value}); # lib does only 0,1,-1
58cde26e
JH
1100 }
1101
1102sub badd
1103 {
1104 # add second arg (BINT or string) to first (BINT) (modifies first)
1105 # return result as BINT
f9a08e12
JH
1106
1107 # set up parameters
1108 my ($self,$x,$y,@r) = (ref($_[0]),@_);
1109 # objectify is costly, so avoid it
1110 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1111 {
1112 ($self,$x,$y,@r) = objectify(2,@_);
1113 }
58cde26e
JH
1114
1115 return $x if $x->modify('badd');
091c87b1 1116 return $upgrade->badd($upgrade->new($x),$upgrade->new($y),@r) if defined $upgrade &&
8f675a64 1117 ((!$x->isa($self)) || (!$y->isa($self)));
58cde26e 1118
61f5c3f5 1119 $r[3] = $y; # no push!
574bacfe
JH
1120 # inf and NaN handling
1121 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
1122 {
1123 # NaN first
1124 return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
13a12e00
JH
1125 # inf handling
1126 if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
574bacfe 1127 {
b3abae2a
JH
1128 # +inf++inf or -inf+-inf => same, rest is NaN
1129 return $x if $x->{sign} eq $y->{sign};
1130 return $x->bnan();
574bacfe
JH
1131 }
1132 # +-inf + something => +inf
1133 # something +-inf => +-inf
1134 $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/;
1135 return $x;
1136 }
1137
b282a552 1138 my ($sx, $sy) = ( $x->{sign}, $y->{sign} ); # get signs
58cde26e
JH
1139
1140 if ($sx eq $sy)
1141 {
574bacfe 1142 $x->{value} = $CALC->_add($x->{value},$y->{value}); # same sign, abs add
58cde26e
JH
1143 }
1144 else
1145 {
574bacfe 1146 my $a = $CALC->_acmp ($y->{value},$x->{value}); # absolute compare
58cde26e
JH
1147 if ($a > 0)
1148 {
574bacfe 1149 $x->{value} = $CALC->_sub($y->{value},$x->{value},1); # abs sub w/ swap
58cde26e
JH
1150 $x->{sign} = $sy;
1151 }
1152 elsif ($a == 0)
1153 {
1154 # speedup, if equal, set result to 0
0716bf9b 1155 $x->{value} = $CALC->_zero();
58cde26e
JH
1156 $x->{sign} = '+';
1157 }
1158 else # a < 0
1159 {
574bacfe 1160 $x->{value} = $CALC->_sub($x->{value}, $y->{value}); # abs sub
a0d0e21e 1161 }
a0d0e21e 1162 }
b68b7ab1 1163 $x->round(@r);
58cde26e
JH
1164 }
1165
1166sub bsub
1167 {
091c87b1 1168 # (BINT or num_str, BINT or num_str) return BINT
58cde26e 1169 # subtract second arg from first, modify first
f9a08e12
JH
1170
1171 # set up parameters
1172 my ($self,$x,$y,@r) = (ref($_[0]),@_);
7d193e39 1173
f9a08e12
JH
1174 # objectify is costly, so avoid it
1175 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1176 {
1177 ($self,$x,$y,@r) = objectify(2,@_);
1178 }
58cde26e 1179
58cde26e 1180 return $x if $x->modify('bsub');
8f675a64 1181
9b924220
RGS
1182 return $upgrade->new($x)->bsub($upgrade->new($y),@r) if defined $upgrade &&
1183 ((!$x->isa($self)) || (!$y->isa($self)));
b3abae2a 1184
b68b7ab1 1185 return $x->round(@r) if $y->is_zero();
b3abae2a 1186
a87115f0
RGS
1187 # To correctly handle the lone special case $x->bsub($x), we note the sign
1188 # of $x, then flip the sign from $y, and if the sign of $x did change, too,
1189 # then we caught the special case:
1190 my $xsign = $x->{sign};
1191 $y->{sign} =~ tr/+\-/-+/; # does nothing for NaN
1192 if ($xsign ne $x->{sign})
03874afe 1193 {
a87115f0
RGS
1194 # special case of $x->bsub($x) results in 0
1195 return $x->bzero(@r) if $xsign =~ /^[+-]$/;
03874afe
T
1196 return $x->bnan(); # NaN, -inf, +inf
1197 }
b3abae2a
JH
1198 $x->badd($y,@r); # badd does not leave internal zeros
1199 $y->{sign} =~ tr/+\-/-+/; # refix $y (does nothing for NaN)
7b29e1e6 1200 $x; # already rounded by badd() or no round nec.
58cde26e
JH
1201 }
1202
1203sub binc
1204 {
1205 # increment arg by one
ee15d750 1206 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
58cde26e 1207 return $x if $x->modify('binc');
e745a66c
JH
1208
1209 if ($x->{sign} eq '+')
1210 {
1211 $x->{value} = $CALC->_inc($x->{value});
b68b7ab1 1212 return $x->round($a,$p,$r);
e745a66c
JH
1213 }
1214 elsif ($x->{sign} eq '-')
1215 {
1216 $x->{value} = $CALC->_dec($x->{value});
1217 $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0
b68b7ab1 1218 return $x->round($a,$p,$r);
e745a66c
JH
1219 }
1220 # inf, nan handling etc
091c87b1 1221 $x->badd($self->bone(),$a,$p,$r); # badd does round
58cde26e
JH
1222 }
1223
1224sub bdec
1225 {
1226 # decrement arg by one
b282a552 1227 my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
58cde26e 1228 return $x if $x->modify('bdec');
e745a66c 1229
b282a552 1230 if ($x->{sign} eq '-')
e745a66c 1231 {
b68b7ab1 1232 # x already < 0
e745a66c 1233 $x->{value} = $CALC->_inc($x->{value});
b282a552
T
1234 }
1235 else
e745a66c 1236 {
b68b7ab1 1237 return $x->badd($self->bone('-'),@r) unless $x->{sign} eq '+'; # inf or NaN
b282a552
T
1238 # >= 0
1239 if ($CALC->_is_zero($x->{value}))
1240 {
1241 # == 0
1242 $x->{value} = $CALC->_one(); $x->{sign} = '-'; # 0 => -1
1243 }
1244 else
1245 {
1246 # > 0
1247 $x->{value} = $CALC->_dec($x->{value});
1248 }
e745a66c 1249 }
b68b7ab1 1250 $x->round(@r);
b282a552 1251 }
58cde26e 1252
61f5c3f5
T
1253sub blog
1254 {
091c87b1
T
1255 # calculate $x = $a ** $base + $b and return $a (e.g. the log() to base
1256 # $base of $x)
1257
1258 # set up parameters
b68b7ab1 1259 my ($self,$x,$base,@r) = (undef,@_);
091c87b1
T
1260 # objectify is costly, so avoid it
1261 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1262 {
2aa6a1fb 1263 ($self,$x,$base,@r) = objectify(2,@_);
091c87b1 1264 }
a0ac753d 1265
ef9466ea
T
1266 return $x if $x->modify('blog');
1267
2ebb273f
T
1268 $base = $self->new($base) if defined $base && !ref $base;
1269
091c87b1
T
1270 # inf, -inf, NaN, <0 => NaN
1271 return $x->bnan()
9b924220 1272 if $x->{sign} ne '+' || (defined $base && $base->{sign} ne '+');
091c87b1 1273
9b924220
RGS
1274 return $upgrade->blog($upgrade->new($x),$base,@r) if
1275 defined $upgrade;
091c87b1 1276
a0ac753d
T
1277 # fix for bug #24969:
1278 # the default base is e (Euler's number) which is not an integer
1279 if (!defined $base)
1280 {
1281 require Math::BigFloat;
1282 my $u = Math::BigFloat->blog(Math::BigFloat->new($x))->as_int();
1283 # modify $x in place
1284 $x->{value} = $u->{value};
1285 $x->{sign} = $u->{sign};
1286 return $x;
1287 }
1288
9b924220
RGS
1289 my ($rc,$exact) = $CALC->_log_int($x->{value},$base->{value});
1290 return $x->bnan() unless defined $rc; # not possible to take log?
1291 $x->{value} = $rc;
1292 $x->round(@r);
61f5c3f5 1293 }
091c87b1 1294
50109ad0
RGS
1295sub bnok
1296 {
1297 # Calculate n over k (binomial coefficient or "choose" function) as integer.
1298 # set up parameters
1299 my ($self,$x,$y,@r) = (ref($_[0]),@_);
1300
1301 # objectify is costly, so avoid it
1302 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1303 {
1304 ($self,$x,$y,@r) = objectify(2,@_);
1305 }
1306
1307 return $x if $x->modify('bnok');
1308 return $x->bnan() if $x->{sign} eq 'NaN' || $y->{sign} eq 'NaN';
1309 return $x->binf() if $x->{sign} eq '+inf';
1310
1311 # k > n or k < 0 => 0
1312 my $cmp = $x->bacmp($y);
1313 return $x->bzero() if $cmp < 0 || $y->{sign} =~ /^-/;
1314 # k == n => 1
1315 return $x->bone(@r) if $cmp == 0;
1316
1317 if ($CALC->can('_nok'))
1318 {
1319 $x->{value} = $CALC->_nok($x->{value},$y->{value});
1320 }
1321 else
1322 {
d5735945
PF
1323 # ( 7 ) 7! 1*2*3*4 * 5*6*7 5 * 6 * 7 6 7
1324 # ( - ) = --------- = --------------- = --------- = 5 * - * -
1325 # ( 3 ) (7-3)! 3! 1*2*3*4 * 1*2*3 1 * 2 * 3 2 3
50109ad0 1326
d5735945 1327 if (!$y->is_zero())
50109ad0 1328 {
d5735945 1329 my $z = $x - $y;
50109ad0
RGS
1330 $z->binc();
1331 my $r = $z->copy(); $z->binc();
1332 my $d = $self->new(2);
d5735945 1333 while ($z->bacmp($x) <= 0) # f <= x ?
50109ad0
RGS
1334 {
1335 $r->bmul($z); $r->bdiv($d);
1336 $z->binc(); $d->binc();
1337 }
1338 $x->{value} = $r->{value}; $x->{sign} = '+';
1339 }
1340 else { $x->bone(); }
1341 }
1342 $x->round(@r);
1343 }
1344
7d193e39
T
1345sub bexp
1346 {
1347 # Calculate e ** $x (Euler's number to the power of X), truncated to
1348 # an integer value.
1349 my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1350 return $x if $x->modify('bexp');
1351
1352 # inf, -inf, NaN, <0 => NaN
1353 return $x->bnan() if $x->{sign} eq 'NaN';
1354 return $x->bone() if $x->is_zero();
1355 return $x if $x->{sign} eq '+inf';
1356 return $x->bzero() if $x->{sign} eq '-inf';
1357
1358 my $u;
1359 {
1360 # run through Math::BigFloat unless told otherwise
50109ad0 1361 require Math::BigFloat unless defined $upgrade;
7d193e39
T
1362 local $upgrade = 'Math::BigFloat' unless defined $upgrade;
1363 # calculate result, truncate it to integer
1364 $u = $upgrade->bexp($upgrade->new($x),@r);
1365 }
1366
1367 if (!defined $upgrade)
1368 {
1369 $u = $u->as_int();
1370 # modify $x in place
1371 $x->{value} = $u->{value};
1372 $x->round(@r);
1373 }
1374 else { $x = $u; }
1375 }
1376
fdd59300
FR
1377sub blcm
1378 {
58cde26e
JH
1379 # (BINT or num_str, BINT or num_str) return BINT
1380 # does not modify arguments, but returns new object
fdd59300 1381 # Lowest Common Multiple
58cde26e 1382
0716bf9b
JH
1383 my $y = shift; my ($x);
1384 if (ref($y))
1385 {
1386 $x = $y->copy();
1387 }
1388 else
1389 {
12fc2493 1390 $x = $class->new($y);
0716bf9b 1391 }
9b924220
RGS
1392 my $self = ref($x);
1393 while (@_)
1394 {
1395 my $y = shift; $y = $self->new($y) if !ref ($y);
1396 $x = __lcm($x,$y);
1397 }
58cde26e
JH
1398 $x;
1399 }
1400
1401sub bgcd
1402 {
1403 # (BINT or num_str, BINT or num_str) return BINT
1404 # does not modify arguments, but returns new object
c4a6f826 1405 # GCD -- Euclid's algorithm, variant C (Knuth Vol 3, pg 341 ff)
0716bf9b 1406
dccbb853 1407 my $y = shift;
12fc2493 1408 $y = $class->new($y) if !ref($y);
dccbb853 1409 my $self = ref($y);
9b924220
RGS
1410 my $x = $y->copy()->babs(); # keep arguments
1411 return $x->bnan() if $x->{sign} !~ /^[+-]$/; # x NaN?
1412
1413 while (@_)
0716bf9b 1414 {
9b924220 1415 $y = shift; $y = $self->new($y) if !ref($y);
9b924220 1416 return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN?
b68b7ab1
T
1417 $x->{value} = $CALC->_gcd($x->{value},$y->{value});
1418 last if $CALC->_is_one($x->{value});
0716bf9b 1419 }
9b924220 1420 $x;
58cde26e
JH
1421 }
1422
58cde26e
JH
1423sub bnot
1424 {
1425 # (num_str or BINT) return BINT
1426 # represent ~x as twos-complement number
ee15d750
JH
1427 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1428 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
1429
58cde26e 1430 return $x if $x->modify('bnot');
091c87b1 1431 $x->binc()->bneg(); # binc already does round
58cde26e
JH
1432 }
1433
091c87b1 1434##############################################################################
b3abae2a 1435# is_foo test routines
091c87b1 1436# we don't need $self, so undef instead of ref($_[0]) make it slightly faster
b3abae2a 1437
58cde26e
JH
1438sub is_zero
1439 {
1440 # return true if arg (BINT or num_str) is zero (array '+', '0')
ee15d750 1441 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
0716bf9b 1442
574bacfe 1443 return 0 if $x->{sign} !~ /^\+$/; # -, NaN & +-inf aren't
17baacb7 1444 $CALC->_is_zero($x->{value});
58cde26e
JH
1445 }
1446
1447sub is_nan
1448 {
1449 # return true if arg (BINT or num_str) is NaN
091c87b1 1450 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
ee15d750 1451
091c87b1 1452 $x->{sign} eq $nan ? 1 : 0;
58cde26e
JH
1453 }
1454
1455sub is_inf
1456 {
1457 # return true if arg (BINT or num_str) is +-inf
091c87b1 1458 my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
58cde26e 1459
091c87b1 1460 if (defined $sign)
ee15d750 1461 {
091c87b1
T
1462 $sign = '[+-]inf' if $sign eq ''; # +- doesn't matter, only that's inf
1463 $sign = "[$1]inf" if $sign =~ /^([+-])(inf)?$/; # extract '+' or '-'
1464 return $x->{sign} =~ /^$sign$/ ? 1 : 0;
ee15d750 1465 }
091c87b1 1466 $x->{sign} =~ /^[+-]inf$/ ? 1 : 0; # only +-inf is infinity
58cde26e
JH
1467 }
1468
1469sub is_one
1470 {
091c87b1 1471 # return true if arg (BINT or num_str) is +1, or -1 if sign is given
ee15d750
JH
1472 my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
1473
990fb837 1474 $sign = '+' if !defined $sign || $sign ne '-';
0716bf9b 1475
ee15d750 1476 return 0 if $x->{sign} ne $sign; # -1 != +1, NaN, +-inf aren't either
394e6ffb 1477 $CALC->_is_one($x->{value});
58cde26e
JH
1478 }
1479
1480sub is_odd
1481 {
1482 # return true when arg (BINT or num_str) is odd, false for even
ee15d750 1483 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
0716bf9b 1484
b22b3e31 1485 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
394e6ffb 1486 $CALC->_is_odd($x->{value});
58cde26e
JH
1487 }
1488
1489sub is_even
1490 {
1491 # return true when arg (BINT or num_str) is even, false for odd
ee15d750 1492 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
0716bf9b 1493
b22b3e31 1494 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
394e6ffb 1495 $CALC->_is_even($x->{value});
0716bf9b
JH
1496 }
1497
1498sub is_positive
1499 {
4af46cb8 1500 # return true when arg (BINT or num_str) is positive (> 0)
ee15d750 1501 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
b68b7ab1
T
1502
1503 return 1 if $x->{sign} eq '+inf'; # +inf is positive
4af46cb8 1504
b68b7ab1 1505 # 0+ is neither positive nor negative
4af46cb8 1506 ($x->{sign} eq '+' && !$x->is_zero()) ? 1 : 0;
0716bf9b
JH
1507 }
1508
1509sub is_negative
1510 {
1511 # return true when arg (BINT or num_str) is negative (< 0)
ee15d750
JH
1512 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1513
b68b7ab1 1514 $x->{sign} =~ /^-/ ? 1 : 0; # -inf is negative, but NaN is not
58cde26e
JH
1515 }
1516
b3abae2a
JH
1517sub is_int
1518 {
1519 # return true when arg (BINT or num_str) is an integer
091c87b1 1520 # always true for BigInt, but different for BigFloats
b3abae2a
JH
1521 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1522
1523 $x->{sign} =~ /^[+-]$/ ? 1 : 0; # inf/-inf/NaN aren't
1524 }
1525
0716bf9b
JH
1526###############################################################################
1527
58cde26e
JH
1528sub bmul
1529 {
c97ef841 1530 # multiply the first number by the second number
58cde26e 1531 # (BINT or num_str, BINT or num_str) return BINT
f9a08e12
JH
1532
1533 # set up parameters
1534 my ($self,$x,$y,@r) = (ref($_[0]),@_);
1535 # objectify is costly, so avoid it
1536 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1537 {
1538 ($self,$x,$y,@r) = objectify(2,@_);
1539 }
a0ac753d 1540
58cde26e 1541 return $x if $x->modify('bmul');
61f5c3f5 1542
574bacfe 1543 return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
b3abae2a 1544
574bacfe
JH
1545 # inf handling
1546 if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
1547 {
b3abae2a 1548 return $x->bnan() if $x->is_zero() || $y->is_zero();
574bacfe
JH
1549 # result will always be +-inf:
1550 # +inf * +/+inf => +inf, -inf * -/-inf => +inf
1551 # +inf * -/-inf => -inf, -inf * +/+inf => -inf
1552 return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
1553 return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
1554 return $x->binf('-');
1555 }
9b924220
RGS
1556
1557 return $upgrade->bmul($x,$upgrade->new($y),@r)
1558 if defined $upgrade && !$y->isa($self);
9393ace2
JH
1559
1560 $r[3] = $y; # no push here
58cde26e 1561
0716bf9b 1562 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => +
dccbb853 1563
b3abae2a
JH
1564 $x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math
1565 $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # no -0
f9a08e12 1566
b68b7ab1 1567 $x->round(@r);
dccbb853
JH
1568 }
1569
80365507
T
1570sub bmuladd
1571 {
1572 # multiply two numbers and then add the third to the result
1573 # (BINT or num_str, BINT or num_str, BINT or num_str) return BINT
1574
1575 # set up parameters
1576 my ($self,$x,$y,$z,@r) = (ref($_[0]),@_);
1577 # objectify is costly, so avoid it
1578 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1579 {
1580 ($self,$x,$y,$z,@r) = objectify(3,@_);
1581 }
1582
1583 return $x if $x->modify('bmuladd');
1584
1585 return $x->bnan() if ($x->{sign} eq $nan) ||
1586 ($y->{sign} eq $nan) ||
1587 ($z->{sign} eq $nan);
1588
1589 # inf handling of x and y
1590 if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
1591 {
1592 return $x->bnan() if $x->is_zero() || $y->is_zero();
1593 # result will always be +-inf:
1594 # +inf * +/+inf => +inf, -inf * -/-inf => +inf
1595 # +inf * -/-inf => -inf, -inf * +/+inf => -inf
1596 return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
1597 return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
1598 return $x->binf('-');
1599 }
1600 # inf handling x*y and z
1601 if (($z->{sign} =~ /^[+-]inf$/))
1602 {
1603 # something +-inf => +-inf
1604 $x->{sign} = $z->{sign}, return $x if $z->{sign} =~ /^[+-]inf$/;
1605 }
1606
1607 return $upgrade->bmuladd($x,$upgrade->new($y),$upgrade->new($z),@r)
1608 if defined $upgrade && (!$y->isa($self) || !$z->isa($self) || !$x->isa($self));
1609
c97ef841 1610 # TODO: what if $y and $z have A or P set?
80365507
T
1611 $r[3] = $z; # no push here
1612
1613 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => +
1614
1615 $x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math
1616 $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # no -0
1617
1618 my ($sx, $sz) = ( $x->{sign}, $z->{sign} ); # get signs
1619
1620 if ($sx eq $sz)
1621 {
1622 $x->{value} = $CALC->_add($x->{value},$z->{value}); # same sign, abs add
1623 }
1624 else
1625 {
1626 my $a = $CALC->_acmp ($z->{value},$x->{value}); # absolute compare
1627 if ($a > 0)
1628 {
1629 $x->{value} = $CALC->_sub($z->{value},$x->{value},1); # abs sub w/ swap
1630 $x->{sign} = $sz;
1631 }
1632 elsif ($a == 0)
1633 {
1634 # speedup, if equal, set result to 0
1635 $x->{value} = $CALC->_zero();
1636 $x->{sign} = '+';
1637 }
1638 else # a < 0
1639 {
1640 $x->{value} = $CALC->_sub($x->{value}, $z->{value}); # abs sub
1641 }
1642 }
1643 $x->round(@r);
1644 }
1645
dccbb853
JH
1646sub _div_inf
1647 {
1648 # helper function that handles +-inf cases for bdiv()/bmod() to reuse code
1649 my ($self,$x,$y) = @_;
1650
1651 # NaN if x == NaN or y == NaN or x==y==0
1652 return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan()
1653 if (($x->is_nan() || $y->is_nan()) ||
1654 ($x->is_zero() && $y->is_zero()));
1655
f603091d 1656 # +-inf / +-inf == NaN, remainder also NaN
b3abae2a 1657 if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
dccbb853 1658 {
b3abae2a 1659 return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan();
dccbb853
JH
1660 }
1661 # x / +-inf => 0, remainder x (works even if x == 0)
1662 if ($y->{sign} =~ /^[+-]inf$/)
1663 {
f9a08e12 1664 my $t = $x->copy(); # bzero clobbers up $x
dccbb853
JH
1665 return wantarray ? ($x->bzero(),$t) : $x->bzero()
1666 }
1667
1668 # 5 / 0 => +inf, -6 / 0 => -inf
1669 # +inf / 0 = inf, inf, and -inf / 0 => -inf, -inf
1670 # exception: -8 / 0 has remainder -8, not 8
1671 # exception: -inf / 0 has remainder -inf, not inf
1672 if ($y->is_zero())
1673 {
1674 # +-inf / 0 => special case for -inf
1675 return wantarray ? ($x,$x->copy()) : $x if $x->is_inf();
1676 if (!$x->is_zero() && !$x->is_inf())
1677 {
1678 my $t = $x->copy(); # binf clobbers up $x
1679 return wantarray ?
1680 ($x->binf($x->{sign}),$t) : $x->binf($x->{sign})
1681 }
1682 }
1683
1684 # last case: +-inf / ordinary number
1685 my $sign = '+inf';
1686 $sign = '-inf' if substr($x->{sign},0,1) ne $y->{sign};
1687 $x->{sign} = $sign;
1688 return wantarray ? ($x,$self->bzero()) : $x;
58cde26e
JH
1689 }
1690
1691sub bdiv
1692 {
1693 # (dividend: BINT or num_str, divisor: BINT or num_str) return
1694 # (BINT,BINT) (quo,rem) or BINT (only rem)
f9a08e12
JH
1695
1696 # set up parameters
1697 my ($self,$x,$y,@r) = (ref($_[0]),@_);
1698 # objectify is costly, so avoid it
1699 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1700 {
1701 ($self,$x,$y,@r) = objectify(2,@_);
1702 }
58cde26e
JH
1703
1704 return $x if $x->modify('bdiv');
1705
dccbb853
JH
1706 return $self->_div_inf($x,$y)
1707 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
58cde26e 1708
9393ace2
JH
1709 return $upgrade->bdiv($upgrade->new($x),$upgrade->new($y),@r)
1710 if defined $upgrade;
58cde26e 1711
990fb837
RGS
1712 $r[3] = $y; # no push!
1713
58cde26e 1714 # calc new sign and in case $y == +/- 1, return $x
dccbb853 1715 my $xsign = $x->{sign}; # keep
58cde26e 1716 $x->{sign} = ($x->{sign} ne $y->{sign} ? '-' : '+');
58cde26e 1717
58cde26e
JH
1718 if (wantarray)
1719 {
394e6ffb
JH
1720 my $rem = $self->bzero();
1721 ($x->{value},$rem->{value}) = $CALC->_div($x->{value},$y->{value});
1722 $x->{sign} = '+' if $CALC->_is_zero($x->{value});
f9a08e12
JH
1723 $rem->{_a} = $x->{_a};
1724 $rem->{_p} = $x->{_p};
b68b7ab1 1725 $x->round(@r);
dccbb853
JH
1726 if (! $CALC->_is_zero($rem->{value}))
1727 {
1728 $rem->{sign} = $y->{sign};
990fb837 1729 $rem = $y->copy()->bsub($rem) if $xsign ne $y->{sign}; # one of them '-'
dccbb853
JH
1730 }
1731 else
1732 {
1733 $rem->{sign} = '+'; # dont leave -0
1734 }
b68b7ab1 1735 $rem->round(@r);
990fb837 1736 return ($x,$rem);
58cde26e 1737 }
394e6ffb
JH
1738
1739 $x->{value} = $CALC->_div($x->{value},$y->{value});
1740 $x->{sign} = '+' if $CALC->_is_zero($x->{value});
f9a08e12 1741
b68b7ab1 1742 $x->round(@r);
58cde26e
JH
1743 }
1744
d614cd8b
JH
1745###############################################################################
1746# modulus functions
1747
dccbb853
JH
1748sub bmod
1749 {
1750 # modulus (or remainder)
1751 # (BINT or num_str, BINT or num_str) return BINT
f9a08e12
JH
1752
1753 # set up parameters
1754 my ($self,$x,$y,@r) = (ref($_[0]),@_);
1755 # objectify is costly, so avoid it
1756 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1757 {
1758 ($self,$x,$y,@r) = objectify(2,@_);
1759 }
28df3e88 1760
dccbb853 1761 return $x if $x->modify('bmod');
61f5c3f5 1762 $r[3] = $y; # no push!
dccbb853
JH
1763 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero())
1764 {
1765 my ($d,$r) = $self->_div_inf($x,$y);
f9a08e12
JH
1766 $x->{sign} = $r->{sign};
1767 $x->{value} = $r->{value};
1768 return $x->round(@r);
dccbb853
JH
1769 }
1770
9b924220
RGS
1771 # calc new sign and in case $y == +/- 1, return $x
1772 $x->{value} = $CALC->_mod($x->{value},$y->{value});
1773 if (!$CALC->_is_zero($x->{value}))
dccbb853 1774 {
b68b7ab1
T
1775 $x->{value} = $CALC->_sub($y->{value},$x->{value},1) # $y-$x
1776 if ($x->{sign} ne $y->{sign});
9b924220 1777 $x->{sign} = $y->{sign};
dccbb853 1778 }
9b924220 1779 else
b3abae2a 1780 {
9b924220 1781 $x->{sign} = '+'; # dont leave -0
b3abae2a 1782 }
b68b7ab1 1783 $x->round(@r);
dccbb853
JH
1784 }
1785
07d34614 1786sub bmodinv
d614cd8b 1787 {
487de07a
PJA
1788 # Return modular multiplicative inverse: z is the modular inverse of x (mod
1789 # y) if and only if x*z (mod y) = 1 (mod y). If the modulus y is larger than
1790 # one, x and z are relative primes (i.e., their greatest common divisor is
1791 # one).
1792 #
1793 # If no modular multiplicative inverse exists, NaN is returned.
d614cd8b 1794
f9a08e12 1795 # set up parameters
b68b7ab1 1796 my ($self,$x,$y,@r) = (undef,@_);
56d9de68 1797 # objectify is costly, so avoid it
f9a08e12
JH
1798 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1799 {
1800 ($self,$x,$y,@r) = objectify(2,@_);
56d9de68 1801 }
d614cd8b 1802
f9a08e12 1803 return $x if $x->modify('bmodinv');
d614cd8b 1804
487de07a
PJA
1805 # Return NaN if one or both arguments is +inf, -inf, or nan.
1806
1807 return $x->bnan() if ($y->{sign} !~ /^[+-]$/ ||
1808 $x->{sign} !~ /^[+-]$/);
1809
1810 # Return NaN if $y is zero; 1 % 0 makes no sense.
1811
1812 return $x->bnan() if $y->is_zero();
1813
1814 # Return 0 in the trivial case. $x % 1 or $x % -1 is zero for all finite
1815 # integers $x.
1816
1817 return $x->bzero() if ($y->is_one() ||
1818 $y->is_one('-'));
1819
1820 # Return NaN if $x = 0, or $x modulo $y is zero. The only valid case when
1821 # $x = 0 is when $y = 1 or $y = -1, but that was covered above.
1822 #
1823 # Note that computing $x modulo $y here affects the value we'll feed to
1824 # $CALC->_modinv() below when $x and $y have opposite signs. E.g., if $x =
1825 # 5 and $y = 7, those two values are fed to _modinv(), but if $x = -5 and
1826 # $y = 7, the values fed to _modinv() are $x = 2 (= -5 % 7) and $y = 7.
1827 # The value if $x is affected only when $x and $y have opposite signs.
1828
1829 $x->bmod($y);
1830 return $x->bnan() if $x->is_zero();
1831
1832 # Compute the modular multiplicative inverse of the absolute values. We'll
1833 # correct for the signs of $x and $y later. Return NaN if no GCD is found.
1834
1835 ($x->{value}, $x->{sign}) = $CALC->_modinv($x->{value}, $y->{value});
1836 return $x->bnan() if !defined $x->{value};
1837
db2e1fb3 1838 # Library inconsistency workaround: _modinv() in Math::BigInt::GMP versions
1839 # <= 1.32 return undef rather than a "+" for the sign.
1840
1841 $x->{sign} = '+' unless defined $x->{sign};
1842
487de07a
PJA
1843 # When one or both arguments are negative, we have the following
1844 # relations. If x and y are positive:
1845 #
1846 # modinv(-x, -y) = -modinv(x, y)
1847 # modinv(-x, y) = y - modinv(x, y) = -modinv(x, y) (mod y)
1848 # modinv( x, -y) = modinv(x, y) - y = modinv(x, y) (mod -y)
1849
1850 # We must swap the sign of the result if the original $x is negative.
1851 # However, we must compensate for ignoring the signs when computing the
1852 # inverse modulo. The net effect is that we must swap the sign of the
1853 # result if $y is negative.
1854
1855 $x -> bneg() if $y->{sign} eq '-';
1856
1857 # Compute $x modulo $y again after correcting the sign.
1858
1859 $x -> bmod($y) if $x->{sign} ne $y->{sign};
1860
1861 return $x;
d614cd8b
JH
1862 }
1863
07d34614 1864sub bmodpow
d614cd8b 1865 {
6c29054c
PJA
1866 # Modular exponentiation. Raises a very large number to a very large exponent
1867 # in a given very large modulus quickly, thanks to binary exponentiation.
1868 # Supports negative exponents.
d614cd8b
JH
1869 my ($self,$num,$exp,$mod,@r) = objectify(3,@_);
1870
1871 return $num if $num->modify('bmodpow');
1872
116f6d6b
PJA
1873 # When the exponent 'e' is negative, use the following relation, which is
1874 # based on finding the multiplicative inverse 'd' of 'b' modulo 'm':
1875 #
1876 # b^(-e) (mod m) = d^e (mod m) where b*d = 1 (mod m)
d614cd8b 1877
116f6d6b 1878 $num->bmodinv($mod) if ($exp->{sign} eq '-');
07d34614 1879
116f6d6b
PJA
1880 # Check for valid input. All operands must be finite, and the modulus must be
1881 # non-zero.
d614cd8b 1882
116f6d6b
PJA
1883 return $num->bnan() if ($num->{sign} =~ /NaN|inf/ || # NaN, -inf, +inf
1884 $exp->{sign} =~ /NaN|inf/ || # NaN, -inf, +inf
1885 $mod->{sign} =~ /NaN|inf/ || # NaN, -inf, +inf
1886 $mod->is_zero());
d614cd8b 1887
116f6d6b
PJA
1888 # Compute 'a (mod m)', ignoring the signs on 'a' and 'm'. If the resulting
1889 # value is zero, the output is also zero, regardless of the signs on 'a' and
1890 # 'm'.
1891
1892 my $value = $CALC->_modpow($num->{value}, $exp->{value}, $mod->{value});
1893 my $sign = '+';
1894
1895 # If the resulting value is non-zero, we have four special cases, depending
1896 # on the signs on 'a' and 'm'.
1897
6c29054c 1898 unless ($CALC->_is_zero($value)) {
116f6d6b
PJA
1899
1900 # There is a negative sign on 'a' (= $num**$exp) only if the number we
1901 # are exponentiating ($num) is negative and the exponent ($exp) is odd.
1902
1903 if ($num->{sign} eq '-' && $exp->is_odd()) {
1904
1905 # When both the number 'a' and the modulus 'm' have a negative sign,
1906 # use this relation:
1907 #
1908 # -a (mod -m) = -(a (mod m))
1909
1910 if ($mod->{sign} eq '-') {
1911 $sign = '-';
1912 }
1913
1914 # When only the number 'a' has a negative sign, use this relation:
1915 #
1916 # -a (mod m) = m - (a (mod m))
1917
1918 else {
1919 # Use copy of $mod since _sub() modifies the first argument.
1920 my $mod = $CALC->_copy($mod->{value});
6c29054c 1921 $value = $CALC->_sub($mod, $value);
116f6d6b
PJA
1922 $sign = '+';
1923 }
1924
1925 } else {
1926
1927 # When only the modulus 'm' has a negative sign, use this relation:
1928 #
1929 # a (mod -m) = (a (mod m)) - m
1930 # = -(m - (a (mod m)))
1931
1932 if ($mod->{sign} eq '-') {
6c29054c 1933 # Use copy of $mod since _sub() modifies the first argument.
116f6d6b 1934 my $mod = $CALC->_copy($mod->{value});
6c29054c 1935 $value = $CALC->_sub($mod, $value);
116f6d6b
PJA
1936 $sign = '-';
1937 }
1938
1939 # When neither the number 'a' nor the modulus 'm' have a negative
1940 # sign, directly return the already computed value.
1941 #
1942 # (a (mod m))
1943
1944 }
1945
1946 }
1947
1948 $num->{value} = $value;
1949 $num->{sign} = $sign;
1950
1951 return $num;
d614cd8b
JH
1952 }
1953
1954###############################################################################
1955
b3abae2a
JH
1956sub bfac
1957 {
1958 # (BINT or num_str, BINT or num_str) return BINT
091c87b1 1959 # compute factorial number from $x, modify $x in place
b68b7ab1 1960 my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
b3abae2a 1961
b68b7ab1
T
1962 return $x if $x->modify('bfac') || $x->{sign} eq '+inf'; # inf => inf
1963 return $x->bnan() if $x->{sign} ne '+'; # NaN, <0 etc => NaN
b3abae2a 1964
9b924220
RGS
1965 $x->{value} = $CALC->_fac($x->{value});
1966 $x->round(@r);
b3abae2a
JH
1967 }
1968
58cde26e
JH
1969sub bpow
1970 {
1971 # (BINT or num_str, BINT or num_str) return BINT
1972 # compute power of two numbers -- stolen from Knuth Vol 2 pg 233
1973 # modifies first argument
aef458a0 1974
f9a08e12
JH
1975 # set up parameters
1976 my ($self,$x,$y,@r) = (ref($_[0]),@_);
1977 # objectify is costly, so avoid it
1978 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1979 {
1980 ($self,$x,$y,@r) = objectify(2,@_);
1981 }
58cde26e
JH
1982
1983 return $x if $x->modify('bpow');
9393ace2 1984
2d2b2744
T
1985 return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
1986
1987 # inf handling
1988 if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
1989 {
1990 if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
1991 {
1992 # +-inf ** +-inf
1993 return $x->bnan();
1994 }
1995 # +-inf ** Y
1996 if ($x->{sign} =~ /^[+-]inf/)
1997 {
1998 # +inf ** 0 => NaN
1999 return $x->bnan() if $y->is_zero();
2000 # -inf ** -1 => 1/inf => 0
2001 return $x->bzero() if $y->is_one('-') && $x->is_negative();
2002
2003 # +inf ** Y => inf
2004 return $x if $x->{sign} eq '+inf';
2005
2006 # -inf ** Y => -inf if Y is odd
2007 return $x if $y->is_odd();
2008 return $x->babs();
2009 }
2010 # X ** +-inf
2011
2012 # 1 ** +inf => 1
2013 return $x if $x->is_one();
2014
2015 # 0 ** inf => 0
2016 return $x if $x->is_zero() && $y->{sign} =~ /^[+]/;
2017
2018 # 0 ** -inf => inf
2019 return $x->binf() if $x->is_zero();
2020
2021 # -1 ** -inf => NaN
2022 return $x->bnan() if $x->is_one('-') && $y->{sign} =~ /^[-]/;
2023
2024 # -X ** -inf => 0
2025 return $x->bzero() if $x->{sign} eq '-' && $y->{sign} =~ /^[-]/;
2026
2027 # -1 ** inf => NaN
2028 return $x->bnan() if $x->{sign} eq '-';
2029
2030 # X ** inf => inf
2031 return $x->binf() if $y->{sign} =~ /^[+]/;
2032 # X ** -inf => 0
2033 return $x->bzero();
2034 }
2035
9393ace2 2036 return $upgrade->bpow($upgrade->new($x),$y,@r)
7b29e1e6 2037 if defined $upgrade && (!$y->isa($self) || $y->{sign} eq '-');
9393ace2 2038
61f5c3f5 2039 $r[3] = $y; # no push!
b282a552
T
2040
2041 # cases 0 ** Y, X ** 0, X ** 1, 1 ** Y are handled by Calc or Emu
2042
9b924220
RGS
2043 my $new_sign = '+';
2044 $new_sign = $y->is_odd() ? '-' : '+' if ($x->{sign} ne '+');
2045
2046 # 0 ** -7 => ( 1 / (0 ** 7)) => 1 / 0 => +inf
2047 return $x->binf()
2048 if $y->{sign} eq '-' && $x->{sign} eq '+' && $CALC->_is_zero($x->{value});
574bacfe
JH
2049 # 1 ** -y => 1 / (1 ** |y|)
2050 # so do test for negative $y after above's clause
9b924220 2051 return $x->bnan() if $y->{sign} eq '-' && !$CALC->_is_one($x->{value});
027dc388 2052
9b924220
RGS
2053 $x->{value} = $CALC->_pow($x->{value},$y->{value});
2054 $x->{sign} = $new_sign;
2055 $x->{sign} = '+' if $CALC->_is_zero($y->{value});
b68b7ab1 2056 $x->round(@r);
58cde26e
JH
2057 }
2058
2059sub blsft
2060 {
2061 # (BINT or num_str, BINT or num_str) return BINT
2062 # compute x << y, base n, y >= 0
f9a08e12
JH
2063
2064 # set up parameters
2065 my ($self,$x,$y,$n,@r) = (ref($_[0]),@_);
2066 # objectify is costly, so avoid it
2067 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
2068 {
2069 ($self,$x,$y,$n,@r) = objectify(2,@_);
2070 }
2071
58cde26e
JH
2072 return $x if $x->modify('blsft');
2073 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
f9a08e12 2074 return $x->round(@r) if $y->is_zero();
58cde26e 2075
574bacfe
JH
2076 $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
2077
9b924220
RGS
2078 $x->{value} = $CALC->_lsft($x->{value},$y->{value},$n);
2079 $x->round(@r);
58cde26e
JH
2080 }
2081
2082sub brsft
2083 {
2084 # (BINT or num_str, BINT or num_str) return BINT
2085 # compute x >> y, base n, y >= 0
f9a08e12
JH
2086
2087 # set up parameters
2088 my ($self,$x,$y,$n,@r) = (ref($_[0]),@_);
2089 # objectify is costly, so avoid it
2090 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
2091 {
2092 ($self,$x,$y,$n,@r) = objectify(2,@_);
2093 }
58cde26e
JH
2094
2095 return $x if $x->modify('brsft');
2096 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
f9a08e12
JH
2097 return $x->round(@r) if $y->is_zero();
2098 return $x->bzero(@r) if $x->is_zero(); # 0 => 0
58cde26e
JH
2099
2100 $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
574bacfe 2101
b3abae2a
JH
2102 # this only works for negative numbers when shifting in base 2
2103 if (($x->{sign} eq '-') && ($n == 2))
2104 {
f9a08e12 2105 return $x->round(@r) if $x->is_one('-'); # -1 => -1
b3abae2a
JH
2106 if (!$y->is_one())
2107 {
2108 # although this is O(N*N) in calc (as_bin!) it is O(N) in Pari et al
2109 # but perhaps there is a better emulation for two's complement shift...
2110 # if $y != 1, we must simulate it by doing:
2111 # convert to bin, flip all bits, shift, and be done
2112 $x->binc(); # -3 => -2
2113 my $bin = $x->as_bin();
2114 $bin =~ s/^-0b//; # strip '-0b' prefix
2115 $bin =~ tr/10/01/; # flip bits
2116 # now shift
a0ac753d 2117 if ($y >= CORE::length($bin))
b3abae2a
JH
2118 {
2119 $bin = '0'; # shifting to far right creates -1
2120 # 0, because later increment makes
2121 # that 1, attached '-' makes it '-1'
2122 # because -1 >> x == -1 !
2123 }
2124 else
2125 {
2126 $bin =~ s/.{$y}$//; # cut off at the right side
2127 $bin = '1' . $bin; # extend left side by one dummy '1'
2128 $bin =~ tr/10/01/; # flip bits back
2129 }
2130 my $res = $self->new('0b'.$bin); # add prefix and convert back
2131 $res->binc(); # remember to increment
2132 $x->{value} = $res->{value}; # take over value
f9a08e12 2133 return $x->round(@r); # we are done now, magic, isn't?
b3abae2a 2134 }
b282a552 2135 # x < 0, n == 2, y == 1
b3abae2a
JH
2136 $x->bdec(); # n == 2, but $y == 1: this fixes it
2137 }
2138
9b924220
RGS
2139 $x->{value} = $CALC->_rsft($x->{value},$y->{value},$n);
2140 $x->round(@r);
58cde26e
JH
2141 }
2142
2143sub band
2144 {
2145 #(BINT or num_str, BINT or num_str) return BINT
2146 # compute x & y
f9a08e12
JH
2147
2148 # set up parameters
2149 my ($self,$x,$y,@r) = (ref($_[0]),@_);
2150 # objectify is costly, so avoid it
2151 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
2152 {
2153 ($self,$x,$y,@r) = objectify(2,@_);
2154 }
58cde26e
JH
2155
2156 return $x if $x->modify('band');
2157
f9a08e12 2158 $r[3] = $y; # no push!
b3abae2a 2159
58cde26e 2160 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
0716bf9b 2161
b282a552
T
2162 my $sx = $x->{sign} eq '+' ? 1 : -1;
2163 my $sy = $y->{sign} eq '+' ? 1 : -1;
574bacfe 2164
9b924220 2165 if ($sx == 1 && $sy == 1)
0716bf9b 2166 {
574bacfe 2167 $x->{value} = $CALC->_and($x->{value},$y->{value});
f9a08e12 2168 return $x->round(@r);
0716bf9b 2169 }
091c87b1
T
2170
2171 if ($CAN{signed_and})
2172 {
2173 $x->{value} = $CALC->_signed_and($x->{value},$y->{value},$sx,$sy);
2174 return $x->round(@r);
2175 }
b282a552
T
2176
2177 require $EMU_LIB;
2178 __emu_band($self,$x,$y,$sx,$sy,@r);
58cde26e
JH
2179 }
2180
2181sub bior
2182 {
2183 #(BINT or num_str, BINT or num_str) return BINT
2184 # compute x | y
f9a08e12
JH
2185
2186 # set up parameters
2187 my ($self,$x,$y,@r) = (ref($_[0]),@_);
2188 # objectify is costly, so avoid it
2189 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
2190 {
2191 ($self,$x,$y,@r) = objectify(2,@_);
2192 }
58cde26e
JH
2193
2194 return $x if $x->modify('bior');
f9a08e12 2195 $r[3] = $y; # no push!
58cde26e
JH
2196
2197 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
574bacfe 2198
b282a552
T
2199 my $sx = $x->{sign} eq '+' ? 1 : -1;
2200 my $sy = $y->{sign} eq '+' ? 1 : -1;
574bacfe 2201
091c87b1
T
2202 # the sign of X follows the sign of X, e.g. sign of Y irrelevant for bior()
2203
574bacfe 2204 # don't use lib for negative values
9b924220 2205 if ($sx == 1 && $sy == 1)
0716bf9b 2206 {
574bacfe 2207 $x->{value} = $CALC->_or($x->{value},$y->{value});
f9a08e12 2208 return $x->round(@r);
0716bf9b
JH
2209 }
2210
b282a552 2211 # if lib can do negative values, let it handle this
091c87b1
T
2212 if ($CAN{signed_or})
2213 {
2214 $x->{value} = $CALC->_signed_or($x->{value},$y->{value},$sx,$sy);
2215 return $x->round(@r);
2216 }
2217
b282a552
T
2218 require $EMU_LIB;
2219 __emu_bior($self,$x,$y,$sx,$sy,@r);
58cde26e
JH
2220 }
2221
2222sub bxor
2223 {
2224 #(BINT or num_str, BINT or num_str) return BINT
2225 # compute x ^ y
f9a08e12
JH
2226
2227 # set up parameters
2228 my ($self,$x,$y,@r) = (ref($_[0]),@_);
2229 # objectify is costly, so avoid it
2230 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
2231 {
2232 ($self,$x,$y,@r) = objectify(2,@_);
2233 }
58cde26e
JH
2234
2235 return $x if $x->modify('bxor');
f9a08e12 2236 $r[3] = $y; # no push!
58cde26e 2237
0716bf9b 2238 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
0716bf9b 2239
b282a552
T
2240 my $sx = $x->{sign} eq '+' ? 1 : -1;
2241 my $sy = $y->{sign} eq '+' ? 1 : -1;
574bacfe
JH
2242
2243 # don't use lib for negative values
9b924220 2244 if ($sx == 1 && $sy == 1)
0716bf9b 2245 {
574bacfe 2246 $x->{value} = $CALC->_xor($x->{value},$y->{value});
f9a08e12 2247 return $x->round(@r);
0716bf9b 2248 }
091c87b1 2249
b282a552 2250 # if lib can do negative values, let it handle this
091c87b1
T
2251 if ($CAN{signed_xor})
2252 {
2253 $x->{value} = $CALC->_signed_xor($x->{value},$y->{value},$sx,$sy);
2254 return $x->round(@r);
2255 }
0716bf9b 2256
b282a552
T
2257 require $EMU_LIB;
2258 __emu_bxor($self,$x,$y,$sx,$sy,@r);
58cde26e
JH
2259 }
2260
2261sub length
2262 {
b282a552 2263 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
58cde26e 2264
0716bf9b 2265 my $e = $CALC->_len($x->{value});
091c87b1 2266 wantarray ? ($e,0) : $e;
58cde26e
JH
2267 }
2268
2269sub digit
2270 {
0716bf9b 2271 # return the nth decimal digit, negative values count backward, 0 is right
ef9466ea 2272 my ($self,$x,$n) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
58cde26e 2273
ef9466ea 2274 $n = $n->numify() if ref($n);
f9a08e12 2275 $CALC->_digit($x->{value},$n||0);
58cde26e
JH
2276 }
2277
2278sub _trailing_zeros
2279 {
b282a552 2280 # return the amount of trailing zeros in $x (as scalar)
58cde26e
JH
2281 my $x = shift;
2282 $x = $class->new($x) unless ref $x;
2283
9b924220 2284 return 0 if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf etc
0716bf9b 2285
9b924220 2286 $CALC->_zeros($x->{value}); # must handle odd values, 0 etc
58cde26e
JH
2287 }
2288
2289sub bsqrt
2290 {
990fb837 2291 # calculate square root of $x
b68b7ab1 2292 my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
58cde26e 2293
b3abae2a
JH
2294 return $x if $x->modify('bsqrt');
2295
990fb837
RGS
2296 return $x->bnan() if $x->{sign} !~ /^\+/; # -x or -inf or NaN => NaN
2297 return $x if $x->{sign} eq '+inf'; # sqrt(+inf) == inf
b3abae2a 2298
f9a08e12 2299 return $upgrade->bsqrt($x,@r) if defined $upgrade;
58cde26e 2300
9b924220
RGS
2301 $x->{value} = $CALC->_sqrt($x->{value});
2302 $x->round(@r);
58cde26e
JH
2303 }
2304
990fb837
RGS
2305sub broot
2306 {
2307 # calculate $y'th root of $x
c38b2de2 2308
990fb837
RGS
2309 # set up parameters
2310 my ($self,$x,$y,@r) = (ref($_[0]),@_);
c38b2de2
JH
2311
2312 $y = $self->new(2) unless defined $y;
2313
990fb837 2314 # objectify is costly, so avoid it
c38b2de2 2315 if ((!ref($x)) || (ref($x) ne ref($y)))
990fb837 2316 {
3a427a11 2317 ($self,$x,$y,@r) = objectify(2,$self || $class,@_);
990fb837
RGS
2318 }
2319
2320 return $x if $x->modify('broot');
2321
2322 # NaN handling: $x ** 1/0, x or y NaN, or y inf/-inf or y == 0
2323 return $x->bnan() if $x->{sign} !~ /^\+/ || $y->is_zero() ||
2324 $y->{sign} !~ /^\+$/;
2325
2326 return $x->round(@r)
2327 if $x->is_zero() || $x->is_one() || $x->is_inf() || $y->is_one();
2328
c38b2de2 2329 return $upgrade->new($x)->broot($upgrade->new($y),@r) if defined $upgrade;
990fb837 2330
9b924220
RGS
2331 $x->{value} = $CALC->_root($x->{value},$y->{value});
2332 $x->round(@r);
990fb837
RGS
2333 }
2334
58cde26e
JH
2335sub exponent
2336 {
2337 # return a copy of the exponent (here always 0, NaN or 1 for $m == 0)
ee15d750 2338 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
58cde26e 2339
ee15d750
JH
2340 if ($x->{sign} !~ /^[+-]$/)
2341 {
b282a552
T
2342 my $s = $x->{sign}; $s =~ s/^[+-]//; # NaN, -inf,+inf => NaN or inf
2343 return $self->new($s);
ee15d750 2344 }
b282a552
T
2345 return $self->bone() if $x->is_zero();
2346
7d193e39
T
2347 # 12300 => 2 trailing zeros => exponent is 2
2348 $self->new( $CALC->_zeros($x->{value}) );
58cde26e
JH
2349 }
2350
2351sub mantissa
2352 {
ee15d750
JH
2353 # return the mantissa (compatible to Math::BigFloat, e.g. reduced)
2354 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
58cde26e 2355
ee15d750
JH
2356 if ($x->{sign} !~ /^[+-]$/)
2357 {
b282a552
T
2358 # for NaN, +inf, -inf: keep the sign
2359 return $self->new($x->{sign});
ee15d750 2360 }
b282a552 2361 my $m = $x->copy(); delete $m->{_p}; delete $m->{_a};
7d193e39 2362
b282a552 2363 # that's a bit inefficient:
7d193e39 2364 my $zeros = $CALC->_zeros($m->{value});
56b9c951 2365 $m->brsft($zeros,10) if $zeros != 0;
56b9c951 2366 $m;
58cde26e
JH
2367 }
2368
2369sub parts
2370 {
ee15d750 2371 # return a copy of both the exponent and the mantissa
091c87b1 2372 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
58cde26e 2373
091c87b1 2374 ($x->mantissa(),$x->exponent());
58cde26e
JH
2375 }
2376
2377##############################################################################
2378# rounding functions
2379
2380sub bfround
2381 {
2382 # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
ee15d750 2383 # $n == 0 || $n == 1 => round to integer
ef9466ea 2384 my $x = shift; my $self = ref($x) || $x; $x = $self->new($x) unless ref $x;
b282a552 2385
b68b7ab1 2386 my ($scale,$mode) = $x->_scale_p(@_);
b282a552
T
2387
2388 return $x if !defined $scale || $x->modify('bfround'); # no-op
58cde26e
JH
2389
2390 # no-op for BigInts if $n <= 0
b282a552 2391 $x->bround( $x->length()-$scale, $mode) if $scale > 0;
58cde26e 2392
ef9466ea
T
2393 delete $x->{_a}; # delete to save memory
2394 $x->{_p} = $scale; # store new _p
ee15d750 2395 $x;
58cde26e
JH
2396 }
2397
2398sub _scan_for_nonzero
2399 {
ae161977
RGS
2400 # internal, used by bround() to scan for non-zeros after a '5'
2401 my ($x,$pad,$xs,$len) = @_;
58cde26e 2402
ae161977 2403 return 0 if $len == 1; # "5" is trailed by invisible zeros
58cde26e
JH
2404 my $follow = $pad - 1;
2405 return 0 if $follow > $len || $follow < 1;
0716bf9b 2406
ae161977
RGS
2407 # use the string form to check whether only '0's follow or not
2408 substr ($xs,-$follow) =~ /[^0]/ ? 1 : 0;
58cde26e
JH
2409 }
2410
2411sub fround
2412 {
091c87b1
T
2413 # Exists to make life easier for switch between MBF and MBI (should we
2414 # autoload fxxx() like MBF does for bxxx()?)
b68b7ab1 2415 my $x = shift; $x = $class->new($x) unless ref $x;
091c87b1 2416 $x->bround(@_);
58cde26e
JH
2417 }
2418
2419sub bround
2420 {
2421 # accuracy: +$n preserve $n digits from left,
2422 # -$n preserve $n digits from right (f.i. for 0.1234 style in MBF)
2423 # no-op for $n == 0
2424 # and overwrite the rest with 0's, return normalized number
2425 # do not return $x->bnorm(), but $x
61f5c3f5 2426
58cde26e 2427 my $x = shift; $x = $class->new($x) unless ref $x;
b68b7ab1
T
2428 my ($scale,$mode) = $x->_scale_a(@_);
2429 return $x if !defined $scale || $x->modify('bround'); # no-op
58cde26e 2430
61f5c3f5
T
2431 if ($x->is_zero() || $scale == 0)
2432 {
2433 $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2
2434 return $x;
2435 }
2436 return $x if $x->{sign} !~ /^[+-]$/; # inf, NaN
58cde26e
JH
2437
2438 # we have fewer digits than we want to scale to
2439 my $len = $x->length();
56d9de68
T
2440 # convert $scale to a scalar in case it is an object (put's a limit on the
2441 # number length, but this would already limited by memory constraints), makes
2442 # it faster
2443 $scale = $scale->numify() if ref ($scale);
2444
ee15d750
JH
2445 # scale < 0, but > -len (not >=!)
2446 if (($scale < 0 && $scale < -$len-1) || ($scale >= $len))
2447 {
61f5c3f5 2448 $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2
ee15d750
JH
2449 return $x;
2450 }
58cde26e
JH
2451
2452 # count of 0's to pad, from left (+) or right (-): 9 - +6 => 3, or |-6| => 6
2453 my ($pad,$digit_round,$digit_after);
2454 $pad = $len - $scale;
ee15d750
JH
2455 $pad = abs($scale-1) if $scale < 0;
2456
ae161977
RGS
2457 # do not use digit(), it is very costly for binary => decimal
2458 # getting the entire string is also costly, but we need to do it only once
0716bf9b
JH
2459 my $xs = $CALC->_str($x->{value});
2460 my $pl = -$pad-1;
56d9de68 2461
0716bf9b
JH
2462 # pad: 123: 0 => -1, at 1 => -2, at 2 => -3, at 3 => -4
2463 # pad+1: 123: 0 => 0, at 1 => -1, at 2 => -2, at 3 => -3
9b924220 2464 $digit_round = '0'; $digit_round = substr($xs,$pl,1) if $pad <= $len;
0716bf9b 2465 $pl++; $pl ++ if $pad >= $len;
9b924220 2466 $digit_after = '0'; $digit_after = substr($xs,$pl,1) if $pad > 0;
ee15d750 2467
58cde26e
JH
2468 # in case of 01234 we round down, for 6789 up, and only in case 5 we look
2469 # closer at the remaining digits of the original $x, remember decision
2470 my $round_up = 1; # default round up
2471 $round_up -- if
2472 ($mode eq 'trunc') || # trunc by round down
2473 ($digit_after =~ /[01234]/) || # round down anyway,
2474 # 6789 => round up
2475 ($digit_after eq '5') && # not 5000...0000
ae161977 2476 ($x->_scan_for_nonzero($pad,$xs,$len) == 0) &&
58cde26e
JH
2477 (
2478 ($mode eq 'even') && ($digit_round =~ /[24680]/) ||
2479 ($mode eq 'odd') && ($digit_round =~ /[13579]/) ||
2480 ($mode eq '+inf') && ($x->{sign} eq '-') ||
2481 ($mode eq '-inf') && ($x->{sign} eq '+') ||
2482 ($mode eq 'zero') # round down if zero, sign adjusted below
2483 );
61f5c3f5
T
2484 my $put_back = 0; # not yet modified
2485
61f5c3f5
T
2486 if (($pad > 0) && ($pad <= $len))
2487 {
ae161977
RGS
2488 substr($xs,-$pad,$pad) = '0' x $pad; # replace with '00...'
2489 $put_back = 1; # need to put back
58cde26e 2490 }
61f5c3f5
T
2491 elsif ($pad > $len)
2492 {
2493 $x->bzero(); # round to '0'
2494 }
2495
58cde26e
JH
2496 if ($round_up) # what gave test above?
2497 {
ae161977 2498 $put_back = 1; # need to put back
9b924220 2499 $pad = $len, $xs = '0' x $pad if $scale < 0; # tlr: whack 0.51=>1.0
61f5c3f5
T
2500
2501 # we modify directly the string variant instead of creating a number and
f9a08e12 2502 # adding it, since that is faster (we already have the string)
61f5c3f5
T
2503 my $c = 0; $pad ++; # for $pad == $len case
2504 while ($pad <= $len)
2505 {
9b924220
RGS
2506 $c = substr($xs,-$pad,1) + 1; $c = '0' if $c eq '10';
2507 substr($xs,-$pad,1) = $c; $pad++;
61f5c3f5
T
2508 last if $c != 0; # no overflow => early out
2509 }
9b924220 2510 $xs = '1'.$xs if $c == 0;
61f5c3f5 2511
58cde26e 2512 }
ae161977 2513 $x->{value} = $CALC->_new($xs) if $put_back == 1; # put back, if needed
ee15d750
JH
2514
2515 $x->{_a} = $scale if $scale >= 0;
2516 if ($scale < 0)
2517 {
2518 $x->{_a} = $len+$scale;
2519 $x->{_a} = 0 if $scale < -$len;
2520 }
58cde26e
JH
2521 $x;
2522 }
2523
2524sub bfloor
2525 {
091c87b1
T
2526 # return integer less or equal then number; no-op since it's already integer
2527 my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
58cde26e 2528
f9a08e12 2529 $x->round(@r);
58cde26e
JH
2530 }
2531
2532sub bceil
2533 {
091c87b1
T
2534 # return integer greater or equal then number; no-op since it's already int
2535 my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
58cde26e 2536
f9a08e12 2537 $x->round(@r);
58cde26e
JH
2538 }
2539
091c87b1
T
2540sub as_number
2541 {
2542 # An object might be asked to return itself as bigint on certain overloaded
7b29e1e6 2543 # operations. This does exactly this, so that sub classes can simple inherit
091c87b1
T
2544 # it or override with their own integer conversion routine.
2545 $_[0]->copy();
2546 }
58cde26e 2547
091c87b1 2548sub as_hex
58cde26e 2549 {
091c87b1
T
2550 # return as hex string, with prefixed 0x
2551 my $x = shift; $x = $class->new($x) if !ref($x);
2552
2553 return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
2554
b282a552 2555 my $s = '';
091c87b1 2556 $s = $x->{sign} if $x->{sign} eq '-';
9b924220 2557 $s . $CALC->_as_hex($x->{value});
58cde26e
JH
2558 }
2559
091c87b1 2560sub as_bin
58cde26e 2561 {
091c87b1
T
2562 # return as binary string, with prefixed 0b
2563 my $x = shift; $x = $class->new($x) if !ref($x);
2564
2565 return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
2566
b282a552 2567 my $s = ''; $s = $x->{sign} if $x->{sign} eq '-';
9b924220 2568 return $s . $CALC->_as_bin($x->{value});
58cde26e
JH
2569 }
2570
7b29e1e6
T
2571sub as_oct
2572 {
2573 # return as octal string, with prefixed 0
2574 my $x = shift; $x = $class->new($x) if !ref($x);
2575
2576 return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
2577
2578 my $s = ''; $s = $x->{sign} if $x->{sign} eq '-';
2579 return $s . $CALC->_as_oct($x->{value});
2580 }
2581
091c87b1
T
2582##############################################################################
2583# private stuff (internal use only)
2584
58cde26e
JH
2585sub objectify
2586 {
2587 # check for strings, if yes, return objects instead
2588
2589 # the first argument is number of args objectify() should look at it will
2590 # return $count+1 elements, the first will be a classname. This is because
2591 # overloaded '""' calls bstr($object,undef,undef) and this would result in
3c4b39be 2592 # useless objects being created and thrown away. So we cannot simple loop
58cde26e
JH
2593 # over @_. If the given count is 0, all arguments will be used.
2594
2595 # If the second arg is a ref, use it as class.
2596 # If not, try to use it as classname, unless undef, then use $class
2597 # (aka Math::BigInt). The latter shouldn't happen,though.
2598
2599 # caller: gives us:
2600 # $x->badd(1); => ref x, scalar y
2601 # Class->badd(1,2); => classname x (scalar), scalar x, scalar y
2602 # Class->badd( Class->(1),2); => classname x (scalar), ref x, scalar y
2603 # Math::BigInt::badd(1,2); => scalar x, scalar y
2604 # In the last case we check number of arguments to turn it silently into
574bacfe 2605 # $class,1,2. (We can not take '1' as class ;o)
58cde26e
JH
2606 # badd($class,1) is not supported (it should, eventually, try to add undef)
2607 # currently it tries 'Math::BigInt' + 1, which will not work.
ee15d750
JH
2608
2609 # some shortcut for the common cases
ee15d750
JH
2610 # $x->unary_op();
2611 return (ref($_[1]),$_[1]) if (@_ == 2) && ($_[0]||0 == 1) && ref($_[1]);
ee15d750 2612
58cde26e
JH
2613 my $count = abs(shift || 0);
2614
9393ace2 2615 my (@a,$k,$d); # resulting array, temp, and downgrade
58cde26e
JH
2616 if (ref $_[0])
2617 {
2618 # okay, got object as first
2619 $a[0] = ref $_[0];
2620 }
2621 else
2622 {
2623 # nope, got 1,2 (Class->xxx(1) => Class,1 and not supported)
2624 $a[0] = $class;
58cde26e
JH
2625 $a[0] = shift if $_[0] =~ /^[A-Z].*::/; # classname as first?
2626 }
8f675a64 2627
9393ace2
JH
2628 no strict 'refs';
2629 # disable downgrading, because Math::BigFLoat->foo('1.0','2.0') needs floats
2630 if (defined ${"$a[0]::downgrade"})
2631 {
2632 $d = ${"$a[0]::downgrade"};
2633 ${"$a[0]::downgrade"} = undef;
2634 }
2635
d614cd8b 2636 my $up = ${"$a[0]::upgrade"};
7d193e39 2637 # print STDERR "# Now in objectify, my class is today $a[0], count = $count\n";
58cde26e
JH
2638 if ($count == 0)
2639 {
2640 while (@_)
2641 {
2642 $k = shift;
2643 if (!ref($k))
2644 {
2645 $k = $a[0]->new($k);
2646 }
d614cd8b 2647 elsif (!defined $up && ref($k) ne $a[0])
58cde26e
JH
2648 {
2649 # foreign object, try to convert to integer
2650 $k->can('as_number') ? $k = $k->as_number() : $k = $a[0]->new($k);
e16b8f49 2651 }
58cde26e
JH
2652 push @a,$k;
2653 }
2654 }
2655 else
2656 {
2657 while ($count > 0)
2658 {
58cde26e 2659 $count--;
7d193e39 2660 $k = shift;
58cde26e
JH
2661 if (!ref($k))
2662 {
2663 $k = $a[0]->new($k);
2664 }
45029d2d 2665 elsif (ref($k) ne $a[0] and !defined $up || ref $k ne $up)
58cde26e
JH
2666 {
2667 # foreign object, try to convert to integer
a0ac753d 2668 $k->can('as_number') ? $k = $k->as_number() : $k = $a[0]->new($k);
e16b8f49 2669 }
58cde26e
JH
2670 push @a,$k;
2671 }
2672 push @a,@_; # return other params, too
2673 }
990fb837
RGS
2674 if (! wantarray)
2675 {
2676 require Carp; Carp::croak ("$class objectify needs list context");
2677 }
9393ace2 2678 ${"$a[0]::downgrade"} = $d;
58cde26e
JH
2679 @a;
2680 }
2681
b68b7ab1
T
2682sub _register_callback
2683 {
2684 my ($class,$callback) = @_;
2685
2686 if (ref($callback) ne 'CODE')
2687 {
2688 require Carp;
2689 Carp::croak ("$callback is not a coderef");
2690 }
2691 $CALLBACKS{$class} = $callback;
2692 }
2693
58cde26e
JH
2694sub import
2695 {
2696 my $self = shift;
61f5c3f5 2697
091c87b1 2698 $IMPORT++; # remember we did import()
8f675a64 2699 my @a; my $l = scalar @_;
7b29e1e6 2700 my $warn_or_die = 0; # 0 - no warn, 1 - warn, 2 - die
8f675a64 2701 for ( my $i = 0; $i < $l ; $i++ )
58cde26e 2702 {
0716bf9b 2703 if ($_[$i] eq ':constant')
58cde26e 2704 {
0716bf9b 2705 # this causes overlord er load to step in
091c87b1
T
2706 overload::constant
2707 integer => sub { $self->new(shift) },
2708 binary => sub { $self->new(shift) };
0716bf9b 2709 }
b3abae2a
JH
2710 elsif ($_[$i] eq 'upgrade')
2711 {
2712 # this causes upgrading
2713 $upgrade = $_[$i+1]; # or undef to disable
8f675a64 2714 $i++;
b3abae2a 2715 }
7b29e1e6 2716 elsif ($_[$i] =~ /^(lib|try|only)\z/)
0716bf9b
JH
2717 {
2718 # this causes a different low lib to take care...
61f5c3f5 2719 $CALC = $_[$i+1] || '';
7b29e1e6
T
2720 # lib => 1 (warn on fallback), try => 0 (no warn), only => 2 (die on fallback)
2721 $warn_or_die = 1 if $_[$i] eq 'lib';
2722 $warn_or_die = 2 if $_[$i] eq 'only';
8f675a64
JH
2723 $i++;
2724 }
2725 else
2726 {
2727 push @a, $_[$i];
58cde26e
JH
2728 }
2729 }
2730 # any non :constant stuff is handled by our parent, Exporter
b68b7ab1
T
2731 if (@a > 0)
2732 {
2733 require Exporter;
2734
2735 $self->SUPER::import(@a); # need it for subclasses
2736 $self->export_to_level(1,$self,@a); # need it for MBF
2737 }
58cde26e 2738
574bacfe
JH
2739 # try to load core math lib
2740 my @c = split /\s*,\s*/,$CALC;
b68b7ab1
T
2741 foreach (@c)
2742 {
2743 $_ =~ tr/a-zA-Z0-9://cd; # limit to sane characters
2744 }
7b29e1e6
T
2745 push @c, \'FastCalc', \'Calc' # if all fail, try these
2746 if $warn_or_die < 2; # but not for "only"
61f5c3f5 2747 $CALC = ''; # signal error
7b29e1e6 2748 foreach my $l (@c)
574bacfe 2749 {
7b29e1e6
T
2750 # fallback libraries are "marked" as \'string', extract string if nec.
2751 my $lib = $l; $lib = $$l if ref($l);
2752
07d34614 2753 next if ($lib || '') eq '';
574bacfe
JH
2754 $lib = 'Math::BigInt::'.$lib if $lib !~ /^Math::BigInt/i;
2755 $lib =~ s/\.pm$//;
61f5c3f5 2756 if ($] < 5.006)
574bacfe 2757 {
b68b7ab1
T
2758 # Perl < 5.6.0 dies with "out of memory!" when eval("") and ':constant' is
2759 # used in the same script, or eval("") inside import().
07d34614
T
2760 my @parts = split /::/, $lib; # Math::BigInt => Math BigInt
2761 my $file = pop @parts; $file .= '.pm'; # BigInt => BigInt.pm
2762 require File::Spec;
2763 $file = File::Spec->catfile (@parts, $file);
2764 eval { require "$file"; $lib->import( @c ); }
574bacfe
JH
2765 }
2766 else
2767 {
61f5c3f5 2768 eval "use $lib qw/@c/;";
574bacfe 2769 }
9b924220
RGS
2770 if ($@ eq '')
2771 {
2772 my $ok = 1;
2773 # loaded it ok, see if the api_version() is high enough
2774 if ($lib->can('api_version') && $lib->api_version() >= 1.0)
2775 {
2776 $ok = 0;
2777 # api_version matches, check if it really provides anything we need
2778 for my $method (qw/
2779 one two ten
2780 str num
2781 add mul div sub dec inc
2782 acmp len digit is_one is_zero is_even is_odd
2783 is_two is_ten
7b29e1e6
T
2784 zeros new copy check
2785 from_hex from_oct from_bin as_hex as_bin as_oct
9b924220
RGS
2786 rsft lsft xor and or
2787 mod sqrt root fac pow modinv modpow log_int gcd
2788 /)
2789 {
2790 if (!$lib->can("_$method"))
2791 {
2792 if (($WARN{$lib}||0) < 2)
2793 {
2794 require Carp;
2795 Carp::carp ("$lib is missing method '_$method'");
2796 $WARN{$lib} = 1; # still warn about the lib
2797 }
2798 $ok++; last;
2799 }
2800 }
2801 }
2802 if ($ok == 0)
2803 {
2804 $CALC = $lib;
7b29e1e6
T
2805 if ($warn_or_die > 0 && ref($l))
2806 {
2807 require Carp;
2808 my $msg = "Math::BigInt: couldn't load specified math lib(s), fallback to $lib";
2809 Carp::carp ($msg) if $warn_or_die == 1;
2810 Carp::croak ($msg) if $warn_or_die == 2;
2811 }
9b924220
RGS
2812 last; # found a usable one, break
2813 }
2814 else
2815 {
2816 if (($WARN{$lib}||0) < 2)
2817 {
a87115f0 2818 my $ver = eval "\$$lib\::VERSION" || 'unknown';
9b924220
RGS
2819 require Carp;
2820 Carp::carp ("Cannot load outdated $lib v$ver, please upgrade");
2821 $WARN{$lib} = 2; # never warn again
2822 }
2823 }
2824 }
574bacfe 2825 }
990fb837
RGS
2826 if ($CALC eq '')
2827 {
2828 require Carp;
7b29e1e6
T
2829 if ($warn_or_die == 2)
2830 {
2831 Carp::croak ("Couldn't load specified math lib(s) and fallback disallowed");
2832 }
2833 else
2834 {
2835 Carp::croak ("Couldn't load any math lib(s), not even fallback to Calc.pm");
2836 }
091c87b1 2837 }
091c87b1 2838
b68b7ab1
T
2839 # notify callbacks
2840 foreach my $class (keys %CALLBACKS)
2841 {
2842 &{$CALLBACKS{$class}}($CALC);
2843 }
2844
2845 # Fill $CAN with the results of $CALC->can(...) for emulating lower math lib
2846 # functions
091c87b1
T
2847
2848 %CAN = ();
b68b7ab1 2849 for my $method (qw/ signed_and signed_or signed_xor /)
091c87b1
T
2850 {
2851 $CAN{$method} = $CALC->can("_$method") ? 1 : 0;
990fb837 2852 }
b68b7ab1
T
2853
2854 # import done
58cde26e
JH
2855 }
2856
7b29e1e6
T
2857sub from_hex
2858 {
2859 # create a bigint from a hexadecimal string
2860 my ($self, $hs) = @_;
2861
7aa7e0ae 2862 my $rc = __from_hex($hs);
7b29e1e6
T
2863
2864 return $self->bnan() unless defined $rc;
2865
2866 $rc;
2867 }
2868
2869sub from_bin
2870 {
2871 # create a bigint from a hexadecimal string
2872 my ($self, $bs) = @_;
2873
7aa7e0ae 2874 my $rc = __from_bin($bs);
7b29e1e6
T
2875
2876 return $self->bnan() unless defined $rc;
2877
2878 $rc;
2879 }
2880
2881sub from_oct
2882 {
2883 # create a bigint from a hexadecimal string
2884 my ($self, $os) = @_;
2885
2886 my $x = $self->bzero();
2887
2888 # strip underscores
7aa7e0ae
T
2889 $os =~ s/([0-7])_([0-7])/$1$2/g;
2890 $os =~ s/([0-7])_([0-7])/$1$2/g;
7b29e1e6 2891
7aa7e0ae 2892 return $x->bnan() if $os !~ /^[\-\+]?0[0-7]+\z/;
7b29e1e6
T
2893
2894 my $sign = '+'; $sign = '-' if $os =~ /^-/;
2895
2896 $os =~ s/^[+-]//; # strip sign
2897 $x->{value} = $CALC->_from_oct($os);
2898 $x->{sign} = $sign unless $CALC->_is_zero($x->{value}); # no '-0'
2899 $x;
2900 }
2901
574bacfe 2902sub __from_hex
58cde26e 2903 {
b68b7ab1 2904 # internal
58cde26e
JH
2905 # convert a (ref to) big hex string to BigInt, return undef for error
2906 my $hs = shift;
2907
2908 my $x = Math::BigInt->bzero();
394e6ffb
JH
2909
2910 # strip underscores
9b924220
RGS
2911 $hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g;
2912 $hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g;
394e6ffb 2913
9b924220 2914 return $x->bnan() if $hs !~ /^[\-\+]?0x[0-9A-Fa-f]+$/;
58cde26e 2915
9b924220 2916 my $sign = '+'; $sign = '-' if $hs =~ /^-/;
58cde26e 2917
9b924220
RGS
2918 $hs =~ s/^[+-]//; # strip sign
2919 $x->{value} = $CALC->_from_hex($hs);
13a12e00
JH
2920 $x->{sign} = $sign unless $CALC->_is_zero($x->{value}); # no '-0'
2921 $x;
58cde26e
JH
2922 }
2923
574bacfe 2924sub __from_bin
58cde26e 2925 {
b68b7ab1 2926 # internal
58cde26e
JH
2927 # convert a (ref to) big binary string to BigInt, return undef for error
2928 my $bs = shift;
2929
2930 my $x = Math::BigInt->bzero();
7b29e1e6 2931
394e6ffb 2932 # strip underscores
9b924220
RGS
2933 $bs =~ s/([01])_([01])/$1$2/g;
2934 $bs =~ s/([01])_([01])/$1$2/g;
2935 return $x->bnan() if $bs !~ /^[+-]?0b[01]+$/;
58cde26e 2936
9b924220
RGS
2937 my $sign = '+'; $sign = '-' if $bs =~ /^\-/;
2938 $bs =~ s/^[+-]//; # strip sign
2939
2940 $x->{value} = $CALC->_from_bin($bs);
13a12e00
JH
2941 $x->{sign} = $sign unless $CALC->_is_zero($x->{value}); # no '-0'
2942 $x;
58cde26e
JH
2943 }
2944
2945sub _split
2946 {
b68b7ab1
T
2947 # input: num_str; output: undef for invalid or
2948 # (\$mantissa_sign,\$mantissa_value,\$mantissa_fraction,\$exp_sign,\$exp_value)
2949 # Internal, take apart a string and return the pieces.
2950 # Strip leading/trailing whitespace, leading zeros, underscore and reject
2951 # invalid input.
58cde26e
JH
2952 my $x = shift;
2953
c4a6f826 2954 # strip white space at front, also extraneous leading zeros
7b29e1e6
T
2955 $x =~ s/^\s*([-]?)0*([0-9])/$1$2/g; # will not strip ' .2'
2956 $x =~ s/^\s+//; # but this will
2957 $x =~ s/\s+$//g; # strip white space at end
58cde26e 2958
574bacfe 2959 # shortcut, if nothing to split, return early
7b29e1e6 2960 if ($x =~ /^[+-]?[0-9]+\z/)
574bacfe 2961 {
9b924220
RGS
2962 $x =~ s/^([+-])0*([0-9])/$2/; my $sign = $1 || '+';
2963 return (\$sign, \$x, \'', \'', \0);
574bacfe 2964 }
58cde26e 2965
574bacfe 2966 # invalid starting char?
9b924220 2967 return if $x !~ /^[+-]?(\.?[0-9]|0b[0-1]|0x[0-9a-fA-F])/;
58cde26e 2968
7b29e1e6
T
2969 return __from_hex($x) if $x =~ /^[\-\+]?0x/; # hex string
2970 return __from_bin($x) if $x =~ /^[\-\+]?0b/; # binary string
394e6ffb
JH
2971
2972 # strip underscores between digits
7b29e1e6
T
2973 $x =~ s/([0-9])_([0-9])/$1$2/g;
2974 $x =~ s/([0-9])_([0-9])/$1$2/g; # do twice for 1_2_3
574bacfe 2975
58cde26e
JH
2976 # some possible inputs:
2977 # 2.1234 # 0.12 # 1 # 1E1 # 2.134E1 # 434E-10 # 1.02009E-2
aef458a0 2978 # .2 # 1_2_3.4_5_6 # 1.4E1_2_3 # 1e3 # +.2 # 0e999
58cde26e 2979
9b924220 2980 my ($m,$e,$last) = split /[Ee]/,$x;
56d9de68 2981 return if defined $last; # last defined => 1e2E3 or others
58cde26e 2982 $e = '0' if !defined $e || $e eq "";
56d9de68 2983
58cde26e
JH
2984 # sign,value for exponent,mantint,mantfrac
2985 my ($es,$ev,$mis,$miv,$mfv);
2986 # valid exponent?
7b29e1e6 2987 if ($e =~ /^([+-]?)0*([0-9]+)$/) # strip leading zeros
58cde26e
JH
2988 {
2989 $es = $1; $ev = $2;
58cde26e
JH
2990 # valid mantissa?
2991 return if $m eq '.' || $m eq '';
56d9de68 2992 my ($mi,$mf,$lastf) = split /\./,$m;
8df1e0a2 2993 return if defined $lastf; # lastf defined => 1.2.3 or others
58cde26e
JH
2994 $mi = '0' if !defined $mi;
2995 $mi .= '0' if $mi =~ /^[\-\+]?$/;
2996 $mf = '0' if !defined $mf || $mf eq '';
7b29e1e6 2997 if ($mi =~ /^([+-]?)0*([0-9]+)$/) # strip leading zeros
58cde26e
JH
2998 {
2999 $mis = $1||'+'; $miv = $2;
7b29e1e6 3000 return unless ($mf =~ /^([0-9]*?)0*$/); # strip trailing zeros
58cde26e 3001 $mfv = $1;
aef458a0
JH
3002 # handle the 0e999 case here
3003 $ev = 0 if $miv eq '0' && $mfv eq '';
58cde26e
JH
3004 return (\$mis,\$miv,\$mfv,\$es,\$ev);
3005 }
3006 }
3007 return; # NaN, not a number
3008 }
3009
58cde26e 3010##############################################################################
0716bf9b 3011# internal calculation routines (others are in Math::BigInt::Calc etc)
58cde26e 3012
dccbb853 3013sub __lcm
58cde26e
JH
3014 {
3015 # (BINT or num_str, BINT or num_str) return BINT
3016 # does modify first argument
3017 # LCM
3018
b68b7ab1 3019 my ($x,$ty) = @_;
58cde26e 3020 return $x->bnan() if ($x->{sign} eq $nan) || ($ty->{sign} eq $nan);
b68b7ab1
T
3021 my $method = ref($x) . '::bgcd';
3022 no strict 'refs';
3023 $x * $ty / &$method($x,$ty);
58cde26e
JH
3024 }
3025
58cde26e 3026###############################################################################
fdb4b05f
T
3027# trigonometric functions
3028
3029sub bpi
3030 {
3031 # Calculate PI to N digits. Unless upgrading is in effect, returns the
3032 # result truncated to an integer, that is, always returns '3'.
3033 my ($self,$n) = @_;
3034 if (@_ == 1)
3035 {
3036 # called like Math::BigInt::bpi(10);
3037 $n = $self; $self = $class;
3038 }
3039 $self = ref($self) if ref($self);
3040
3041 return $upgrade->new($n) if defined $upgrade;
3042
3043 # hard-wired to "3"
3044 $self->new(3);
3045 }
3046
60a1aa19
T
3047sub bcos
3048 {
3049 # Calculate cosinus(x) to N digits. Unless upgrading is in effect, returns the
3050 # result truncated to an integer.
3051 my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
3052
3053 return $x if $x->modify('bcos');
3054
3055 return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN
3056
3057 return $upgrade->new($x)->bcos(@r) if defined $upgrade;
3058
20e2035c 3059 require Math::BigFloat;
60a1aa19
T
3060 # calculate the result and truncate it to integer
3061 my $t = Math::BigFloat->new($x)->bcos(@r)->as_int();
3062
3063 $x->bone() if $t->is_one();
3064 $x->bzero() if $t->is_zero();
3065 $x->round(@r);
3066 }
3067
3068sub bsin
3069 {
3070 # Calculate sinus(x) to N digits. Unless upgrading is in effect, returns the
3071 # result truncated to an integer.
3072 my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
3073
3074 return $x if $x->modify('bsin');
3075
3076 return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN
3077
3078 return $upgrade->new($x)->bsin(@r) if defined $upgrade;
3079
20e2035c 3080 require Math::BigFloat;
60a1aa19
T
3081 # calculate the result and truncate it to integer
3082 my $t = Math::BigFloat->new($x)->bsin(@r)->as_int();
3083
3084 $x->bone() if $t->is_one();
3085 $x->bzero() if $t->is_zero();
3086 $x->round(@r);
3087 }
3088
20e2035c
T
3089sub batan2
3090 {
30afc38d 3091 # calculate arcus tangens of ($y/$x)
20e2035c
T
3092
3093 # set up parameters
30afc38d 3094 my ($self,$y,$x,@r) = (ref($_[0]),@_);
20e2035c
T
3095 # objectify is costly, so avoid it
3096 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
3097 {
30afc38d 3098 ($self,$y,$x,@r) = objectify(2,@_);
20e2035c
T
3099 }
3100
30afc38d 3101 return $y if $y->modify('batan2');
20e2035c 3102
30afc38d
T
3103 return $y->bnan() if ($y->{sign} eq $nan) || ($x->{sign} eq $nan);
3104
0dceeee6
RGS
3105 # Y X
3106 # != 0 -inf result is +- pi
3107 if ($x->is_inf() || $y->is_inf())
3108 {
3109 # upgrade to BigFloat etc.
3110 return $upgrade->new($y)->batan2($upgrade->new($x),@r) if defined $upgrade;
3111 if ($y->is_inf())
3112 {
3113 if ($x->{sign} eq '-inf')
3114 {
3115 # calculate 3 pi/4 => 2.3.. => 2
3116 $y->bone( substr($y->{sign},0,1) );
3117 $y->bmul($self->new(2));
3118 }
3119 elsif ($x->{sign} eq '+inf')
3120 {
3121 # calculate pi/4 => 0.7 => 0
3122 $y->bzero();
3123 }
3124 else
3125 {
3126 # calculate pi/2 => 1.5 => 1
3127 $y->bone( substr($y->{sign},0,1) );
3128 }
3129 }
3130 else
3131 {
3132 if ($x->{sign} eq '+inf')
3133 {
3134 # calculate pi/4 => 0.7 => 0
3135 $y->bzero();
3136 }
3137 else
3138 {
3139 # PI => 3.1415.. => 3
3140 $y->bone( substr($y->{sign},0,1) );
3141 $y->bmul($self->new(3));
3142 }
3143 }
3144 return $y;
3145 }
20e2035c 3146
30afc38d 3147 return $upgrade->new($y)->batan2($upgrade->new($x),@r) if defined $upgrade;
20e2035c
T
3148
3149 require Math::BigFloat;
30afc38d 3150 my $r = Math::BigFloat->new($y)->batan2(Math::BigFloat->new($x),@r)->as_int();
20e2035c
T
3151
3152 $x->{value} = $r->{value};
3153 $x->{sign} = $r->{sign};
3154
3155 $x;
3156 }
3157
60a1aa19
T
3158sub batan
3159 {
3160 # Calculate arcus tangens of x to N digits. Unless upgrading is in effect, returns the
3161 # result truncated to an integer.
3162 my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
3163
3164 return $x if $x->modify('batan');
3165
3166 return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN
3167
3168 return $upgrade->new($x)->batan(@r) if defined $upgrade;
3169
3170 # calculate the result and truncate it to integer
3171 my $t = Math::BigFloat->new($x)->batan(@r);
3172
3173 $x->{value} = $CALC->_new( $x->as_int()->bstr() );
3174 $x->round(@r);
3175 }
3176
fdb4b05f 3177###############################################################################
b68b7ab1 3178# this method returns 0 if the object can be modified, or 1 if not.
b282a552 3179# We use a fast constant sub() here, to avoid costly calls. Subclasses
58cde26e
JH
3180# may override it with special code (f.i. Math::BigInt::Constant does so)
3181
0716bf9b 3182sub modify () { 0; }
e16b8f49 3183
a0d0e21e 31841;
a5f75d66
AD
3185__END__
3186
233f7bc0
T
3187=pod
3188
a5f75d66
AD
3189=head1 NAME
3190
233f7bc0 3191Math::BigInt - Arbitrary size integer/float math package
a5f75d66
AD
3192
3193=head1 SYNOPSIS
3194
3195 use Math::BigInt;
58cde26e 3196
0dceeee6
RGS
3197 # or make it faster with huge numbers: install (optional)
3198 # Math::BigInt::GMP and always use (it will fall back to
3199 # pure Perl if the GMP library is not installed):
3200 # (See also the L<MATH LIBRARY> section!)
990fb837 3201
7b29e1e6 3202 # will warn if Math::BigInt::GMP cannot be found
990fb837
RGS
3203 use Math::BigInt lib => 'GMP';
3204
9681bfa6 3205 # to suppress the warning use this:
7b29e1e6
T
3206 # use Math::BigInt try => 'GMP';
3207
0dceeee6
RGS
3208 # dies if GMP cannot be loaded:
3209 # use Math::BigInt only => 'GMP';
3210
9b924220
RGS
3211 my $str = '1234567890';
3212 my @values = (64,74,18);
3213 my $n = 1; my $sign = '-';
3214
58cde26e 3215 # Number creation
fdb4b05f
T
3216 my $x = Math::BigInt->new($str); # defaults to 0
3217 my $y = $x->copy(); # make a true copy
3218 my $nan = Math::BigInt->bnan(); # create a NotANumber
3219 my $zero = Math::BigInt->bzero(); # create a +0
3220 my $inf = Math::BigInt->binf(); # create a +inf
3221 my $inf = Math::BigInt->binf('-'); # create a -inf
3222 my $one = Math::BigInt->bone(); # create a +1
3223 my $mone = Math::BigInt->bone('-'); # create a -1
3224
3225 my $pi = Math::BigInt->bpi(); # returns '3'
3226 # see Math::BigFloat::bpi()
58cde26e 3227
7b29e1e6
T
3228 $h = Math::BigInt->new('0x123'); # from hexadecimal
3229 $b = Math::BigInt->new('0b101'); # from binary
3230 $o = Math::BigInt->from_oct('0101'); # from octal
3231
56d9de68
T
3232 # Testing (don't modify their arguments)
3233 # (return true if the condition is met, otherwise false)
3234
3235 $x->is_zero(); # if $x is +0
3236 $x->is_nan(); # if $x is NaN
3237 $x->is_one(); # if $x is +1
3238 $x->is_one('-'); # if $x is -1
3239 $x->is_odd(); # if $x is odd
3240 $x->is_even(); # if $x is even
4af46cb8
FR
3241 $x->is_pos(); # if $x > 0
3242 $x->is_neg(); # if $x < 0
9b924220 3243 $x->is_inf($sign); # if $x is +inf, or -inf (sign is default '+')
56d9de68
T
3244 $x->is_int(); # if $x is an integer (not a float)
3245
3c4b39be 3246 # comparing and digit/sign extraction
56d9de68
T
3247 $x->bcmp($y); # compare numbers (undef,<0,=0,>0)
3248 $x->bacmp($y); # compare absolutely (undef,<0,=0,>0)
3249 $x->sign(); # return the sign, either +,- or NaN
3250 $x->digit($n); # return the nth digit, counting from right
3251 $x->digit(-$n); # return the nth digit, counting from left
58cde26e 3252
990fb837
RGS
3253 # The following all modify their first argument. If you want to preserve
3254 # $x, use $z = $x->copy()->bXXX($y); See under L<CAVEATS> for why this is
3c4b39be 3255 # necessary when mixing $a = $b assignments with non-overloaded math.
58cde26e 3256
56d9de68
T
3257 $x->bzero(); # set $x to 0
3258 $x->bnan(); # set $x to NaN
3259 $x->bone(); # set $x to +1
3260 $x->bone('-'); # set $x to -1
3261 $x->binf(); # set $x to inf
3262 $x->binf('-'); # set $x to -inf
3263
3264 $x->bneg(); # negation
3265 $x->babs(); # absolute value
3266 $x->bnorm(); # normalize (no-op in BigInt)
3267 $x->bnot(); # two's complement (bit wise not)
3268 $x->binc(); # increment $x by 1
3269 $x->bdec(); # decrement $x by 1
53ea20b1 3270
56d9de68
T
3271 $x->badd($y); # addition (add $y to $x)
3272 $x->bsub($y); # subtraction (subtract $y from $x)
3273 $x->bmul($y); # multiplication (multiply $x by $y)
3274 $x->bdiv($y); # divide, set $x to quotient
3275 # return (quo,rem) or quo if scalar
3276
80365507
T
3277 $x->bmuladd($y,$z); # $x = $x * $y + $z
3278
56d9de68 3279 $x->bmod($y); # modulus (x % y)
116f6d6b
PJA
3280 $x->bmodpow($y,$mod); # modular exponentiation (($x ** $y) % $mod)
3281 $x->bmodinv($mod); # modular multiplicative inverse
56d9de68 3282 $x->bpow($y); # power of arguments (x ** y)
7d193e39
T
3283 $x->blsft($y); # left shift in base 2
3284 $x->brsft($y); # right shift in base 2
7b29e1e6
T
3285 # returns (quo,rem) or quo if in scalar context
3286 $x->blsft($y,$n); # left shift by $y places in base $n
3287 $x->brsft($y,$n); # right shift by $y places in base $n
3288 # returns (quo,rem) or quo if in scalar context
53ea20b1 3289
56d9de68
T
3290 $x->band($y); # bitwise and
3291 $x->bior($y); # bitwise inclusive or
3292 $x->bxor($y); # bitwise exclusive or
3293 $x->bnot(); # bitwise not (two's complement)
3294
3295 $x->bsqrt(); # calculate square-root
990fb837 3296 $x->broot($y); # $y'th root of $x (e.g. $y == 3 => cubic root)
56d9de68 3297 $x->bfac(); # factorial of $x (1*2*3*4*..$x)
58cde26e 3298
50109ad0
RGS
3299 $x->bnok($y); # x over y (binomial coefficient n over k)
3300
7d193e39
T
3301 $x->blog(); # logarithm of $x to base e (Euler's number)
3302 $x->blog($base); # logarithm of $x to base $base (f.i. 2)
3303 $x->bexp(); # calculate e ** $x where e is Euler's number
53ea20b1 3304
990fb837 3305 $x->round($A,$P,$mode); # round to accuracy or precision using mode $mode
9b924220 3306 $x->bround($n); # accuracy: preserve $n digits
d5351619
T
3307 $x->bfround($n); # $n > 0: round $nth digits,
3308 # $n < 0: round to the $nth digit after the
3309 # dot, no-op for BigInts
58cde26e 3310
990fb837 3311 # The following do not modify their arguments in BigInt (are no-ops),
56d9de68 3312 # but do so in BigFloat:
58cde26e 3313
56d9de68
T
3314 $x->bfloor(); # return integer less or equal than $x
3315 $x->bceil(); # return integer greater or equal than $x
fdd59300 3316
58cde26e
JH
3317 # The following do not modify their arguments:
3318
9b924220
RGS
3319 # greatest common divisor (no OO style)
3320 my $gcd = Math::BigInt::bgcd(@values);
fdd59300
FR
3321 # lowest common multiple (no OO style)
3322 my $lcm = Math::BigInt::blcm(@values);
3323
56d9de68 3324 $x->length(); # return number of digits in number
9b924220 3325 ($xl,$f) = $x->length(); # length of number and length of fraction part,
b68b7ab1 3326 # latter is always 0 digits long for BigInts
56d9de68
T
3327
3328 $x->exponent(); # return exponent as BigInt
3329 $x->mantissa(); # return (signed) mantissa as BigInt
3330 $x->parts(); # return (mantissa,exponent) as BigInt
3331 $x->copy(); # make a true copy of $x (unlike $y = $x;)
b282a552
T
3332 $x->as_int(); # return as BigInt (in BigInt: same as copy())
3333 $x->numify(); # return as scalar (might overflow!)
53ea20b1 3334
9681bfa6 3335 # conversion to string (do not modify their argument)
b68b7ab1
T
3336 $x->bstr(); # normalized string (e.g. '3')
3337 $x->bsstr(); # norm. string in scientific notation (e.g. '3E0')
56d9de68
T
3338 $x->as_hex(); # as signed hexadecimal string with prefixed 0x
3339 $x->as_bin(); # as signed binary string with prefixed 0b
7b29e1e6 3340 $x->as_oct(); # as signed octal string with prefixed 0
b282a552 3341
bd05a461 3342
f9a08e12 3343 # precision and accuracy (see section about rounding for more)
56d9de68
T
3344 $x->precision(); # return P of $x (or global, if P of $x undef)
3345 $x->precision($n); # set P of $x to $n
3346 $x->accuracy(); # return A of $x (or global, if A of $x undef)
3347 $x->accuracy($n); # set A $x to $n
f9a08e12 3348
56d9de68 3349 # Global methods
b68b7ab1
T
3350 Math::BigInt->precision(); # get/set global P for all BigInt objects
3351 Math::BigInt->accuracy(); # get/set global A for all BigInt objects
3352 Math::BigInt->round_mode(); # get/set global round mode, one of
7b29e1e6 3353 # 'even', 'odd', '+inf', '-inf', 'zero', 'trunc' or 'common'
b68b7ab1 3354 Math::BigInt->config(); # return hash containing configuration
f9a08e12 3355
a5f75d66
AD
3356=head1 DESCRIPTION
3357
3c4b39be 3358All operators (including basic math operations) are overloaded if you
58cde26e 3359declare your big integers as
a5f75d66 3360
58cde26e 3361 $i = new Math::BigInt '123_456_789_123_456_789';
a5f75d66 3362
58cde26e
JH
3363Operations with overloaded operators preserve the arguments which is
3364exactly what you expect.
a5f75d66
AD
3365
3366=over 2
3367
aef458a0 3368=item Input
a5f75d66 3369
aef458a0
JH
3370Input values to these routines may be any string, that looks like a number
3371and results in an integer, including hexadecimal and binary numbers.
58cde26e 3372
aef458a0 3373Scalars holding numbers may also be passed, but note that non-integer numbers
9681bfa6 3374may already have lost precision due to the conversion to float. Quote
091c87b1 3375your input if you want BigInt to see all the digits:
a5f75d66 3376
aef458a0
JH
3377 $x = Math::BigInt->new(12345678890123456789); # bad
3378 $x = Math::BigInt->new('12345678901234567890'); # good
58cde26e 3379
56d9de68 3380You can include one underscore between any two digits.
58cde26e
JH
3381
3382This means integer values like 1.01E2 or even 1000E-2 are also accepted.
aef458a0 3383Non-integer values result in NaN.
58cde26e 3384
7b29e1e6
T
3385Hexadecimal (prefixed with "0x") and binary numbers (prefixed with "0b")
3386are accepted, too. Please note that octal numbers are not recognized
3387by new(), so the following will print "123":
3388
3389 perl -MMath::BigInt -le 'print Math::BigInt->new("0123")'
53ea20b1 3390
7b29e1e6
T
3391To convert an octal number, use from_oct();
3392
3393 perl -MMath::BigInt -le 'print Math::BigInt->from_oct("0123")'
3394
aef458a0 3395Currently, Math::BigInt::new() defaults to 0, while Math::BigInt::new('')
091c87b1
T
3396results in 'NaN'. This might change in the future, so use always the following
3397explicit forms to get a zero or NaN:
3398
53ea20b1
NC
3399 $zero = Math::BigInt->bzero();
3400 $nan = Math::BigInt->bnan();
58cde26e 3401
aef458a0 3402C<bnorm()> on a BigInt object is now effectively a no-op, since the numbers
091c87b1 3403are always stored in normalized form. If passed a string, creates a BigInt
aef458a0 3404object from the input.
a5f75d66
AD
3405
3406=item Output
3407
b68b7ab1
T
3408Output values are BigInt objects (normalized), except for the methods which
3409return a string (see L<SYNOPSIS>).
3410
58cde26e 3411Some routines (C<is_odd()>, C<is_even()>, C<is_zero()>, C<is_one()>,
b68b7ab1
T
3412C<is_nan()>, etc.) return true or false, while others (C<bcmp()>, C<bacmp()>)
3413return either undef (if NaN is involved), <0, 0 or >0 and are suited for sort.
a5f75d66
AD
3414
3415=back
3416
b3abae2a
JH
3417=head1 METHODS
3418
56d9de68 3419Each of the methods below (except config(), accuracy() and precision())
b68b7ab1
T
3420accepts three additional parameters. These arguments C<$A>, C<$P> and C<$R>
3421are C<accuracy>, C<precision> and C<round_mode>. Please see the section about
56d9de68 3422L<ACCURACY and PRECISION> for more information.
b3abae2a 3423
7b29e1e6 3424=head2 config()
8f675a64
JH
3425
3426 use Data::Dumper;
3427
3428 print Dumper ( Math::BigInt->config() );
56d9de68 3429 print Math::BigInt->config()->{lib},"\n";
8f675a64
JH
3430
3431Returns a hash containing the configura