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