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