xref: /openbsd-src/gnu/usr.bin/perl/cpan/Math-BigInt/lib/Math/BigInt/Lib.pm (revision 5486feefcc8cb79b19e014ab332cc5dfd05b3b33)
15759b3d2Safresh1package Math::BigInt::Lib;
25759b3d2Safresh1
35759b3d2Safresh1use 5.006001;
45759b3d2Safresh1use strict;
55759b3d2Safresh1use warnings;
65759b3d2Safresh1
7*5486feefSafresh1our $VERSION = '2.003002';
8256a93a4Safresh1$VERSION =~ tr/_//d;
95759b3d2Safresh1
105759b3d2Safresh1use Carp;
115759b3d2Safresh1
125759b3d2Safresh1use overload
135759b3d2Safresh1
145759b3d2Safresh1  # overload key: with_assign
155759b3d2Safresh1
165759b3d2Safresh1  '+'    => sub {
175759b3d2Safresh1                my $class = ref $_[0];
185759b3d2Safresh1                my $x = $class -> _copy($_[0]);
195759b3d2Safresh1                my $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
205759b3d2Safresh1                return $class -> _add($x, $y);
215759b3d2Safresh1            },
225759b3d2Safresh1
235759b3d2Safresh1  '-'    => sub {
245759b3d2Safresh1                my $class = ref $_[0];
255759b3d2Safresh1                my ($x, $y);
265759b3d2Safresh1                if ($_[2]) {            # if swapped
275759b3d2Safresh1                    $y = $_[0];
285759b3d2Safresh1                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
295759b3d2Safresh1                } else {
305759b3d2Safresh1                    $x = $class -> _copy($_[0]);
315759b3d2Safresh1                    $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
325759b3d2Safresh1                }
335759b3d2Safresh1                return $class -> _sub($x, $y);
345759b3d2Safresh1            },
355759b3d2Safresh1
365759b3d2Safresh1  '*'    => sub {
375759b3d2Safresh1                my $class = ref $_[0];
385759b3d2Safresh1                my $x = $class -> _copy($_[0]);
395759b3d2Safresh1                my $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
405759b3d2Safresh1                return $class -> _mul($x, $y);
415759b3d2Safresh1            },
425759b3d2Safresh1
435759b3d2Safresh1  '/'    => sub {
445759b3d2Safresh1                my $class = ref $_[0];
455759b3d2Safresh1                my ($x, $y);
465759b3d2Safresh1                if ($_[2]) {            # if swapped
475759b3d2Safresh1                    $y = $_[0];
485759b3d2Safresh1                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
495759b3d2Safresh1                } else {
505759b3d2Safresh1                    $x = $class -> _copy($_[0]);
515759b3d2Safresh1                    $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
525759b3d2Safresh1                }
535759b3d2Safresh1                return $class -> _div($x, $y);
545759b3d2Safresh1            },
555759b3d2Safresh1
565759b3d2Safresh1  '%'    => sub {
575759b3d2Safresh1                my $class = ref $_[0];
585759b3d2Safresh1                my ($x, $y);
595759b3d2Safresh1                if ($_[2]) {            # if swapped
605759b3d2Safresh1                    $y = $_[0];
615759b3d2Safresh1                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
625759b3d2Safresh1                } else {
635759b3d2Safresh1                    $x = $class -> _copy($_[0]);
645759b3d2Safresh1                    $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
655759b3d2Safresh1                }
665759b3d2Safresh1                return $class -> _mod($x, $y);
675759b3d2Safresh1            },
685759b3d2Safresh1
695759b3d2Safresh1  '**'   => sub {
705759b3d2Safresh1                my $class = ref $_[0];
715759b3d2Safresh1                my ($x, $y);
725759b3d2Safresh1                if ($_[2]) {            # if swapped
735759b3d2Safresh1                    $y = $_[0];
745759b3d2Safresh1                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
755759b3d2Safresh1                } else {
765759b3d2Safresh1                    $x = $class -> _copy($_[0]);
775759b3d2Safresh1                    $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
785759b3d2Safresh1                }
795759b3d2Safresh1                return $class -> _pow($x, $y);
805759b3d2Safresh1            },
815759b3d2Safresh1
825759b3d2Safresh1  '<<'   => sub {
835759b3d2Safresh1                my $class = ref $_[0];
845759b3d2Safresh1                my ($x, $y);
855759b3d2Safresh1                if ($_[2]) {            # if swapped
865759b3d2Safresh1                    $y = $class -> _num($_[0]);
875759b3d2Safresh1                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
885759b3d2Safresh1                } else {
895759b3d2Safresh1                    $x = $_[0];
905759b3d2Safresh1                    $y = ref($_[1]) ? $class -> _num($_[1]) : $_[1];
915759b3d2Safresh1                }
92256a93a4Safresh1                return $class -> _lsft($x, $y);
935759b3d2Safresh1            },
945759b3d2Safresh1
955759b3d2Safresh1  '>>'   => sub {
965759b3d2Safresh1                my $class = ref $_[0];
975759b3d2Safresh1                my ($x, $y);
985759b3d2Safresh1                if ($_[2]) {            # if swapped
995759b3d2Safresh1                    $y = $_[0];
1005759b3d2Safresh1                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
1015759b3d2Safresh1                } else {
1025759b3d2Safresh1                    $x = $class -> _copy($_[0]);
1035759b3d2Safresh1                    $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
1045759b3d2Safresh1                }
105256a93a4Safresh1                return $class -> _rsft($x, $y);
1065759b3d2Safresh1            },
1075759b3d2Safresh1
1085759b3d2Safresh1  # overload key: num_comparison
1095759b3d2Safresh1
1105759b3d2Safresh1  '<'    => sub {
1115759b3d2Safresh1                my $class = ref $_[0];
1125759b3d2Safresh1                my ($x, $y);
1135759b3d2Safresh1                if ($_[2]) {            # if swapped
1145759b3d2Safresh1                    $y = $_[0];
1155759b3d2Safresh1                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
1165759b3d2Safresh1                } else {
1175759b3d2Safresh1                    $x = $class -> _copy($_[0]);
1185759b3d2Safresh1                    $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
1195759b3d2Safresh1                }
1205759b3d2Safresh1                return $class -> _acmp($x, $y) < 0;
1215759b3d2Safresh1            },
1225759b3d2Safresh1
1235759b3d2Safresh1  '<='   => sub {
1245759b3d2Safresh1                my $class = ref $_[0];
1255759b3d2Safresh1                my ($x, $y);
1265759b3d2Safresh1                if ($_[2]) {            # if swapped
1275759b3d2Safresh1                    $y = $_[0];
1285759b3d2Safresh1                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
1295759b3d2Safresh1                } else {
1305759b3d2Safresh1                    $x = $class -> _copy($_[0]);
1315759b3d2Safresh1                    $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
1325759b3d2Safresh1                }
1335759b3d2Safresh1                return $class -> _acmp($x, $y) <= 0;
1345759b3d2Safresh1            },
1355759b3d2Safresh1
1365759b3d2Safresh1  '>'    => sub {
1375759b3d2Safresh1                my $class = ref $_[0];
1385759b3d2Safresh1                my ($x, $y);
1395759b3d2Safresh1                if ($_[2]) {            # if swapped
1405759b3d2Safresh1                    $y = $_[0];
1415759b3d2Safresh1                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
1425759b3d2Safresh1                } else {
1435759b3d2Safresh1                    $x = $class -> _copy($_[0]);
1445759b3d2Safresh1                    $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
1455759b3d2Safresh1                }
1465759b3d2Safresh1                return $class -> _acmp($x, $y) > 0;
1475759b3d2Safresh1            },
1485759b3d2Safresh1
1495759b3d2Safresh1  '>='   => sub {
1505759b3d2Safresh1                my $class = ref $_[0];
1515759b3d2Safresh1                my ($x, $y);
1525759b3d2Safresh1                if ($_[2]) {            # if swapped
1535759b3d2Safresh1                    $y = $_[0];
1545759b3d2Safresh1                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
1555759b3d2Safresh1                } else {
1565759b3d2Safresh1                    $x = $class -> _copy($_[0]);
1575759b3d2Safresh1                    $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
1585759b3d2Safresh1                }
1595759b3d2Safresh1                return $class -> _acmp($x, $y) >= 0;
1605759b3d2Safresh1          },
1615759b3d2Safresh1
1625759b3d2Safresh1  '=='   => sub {
1635759b3d2Safresh1                my $class = ref $_[0];
1645759b3d2Safresh1                my $x = $class -> _copy($_[0]);
1655759b3d2Safresh1                my $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
1665759b3d2Safresh1                return $class -> _acmp($x, $y) == 0;
1675759b3d2Safresh1            },
1685759b3d2Safresh1
1695759b3d2Safresh1  '!='   => sub {
1705759b3d2Safresh1                my $class = ref $_[0];
1715759b3d2Safresh1                my $x = $class -> _copy($_[0]);
1725759b3d2Safresh1                my $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
1735759b3d2Safresh1                return $class -> _acmp($x, $y) != 0;
1745759b3d2Safresh1            },
1755759b3d2Safresh1
1765759b3d2Safresh1  # overload key: 3way_comparison
1775759b3d2Safresh1
1785759b3d2Safresh1  '<=>'  => sub {
1795759b3d2Safresh1                my $class = ref $_[0];
1805759b3d2Safresh1                my ($x, $y);
1815759b3d2Safresh1                if ($_[2]) {            # if swapped
1825759b3d2Safresh1                    $y = $_[0];
1835759b3d2Safresh1                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
1845759b3d2Safresh1                } else {
1855759b3d2Safresh1                    $x = $class -> _copy($_[0]);
1865759b3d2Safresh1                    $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
1875759b3d2Safresh1                }
1885759b3d2Safresh1                return $class -> _acmp($x, $y);
1895759b3d2Safresh1            },
1905759b3d2Safresh1
1915759b3d2Safresh1  # overload key: binary
1925759b3d2Safresh1
1935759b3d2Safresh1  '&'    => sub {
1945759b3d2Safresh1                my $class = ref $_[0];
1955759b3d2Safresh1                my ($x, $y);
1965759b3d2Safresh1                if ($_[2]) {            # if swapped
1975759b3d2Safresh1                    $y = $_[0];
1985759b3d2Safresh1                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
1995759b3d2Safresh1                } else {
2005759b3d2Safresh1                    $x = $class -> _copy($_[0]);
2015759b3d2Safresh1                    $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
2025759b3d2Safresh1                }
2035759b3d2Safresh1                return $class -> _and($x, $y);
2045759b3d2Safresh1            },
2055759b3d2Safresh1
2065759b3d2Safresh1  '|'    => sub {
2075759b3d2Safresh1                my $class = ref $_[0];
2085759b3d2Safresh1                my ($x, $y);
2095759b3d2Safresh1                if ($_[2]) {            # if swapped
2105759b3d2Safresh1                    $y = $_[0];
2115759b3d2Safresh1                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
2125759b3d2Safresh1                } else {
2135759b3d2Safresh1                    $x = $class -> _copy($_[0]);
2145759b3d2Safresh1                    $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
2155759b3d2Safresh1                }
2165759b3d2Safresh1                return $class -> _or($x, $y);
2175759b3d2Safresh1            },
2185759b3d2Safresh1
2195759b3d2Safresh1  '^'    => sub {
2205759b3d2Safresh1                my $class = ref $_[0];
2215759b3d2Safresh1                my ($x, $y);
2225759b3d2Safresh1                if ($_[2]) {            # if swapped
2235759b3d2Safresh1                    $y = $_[0];
2245759b3d2Safresh1                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
2255759b3d2Safresh1                } else {
2265759b3d2Safresh1                    $x = $class -> _copy($_[0]);
2275759b3d2Safresh1                    $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
2285759b3d2Safresh1                }
2295759b3d2Safresh1                return $class -> _xor($x, $y);
2305759b3d2Safresh1            },
2315759b3d2Safresh1
2325759b3d2Safresh1  # overload key: func
2335759b3d2Safresh1
2345759b3d2Safresh1  'abs'  => sub { $_[0] },
2355759b3d2Safresh1
2365759b3d2Safresh1  'sqrt' => sub {
2375759b3d2Safresh1                my $class = ref $_[0];
2385759b3d2Safresh1                return $class -> _sqrt($class -> _copy($_[0]));
2395759b3d2Safresh1            },
2405759b3d2Safresh1
2415759b3d2Safresh1  'int'  => sub { $_[0] },
2425759b3d2Safresh1
2435759b3d2Safresh1  # overload key: conversion
2445759b3d2Safresh1
2455759b3d2Safresh1  'bool' => sub { ref($_[0]) -> _is_zero($_[0]) ? '' : 1; },
2465759b3d2Safresh1
2475759b3d2Safresh1  '""'   => sub { ref($_[0]) -> _str($_[0]); },
2485759b3d2Safresh1
2495759b3d2Safresh1  '0+'   => sub { ref($_[0]) -> _num($_[0]); },
2505759b3d2Safresh1
2515759b3d2Safresh1  '='    => sub { ref($_[0]) -> _copy($_[0]); },
2525759b3d2Safresh1
2535759b3d2Safresh1  ;
2545759b3d2Safresh1
2555759b3d2Safresh1sub _new {
2565759b3d2Safresh1    croak "@{[(caller 0)[3]]} method not implemented";
2575759b3d2Safresh1}
2585759b3d2Safresh1
2595759b3d2Safresh1sub _zero {
2605759b3d2Safresh1    my $class = shift;
2615759b3d2Safresh1    return $class -> _new("0");
2625759b3d2Safresh1}
2635759b3d2Safresh1
2645759b3d2Safresh1sub _one {
2655759b3d2Safresh1    my $class = shift;
2665759b3d2Safresh1    return $class -> _new("1");
2675759b3d2Safresh1}
2685759b3d2Safresh1
2695759b3d2Safresh1sub _two {
2705759b3d2Safresh1    my $class = shift;
2715759b3d2Safresh1    return $class -> _new("2");
2725759b3d2Safresh1
2735759b3d2Safresh1}
2745759b3d2Safresh1sub _ten {
2755759b3d2Safresh1    my $class = shift;
2765759b3d2Safresh1    return $class -> _new("10");
2775759b3d2Safresh1}
2785759b3d2Safresh1
2795759b3d2Safresh1sub _1ex {
2805759b3d2Safresh1    my ($class, $exp) = @_;
2815759b3d2Safresh1    $exp = $class -> _num($exp) if ref($exp);
2825759b3d2Safresh1    return $class -> _new("1" . ("0" x $exp));
2835759b3d2Safresh1}
2845759b3d2Safresh1
2855759b3d2Safresh1sub _copy {
2865759b3d2Safresh1    my ($class, $x) = @_;
2875759b3d2Safresh1    return $class -> _new($class -> _str($x));
2885759b3d2Safresh1}
2895759b3d2Safresh1
2905759b3d2Safresh1# catch and throw away
2915759b3d2Safresh1sub import { }
2925759b3d2Safresh1
2935759b3d2Safresh1##############################################################################
2945759b3d2Safresh1# convert back to string and number
2955759b3d2Safresh1
2965759b3d2Safresh1sub _str {
2975759b3d2Safresh1    # Convert number from internal base 1eN format to string format. Internal
2985759b3d2Safresh1    # format is always normalized, i.e., no leading zeros.
2995759b3d2Safresh1    croak "@{[(caller 0)[3]]} method not implemented";
3005759b3d2Safresh1}
3015759b3d2Safresh1
3025759b3d2Safresh1sub _num {
3035759b3d2Safresh1    my ($class, $x) = @_;
3045759b3d2Safresh1    0 + $class -> _str($x);
3055759b3d2Safresh1}
3065759b3d2Safresh1
3075759b3d2Safresh1##############################################################################
3085759b3d2Safresh1# actual math code
3095759b3d2Safresh1
3105759b3d2Safresh1sub _add {
3115759b3d2Safresh1    croak "@{[(caller 0)[3]]} method not implemented";
3125759b3d2Safresh1}
3135759b3d2Safresh1
3145759b3d2Safresh1sub _sub {
3155759b3d2Safresh1    croak "@{[(caller 0)[3]]} method not implemented";
3165759b3d2Safresh1}
3175759b3d2Safresh1
3185759b3d2Safresh1sub _mul {
3195759b3d2Safresh1    my ($class, $x, $y) = @_;
3205759b3d2Safresh1    my $sum = $class -> _zero();
3215759b3d2Safresh1    my $i   = $class -> _zero();
3225759b3d2Safresh1    while ($class -> _acmp($i, $y) < 0) {
3235759b3d2Safresh1        $sum = $class -> _add($sum, $x);
3245759b3d2Safresh1        $i   = $class -> _inc($i);
3255759b3d2Safresh1    }
3265759b3d2Safresh1    return $sum;
3275759b3d2Safresh1}
3285759b3d2Safresh1
3295759b3d2Safresh1sub _div {
3305759b3d2Safresh1    my ($class, $x, $y) = @_;
3315759b3d2Safresh1
3325759b3d2Safresh1    croak "@{[(caller 0)[3]]} requires non-zero divisor"
3335759b3d2Safresh1      if $class -> _is_zero($y);
3345759b3d2Safresh1
3355759b3d2Safresh1    my $r = $class -> _copy($x);
3365759b3d2Safresh1    my $q = $class -> _zero();
3375759b3d2Safresh1    while ($class -> _acmp($r, $y) >= 0) {
3385759b3d2Safresh1        $q = $class -> _inc($q);
3395759b3d2Safresh1        $r = $class -> _sub($r, $y);
3405759b3d2Safresh1    }
3415759b3d2Safresh1
3425759b3d2Safresh1    return $q, $r if wantarray;
3435759b3d2Safresh1    return $q;
3445759b3d2Safresh1}
3455759b3d2Safresh1
3465759b3d2Safresh1sub _inc {
3475759b3d2Safresh1    my ($class, $x) = @_;
3485759b3d2Safresh1    $class -> _add($x, $class -> _one());
3495759b3d2Safresh1}
3505759b3d2Safresh1
3515759b3d2Safresh1sub _dec {
3525759b3d2Safresh1    my ($class, $x) = @_;
3535759b3d2Safresh1    $class -> _sub($x, $class -> _one());
3545759b3d2Safresh1}
3555759b3d2Safresh1
356256a93a4Safresh1# Signed addition. If the flag is false, $xa might be modified, but not $ya. If
357256a93a4Safresh1# the false is true, $ya might be modified, but not $xa.
358256a93a4Safresh1
359256a93a4Safresh1sub _sadd {
360256a93a4Safresh1    my $class = shift;
361256a93a4Safresh1    my ($xa, $xs, $ya, $ys, $flag) = @_;
362256a93a4Safresh1    my ($za, $zs);
363256a93a4Safresh1
364256a93a4Safresh1    # If the signs are equal we can add them (-5 + -3 => -(5 + 3) => -8)
365256a93a4Safresh1
366256a93a4Safresh1    if ($xs eq $ys) {
367256a93a4Safresh1        if ($flag) {
368256a93a4Safresh1            $za = $class -> _add($ya, $xa);
369256a93a4Safresh1        } else {
370256a93a4Safresh1            $za = $class -> _add($xa, $ya);
371256a93a4Safresh1        }
372256a93a4Safresh1        $zs = $class -> _is_zero($za) ? '+' : $xs;
373256a93a4Safresh1        return $za, $zs;
374256a93a4Safresh1    }
375256a93a4Safresh1
376256a93a4Safresh1    my $acmp = $class -> _acmp($xa, $ya);       # abs(x) = abs(y)
377256a93a4Safresh1
378256a93a4Safresh1    if ($acmp == 0) {                           # x = -y or -x = y
379256a93a4Safresh1        $za = $class -> _zero();
380256a93a4Safresh1        $zs = '+';
381256a93a4Safresh1        return $za, $zs;
382256a93a4Safresh1    }
383256a93a4Safresh1
384256a93a4Safresh1    if ($acmp > 0) {                            # abs(x) > abs(y)
385256a93a4Safresh1        $za = $class -> _sub($xa, $ya, $flag);
386256a93a4Safresh1        $zs = $xs;
387256a93a4Safresh1    } else {                                    # abs(x) < abs(y)
388256a93a4Safresh1        $za = $class -> _sub($ya, $xa, !$flag);
389256a93a4Safresh1        $zs = $ys;
390256a93a4Safresh1    }
391256a93a4Safresh1    return $za, $zs;
392256a93a4Safresh1}
393256a93a4Safresh1
394256a93a4Safresh1# Signed subtraction. If the flag is false, $xa might be modified, but not $ya.
395256a93a4Safresh1# If the false is true, $ya might be modified, but not $xa.
396256a93a4Safresh1
397256a93a4Safresh1sub _ssub {
398256a93a4Safresh1    my $class = shift;
399256a93a4Safresh1    my ($xa, $xs, $ya, $ys, $flag) = @_;
400256a93a4Safresh1
401256a93a4Safresh1    # Swap sign of second operand and let _sadd() do the job.
402256a93a4Safresh1    $ys = $ys eq '+' ? '-' : '+';
403256a93a4Safresh1    $class -> _sadd($xa, $xs, $ya, $ys, $flag);
404256a93a4Safresh1}
405256a93a4Safresh1
4065759b3d2Safresh1##############################################################################
4075759b3d2Safresh1# testing
4085759b3d2Safresh1
4095759b3d2Safresh1sub _acmp {
4105759b3d2Safresh1    # Compare two (absolute) values. Return -1, 0, or 1.
4115759b3d2Safresh1    my ($class, $x, $y) = @_;
4125759b3d2Safresh1    my $xstr = $class -> _str($x);
4135759b3d2Safresh1    my $ystr = $class -> _str($y);
4145759b3d2Safresh1
4155759b3d2Safresh1    length($xstr) <=> length($ystr) || $xstr cmp $ystr;
4165759b3d2Safresh1}
4175759b3d2Safresh1
4185759b3d2Safresh1sub _len {
4195759b3d2Safresh1    my ($class, $x) = @_;
4205759b3d2Safresh1    CORE::length($class -> _str($x));
4215759b3d2Safresh1}
4225759b3d2Safresh1
4235759b3d2Safresh1sub _alen {
4245759b3d2Safresh1    my ($class, $x) = @_;
4255759b3d2Safresh1    $class -> _len($x);
4265759b3d2Safresh1}
4275759b3d2Safresh1
4285759b3d2Safresh1sub _digit {
4295759b3d2Safresh1    my ($class, $x, $n) = @_;
4305759b3d2Safresh1    substr($class ->_str($x), -($n+1), 1);
4315759b3d2Safresh1}
4325759b3d2Safresh1
433de8cc8edSafresh1sub _digitsum {
434de8cc8edSafresh1    my ($class, $x) = @_;
435de8cc8edSafresh1
436de8cc8edSafresh1    my $len = $class -> _len($x);
437de8cc8edSafresh1    my $sum = $class -> _zero();
438de8cc8edSafresh1    for (my $i = 0 ; $i < $len ; ++$i) {
439de8cc8edSafresh1        my $digit = $class -> _digit($x, $i);
440de8cc8edSafresh1        $digit = $class -> _new($digit);
441de8cc8edSafresh1        $sum = $class -> _add($sum, $digit);
442de8cc8edSafresh1    }
443de8cc8edSafresh1
444de8cc8edSafresh1    return $sum;
445de8cc8edSafresh1}
446de8cc8edSafresh1
4475759b3d2Safresh1sub _zeros {
4485759b3d2Safresh1    my ($class, $x) = @_;
4495759b3d2Safresh1    my $str = $class -> _str($x);
4505759b3d2Safresh1    $str =~ /[^0](0*)\z/ ? CORE::length($1) : 0;
4515759b3d2Safresh1}
4525759b3d2Safresh1
4535759b3d2Safresh1##############################################################################
4545759b3d2Safresh1# _is_* routines
4555759b3d2Safresh1
4565759b3d2Safresh1sub _is_zero {
4575759b3d2Safresh1    # return true if arg is zero
4585759b3d2Safresh1    my ($class, $x) = @_;
4595759b3d2Safresh1    $class -> _str($x) == 0;
4605759b3d2Safresh1}
4615759b3d2Safresh1
4625759b3d2Safresh1sub _is_even {
4635759b3d2Safresh1    # return true if arg is even
4645759b3d2Safresh1    my ($class, $x) = @_;
4655759b3d2Safresh1    substr($class -> _str($x), -1, 1) % 2 == 0;
4665759b3d2Safresh1}
4675759b3d2Safresh1
4685759b3d2Safresh1sub _is_odd {
4695759b3d2Safresh1    # return true if arg is odd
4705759b3d2Safresh1    my ($class, $x) = @_;
4715759b3d2Safresh1    substr($class -> _str($x), -1, 1) % 2 != 0;
4725759b3d2Safresh1}
4735759b3d2Safresh1
4745759b3d2Safresh1sub _is_one {
4755759b3d2Safresh1    # return true if arg is one
4765759b3d2Safresh1    my ($class, $x) = @_;
4775759b3d2Safresh1    $class -> _str($x) == 1;
4785759b3d2Safresh1}
4795759b3d2Safresh1
4805759b3d2Safresh1sub _is_two {
4815759b3d2Safresh1    # return true if arg is two
4825759b3d2Safresh1    my ($class, $x) = @_;
4835759b3d2Safresh1    $class -> _str($x) == 2;
4845759b3d2Safresh1}
4855759b3d2Safresh1
4865759b3d2Safresh1sub _is_ten {
4875759b3d2Safresh1    # return true if arg is ten
4885759b3d2Safresh1    my ($class, $x) = @_;
4895759b3d2Safresh1    $class -> _str($x) == 10;
4905759b3d2Safresh1}
4915759b3d2Safresh1
4925759b3d2Safresh1###############################################################################
4935759b3d2Safresh1# check routine to test internal state for corruptions
4945759b3d2Safresh1
4955759b3d2Safresh1sub _check {
4965759b3d2Safresh1    # used by the test suite
4975759b3d2Safresh1    my ($class, $x) = @_;
4985759b3d2Safresh1    return "Input is undefined" unless defined $x;
4995759b3d2Safresh1    return "$x is not a reference" unless ref($x);
5005759b3d2Safresh1    return 0;
5015759b3d2Safresh1}
5025759b3d2Safresh1
5035759b3d2Safresh1###############################################################################
5045759b3d2Safresh1
5055759b3d2Safresh1sub _mod {
5065759b3d2Safresh1    # modulus
5075759b3d2Safresh1    my ($class, $x, $y) = @_;
5085759b3d2Safresh1
5095759b3d2Safresh1    croak "@{[(caller 0)[3]]} requires non-zero second operand"
5105759b3d2Safresh1      if $class -> _is_zero($y);
5115759b3d2Safresh1
5125759b3d2Safresh1    if ($class -> can('_div')) {
5135759b3d2Safresh1        $x = $class -> _copy($x);
5145759b3d2Safresh1        my ($q, $r) = $class -> _div($x, $y);
5155759b3d2Safresh1        return $r;
5165759b3d2Safresh1    } else {
5175759b3d2Safresh1        my $r = $class -> _copy($x);
5185759b3d2Safresh1        while ($class -> _acmp($r, $y) >= 0) {
5195759b3d2Safresh1            $r = $class -> _sub($r, $y);
5205759b3d2Safresh1        }
5215759b3d2Safresh1        return $r;
5225759b3d2Safresh1    }
5235759b3d2Safresh1}
5245759b3d2Safresh1
5255759b3d2Safresh1##############################################################################
5265759b3d2Safresh1# shifts
5275759b3d2Safresh1
5285759b3d2Safresh1sub _rsft {
5295759b3d2Safresh1    my ($class, $x, $n, $b) = @_;
5305759b3d2Safresh1    $b = $class -> _new($b) unless ref $b;
5315759b3d2Safresh1    return scalar $class -> _div($x, $class -> _pow($class -> _copy($b), $n));
5325759b3d2Safresh1}
5335759b3d2Safresh1
5345759b3d2Safresh1sub _lsft {
5355759b3d2Safresh1    my ($class, $x, $n, $b) = @_;
5365759b3d2Safresh1    $b = $class -> _new($b) unless ref $b;
5375759b3d2Safresh1    return $class -> _mul($x, $class -> _pow($class -> _copy($b), $n));
5385759b3d2Safresh1}
5395759b3d2Safresh1
5405759b3d2Safresh1sub _pow {
5415759b3d2Safresh1    # power of $x to $y
5425759b3d2Safresh1    my ($class, $x, $y) = @_;
5435759b3d2Safresh1
5445759b3d2Safresh1    if ($class -> _is_zero($y)) {
5455759b3d2Safresh1        return $class -> _one();        # y == 0 => x => 1
5465759b3d2Safresh1    }
5475759b3d2Safresh1
5485759b3d2Safresh1    if (($class -> _is_one($x)) ||      #    x == 1
5495759b3d2Safresh1        ($class -> _is_one($y)))        # or y == 1
5505759b3d2Safresh1    {
5515759b3d2Safresh1        return $x;
5525759b3d2Safresh1    }
5535759b3d2Safresh1
5545759b3d2Safresh1    if ($class -> _is_zero($x)) {
5555759b3d2Safresh1        return $class -> _zero();       # 0 ** y => 0 (if not y <= 0)
5565759b3d2Safresh1    }
5575759b3d2Safresh1
5585759b3d2Safresh1    my $pow2 = $class -> _one();
5595759b3d2Safresh1
5605759b3d2Safresh1    my $y_bin = $class -> _as_bin($y);
5615759b3d2Safresh1    $y_bin =~ s/^0b//;
5625759b3d2Safresh1    my $len = length($y_bin);
5635759b3d2Safresh1
5645759b3d2Safresh1    while (--$len > 0) {
5655759b3d2Safresh1        $pow2 = $class -> _mul($pow2, $x) if substr($y_bin, $len, 1) eq '1';
5665759b3d2Safresh1        $x = $class -> _mul($x, $x);
5675759b3d2Safresh1    }
5685759b3d2Safresh1
5695759b3d2Safresh1    $x = $class -> _mul($x, $pow2);
5705759b3d2Safresh1    return $x;
5715759b3d2Safresh1}
5725759b3d2Safresh1
5735759b3d2Safresh1sub _nok {
5745759b3d2Safresh1    # Return binomial coefficient (n over k).
5755759b3d2Safresh1    my ($class, $n, $k) = @_;
5765759b3d2Safresh1
5775759b3d2Safresh1    # If k > n/2, or, equivalently, 2*k > n, compute nok(n, k) as
5785759b3d2Safresh1    # nok(n, n-k), to minimize the number if iterations in the loop.
5795759b3d2Safresh1
5805759b3d2Safresh1    {
5815759b3d2Safresh1        my $twok = $class -> _mul($class -> _two(), $class -> _copy($k));
5825759b3d2Safresh1        if ($class -> _acmp($twok, $n) > 0) {
5835759b3d2Safresh1            $k = $class -> _sub($class -> _copy($n), $k);
5845759b3d2Safresh1        }
5855759b3d2Safresh1    }
5865759b3d2Safresh1
5875759b3d2Safresh1    # Example:
5885759b3d2Safresh1    #
5895759b3d2Safresh1    # / 7 \       7!       1*2*3*4 * 5*6*7   5 * 6 * 7
5905759b3d2Safresh1    # |   | = --------- =  --------------- = --------- = ((5 * 6) / 2 * 7) / 3
5915759b3d2Safresh1    # \ 3 /   (7-3)! 3!    1*2*3*4 * 1*2*3   1 * 2 * 3
5925759b3d2Safresh1    #
5935759b3d2Safresh1    # Equivalently, _nok(11, 5) is computed as
5945759b3d2Safresh1    #
5955759b3d2Safresh1    # (((((((7 * 8) / 2) * 9) / 3) * 10) / 4) * 11) / 5
5965759b3d2Safresh1
5975759b3d2Safresh1    if ($class -> _is_zero($k)) {
5985759b3d2Safresh1        return $class -> _one();
5995759b3d2Safresh1    }
6005759b3d2Safresh1
6015759b3d2Safresh1    # Make a copy of the original n, in case the subclass modifies n in-place.
6025759b3d2Safresh1
6035759b3d2Safresh1    my $n_orig = $class -> _copy($n);
6045759b3d2Safresh1
6055759b3d2Safresh1    # n = 5, f = 6, d = 2 (cf. example above)
6065759b3d2Safresh1
6075759b3d2Safresh1    $n = $class -> _sub($n, $k);
6085759b3d2Safresh1    $n = $class -> _inc($n);
6095759b3d2Safresh1
6105759b3d2Safresh1    my $f = $class -> _copy($n);
6115759b3d2Safresh1    $f = $class -> _inc($f);
6125759b3d2Safresh1
6135759b3d2Safresh1    my $d = $class -> _two();
6145759b3d2Safresh1
6155759b3d2Safresh1    # while f <= n (the original n, that is) ...
6165759b3d2Safresh1
6175759b3d2Safresh1    while ($class -> _acmp($f, $n_orig) <= 0) {
6185759b3d2Safresh1        $n = $class -> _mul($n, $f);
6195759b3d2Safresh1        $n = $class -> _div($n, $d);
6205759b3d2Safresh1        $f = $class -> _inc($f);
6215759b3d2Safresh1        $d = $class -> _inc($d);
6225759b3d2Safresh1    }
6235759b3d2Safresh1
6245759b3d2Safresh1    return $n;
6255759b3d2Safresh1}
6265759b3d2Safresh1
627256a93a4Safresh1#sub _fac {
628256a93a4Safresh1#    # factorial
629256a93a4Safresh1#    my ($class, $x) = @_;
630256a93a4Safresh1#
631256a93a4Safresh1#    my $two = $class -> _two();
632256a93a4Safresh1#
633256a93a4Safresh1#    if ($class -> _acmp($x, $two) < 0) {
634256a93a4Safresh1#        return $class -> _one();
635256a93a4Safresh1#    }
636256a93a4Safresh1#
637256a93a4Safresh1#    my $i = $class -> _copy($x);
638256a93a4Safresh1#    while ($class -> _acmp($i, $two) > 0) {
639256a93a4Safresh1#        $i = $class -> _dec($i);
640256a93a4Safresh1#        $x = $class -> _mul($x, $i);
641256a93a4Safresh1#    }
642256a93a4Safresh1#
643256a93a4Safresh1#    return $x;
644256a93a4Safresh1#}
645256a93a4Safresh1
6465759b3d2Safresh1sub _fac {
6475759b3d2Safresh1    # factorial
6485759b3d2Safresh1    my ($class, $x) = @_;
6495759b3d2Safresh1
650256a93a4Safresh1    # This is an implementation of the split recursive algorithm. See
651256a93a4Safresh1    # http://www.luschny.de/math/factorial/csharp/FactorialSplit.cs.html
652256a93a4Safresh1
653256a93a4Safresh1    my $p   = $class -> _one();
654256a93a4Safresh1    my $r   = $class -> _one();
6555759b3d2Safresh1    my $two = $class -> _two();
6565759b3d2Safresh1
657256a93a4Safresh1    my ($log2n) = $class -> _log_int($class -> _copy($x), $two);
658256a93a4Safresh1    my $h     = $class -> _zero();
659256a93a4Safresh1    my $shift = $class -> _zero();
660256a93a4Safresh1    my $k     = $class -> _one();
6615759b3d2Safresh1
662256a93a4Safresh1    while ($class -> _acmp($h, $x)) {
663256a93a4Safresh1        $shift = $class -> _add($shift, $h);
664256a93a4Safresh1        $h = $class -> _rsft($class -> _copy($x), $log2n, $two);
665256a93a4Safresh1        $log2n = $class -> _dec($log2n) if !$class -> _is_zero($log2n);
666256a93a4Safresh1        my $high = $class -> _copy($h);
667256a93a4Safresh1        $high = $class -> _dec($high) if $class -> _is_even($h);
668256a93a4Safresh1        while ($class -> _acmp($k, $high)) {
669256a93a4Safresh1            $k = $class -> _add($k, $two);
670256a93a4Safresh1            $p = $class -> _mul($p, $k);
6715759b3d2Safresh1        }
672256a93a4Safresh1        $r = $class -> _mul($r, $p);
673256a93a4Safresh1    }
674256a93a4Safresh1    return $class -> _lsft($r, $shift, $two);
6755759b3d2Safresh1}
6765759b3d2Safresh1
6775759b3d2Safresh1sub _dfac {
6785759b3d2Safresh1    # double factorial
6795759b3d2Safresh1    my ($class, $x) = @_;
6805759b3d2Safresh1
6815759b3d2Safresh1    my $two = $class -> _two();
6825759b3d2Safresh1
6835759b3d2Safresh1    if ($class -> _acmp($x, $two) < 0) {
6845759b3d2Safresh1        return $class -> _one();
6855759b3d2Safresh1    }
6865759b3d2Safresh1
6875759b3d2Safresh1    my $i = $class -> _copy($x);
6885759b3d2Safresh1    while ($class -> _acmp($i, $two) > 0) {
6895759b3d2Safresh1        $i = $class -> _sub($i, $two);
6905759b3d2Safresh1        $x = $class -> _mul($x, $i);
6915759b3d2Safresh1    }
6925759b3d2Safresh1
6935759b3d2Safresh1    return $x;
6945759b3d2Safresh1}
6955759b3d2Safresh1
6965759b3d2Safresh1sub _log_int {
6975759b3d2Safresh1    # calculate integer log of $x to base $base
6985759b3d2Safresh1    # calculate integer log of $x to base $base
6995759b3d2Safresh1    # ref to array, ref to array - return ref to array
7005759b3d2Safresh1    my ($class, $x, $base) = @_;
7015759b3d2Safresh1
7025759b3d2Safresh1    # X == 0 => NaN
7035759b3d2Safresh1    return if $class -> _is_zero($x);
7045759b3d2Safresh1
7055759b3d2Safresh1    $base = $class -> _new(2)     unless defined($base);
7065759b3d2Safresh1    $base = $class -> _new($base) unless ref($base);
7075759b3d2Safresh1
7085759b3d2Safresh1    # BASE 0 or 1 => NaN
7095759b3d2Safresh1    return if $class -> _is_zero($base) || $class -> _is_one($base);
7105759b3d2Safresh1
7115759b3d2Safresh1    # X == 1 => 0 (is exact)
7125759b3d2Safresh1    if ($class -> _is_one($x)) {
713*5486feefSafresh1        return $class -> _zero(), 1 if wantarray;
714*5486feefSafresh1        return $class -> _zero();
7155759b3d2Safresh1    }
7165759b3d2Safresh1
7175759b3d2Safresh1    my $cmp = $class -> _acmp($x, $base);
7185759b3d2Safresh1
7195759b3d2Safresh1    # X == BASE => 1 (is exact)
7205759b3d2Safresh1    if ($cmp == 0) {
721*5486feefSafresh1        return $class -> _one(), 1 if wantarray;
722*5486feefSafresh1        return $class -> _one();
7235759b3d2Safresh1    }
7245759b3d2Safresh1
7255759b3d2Safresh1    # 1 < X < BASE => 0 (is truncated)
7265759b3d2Safresh1    if ($cmp < 0) {
727*5486feefSafresh1        return $class -> _zero(), 0 if wantarray;
728*5486feefSafresh1        return $class -> _zero();
7295759b3d2Safresh1    }
7305759b3d2Safresh1
7315759b3d2Safresh1    my $y;
7325759b3d2Safresh1
7335759b3d2Safresh1    # log(x) / log(b) = log(xm * 10^xe) / log(bm * 10^be)
7345759b3d2Safresh1    #                 = (log(xm) + xe*(log(10))) / (log(bm) + be*log(10))
7355759b3d2Safresh1
7365759b3d2Safresh1    {
7375759b3d2Safresh1        my $x_str = $class -> _str($x);
7385759b3d2Safresh1        my $b_str = $class -> _str($base);
7395759b3d2Safresh1        my $xm    = "." . $x_str;
7405759b3d2Safresh1        my $bm    = "." . $b_str;
7415759b3d2Safresh1        my $xe    = length($x_str);
7425759b3d2Safresh1        my $be    = length($b_str);
7435759b3d2Safresh1        my $log10 = log(10);
7445759b3d2Safresh1        my $guess = int((log($xm) + $xe * $log10) / (log($bm) + $be * $log10));
7455759b3d2Safresh1        $y = $class -> _new($guess);
7465759b3d2Safresh1    }
7475759b3d2Safresh1
7485759b3d2Safresh1    my $trial = $class -> _pow($class -> _copy($base), $y);
7495759b3d2Safresh1    my $acmp  = $class -> _acmp($trial, $x);
7505759b3d2Safresh1
7515759b3d2Safresh1    # Too small?
7525759b3d2Safresh1
7535759b3d2Safresh1    while ($acmp < 0) {
7545759b3d2Safresh1        $trial = $class -> _mul($trial, $base);
7555759b3d2Safresh1        $y     = $class -> _inc($y);
7565759b3d2Safresh1        $acmp  = $class -> _acmp($trial, $x);
7575759b3d2Safresh1    }
7585759b3d2Safresh1
7595759b3d2Safresh1    # Too big?
7605759b3d2Safresh1
7615759b3d2Safresh1    while ($acmp > 0) {
7625759b3d2Safresh1        $trial = $class -> _div($trial, $base);
7635759b3d2Safresh1        $y     = $class -> _dec($y);
7645759b3d2Safresh1        $acmp  = $class -> _acmp($trial, $x);
7655759b3d2Safresh1    }
7665759b3d2Safresh1
767*5486feefSafresh1    return wantarray ? ($y, 1) : $y if $acmp == 0;      # result is exact
768*5486feefSafresh1    return wantarray ? ($y, 0) : $y;                    # result is too small
769*5486feefSafresh1}
770*5486feefSafresh1
771*5486feefSafresh1sub _ilog2 {
772*5486feefSafresh1    my ($class, $x) = @_;
773*5486feefSafresh1
774*5486feefSafresh1    return if $class -> _is_zero($x);
775*5486feefSafresh1
776*5486feefSafresh1    my $str = $class -> _to_hex($x);
777*5486feefSafresh1
778*5486feefSafresh1    # First do the bits in all but the most significant hex digit.
779*5486feefSafresh1
780*5486feefSafresh1    my $y = $class -> _new(length($str) - 1);
781*5486feefSafresh1    $y = $class -> _mul($y, $class -> _new(4));
782*5486feefSafresh1
783*5486feefSafresh1    # Now add the number of bits in the most significant hex digit.
784*5486feefSafresh1
785*5486feefSafresh1    my $n = int log(hex(substr($str, 0, 1))) / log(2);
786*5486feefSafresh1    $y = $class -> _add($y, $class -> _new($n));
787*5486feefSafresh1    return $y unless wantarray;
788*5486feefSafresh1
789*5486feefSafresh1    my $pow2 = $class -> _lsft($class -> _one(), $y, 2);
790*5486feefSafresh1    my $is_exact = $class -> _acmp($x, $pow2) == 0 ? 1 : 0;
791*5486feefSafresh1    return $y, $is_exact;
792*5486feefSafresh1}
793*5486feefSafresh1
794*5486feefSafresh1sub _ilog10 {
795*5486feefSafresh1    my ($class, $x) = @_;
796*5486feefSafresh1
797*5486feefSafresh1    return if $class -> _is_zero($x);
798*5486feefSafresh1
799*5486feefSafresh1    my $str = $class -> _str($x);
800*5486feefSafresh1    my $len = length($str);
801*5486feefSafresh1    my $y = $class -> _new($len - 1);
802*5486feefSafresh1    return $y unless wantarray;
803*5486feefSafresh1
804*5486feefSafresh1    #my $pow10 = $class -> _1ex($y);
805*5486feefSafresh1    #my $is_exact = $class -> _acmp($x, $pow10) ? 1 : 0;
806*5486feefSafresh1
807*5486feefSafresh1    my $is_exact = $str =~ /^10*$/ ? 1 : 0;
808*5486feefSafresh1    return $y, $is_exact;
809*5486feefSafresh1}
810*5486feefSafresh1
811*5486feefSafresh1sub _clog2 {
812*5486feefSafresh1    my ($class, $x) = @_;
813*5486feefSafresh1
814*5486feefSafresh1    return if $class -> _is_zero($x);
815*5486feefSafresh1
816*5486feefSafresh1    my $str = $class -> _to_hex($x);
817*5486feefSafresh1
818*5486feefSafresh1    # First do the bits in all but the most significant hex digit.
819*5486feefSafresh1
820*5486feefSafresh1    my $y = $class -> _new(length($str) - 1);
821*5486feefSafresh1    $y = $class -> _mul($y, $class -> _new(4));
822*5486feefSafresh1
823*5486feefSafresh1    # Now add the number of bits in the most significant hex digit.
824*5486feefSafresh1
825*5486feefSafresh1    my $n = int log(hex(substr($str, 0, 1))) / log(2);
826*5486feefSafresh1    $y = $class -> _add($y, $class -> _new($n));
827*5486feefSafresh1
828*5486feefSafresh1    # $y is now 1 too small unless $y is an exact power of 2.
829*5486feefSafresh1
830*5486feefSafresh1    my $pow2 = $class -> _lsft($class -> _one(), $y, 2);
831*5486feefSafresh1    my $is_exact = $class -> _acmp($x, $pow2) == 0 ? 1 : 0;
832*5486feefSafresh1    $y = $class -> _inc($y) if $is_exact == 0;
833*5486feefSafresh1    return $y, $is_exact if wantarray;
834*5486feefSafresh1    return $y;
835*5486feefSafresh1}
836*5486feefSafresh1
837*5486feefSafresh1sub _clog10 {
838*5486feefSafresh1    my ($class, $x) = @_;
839*5486feefSafresh1
840*5486feefSafresh1    return if $class -> _is_zero($x);
841*5486feefSafresh1
842*5486feefSafresh1    my $str = $class -> _str($x);
843*5486feefSafresh1    my $len = length($str);
844*5486feefSafresh1
845*5486feefSafresh1    if ($str =~ /^10*$/) {
846*5486feefSafresh1        my $y = $class -> _new($len - 1);
847*5486feefSafresh1        return $y, 1 if wantarray;
848*5486feefSafresh1        return $y;
849*5486feefSafresh1    }
850*5486feefSafresh1
851*5486feefSafresh1    my $y = $class -> _new($len);
852*5486feefSafresh1    return $y, 0 if wantarray;
853*5486feefSafresh1    return $y;
8545759b3d2Safresh1}
8555759b3d2Safresh1
8565759b3d2Safresh1sub _sqrt {
8575759b3d2Safresh1    # square-root of $y in place
8585759b3d2Safresh1    my ($class, $y) = @_;
8595759b3d2Safresh1
8605759b3d2Safresh1    return $y if $class -> _is_zero($y);
8615759b3d2Safresh1
8625759b3d2Safresh1    my $y_str = $class -> _str($y);
8635759b3d2Safresh1    my $y_len = length($y_str);
8645759b3d2Safresh1
8655759b3d2Safresh1    # Compute the guess $x.
8665759b3d2Safresh1
8675759b3d2Safresh1    my $xm;
8685759b3d2Safresh1    my $xe;
8695759b3d2Safresh1    if ($y_len % 2 == 0) {
8705759b3d2Safresh1        $xm = sqrt("." . $y_str);
8715759b3d2Safresh1        $xe = $y_len / 2;
8725759b3d2Safresh1        $xm = sprintf "%.0f", int($xm * 1e15);
8735759b3d2Safresh1        $xe -= 15;
8745759b3d2Safresh1    } else {
8755759b3d2Safresh1        $xm = sqrt(".0" . $y_str);
8765759b3d2Safresh1        $xe = ($y_len + 1) / 2;
8775759b3d2Safresh1        $xm = sprintf "%.0f", int($xm * 1e16);
8785759b3d2Safresh1        $xe -= 16;
8795759b3d2Safresh1    }
8805759b3d2Safresh1
8815759b3d2Safresh1    my $x;
8825759b3d2Safresh1    if ($xe < 0) {
8835759b3d2Safresh1        $x = substr $xm, 0, length($xm) + $xe;
8845759b3d2Safresh1    } else {
8855759b3d2Safresh1        $x = $xm . ("0" x $xe);
8865759b3d2Safresh1    }
8875759b3d2Safresh1
8885759b3d2Safresh1    $x = $class -> _new($x);
8895759b3d2Safresh1
8905759b3d2Safresh1    # Newton's method for computing square root of y
8915759b3d2Safresh1    #
8925759b3d2Safresh1    # x(i+1) = x(i) - f(x(i)) / f'(x(i))
8935759b3d2Safresh1    #        = x(i) - (x(i)^2 - y) / (2 * x(i))     # use if x(i)^2 > y
894256a93a4Safresh1    #        = x(i) + (y - x(i)^2) / (2 * x(i))     # use if x(i)^2 < y
8955759b3d2Safresh1
8965759b3d2Safresh1    # Determine if x, our guess, is too small, correct, or too large.
8975759b3d2Safresh1
8985759b3d2Safresh1    my $xsq = $class -> _mul($class -> _copy($x), $x);          # x(i)^2
8995759b3d2Safresh1    my $acmp = $class -> _acmp($xsq, $y);                       # x(i)^2 <=> y
9005759b3d2Safresh1
9015759b3d2Safresh1    # Only assign a value to this variable if we will be using it.
9025759b3d2Safresh1
9035759b3d2Safresh1    my $two;
9045759b3d2Safresh1    $two = $class -> _two() if $acmp != 0;
9055759b3d2Safresh1
9065759b3d2Safresh1    # If x is too small, do one iteration of Newton's method. Since the
9075759b3d2Safresh1    # function f(x) = x^2 - y is concave and monotonically increasing, the next
9085759b3d2Safresh1    # guess for x will either be correct or too large.
9095759b3d2Safresh1
9105759b3d2Safresh1    if ($acmp < 0) {
9115759b3d2Safresh1
9125759b3d2Safresh1        # x(i+1) = x(i) + (y - x(i)^2) / (2 * x(i))
9135759b3d2Safresh1
9145759b3d2Safresh1        my $numer = $class -> _sub($class -> _copy($y), $xsq);  # y - x(i)^2
9155759b3d2Safresh1        my $denom = $class -> _mul($class -> _copy($two), $x);  # 2 * x(i)
9165759b3d2Safresh1        my $delta = $class -> _div($numer, $denom);
9175759b3d2Safresh1
9185759b3d2Safresh1        unless ($class -> _is_zero($delta)) {
9195759b3d2Safresh1            $x    = $class -> _add($x, $delta);
9205759b3d2Safresh1            $xsq  = $class -> _mul($class -> _copy($x), $x);    # x(i)^2
9215759b3d2Safresh1            $acmp = $class -> _acmp($xsq, $y);                  # x(i)^2 <=> y
9225759b3d2Safresh1        }
9235759b3d2Safresh1    }
9245759b3d2Safresh1
9255759b3d2Safresh1    # If our guess for x is too large, apply Newton's method repeatedly until
9265759b3d2Safresh1    # we either have got the correct value, or the delta is zero.
9275759b3d2Safresh1
9285759b3d2Safresh1    while ($acmp > 0) {
9295759b3d2Safresh1
9305759b3d2Safresh1        # x(i+1) = x(i) - (x(i)^2 - y) / (2 * x(i))
9315759b3d2Safresh1
9325759b3d2Safresh1        my $numer = $class -> _sub($xsq, $y);                   # x(i)^2 - y
9335759b3d2Safresh1        my $denom = $class -> _mul($class -> _copy($two), $x);  # 2 * x(i)
9345759b3d2Safresh1        my $delta = $class -> _div($numer, $denom);
9355759b3d2Safresh1        last if $class -> _is_zero($delta);
9365759b3d2Safresh1
9375759b3d2Safresh1        $x    = $class -> _sub($x, $delta);
9385759b3d2Safresh1        $xsq  = $class -> _mul($class -> _copy($x), $x);        # x(i)^2
9395759b3d2Safresh1        $acmp = $class -> _acmp($xsq, $y);                      # x(i)^2 <=> y
9405759b3d2Safresh1    }
9415759b3d2Safresh1
9425759b3d2Safresh1    # When the delta is zero, our value for x might still be too large. We
9435759b3d2Safresh1    # require that the outout is either exact or too small (i.e., rounded down
9445759b3d2Safresh1    # to the nearest integer), so do a final check.
9455759b3d2Safresh1
9465759b3d2Safresh1    while ($acmp > 0) {
9475759b3d2Safresh1        $x    = $class -> _dec($x);
9485759b3d2Safresh1        $xsq  = $class -> _mul($class -> _copy($x), $x);        # x(i)^2
9495759b3d2Safresh1        $acmp = $class -> _acmp($xsq, $y);                      # x(i)^2 <=> y
9505759b3d2Safresh1    }
9515759b3d2Safresh1
9525759b3d2Safresh1    return $x;
9535759b3d2Safresh1}
9545759b3d2Safresh1
9555759b3d2Safresh1sub _root {
9565759b3d2Safresh1    my ($class, $y, $n) = @_;
9575759b3d2Safresh1
9585759b3d2Safresh1    return $y if $class -> _is_zero($y) || $class -> _is_one($y) ||
9595759b3d2Safresh1                 $class -> _is_one($n);
9605759b3d2Safresh1
9615759b3d2Safresh1    # If y <= n, the result is always (truncated to) 1.
9625759b3d2Safresh1
9635759b3d2Safresh1    return $class -> _one() if $class -> _acmp($y, $n) <= 0;
9645759b3d2Safresh1
9655759b3d2Safresh1    # Compute the initial guess x of y^(1/n). When n is large, Newton's method
9665759b3d2Safresh1    # converges slowly if the "guess" (initial value) is poor, so we need a
9675759b3d2Safresh1    # good guess. It the guess is too small, the next guess will be too large,
9685759b3d2Safresh1    # and from then on all guesses are too large.
9695759b3d2Safresh1
9705759b3d2Safresh1    my $DEBUG = 0;
9715759b3d2Safresh1
9725759b3d2Safresh1    # Split y into mantissa and exponent in base 10, so that
9735759b3d2Safresh1    #
9745759b3d2Safresh1    #   y = xm * 10^xe, where 0 < xm < 1 and xe is an integer
9755759b3d2Safresh1
9765759b3d2Safresh1    my $y_str  = $class -> _str($y);
9775759b3d2Safresh1    my $ym = "." . $y_str;
9785759b3d2Safresh1    my $ye = length($y_str);
9795759b3d2Safresh1
9805759b3d2Safresh1    # From this compute the approximate base 10 logarithm of y
9815759b3d2Safresh1    #
9825759b3d2Safresh1    #   log_10(y) = log_10(ym) + log_10(ye^10)
9835759b3d2Safresh1    #             = log(ym)/log(10) + ye
9845759b3d2Safresh1
9855759b3d2Safresh1    my $log10y = log($ym) / log(10) + $ye;
9865759b3d2Safresh1
9875759b3d2Safresh1    # And from this compute the approximate base 10 logarithm of x, where
9885759b3d2Safresh1    # x = y^(1/n)
9895759b3d2Safresh1    #
9905759b3d2Safresh1    #   log_10(x) = log_10(y)/n
9915759b3d2Safresh1
9925759b3d2Safresh1    my $log10x = $log10y / $class -> _num($n);
9935759b3d2Safresh1
9945759b3d2Safresh1    # From this compute xm and xe, the mantissa and exponent (in base 10) of x,
9955759b3d2Safresh1    # where 1 < xm <= 10 and xe is an integer.
9965759b3d2Safresh1
9975759b3d2Safresh1    my $xe = int $log10x;
9985759b3d2Safresh1    my $xm = 10 ** ($log10x - $xe);
9995759b3d2Safresh1
10005759b3d2Safresh1    # Scale the mantissa and exponent to increase the integer part of ym, which
10015759b3d2Safresh1    # gives us better accuracy.
10025759b3d2Safresh1
10035759b3d2Safresh1    if ($DEBUG) {
10045759b3d2Safresh1        print "\n";
10055759b3d2Safresh1        print "y_str  = $y_str\n";
10065759b3d2Safresh1        print "ym     = $ym\n";
10075759b3d2Safresh1        print "ye     = $ye\n";
10085759b3d2Safresh1        print "log10y = $log10y\n";
10095759b3d2Safresh1        print "log10x = $log10x\n";
10105759b3d2Safresh1        print "xm     = $xm\n";
10115759b3d2Safresh1        print "xe     = $xe\n";
10125759b3d2Safresh1    }
10135759b3d2Safresh1
10145759b3d2Safresh1    my $d = $xe < 15 ? $xe : 15;
10155759b3d2Safresh1    $xm *= 10 ** $d;
10165759b3d2Safresh1    $xe -= $d;
10175759b3d2Safresh1
10185759b3d2Safresh1    if ($DEBUG) {
10195759b3d2Safresh1        print "\n";
10205759b3d2Safresh1        print "xm     = $xm\n";
10215759b3d2Safresh1        print "xe     = $xe\n";
10225759b3d2Safresh1    }
10235759b3d2Safresh1
10245759b3d2Safresh1    # If the mantissa is not an integer, round up to nearest integer, and then
10255759b3d2Safresh1    # convert the number to a string. It is important to always round up due to
10265759b3d2Safresh1    # how Newton's method behaves in this case. If the initial guess is too
10275759b3d2Safresh1    # small, the next guess will be too large, after which every succeeding
10285759b3d2Safresh1    # guess converges the correct value from above. Now, if the initial guess
10295759b3d2Safresh1    # is too small and n is large, the next guess will be much too large and
10305759b3d2Safresh1    # require a large number of iterations to get close to the solution.
10315759b3d2Safresh1    # Because of this, we are likely to find the solution faster if we make
10325759b3d2Safresh1    # sure the initial guess is not too small.
10335759b3d2Safresh1
10345759b3d2Safresh1    my $xm_int = int($xm);
10355759b3d2Safresh1    my $x_str = sprintf '%.0f', $xm > $xm_int ? $xm_int + 1 : $xm_int;
10365759b3d2Safresh1    $x_str .= "0" x $xe;
10375759b3d2Safresh1
10385759b3d2Safresh1    my $x = $class -> _new($x_str);
10395759b3d2Safresh1
10405759b3d2Safresh1    if ($DEBUG) {
10415759b3d2Safresh1        print "xm     = $xm\n";
10425759b3d2Safresh1        print "xe     = $xe\n";
10435759b3d2Safresh1        print "\n";
10445759b3d2Safresh1        print "x_str  = $x_str (initial guess)\n";
10455759b3d2Safresh1        print "\n";
10465759b3d2Safresh1    }
10475759b3d2Safresh1
10485759b3d2Safresh1    # Use Newton's method for computing n'th root of y.
10495759b3d2Safresh1    #
10505759b3d2Safresh1    # x(i+1) = x(i) - f(x(i)) / f'(x(i))
10515759b3d2Safresh1    #        = x(i) - (x(i)^n - y) / (n * x(i)^(n-1))   # use if x(i)^n > y
10525759b3d2Safresh1    #        = x(i) + (y - x(i)^n) / (n * x(i)^(n-1))   # use if x(i)^n < y
10535759b3d2Safresh1
10545759b3d2Safresh1    # Determine if x, our guess, is too small, correct, or too large. Rather
10555759b3d2Safresh1    # than computing x(i)^n and x(i)^(n-1) directly, compute x(i)^(n-1) and
10565759b3d2Safresh1    # then the same value multiplied by x.
10575759b3d2Safresh1
10585759b3d2Safresh1    my $nm1     = $class -> _dec($class -> _copy($n));           # n-1
10595759b3d2Safresh1    my $xpownm1 = $class -> _pow($class -> _copy($x), $nm1);     # x(i)^(n-1)
10605759b3d2Safresh1    my $xpown   = $class -> _mul($class -> _copy($xpownm1), $x); # x(i)^n
10615759b3d2Safresh1    my $acmp    = $class -> _acmp($xpown, $y);                   # x(i)^n <=> y
10625759b3d2Safresh1
10635759b3d2Safresh1    if ($DEBUG) {
10645759b3d2Safresh1        print "\n";
10655759b3d2Safresh1        print "x      = ", $class -> _str($x), "\n";
10665759b3d2Safresh1        print "x^n    = ", $class -> _str($xpown), "\n";
10675759b3d2Safresh1        print "y      = ", $class -> _str($y), "\n";
10685759b3d2Safresh1        print "acmp   = $acmp\n";
10695759b3d2Safresh1    }
10705759b3d2Safresh1
10715759b3d2Safresh1    # If x is too small, do one iteration of Newton's method. Since the
10725759b3d2Safresh1    # function f(x) = x^n - y is concave and monotonically increasing, the next
10735759b3d2Safresh1    # guess for x will either be correct or too large.
10745759b3d2Safresh1
10755759b3d2Safresh1    if ($acmp < 0) {
10765759b3d2Safresh1
10775759b3d2Safresh1        # x(i+1) = x(i) + (y - x(i)^n) / (n * x(i)^(n-1))
10785759b3d2Safresh1
10795759b3d2Safresh1        my $numer = $class -> _sub($class -> _copy($y), $xpown);    # y - x(i)^n
10805759b3d2Safresh1        my $denom = $class -> _mul($class -> _copy($n), $xpownm1);  # n * x(i)^(n-1)
10815759b3d2Safresh1        my $delta = $class -> _div($numer, $denom);
10825759b3d2Safresh1
10835759b3d2Safresh1        if ($DEBUG) {
10845759b3d2Safresh1            print "\n";
10855759b3d2Safresh1            print "numer  = ", $class -> _str($numer), "\n";
10865759b3d2Safresh1            print "denom  = ", $class -> _str($denom), "\n";
10875759b3d2Safresh1            print "delta  = ", $class -> _str($delta), "\n";
10885759b3d2Safresh1        }
10895759b3d2Safresh1
10905759b3d2Safresh1        unless ($class -> _is_zero($delta)) {
10915759b3d2Safresh1            $x       = $class -> _add($x, $delta);
10925759b3d2Safresh1            $xpownm1 = $class -> _pow($class -> _copy($x), $nm1);     # x(i)^(n-1)
10935759b3d2Safresh1            $xpown   = $class -> _mul($class -> _copy($xpownm1), $x); # x(i)^n
10945759b3d2Safresh1            $acmp    = $class -> _acmp($xpown, $y);                   # x(i)^n <=> y
10955759b3d2Safresh1
10965759b3d2Safresh1            if ($DEBUG) {
10975759b3d2Safresh1                print "\n";
10985759b3d2Safresh1                print "x      = ", $class -> _str($x), "\n";
10995759b3d2Safresh1                print "x^n    = ", $class -> _str($xpown), "\n";
11005759b3d2Safresh1                print "y      = ", $class -> _str($y), "\n";
11015759b3d2Safresh1                print "acmp   = $acmp\n";
11025759b3d2Safresh1            }
11035759b3d2Safresh1        }
11045759b3d2Safresh1    }
11055759b3d2Safresh1
11065759b3d2Safresh1    # If our guess for x is too large, apply Newton's method repeatedly until
11075759b3d2Safresh1    # we either have got the correct value, or the delta is zero.
11085759b3d2Safresh1
11095759b3d2Safresh1    while ($acmp > 0) {
11105759b3d2Safresh1
11115759b3d2Safresh1        # x(i+1) = x(i) - (x(i)^n - y) / (n * x(i)^(n-1))
11125759b3d2Safresh1
11135759b3d2Safresh1        my $numer = $class -> _sub($class -> _copy($xpown), $y);    # x(i)^n - y
11145759b3d2Safresh1        my $denom = $class -> _mul($class -> _copy($n), $xpownm1);  # n * x(i)^(n-1)
11155759b3d2Safresh1
11165759b3d2Safresh1        if ($DEBUG) {
11175759b3d2Safresh1            print "numer  = ", $class -> _str($numer), "\n";
11185759b3d2Safresh1            print "denom  = ", $class -> _str($denom), "\n";
11195759b3d2Safresh1        }
11205759b3d2Safresh1
11215759b3d2Safresh1        my $delta = $class -> _div($numer, $denom);
11225759b3d2Safresh1
11235759b3d2Safresh1        if ($DEBUG) {
11245759b3d2Safresh1            print "delta  = ", $class -> _str($delta), "\n";
11255759b3d2Safresh1        }
11265759b3d2Safresh1
11275759b3d2Safresh1        last if $class -> _is_zero($delta);
11285759b3d2Safresh1
11295759b3d2Safresh1        $x       = $class -> _sub($x, $delta);
11305759b3d2Safresh1        $xpownm1 = $class -> _pow($class -> _copy($x), $nm1);     # x(i)^(n-1)
11315759b3d2Safresh1        $xpown   = $class -> _mul($class -> _copy($xpownm1), $x); # x(i)^n
11325759b3d2Safresh1        $acmp    = $class -> _acmp($xpown, $y);                   # x(i)^n <=> y
11335759b3d2Safresh1
11345759b3d2Safresh1        if ($DEBUG) {
11355759b3d2Safresh1            print "\n";
11365759b3d2Safresh1            print "x      = ", $class -> _str($x), "\n";
11375759b3d2Safresh1            print "x^n    = ", $class -> _str($xpown), "\n";
11385759b3d2Safresh1            print "y      = ", $class -> _str($y), "\n";
11395759b3d2Safresh1            print "acmp   = $acmp\n";
11405759b3d2Safresh1        }
11415759b3d2Safresh1    }
11425759b3d2Safresh1
11435759b3d2Safresh1    # When the delta is zero, our value for x might still be too large. We
11445759b3d2Safresh1    # require that the outout is either exact or too small (i.e., rounded down
11455759b3d2Safresh1    # to the nearest integer), so do a final check.
11465759b3d2Safresh1
11475759b3d2Safresh1    while ($acmp > 0) {
11485759b3d2Safresh1        $x     = $class -> _dec($x);
11495759b3d2Safresh1        $xpown = $class -> _pow($class -> _copy($x), $n);     # x(i)^n
11505759b3d2Safresh1        $acmp  = $class -> _acmp($xpown, $y);                 # x(i)^n <=> y
11515759b3d2Safresh1    }
11525759b3d2Safresh1
11535759b3d2Safresh1    return $x;
11545759b3d2Safresh1}
11555759b3d2Safresh1
11565759b3d2Safresh1##############################################################################
11575759b3d2Safresh1# binary stuff
11585759b3d2Safresh1
11595759b3d2Safresh1sub _and {
11605759b3d2Safresh1    my ($class, $x, $y) = @_;
11615759b3d2Safresh1
11625759b3d2Safresh1    return $x if $class -> _acmp($x, $y) == 0;
11635759b3d2Safresh1
11645759b3d2Safresh1    my $m    = $class -> _one();
11655759b3d2Safresh1    my $mask = $class -> _new("32768");
11665759b3d2Safresh1
11675759b3d2Safresh1    my ($xr, $yr);                # remainders after division
11685759b3d2Safresh1
11695759b3d2Safresh1    my $xc = $class -> _copy($x);
11705759b3d2Safresh1    my $yc = $class -> _copy($y);
11715759b3d2Safresh1    my $z  = $class -> _zero();
11725759b3d2Safresh1
11735759b3d2Safresh1    until ($class -> _is_zero($xc) || $class -> _is_zero($yc)) {
11745759b3d2Safresh1        ($xc, $xr) = $class -> _div($xc, $mask);
11755759b3d2Safresh1        ($yc, $yr) = $class -> _div($yc, $mask);
11765759b3d2Safresh1        my $bits = $class -> _new($class -> _num($xr) & $class -> _num($yr));
11775759b3d2Safresh1        $z = $class -> _add($z, $class -> _mul($bits, $m));
11785759b3d2Safresh1        $m = $class -> _mul($m, $mask);
11795759b3d2Safresh1    }
11805759b3d2Safresh1
11815759b3d2Safresh1    return $z;
11825759b3d2Safresh1}
11835759b3d2Safresh1
11845759b3d2Safresh1sub _xor {
11855759b3d2Safresh1    my ($class, $x, $y) = @_;
11865759b3d2Safresh1
11875759b3d2Safresh1    return $class -> _zero() if $class -> _acmp($x, $y) == 0;
11885759b3d2Safresh1
11895759b3d2Safresh1    my $m    = $class -> _one();
11905759b3d2Safresh1    my $mask = $class -> _new("32768");
11915759b3d2Safresh1
11925759b3d2Safresh1    my ($xr, $yr);                # remainders after division
11935759b3d2Safresh1
11945759b3d2Safresh1    my $xc = $class -> _copy($x);
11955759b3d2Safresh1    my $yc = $class -> _copy($y);
11965759b3d2Safresh1    my $z  = $class -> _zero();
11975759b3d2Safresh1
11985759b3d2Safresh1    until ($class -> _is_zero($xc) || $class -> _is_zero($yc)) {
11995759b3d2Safresh1        ($xc, $xr) = $class -> _div($xc, $mask);
12005759b3d2Safresh1        ($yc, $yr) = $class -> _div($yc, $mask);
12015759b3d2Safresh1        my $bits = $class -> _new($class -> _num($xr) ^ $class -> _num($yr));
12025759b3d2Safresh1        $z = $class -> _add($z, $class -> _mul($bits, $m));
12035759b3d2Safresh1        $m = $class -> _mul($m, $mask);
12045759b3d2Safresh1    }
12055759b3d2Safresh1
12065759b3d2Safresh1    # The loop above stops when the smallest of the two numbers is exhausted.
12075759b3d2Safresh1    # The remainder of the longer one will survive bit-by-bit, so we simple
12085759b3d2Safresh1    # multiply-add it in.
12095759b3d2Safresh1
12105759b3d2Safresh1    $z = $class -> _add($z, $class -> _mul($xc, $m))
12115759b3d2Safresh1      unless $class -> _is_zero($xc);
12125759b3d2Safresh1    $z = $class -> _add($z, $class -> _mul($yc, $m))
12135759b3d2Safresh1      unless $class -> _is_zero($yc);
12145759b3d2Safresh1
12155759b3d2Safresh1    return $z;
12165759b3d2Safresh1}
12175759b3d2Safresh1
12185759b3d2Safresh1sub _or {
12195759b3d2Safresh1    my ($class, $x, $y) = @_;
12205759b3d2Safresh1
12215759b3d2Safresh1    return $x if $class -> _acmp($x, $y) == 0; # shortcut (see _and)
12225759b3d2Safresh1
12235759b3d2Safresh1    my $m    = $class -> _one();
12245759b3d2Safresh1    my $mask = $class -> _new("32768");
12255759b3d2Safresh1
12265759b3d2Safresh1    my ($xr, $yr);                # remainders after division
12275759b3d2Safresh1
12285759b3d2Safresh1    my $xc = $class -> _copy($x);
12295759b3d2Safresh1    my $yc = $class -> _copy($y);
12305759b3d2Safresh1    my $z  = $class -> _zero();
12315759b3d2Safresh1
12325759b3d2Safresh1    until ($class -> _is_zero($xc) || $class -> _is_zero($yc)) {
12335759b3d2Safresh1        ($xc, $xr) = $class -> _div($xc, $mask);
12345759b3d2Safresh1        ($yc, $yr) = $class -> _div($yc, $mask);
12355759b3d2Safresh1        my $bits = $class -> _new($class -> _num($xr) | $class -> _num($yr));
12365759b3d2Safresh1        $z = $class -> _add($z, $class -> _mul($bits, $m));
12375759b3d2Safresh1        $m = $class -> _mul($m, $mask);
12385759b3d2Safresh1    }
12395759b3d2Safresh1
12405759b3d2Safresh1    # The loop above stops when the smallest of the two numbers is exhausted.
12415759b3d2Safresh1    # The remainder of the longer one will survive bit-by-bit, so we simple
12425759b3d2Safresh1    # multiply-add it in.
12435759b3d2Safresh1
12445759b3d2Safresh1    $z = $class -> _add($z, $class -> _mul($xc, $m))
12455759b3d2Safresh1      unless $class -> _is_zero($xc);
12465759b3d2Safresh1    $z = $class -> _add($z, $class -> _mul($yc, $m))
12475759b3d2Safresh1      unless $class -> _is_zero($yc);
12485759b3d2Safresh1
12495759b3d2Safresh1    return $z;
12505759b3d2Safresh1}
12515759b3d2Safresh1
1252f3efcd01Safresh1sub _sand {
1253f3efcd01Safresh1    my ($class, $x, $sx, $y, $sy) = @_;
1254f3efcd01Safresh1
1255f3efcd01Safresh1    return ($class -> _zero(), '+')
1256f3efcd01Safresh1      if $class -> _is_zero($x) || $class -> _is_zero($y);
1257f3efcd01Safresh1
1258f3efcd01Safresh1    my $sign = $sx eq '-' && $sy eq '-' ? '-' : '+';
1259f3efcd01Safresh1
1260f3efcd01Safresh1    my ($bx, $by);
1261f3efcd01Safresh1
1262f3efcd01Safresh1    if ($sx eq '-') {                   # if x is negative
1263f3efcd01Safresh1        # two's complement: inc (dec unsigned value) and flip all "bits" in $bx
1264f3efcd01Safresh1        $bx = $class -> _copy($x);
1265f3efcd01Safresh1        $bx = $class -> _dec($bx);
1266f3efcd01Safresh1        $bx = $class -> _as_hex($bx);
1267f3efcd01Safresh1        $bx =~ s/^-?0x//;
1268f3efcd01Safresh1        $bx =~ tr<0123456789abcdef>
1269f3efcd01Safresh1                <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
1270f3efcd01Safresh1    } else {                            # if x is positive
1271f3efcd01Safresh1        $bx = $class -> _as_hex($x);    # get binary representation
1272f3efcd01Safresh1        $bx =~ s/^-?0x//;
1273f3efcd01Safresh1        $bx =~ tr<fedcba9876543210>
1274f3efcd01Safresh1                 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
1275f3efcd01Safresh1    }
1276f3efcd01Safresh1
1277f3efcd01Safresh1    if ($sy eq '-') {                   # if y is negative
1278f3efcd01Safresh1        # two's complement: inc (dec unsigned value) and flip all "bits" in $by
1279f3efcd01Safresh1        $by = $class -> _copy($y);
1280f3efcd01Safresh1        $by = $class -> _dec($by);
1281f3efcd01Safresh1        $by = $class -> _as_hex($by);
1282f3efcd01Safresh1        $by =~ s/^-?0x//;
1283f3efcd01Safresh1        $by =~ tr<0123456789abcdef>
1284f3efcd01Safresh1                <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
1285f3efcd01Safresh1    } else {
1286f3efcd01Safresh1        $by = $class -> _as_hex($y);    # get binary representation
1287f3efcd01Safresh1        $by =~ s/^-?0x//;
1288f3efcd01Safresh1        $by =~ tr<fedcba9876543210>
1289f3efcd01Safresh1                <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
1290f3efcd01Safresh1    }
1291f3efcd01Safresh1
1292f3efcd01Safresh1    # now we have bit-strings from X and Y, reverse them for padding
1293f3efcd01Safresh1    $bx = reverse $bx;
1294f3efcd01Safresh1    $by = reverse $by;
1295f3efcd01Safresh1
1296f3efcd01Safresh1    # padd the shorter string
1297f3efcd01Safresh1    my $xx = "\x00"; $xx = "\x0f" if $sx eq '-';
1298f3efcd01Safresh1    my $yy = "\x00"; $yy = "\x0f" if $sy eq '-';
1299f3efcd01Safresh1    my $diff = CORE::length($bx) - CORE::length($by);
1300f3efcd01Safresh1    if ($diff > 0) {
1301f3efcd01Safresh1        # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by
1302f3efcd01Safresh1        $by .= $yy x $diff;
1303f3efcd01Safresh1    } elsif ($diff < 0) {
1304f3efcd01Safresh1        # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx
1305f3efcd01Safresh1        $bx .= $xx x abs($diff);
1306f3efcd01Safresh1    }
1307f3efcd01Safresh1
1308f3efcd01Safresh1    # and the strings together
1309f3efcd01Safresh1    my $r = $bx & $by;
1310f3efcd01Safresh1
1311f3efcd01Safresh1    # and reverse the result again
1312f3efcd01Safresh1    $bx = reverse $r;
1313f3efcd01Safresh1
1314f3efcd01Safresh1    # One of $bx or $by was negative, so need to flip bits in the result. In both
1315f3efcd01Safresh1    # cases (one or two of them negative, or both positive) we need to get the
1316f3efcd01Safresh1    # characters back.
1317f3efcd01Safresh1    if ($sign eq '-') {
1318f3efcd01Safresh1        $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
1319f3efcd01Safresh1                 <0123456789abcdef>;
1320f3efcd01Safresh1    } else {
1321f3efcd01Safresh1        $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
1322f3efcd01Safresh1                 <fedcba9876543210>;
1323f3efcd01Safresh1    }
1324f3efcd01Safresh1
1325f3efcd01Safresh1    # leading zeros will be stripped by _from_hex()
1326f3efcd01Safresh1    $bx = '0x' . $bx;
1327f3efcd01Safresh1    $bx = $class -> _from_hex($bx);
1328f3efcd01Safresh1
1329f3efcd01Safresh1    $bx = $class -> _inc($bx) if $sign eq '-';
1330f3efcd01Safresh1
1331f3efcd01Safresh1    # avoid negative zero
1332f3efcd01Safresh1    $sign = '+' if $class -> _is_zero($bx);
1333f3efcd01Safresh1
1334f3efcd01Safresh1    return $bx, $sign;
1335f3efcd01Safresh1}
1336f3efcd01Safresh1
1337f3efcd01Safresh1sub _sxor {
1338f3efcd01Safresh1    my ($class, $x, $sx, $y, $sy) = @_;
1339f3efcd01Safresh1
1340f3efcd01Safresh1    return ($class -> _zero(), '+')
1341f3efcd01Safresh1      if $class -> _is_zero($x) && $class -> _is_zero($y);
1342f3efcd01Safresh1
1343f3efcd01Safresh1    my $sign = $sx ne $sy ? '-' : '+';
1344f3efcd01Safresh1
1345f3efcd01Safresh1    my ($bx, $by);
1346f3efcd01Safresh1
1347f3efcd01Safresh1    if ($sx eq '-') {                   # if x is negative
1348f3efcd01Safresh1        # two's complement: inc (dec unsigned value) and flip all "bits" in $bx
1349f3efcd01Safresh1        $bx = $class -> _copy($x);
1350f3efcd01Safresh1        $bx = $class -> _dec($bx);
1351f3efcd01Safresh1        $bx = $class -> _as_hex($bx);
1352f3efcd01Safresh1        $bx =~ s/^-?0x//;
1353f3efcd01Safresh1        $bx =~ tr<0123456789abcdef>
1354f3efcd01Safresh1                <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
1355f3efcd01Safresh1    } else {                            # if x is positive
1356f3efcd01Safresh1        $bx = $class -> _as_hex($x);    # get binary representation
1357f3efcd01Safresh1        $bx =~ s/^-?0x//;
1358f3efcd01Safresh1        $bx =~ tr<fedcba9876543210>
1359f3efcd01Safresh1                 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
1360f3efcd01Safresh1    }
1361f3efcd01Safresh1
1362f3efcd01Safresh1    if ($sy eq '-') {                   # if y is negative
1363f3efcd01Safresh1        # two's complement: inc (dec unsigned value) and flip all "bits" in $by
1364f3efcd01Safresh1        $by = $class -> _copy($y);
1365f3efcd01Safresh1        $by = $class -> _dec($by);
1366f3efcd01Safresh1        $by = $class -> _as_hex($by);
1367f3efcd01Safresh1        $by =~ s/^-?0x//;
1368f3efcd01Safresh1        $by =~ tr<0123456789abcdef>
1369f3efcd01Safresh1                <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
1370f3efcd01Safresh1    } else {
1371f3efcd01Safresh1        $by = $class -> _as_hex($y);    # get binary representation
1372f3efcd01Safresh1        $by =~ s/^-?0x//;
1373f3efcd01Safresh1        $by =~ tr<fedcba9876543210>
1374f3efcd01Safresh1                <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
1375f3efcd01Safresh1    }
1376f3efcd01Safresh1
1377f3efcd01Safresh1    # now we have bit-strings from X and Y, reverse them for padding
1378f3efcd01Safresh1    $bx = reverse $bx;
1379f3efcd01Safresh1    $by = reverse $by;
1380f3efcd01Safresh1
1381f3efcd01Safresh1    # padd the shorter string
1382f3efcd01Safresh1    my $xx = "\x00"; $xx = "\x0f" if $sx eq '-';
1383f3efcd01Safresh1    my $yy = "\x00"; $yy = "\x0f" if $sy eq '-';
1384f3efcd01Safresh1    my $diff = CORE::length($bx) - CORE::length($by);
1385f3efcd01Safresh1    if ($diff > 0) {
1386f3efcd01Safresh1        # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by
1387f3efcd01Safresh1        $by .= $yy x $diff;
1388f3efcd01Safresh1    } elsif ($diff < 0) {
1389f3efcd01Safresh1        # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx
1390f3efcd01Safresh1        $bx .= $xx x abs($diff);
1391f3efcd01Safresh1    }
1392f3efcd01Safresh1
1393f3efcd01Safresh1    # xor the strings together
1394f3efcd01Safresh1    my $r = $bx ^ $by;
1395f3efcd01Safresh1
1396f3efcd01Safresh1    # and reverse the result again
1397f3efcd01Safresh1    $bx = reverse $r;
1398f3efcd01Safresh1
1399f3efcd01Safresh1    # One of $bx or $by was negative, so need to flip bits in the result. In both
1400f3efcd01Safresh1    # cases (one or two of them negative, or both positive) we need to get the
1401f3efcd01Safresh1    # characters back.
1402f3efcd01Safresh1    if ($sign eq '-') {
1403f3efcd01Safresh1        $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
1404f3efcd01Safresh1                 <0123456789abcdef>;
1405f3efcd01Safresh1    } else {
1406f3efcd01Safresh1        $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
1407f3efcd01Safresh1                 <fedcba9876543210>;
1408f3efcd01Safresh1    }
1409f3efcd01Safresh1
1410f3efcd01Safresh1    # leading zeros will be stripped by _from_hex()
1411f3efcd01Safresh1    $bx = '0x' . $bx;
1412f3efcd01Safresh1    $bx = $class -> _from_hex($bx);
1413f3efcd01Safresh1
1414f3efcd01Safresh1    $bx = $class -> _inc($bx) if $sign eq '-';
1415f3efcd01Safresh1
1416f3efcd01Safresh1    # avoid negative zero
1417f3efcd01Safresh1    $sign = '+' if $class -> _is_zero($bx);
1418f3efcd01Safresh1
1419f3efcd01Safresh1    return $bx, $sign;
1420f3efcd01Safresh1}
1421f3efcd01Safresh1
1422f3efcd01Safresh1sub _sor {
1423f3efcd01Safresh1    my ($class, $x, $sx, $y, $sy) = @_;
1424f3efcd01Safresh1
1425f3efcd01Safresh1    return ($class -> _zero(), '+')
1426f3efcd01Safresh1      if $class -> _is_zero($x) && $class -> _is_zero($y);
1427f3efcd01Safresh1
1428f3efcd01Safresh1    my $sign = $sx eq '-' || $sy eq '-' ? '-' : '+';
1429f3efcd01Safresh1
1430f3efcd01Safresh1    my ($bx, $by);
1431f3efcd01Safresh1
1432f3efcd01Safresh1    if ($sx eq '-') {                   # if x is negative
1433f3efcd01Safresh1        # two's complement: inc (dec unsigned value) and flip all "bits" in $bx
1434f3efcd01Safresh1        $bx = $class -> _copy($x);
1435f3efcd01Safresh1        $bx = $class -> _dec($bx);
1436f3efcd01Safresh1        $bx = $class -> _as_hex($bx);
1437f3efcd01Safresh1        $bx =~ s/^-?0x//;
1438f3efcd01Safresh1        $bx =~ tr<0123456789abcdef>
1439f3efcd01Safresh1                <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
1440f3efcd01Safresh1    } else {                            # if x is positive
1441f3efcd01Safresh1        $bx = $class -> _as_hex($x);     # get binary representation
1442f3efcd01Safresh1        $bx =~ s/^-?0x//;
1443f3efcd01Safresh1        $bx =~ tr<fedcba9876543210>
1444f3efcd01Safresh1                 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
1445f3efcd01Safresh1    }
1446f3efcd01Safresh1
1447f3efcd01Safresh1    if ($sy eq '-') {                   # if y is negative
1448f3efcd01Safresh1        # two's complement: inc (dec unsigned value) and flip all "bits" in $by
1449f3efcd01Safresh1        $by = $class -> _copy($y);
1450f3efcd01Safresh1        $by = $class -> _dec($by);
1451f3efcd01Safresh1        $by = $class -> _as_hex($by);
1452f3efcd01Safresh1        $by =~ s/^-?0x//;
1453f3efcd01Safresh1        $by =~ tr<0123456789abcdef>
1454f3efcd01Safresh1                <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
1455f3efcd01Safresh1    } else {
1456f3efcd01Safresh1        $by = $class -> _as_hex($y);     # get binary representation
1457f3efcd01Safresh1        $by =~ s/^-?0x//;
1458f3efcd01Safresh1        $by =~ tr<fedcba9876543210>
1459f3efcd01Safresh1                <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
1460f3efcd01Safresh1    }
1461f3efcd01Safresh1
1462f3efcd01Safresh1    # now we have bit-strings from X and Y, reverse them for padding
1463f3efcd01Safresh1    $bx = reverse $bx;
1464f3efcd01Safresh1    $by = reverse $by;
1465f3efcd01Safresh1
1466f3efcd01Safresh1    # padd the shorter string
1467f3efcd01Safresh1    my $xx = "\x00"; $xx = "\x0f" if $sx eq '-';
1468f3efcd01Safresh1    my $yy = "\x00"; $yy = "\x0f" if $sy eq '-';
1469f3efcd01Safresh1    my $diff = CORE::length($bx) - CORE::length($by);
1470f3efcd01Safresh1    if ($diff > 0) {
1471f3efcd01Safresh1        # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by
1472f3efcd01Safresh1        $by .= $yy x $diff;
1473f3efcd01Safresh1    } elsif ($diff < 0) {
1474f3efcd01Safresh1        # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx
1475f3efcd01Safresh1        $bx .= $xx x abs($diff);
1476f3efcd01Safresh1    }
1477f3efcd01Safresh1
1478f3efcd01Safresh1    # or the strings together
1479f3efcd01Safresh1    my $r = $bx | $by;
1480f3efcd01Safresh1
1481f3efcd01Safresh1    # and reverse the result again
1482f3efcd01Safresh1    $bx = reverse $r;
1483f3efcd01Safresh1
1484f3efcd01Safresh1    # One of $bx or $by was negative, so need to flip bits in the result. In both
1485f3efcd01Safresh1    # cases (one or two of them negative, or both positive) we need to get the
1486f3efcd01Safresh1    # characters back.
1487f3efcd01Safresh1    if ($sign eq '-') {
1488f3efcd01Safresh1        $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
1489f3efcd01Safresh1                 <0123456789abcdef>;
1490f3efcd01Safresh1    } else {
1491f3efcd01Safresh1        $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
1492f3efcd01Safresh1                 <fedcba9876543210>;
1493f3efcd01Safresh1    }
1494f3efcd01Safresh1
1495f3efcd01Safresh1    # leading zeros will be stripped by _from_hex()
1496f3efcd01Safresh1    $bx = '0x' . $bx;
1497f3efcd01Safresh1    $bx = $class -> _from_hex($bx);
1498f3efcd01Safresh1
1499f3efcd01Safresh1    $bx = $class -> _inc($bx) if $sign eq '-';
1500f3efcd01Safresh1
1501f3efcd01Safresh1    # avoid negative zero
1502f3efcd01Safresh1    $sign = '+' if $class -> _is_zero($bx);
1503f3efcd01Safresh1
1504f3efcd01Safresh1    return $bx, $sign;
1505f3efcd01Safresh1}
1506f3efcd01Safresh1
15075759b3d2Safresh1sub _to_bin {
15085759b3d2Safresh1    # convert the number to a string of binary digits without prefix
15095759b3d2Safresh1    my ($class, $x) = @_;
15105759b3d2Safresh1    my $str    = '';
15115759b3d2Safresh1    my $tmp    = $class -> _copy($x);
15125759b3d2Safresh1    my $chunk = $class -> _new("16777216");     # 2^24 = 24 binary digits
15135759b3d2Safresh1    my $rem;
15145759b3d2Safresh1    until ($class -> _acmp($tmp, $chunk) < 0) {
15155759b3d2Safresh1        ($tmp, $rem) = $class -> _div($tmp, $chunk);
15165759b3d2Safresh1        $str = sprintf("%024b", $class -> _num($rem)) . $str;
15175759b3d2Safresh1    }
15185759b3d2Safresh1    unless ($class -> _is_zero($tmp)) {
15195759b3d2Safresh1        $str = sprintf("%b", $class -> _num($tmp)) . $str;
15205759b3d2Safresh1    }
15215759b3d2Safresh1    return length($str) ? $str : '0';
15225759b3d2Safresh1}
15235759b3d2Safresh1
15245759b3d2Safresh1sub _to_oct {
15255759b3d2Safresh1    # convert the number to a string of octal digits without prefix
15265759b3d2Safresh1    my ($class, $x) = @_;
15275759b3d2Safresh1    my $str    = '';
15285759b3d2Safresh1    my $tmp    = $class -> _copy($x);
15295759b3d2Safresh1    my $chunk = $class -> _new("16777216");     # 2^24 = 8 octal digits
15305759b3d2Safresh1    my $rem;
15315759b3d2Safresh1    until ($class -> _acmp($tmp, $chunk) < 0) {
15325759b3d2Safresh1        ($tmp, $rem) = $class -> _div($tmp, $chunk);
15335759b3d2Safresh1        $str = sprintf("%08o", $class -> _num($rem)) . $str;
15345759b3d2Safresh1    }
15355759b3d2Safresh1    unless ($class -> _is_zero($tmp)) {
15365759b3d2Safresh1        $str = sprintf("%o", $class -> _num($tmp)) . $str;
15375759b3d2Safresh1    }
15385759b3d2Safresh1    return length($str) ? $str : '0';
15395759b3d2Safresh1}
15405759b3d2Safresh1
15415759b3d2Safresh1sub _to_hex {
15425759b3d2Safresh1    # convert the number to a string of hexadecimal digits without prefix
15435759b3d2Safresh1    my ($class, $x) = @_;
15445759b3d2Safresh1    my $str    = '';
15455759b3d2Safresh1    my $tmp    = $class -> _copy($x);
15465759b3d2Safresh1    my $chunk = $class -> _new("16777216");     # 2^24 = 6 hexadecimal digits
15475759b3d2Safresh1    my $rem;
15485759b3d2Safresh1    until ($class -> _acmp($tmp, $chunk) < 0) {
15495759b3d2Safresh1        ($tmp, $rem) = $class -> _div($tmp, $chunk);
15505759b3d2Safresh1        $str = sprintf("%06x", $class -> _num($rem)) . $str;
15515759b3d2Safresh1    }
15525759b3d2Safresh1    unless ($class -> _is_zero($tmp)) {
15535759b3d2Safresh1        $str = sprintf("%x", $class -> _num($tmp)) . $str;
15545759b3d2Safresh1    }
15555759b3d2Safresh1    return length($str) ? $str : '0';
15565759b3d2Safresh1}
15575759b3d2Safresh1
15585759b3d2Safresh1sub _as_bin {
15595759b3d2Safresh1    # convert the number to a string of binary digits with prefix
15605759b3d2Safresh1    my ($class, $x) = @_;
15615759b3d2Safresh1    return '0b' . $class -> _to_bin($x);
15625759b3d2Safresh1}
15635759b3d2Safresh1
15645759b3d2Safresh1sub _as_oct {
15655759b3d2Safresh1    # convert the number to a string of octal digits with prefix
15665759b3d2Safresh1    my ($class, $x) = @_;
15675759b3d2Safresh1    return '0' . $class -> _to_oct($x);         # yes, 0 becomes "00"
15685759b3d2Safresh1}
15695759b3d2Safresh1
15705759b3d2Safresh1sub _as_hex {
15715759b3d2Safresh1    # convert the number to a string of hexadecimal digits with prefix
15725759b3d2Safresh1    my ($class, $x) = @_;
15735759b3d2Safresh1    return '0x' . $class -> _to_hex($x);
15745759b3d2Safresh1}
15755759b3d2Safresh1
15765759b3d2Safresh1sub _to_bytes {
15775759b3d2Safresh1    # convert the number to a string of bytes
15785759b3d2Safresh1    my ($class, $x) = @_;
15795759b3d2Safresh1    my $str    = '';
15805759b3d2Safresh1    my $tmp    = $class -> _copy($x);
15815759b3d2Safresh1    my $chunk = $class -> _new("65536");
15825759b3d2Safresh1    my $rem;
15835759b3d2Safresh1    until ($class -> _is_zero($tmp)) {
15845759b3d2Safresh1        ($tmp, $rem) = $class -> _div($tmp, $chunk);
15855759b3d2Safresh1        $str = pack('n', $class -> _num($rem)) . $str;
15865759b3d2Safresh1    }
15875759b3d2Safresh1    $str =~ s/^\0+//;
15885759b3d2Safresh1    return length($str) ? $str : "\x00";
15895759b3d2Safresh1}
15905759b3d2Safresh1
15915759b3d2Safresh1*_as_bytes = \&_to_bytes;
15925759b3d2Safresh1
1593f3efcd01Safresh1sub _to_base {
1594f3efcd01Safresh1    # convert the number to a string of digits in various bases
1595f3efcd01Safresh1    my $class = shift;
1596f3efcd01Safresh1    my $x     = shift;
1597f3efcd01Safresh1    my $base  = shift;
1598f3efcd01Safresh1    $base = $class -> _new($base) unless ref($base);
1599f3efcd01Safresh1
1600f3efcd01Safresh1    my $collseq;
1601f3efcd01Safresh1    if (@_) {
1602256a93a4Safresh1        $collseq = shift;
1603256a93a4Safresh1        croak "The collation sequence must be a non-empty string"
1604256a93a4Safresh1          unless defined($collseq) && length($collseq);
1605f3efcd01Safresh1    } else {
1606de8cc8edSafresh1        if ($class -> _acmp($base, $class -> _new("94")) <= 0) {
1607de8cc8edSafresh1            $collseq = '0123456789'                     #  48 ..  57
1608de8cc8edSafresh1                     . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'     #  65 ..  90
1609de8cc8edSafresh1                     . 'abcdefghijklmnopqrstuvwxyz'     #  97 .. 122
1610de8cc8edSafresh1                     . '!"#$%&\'()*+,-./'               #  33 ..  47
1611de8cc8edSafresh1                     . ':;<=>?@'                        #  58 ..  64
1612de8cc8edSafresh1                     . '[\\]^_`'                        #  91 ..  96
1613de8cc8edSafresh1                     . '{|}~';                          # 123 .. 126
1614f3efcd01Safresh1        } else {
1615de8cc8edSafresh1            croak "When base > 94, a collation sequence must be given";
1616f3efcd01Safresh1        }
1617f3efcd01Safresh1    }
1618f3efcd01Safresh1
1619f3efcd01Safresh1    my @collseq = split '', $collseq;
1620f3efcd01Safresh1
1621f3efcd01Safresh1    my $str   = '';
1622f3efcd01Safresh1    my $tmp   = $class -> _copy($x);
1623f3efcd01Safresh1    my $rem;
1624f3efcd01Safresh1    until ($class -> _is_zero($tmp)) {
1625f3efcd01Safresh1        ($tmp, $rem) = $class -> _div($tmp, $base);
1626f3efcd01Safresh1        my $num = $class -> _num($rem);
1627f3efcd01Safresh1        croak "no character to represent '$num' in collation sequence",
1628f3efcd01Safresh1          " (collation sequence is too short)" if $num > $#collseq;
1629f3efcd01Safresh1        my $chr = $collseq[$num];
1630f3efcd01Safresh1        $str = $chr . $str;
1631f3efcd01Safresh1    }
1632256a93a4Safresh1    return $collseq[0] unless length $str;
1633f3efcd01Safresh1    return $str;
1634f3efcd01Safresh1}
1635f3efcd01Safresh1
1636256a93a4Safresh1sub _to_base_num {
1637256a93a4Safresh1    # Convert the number to an array of integers in any base.
1638256a93a4Safresh1    my ($class, $x, $base) = @_;
1639256a93a4Safresh1
1640256a93a4Safresh1    # Make sure the base is an object and >= 2.
1641256a93a4Safresh1    $base = $class -> _new($base) unless ref($base);
1642256a93a4Safresh1    my $two = $class -> _two();
1643256a93a4Safresh1    croak "base must be >= 2" unless $class -> _acmp($base, $two) >= 0;
1644256a93a4Safresh1
1645256a93a4Safresh1    my $out   = [];
1646256a93a4Safresh1    my $xcopy = $class -> _copy($x);
1647256a93a4Safresh1    my $rem;
1648256a93a4Safresh1
1649256a93a4Safresh1    # Do all except the last (most significant) element.
1650256a93a4Safresh1    until ($class -> _acmp($xcopy, $base) < 0) {
1651256a93a4Safresh1        ($xcopy, $rem) = $class -> _div($xcopy, $base);
1652256a93a4Safresh1        unshift @$out, $rem;
1653256a93a4Safresh1    }
1654256a93a4Safresh1
1655256a93a4Safresh1    # Do the last (most significant element).
1656256a93a4Safresh1    unless ($class -> _is_zero($xcopy)) {
1657256a93a4Safresh1        unshift @$out, $xcopy;
1658256a93a4Safresh1    }
1659256a93a4Safresh1
1660256a93a4Safresh1    # $out is empty if $x is zero.
1661256a93a4Safresh1    unshift @$out, $class -> _zero() unless @$out;
1662256a93a4Safresh1
1663256a93a4Safresh1    return $out;
1664256a93a4Safresh1}
1665256a93a4Safresh1
16665759b3d2Safresh1sub _from_hex {
16675759b3d2Safresh1    # Convert a string of hexadecimal digits to a number.
16685759b3d2Safresh1
16695759b3d2Safresh1    my ($class, $hex) = @_;
16705759b3d2Safresh1    $hex =~ s/^0[xX]//;
16715759b3d2Safresh1
16725759b3d2Safresh1    # Find the largest number of hexadecimal digits that we can safely use with
16735759b3d2Safresh1    # 32 bit integers. There are 4 bits pr hexadecimal digit, and we use only
16745759b3d2Safresh1    # 31 bits to play safe. This gives us int(31 / 4) = 7.
16755759b3d2Safresh1
16765759b3d2Safresh1    my $len = length $hex;
16775759b3d2Safresh1    my $rem = 1 + ($len - 1) % 7;
16785759b3d2Safresh1
16795759b3d2Safresh1    # Do the first chunk.
16805759b3d2Safresh1
16815759b3d2Safresh1    my $ret = $class -> _new(int hex substr $hex, 0, $rem);
16825759b3d2Safresh1    return $ret if $rem == $len;
16835759b3d2Safresh1
16845759b3d2Safresh1    # Do the remaining chunks, if any.
16855759b3d2Safresh1
16865759b3d2Safresh1    my $shift = $class -> _new(1 << (4 * 7));
16875759b3d2Safresh1    for (my $offset = $rem ; $offset < $len ; $offset += 7) {
16885759b3d2Safresh1        my $part = int hex substr $hex, $offset, 7;
16895759b3d2Safresh1        $ret = $class -> _mul($ret, $shift);
16905759b3d2Safresh1        $ret = $class -> _add($ret, $class -> _new($part));
16915759b3d2Safresh1    }
16925759b3d2Safresh1
16935759b3d2Safresh1    return $ret;
16945759b3d2Safresh1}
16955759b3d2Safresh1
16965759b3d2Safresh1sub _from_oct {
16975759b3d2Safresh1    # Convert a string of octal digits to a number.
16985759b3d2Safresh1
16995759b3d2Safresh1    my ($class, $oct) = @_;
17005759b3d2Safresh1
17015759b3d2Safresh1    # Find the largest number of octal digits that we can safely use with 32
17025759b3d2Safresh1    # bit integers. There are 3 bits pr octal digit, and we use only 31 bits to
17035759b3d2Safresh1    # play safe. This gives us int(31 / 3) = 10.
17045759b3d2Safresh1
17055759b3d2Safresh1    my $len = length $oct;
17065759b3d2Safresh1    my $rem = 1 + ($len - 1) % 10;
17075759b3d2Safresh1
17085759b3d2Safresh1    # Do the first chunk.
17095759b3d2Safresh1
17105759b3d2Safresh1    my $ret = $class -> _new(int oct substr $oct, 0, $rem);
17115759b3d2Safresh1    return $ret if $rem == $len;
17125759b3d2Safresh1
17135759b3d2Safresh1    # Do the remaining chunks, if any.
17145759b3d2Safresh1
17155759b3d2Safresh1    my $shift = $class -> _new(1 << (3 * 10));
17165759b3d2Safresh1    for (my $offset = $rem ; $offset < $len ; $offset += 10) {
17175759b3d2Safresh1        my $part = int oct substr $oct, $offset, 10;
17185759b3d2Safresh1        $ret = $class -> _mul($ret, $shift);
17195759b3d2Safresh1        $ret = $class -> _add($ret, $class -> _new($part));
17205759b3d2Safresh1    }
17215759b3d2Safresh1
17225759b3d2Safresh1    return $ret;
17235759b3d2Safresh1}
17245759b3d2Safresh1
17255759b3d2Safresh1sub _from_bin {
17265759b3d2Safresh1    # Convert a string of binary digits to a number.
17275759b3d2Safresh1
17285759b3d2Safresh1    my ($class, $bin) = @_;
17295759b3d2Safresh1    $bin =~ s/^0[bB]//;
17305759b3d2Safresh1
17315759b3d2Safresh1    # The largest number of binary digits that we can safely use with 32 bit
17325759b3d2Safresh1    # integers is 31. We use only 31 bits to play safe.
17335759b3d2Safresh1
17345759b3d2Safresh1    my $len = length $bin;
17355759b3d2Safresh1    my $rem = 1 + ($len - 1) % 31;
17365759b3d2Safresh1
17375759b3d2Safresh1    # Do the first chunk.
17385759b3d2Safresh1
17395759b3d2Safresh1    my $ret = $class -> _new(int oct '0b' . substr $bin, 0, $rem);
17405759b3d2Safresh1    return $ret if $rem == $len;
17415759b3d2Safresh1
17425759b3d2Safresh1    # Do the remaining chunks, if any.
17435759b3d2Safresh1
17445759b3d2Safresh1    my $shift = $class -> _new(1 << 31);
17455759b3d2Safresh1    for (my $offset = $rem ; $offset < $len ; $offset += 31) {
17465759b3d2Safresh1        my $part = int oct '0b' . substr $bin, $offset, 31;
17475759b3d2Safresh1        $ret = $class -> _mul($ret, $shift);
17485759b3d2Safresh1        $ret = $class -> _add($ret, $class -> _new($part));
17495759b3d2Safresh1    }
17505759b3d2Safresh1
17515759b3d2Safresh1    return $ret;
17525759b3d2Safresh1}
17535759b3d2Safresh1
17545759b3d2Safresh1sub _from_bytes {
17555759b3d2Safresh1    # convert string of bytes to a number
17565759b3d2Safresh1    my ($class, $str) = @_;
17575759b3d2Safresh1    my $x    = $class -> _zero();
17585759b3d2Safresh1    my $base = $class -> _new("256");
17595759b3d2Safresh1    my $n    = length($str);
17605759b3d2Safresh1    for (my $i = 0 ; $i < $n ; ++$i) {
17615759b3d2Safresh1        $x = $class -> _mul($x, $base);
17625759b3d2Safresh1        my $byteval = $class -> _new(unpack 'C', substr($str, $i, 1));
17635759b3d2Safresh1        $x = $class -> _add($x, $byteval);
17645759b3d2Safresh1    }
17655759b3d2Safresh1    return $x;
17665759b3d2Safresh1}
17675759b3d2Safresh1
1768f3efcd01Safresh1sub _from_base {
1769f3efcd01Safresh1    # convert a string to a decimal number
1770f3efcd01Safresh1    my $class = shift;
1771f3efcd01Safresh1    my $str   = shift;
1772f3efcd01Safresh1    my $base  = shift;
1773f3efcd01Safresh1    $base = $class -> _new($base) unless ref($base);
1774f3efcd01Safresh1
1775f3efcd01Safresh1    my $n = length($str);
1776f3efcd01Safresh1    my $x = $class -> _zero();
1777f3efcd01Safresh1
1778f3efcd01Safresh1    my $collseq;
1779f3efcd01Safresh1    if (@_) {
1780f3efcd01Safresh1        $collseq = shift();
1781f3efcd01Safresh1    } else {
1782f3efcd01Safresh1        if ($class -> _acmp($base, $class -> _new("36")) <= 0) {
1783f3efcd01Safresh1            $str = uc $str;
1784f3efcd01Safresh1            $collseq = '0123456789' . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
1785de8cc8edSafresh1        } elsif ($class -> _acmp($base, $class -> _new("94")) <= 0) {
1786de8cc8edSafresh1            $collseq = '0123456789'                     #  48 ..  57
1787de8cc8edSafresh1                     . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'     #  65 ..  90
1788de8cc8edSafresh1                     . 'abcdefghijklmnopqrstuvwxyz'     #  97 .. 122
1789de8cc8edSafresh1                     . '!"#$%&\'()*+,-./'               #  33 ..  47
1790de8cc8edSafresh1                     . ':;<=>?@'                        #  58 ..  64
1791de8cc8edSafresh1                     . '[\\]^_`'                        #  91 ..  96
1792de8cc8edSafresh1                     . '{|}~';                          # 123 .. 126
1793f3efcd01Safresh1        } else {
1794de8cc8edSafresh1            croak "When base > 94, a collation sequence must be given";
1795f3efcd01Safresh1        }
1796f3efcd01Safresh1        $collseq = substr $collseq, 0, $class -> _num($base);
1797f3efcd01Safresh1    }
1798f3efcd01Safresh1
1799f3efcd01Safresh1    # Create a mapping from each character in the collation sequence to the
1800f3efcd01Safresh1    # corresponding integer. Check for duplicates in the collation sequence.
1801f3efcd01Safresh1
1802f3efcd01Safresh1    my @collseq = split '', $collseq;
1803f3efcd01Safresh1    my %collseq;
1804f3efcd01Safresh1    for my $num (0 .. $#collseq) {
1805f3efcd01Safresh1        my $chr = $collseq[$num];
1806f3efcd01Safresh1        die "duplicate character '$chr' in collation sequence"
1807f3efcd01Safresh1          if exists $collseq{$chr};
1808f3efcd01Safresh1        $collseq{$chr} = $num;
1809f3efcd01Safresh1    }
1810f3efcd01Safresh1
1811f3efcd01Safresh1    for (my $i = 0 ; $i < $n ; ++$i) {
1812f3efcd01Safresh1        my $chr = substr($str, $i, 1);
1813f3efcd01Safresh1        die "input character '$chr' does not exist in collation sequence"
1814f3efcd01Safresh1          unless exists $collseq{$chr};
1815f3efcd01Safresh1        $x = $class -> _mul($x, $base);
1816f3efcd01Safresh1        my $num = $class -> _new($collseq{$chr});
1817f3efcd01Safresh1        $x = $class -> _add($x, $num);
1818f3efcd01Safresh1    }
1819f3efcd01Safresh1
1820f3efcd01Safresh1    return $x;
1821f3efcd01Safresh1}
1822f3efcd01Safresh1
1823256a93a4Safresh1sub _from_base_num {
1824256a93a4Safresh1    # Convert an array in the given base to a number.
1825256a93a4Safresh1    my ($class, $in, $base) = @_;
1826256a93a4Safresh1
1827256a93a4Safresh1    # Make sure the base is an object and >= 2.
1828256a93a4Safresh1    $base = $class -> _new($base) unless ref($base);
1829256a93a4Safresh1    my $two = $class -> _two();
1830256a93a4Safresh1    croak "base must be >= 2" unless $class -> _acmp($base, $two) >= 0;
1831256a93a4Safresh1
1832256a93a4Safresh1    # @$in = map { ref($_) ? $_ : $class -> _new($_) } @$in;
1833256a93a4Safresh1
1834256a93a4Safresh1    my $ele = $in -> [0];
1835256a93a4Safresh1
1836256a93a4Safresh1    $ele = $class -> _new($ele) unless ref($ele);
1837256a93a4Safresh1    my $x = $class -> _copy($ele);
1838256a93a4Safresh1
1839256a93a4Safresh1    for my $i (1 .. $#$in) {
1840256a93a4Safresh1        $x = $class -> _mul($x, $base);
1841256a93a4Safresh1        $ele = $in -> [$i];
1842256a93a4Safresh1        $ele = $class -> _new($ele) unless ref($ele);
1843256a93a4Safresh1        $x = $class -> _add($x, $ele);
1844256a93a4Safresh1    }
1845256a93a4Safresh1
1846256a93a4Safresh1    return $x;
1847256a93a4Safresh1}
1848256a93a4Safresh1
18495759b3d2Safresh1##############################################################################
18505759b3d2Safresh1# special modulus functions
18515759b3d2Safresh1
18525759b3d2Safresh1sub _modinv {
18535759b3d2Safresh1    # modular multiplicative inverse
18545759b3d2Safresh1    my ($class, $x, $y) = @_;
18555759b3d2Safresh1
18565759b3d2Safresh1    # modulo zero
18575759b3d2Safresh1    if ($class -> _is_zero($y)) {
1858f2a19305Safresh1        return;
18595759b3d2Safresh1    }
18605759b3d2Safresh1
18615759b3d2Safresh1    # modulo one
18625759b3d2Safresh1    if ($class -> _is_one($y)) {
18635759b3d2Safresh1        return ($class -> _zero(), '+');
18645759b3d2Safresh1    }
18655759b3d2Safresh1
18665759b3d2Safresh1    my $u = $class -> _zero();
18675759b3d2Safresh1    my $v = $class -> _one();
18685759b3d2Safresh1    my $a = $class -> _copy($y);
18695759b3d2Safresh1    my $b = $class -> _copy($x);
18705759b3d2Safresh1
18715759b3d2Safresh1    # Euclid's Algorithm for bgcd().
18725759b3d2Safresh1
18735759b3d2Safresh1    my $q;
18745759b3d2Safresh1    my $sign = 1;
18755759b3d2Safresh1    {
18765759b3d2Safresh1        ($a, $q, $b) = ($b, $class -> _div($a, $b));
18775759b3d2Safresh1        last if $class -> _is_zero($b);
18785759b3d2Safresh1
18795759b3d2Safresh1        my $vq = $class -> _mul($class -> _copy($v), $q);
18805759b3d2Safresh1        my $t = $class -> _add($vq, $u);
18815759b3d2Safresh1        $u = $v;
18825759b3d2Safresh1        $v = $t;
18835759b3d2Safresh1        $sign = -$sign;
18845759b3d2Safresh1        redo;
18855759b3d2Safresh1    }
18865759b3d2Safresh1
18875759b3d2Safresh1    # if the gcd is not 1, there exists no modular multiplicative inverse
1888f2a19305Safresh1    return unless $class -> _is_one($a);
18895759b3d2Safresh1
18905759b3d2Safresh1    ($v, $sign == 1 ? '+' : '-');
18915759b3d2Safresh1}
18925759b3d2Safresh1
18935759b3d2Safresh1sub _modpow {
18945759b3d2Safresh1    # modulus of power ($x ** $y) % $z
18955759b3d2Safresh1    my ($class, $num, $exp, $mod) = @_;
18965759b3d2Safresh1
18975759b3d2Safresh1    # a^b (mod 1) = 0 for all a and b
18985759b3d2Safresh1    if ($class -> _is_one($mod)) {
18995759b3d2Safresh1        return $class -> _zero();
19005759b3d2Safresh1    }
19015759b3d2Safresh1
19025759b3d2Safresh1    # 0^a (mod m) = 0 if m != 0, a != 0
19035759b3d2Safresh1    # 0^0 (mod m) = 1 if m != 0
19045759b3d2Safresh1    if ($class -> _is_zero($num)) {
19055759b3d2Safresh1        return $class -> _is_zero($exp) ? $class -> _one()
19065759b3d2Safresh1                                        : $class -> _zero();
19075759b3d2Safresh1    }
19085759b3d2Safresh1
19095759b3d2Safresh1    #  $num = $class -> _mod($num, $mod);   # this does not make it faster
19105759b3d2Safresh1
19115759b3d2Safresh1    my $acc = $class -> _copy($num);
19125759b3d2Safresh1    my $t   = $class -> _one();
19135759b3d2Safresh1
19145759b3d2Safresh1    my $expbin = $class -> _as_bin($exp);
19155759b3d2Safresh1    $expbin =~ s/^0b//;
19165759b3d2Safresh1    my $len = length($expbin);
19175759b3d2Safresh1
19185759b3d2Safresh1    while (--$len >= 0) {
19195759b3d2Safresh1        if (substr($expbin, $len, 1) eq '1') {
19205759b3d2Safresh1            $t = $class -> _mul($t, $acc);
19215759b3d2Safresh1            $t = $class -> _mod($t, $mod);
19225759b3d2Safresh1        }
19235759b3d2Safresh1        $acc = $class -> _mul($acc, $acc);
19245759b3d2Safresh1        $acc = $class -> _mod($acc, $mod);
19255759b3d2Safresh1    }
19265759b3d2Safresh1    return $t;
19275759b3d2Safresh1}
19285759b3d2Safresh1
19295759b3d2Safresh1sub _gcd {
19305759b3d2Safresh1    # Greatest common divisor.
19315759b3d2Safresh1
19325759b3d2Safresh1    my ($class, $x, $y) = @_;
19335759b3d2Safresh1
19345759b3d2Safresh1    # gcd(0, 0) = 0
19355759b3d2Safresh1    # gcd(0, a) = a, if a != 0
19365759b3d2Safresh1
19375759b3d2Safresh1    if ($class -> _acmp($x, $y) == 0) {
19385759b3d2Safresh1        return $class -> _copy($x);
19395759b3d2Safresh1    }
19405759b3d2Safresh1
19415759b3d2Safresh1    if ($class -> _is_zero($x)) {
19425759b3d2Safresh1        if ($class -> _is_zero($y)) {
19435759b3d2Safresh1            return $class -> _zero();
19445759b3d2Safresh1        } else {
19455759b3d2Safresh1            return $class -> _copy($y);
19465759b3d2Safresh1        }
19475759b3d2Safresh1    } else {
19485759b3d2Safresh1        if ($class -> _is_zero($y)) {
19495759b3d2Safresh1            return $class -> _copy($x);
19505759b3d2Safresh1        } else {
19515759b3d2Safresh1
19525759b3d2Safresh1            # Until $y is zero ...
19535759b3d2Safresh1
19545759b3d2Safresh1            $x = $class -> _copy($x);
19555759b3d2Safresh1            until ($class -> _is_zero($y)) {
19565759b3d2Safresh1
19575759b3d2Safresh1                # Compute remainder.
19585759b3d2Safresh1
19595759b3d2Safresh1                $x = $class -> _mod($x, $y);
19605759b3d2Safresh1
19615759b3d2Safresh1                # Swap $x and $y.
19625759b3d2Safresh1
19635759b3d2Safresh1                my $tmp = $x;
19645759b3d2Safresh1                $x = $class -> _copy($y);
19655759b3d2Safresh1                $y = $tmp;
19665759b3d2Safresh1            }
19675759b3d2Safresh1
19685759b3d2Safresh1            return $x;
19695759b3d2Safresh1        }
19705759b3d2Safresh1    }
19715759b3d2Safresh1}
19725759b3d2Safresh1
19735759b3d2Safresh1sub _lcm {
19745759b3d2Safresh1    # Least common multiple.
19755759b3d2Safresh1
19765759b3d2Safresh1    my ($class, $x, $y) = @_;
19775759b3d2Safresh1
19785759b3d2Safresh1    # lcm(0, x) = 0 for all x
19795759b3d2Safresh1
19805759b3d2Safresh1    return $class -> _zero()
19815759b3d2Safresh1      if ($class -> _is_zero($x) ||
19825759b3d2Safresh1          $class -> _is_zero($y));
19835759b3d2Safresh1
19845759b3d2Safresh1    my $gcd = $class -> _gcd($class -> _copy($x), $y);
19855759b3d2Safresh1    $x = $class -> _div($x, $gcd);
19865759b3d2Safresh1    $x = $class -> _mul($x, $y);
19875759b3d2Safresh1    return $x;
19885759b3d2Safresh1}
19895759b3d2Safresh1
19905759b3d2Safresh1sub _lucas {
19915759b3d2Safresh1    my ($class, $n) = @_;
19925759b3d2Safresh1
19935759b3d2Safresh1    $n = $class -> _num($n) if ref $n;
19945759b3d2Safresh1
19955759b3d2Safresh1    # In list context, use lucas(n) = lucas(n-1) + lucas(n-2)
19965759b3d2Safresh1
19975759b3d2Safresh1    if (wantarray) {
19985759b3d2Safresh1        my @y;
19995759b3d2Safresh1
20005759b3d2Safresh1        push @y, $class -> _two();
20015759b3d2Safresh1        return @y if $n == 0;
20025759b3d2Safresh1
20035759b3d2Safresh1        push @y, $class -> _one();
20045759b3d2Safresh1        return @y if $n == 1;
20055759b3d2Safresh1
20065759b3d2Safresh1        for (my $i = 2 ; $i <= $n ; ++ $i) {
20075759b3d2Safresh1            $y[$i] = $class -> _add($class -> _copy($y[$i - 1]), $y[$i - 2]);
20085759b3d2Safresh1        }
20095759b3d2Safresh1
20105759b3d2Safresh1        return @y;
20115759b3d2Safresh1    }
20125759b3d2Safresh1
20135759b3d2Safresh1    # In scalar context use that lucas(n) = fib(n-1) + fib(n+1).
20145759b3d2Safresh1    #
20155759b3d2Safresh1    # Remember that _fib() behaves differently in scalar context and list
20165759b3d2Safresh1    # context, so we must add scalar() to get the desired behaviour.
20175759b3d2Safresh1
20185759b3d2Safresh1    return $class -> _two() if $n == 0;
20195759b3d2Safresh1
2020256a93a4Safresh1    return $class -> _add(scalar($class -> _fib($n - 1)),
2021256a93a4Safresh1                          scalar($class -> _fib($n + 1)));
20225759b3d2Safresh1}
20235759b3d2Safresh1
20245759b3d2Safresh1sub _fib {
20255759b3d2Safresh1    my ($class, $n) = @_;
20265759b3d2Safresh1
20275759b3d2Safresh1    $n = $class -> _num($n) if ref $n;
20285759b3d2Safresh1
20295759b3d2Safresh1    # In list context, use fib(n) = fib(n-1) + fib(n-2)
20305759b3d2Safresh1
20315759b3d2Safresh1    if (wantarray) {
20325759b3d2Safresh1        my @y;
20335759b3d2Safresh1
20345759b3d2Safresh1        push @y, $class -> _zero();
20355759b3d2Safresh1        return @y if $n == 0;
20365759b3d2Safresh1
20375759b3d2Safresh1        push @y, $class -> _one();
20385759b3d2Safresh1        return @y if $n == 1;
20395759b3d2Safresh1
20405759b3d2Safresh1        for (my $i = 2 ; $i <= $n ; ++ $i) {
20415759b3d2Safresh1            $y[$i] = $class -> _add($class -> _copy($y[$i - 1]), $y[$i - 2]);
20425759b3d2Safresh1        }
20435759b3d2Safresh1
20445759b3d2Safresh1        return @y;
20455759b3d2Safresh1    }
20465759b3d2Safresh1
20475759b3d2Safresh1    # In scalar context use a fast algorithm that is much faster than the
20485759b3d2Safresh1    # recursive algorith used in list context.
20495759b3d2Safresh1
20505759b3d2Safresh1    my $cache = {};
20515759b3d2Safresh1    my $two = $class -> _two();
20525759b3d2Safresh1    my $fib;
20535759b3d2Safresh1
20545759b3d2Safresh1    $fib = sub {
20555759b3d2Safresh1        my $n = shift;
20565759b3d2Safresh1        return $class -> _zero() if $n <= 0;
20575759b3d2Safresh1        return $class -> _one()  if $n <= 2;
20585759b3d2Safresh1        return $cache -> {$n}    if exists $cache -> {$n};
20595759b3d2Safresh1
20605759b3d2Safresh1        my $k = int($n / 2);
20615759b3d2Safresh1        my $a = $fib -> ($k + 1);
20625759b3d2Safresh1        my $b = $fib -> ($k);
20635759b3d2Safresh1        my $y;
20645759b3d2Safresh1
20655759b3d2Safresh1        if ($n % 2 == 1) {
20665759b3d2Safresh1            # a*a + b*b
20675759b3d2Safresh1            $y = $class -> _add($class -> _mul($class -> _copy($a), $a),
20685759b3d2Safresh1                                $class -> _mul($class -> _copy($b), $b));
20695759b3d2Safresh1        } else {
20705759b3d2Safresh1            # (2*a - b)*b
20715759b3d2Safresh1            $y = $class -> _mul($class -> _sub($class -> _mul(
20725759b3d2Safresh1                   $class -> _copy($two), $a), $b), $b);
20735759b3d2Safresh1        }
20745759b3d2Safresh1
20755759b3d2Safresh1        $cache -> {$n} = $y;
20765759b3d2Safresh1        return $y;
20775759b3d2Safresh1    };
20785759b3d2Safresh1
20795759b3d2Safresh1    return $fib -> ($n);
20805759b3d2Safresh1}
20815759b3d2Safresh1
20825759b3d2Safresh1##############################################################################
20835759b3d2Safresh1##############################################################################
20845759b3d2Safresh1
20855759b3d2Safresh11;
20865759b3d2Safresh1
20875759b3d2Safresh1__END__
20885759b3d2Safresh1
20895759b3d2Safresh1=pod
20905759b3d2Safresh1
20915759b3d2Safresh1=head1 NAME
20925759b3d2Safresh1
20935759b3d2Safresh1Math::BigInt::Lib - virtual parent class for Math::BigInt libraries
20945759b3d2Safresh1
20955759b3d2Safresh1=head1 SYNOPSIS
20965759b3d2Safresh1
20975759b3d2Safresh1    # In the backend library for Math::BigInt et al.
20985759b3d2Safresh1
20995759b3d2Safresh1    package Math::BigInt::MyBackend;
21005759b3d2Safresh1
2101256a93a4Safresh1    use Math::BigInt::Lib;
2102256a93a4Safresh1    our @ISA = qw< Math::BigInt::Lib >;
21035759b3d2Safresh1
21045759b3d2Safresh1    sub _new { ... }
21055759b3d2Safresh1    sub _str { ... }
21065759b3d2Safresh1    sub _add { ... }
21075759b3d2Safresh1    str _sub { ... }
21085759b3d2Safresh1    ...
21095759b3d2Safresh1
21105759b3d2Safresh1    # In your main program.
21115759b3d2Safresh1
21125759b3d2Safresh1    use Math::BigInt lib => 'MyBackend';
21135759b3d2Safresh1
21145759b3d2Safresh1=head1 DESCRIPTION
21155759b3d2Safresh1
21165759b3d2Safresh1This module provides support for big integer calculations. It is not intended
21175759b3d2Safresh1to be used directly, but rather as a parent class for backend libraries used by
21185759b3d2Safresh1Math::BigInt, Math::BigFloat, Math::BigRat, and related modules.
21195759b3d2Safresh1
21205759b3d2Safresh1Other backend libraries include Math::BigInt::Calc, Math::BigInt::FastCalc,
21215759b3d2Safresh1Math::BigInt::GMP, and Math::BigInt::Pari.
21225759b3d2Safresh1
21235759b3d2Safresh1In order to allow for multiple big integer libraries, Math::BigInt was
21245759b3d2Safresh1rewritten to use a plug-in library for core math routines. Any module which
21255759b3d2Safresh1conforms to the API can be used by Math::BigInt by using this in your program:
21265759b3d2Safresh1
21275759b3d2Safresh1        use Math::BigInt lib => 'libname';
21285759b3d2Safresh1
21295759b3d2Safresh1'libname' is either the long name, like 'Math::BigInt::Pari', or only the short
21305759b3d2Safresh1version, like 'Pari'.
21315759b3d2Safresh1
21325759b3d2Safresh1=head2 General Notes
21335759b3d2Safresh1
21345759b3d2Safresh1A library only needs to deal with unsigned big integers. Testing of input
21355759b3d2Safresh1parameter validity is done by the caller, so there is no need to worry about
21365759b3d2Safresh1underflow (e.g., in C<_sub()> and C<_dec()>) or about division by zero (e.g.,
21375759b3d2Safresh1in C<_div()> and C<_mod()>)) or similar cases.
21385759b3d2Safresh1
21395759b3d2Safresh1Some libraries use methods that don't modify their argument, and some libraries
21405759b3d2Safresh1don't even use objects, but rather unblessed references. Because of this,
21415759b3d2Safresh1liberary methods are always called as class methods, not instance methods:
21425759b3d2Safresh1
21435759b3d2Safresh1    $x = Class -> method($x, $y);     # like this
21445759b3d2Safresh1    $x = $x -> method($y);            # not like this ...
21455759b3d2Safresh1    $x -> method($y);                 # ... or like this
21465759b3d2Safresh1
21475759b3d2Safresh1And with boolean methods
21485759b3d2Safresh1
21495759b3d2Safresh1    $bool = Class -> method($x, $y);  # like this
21505759b3d2Safresh1    $bool = $x -> method($y);         # not like this
21515759b3d2Safresh1
21525759b3d2Safresh1Return values are always objects, strings, Perl scalars, or true/false for
21535759b3d2Safresh1comparison routines.
21545759b3d2Safresh1
21555759b3d2Safresh1=head3 API version
21565759b3d2Safresh1
21575759b3d2Safresh1=over 4
21585759b3d2Safresh1
21595759b3d2Safresh1=item CLASS-E<gt>api_version()
21605759b3d2Safresh1
2161de8cc8edSafresh1This method is no longer used and can be omitted. Methods that are not
2162de8cc8edSafresh1implemented by a subclass will be inherited from this class.
21635759b3d2Safresh1
21645759b3d2Safresh1=back
21655759b3d2Safresh1
21665759b3d2Safresh1=head3 Constructors
21675759b3d2Safresh1
21685759b3d2Safresh1The following methods are mandatory: _new(), _str(), _add(), and _sub().
21695759b3d2Safresh1However, computations will be very slow without _mul() and _div().
21705759b3d2Safresh1
21715759b3d2Safresh1=over 4
21725759b3d2Safresh1
21735759b3d2Safresh1=item CLASS-E<gt>_new(STR)
21745759b3d2Safresh1
21755759b3d2Safresh1Convert a string representing an unsigned decimal number to an object
21765759b3d2Safresh1representing the same number. The input is normalized, i.e., it matches
21775759b3d2Safresh1C<^(0|[1-9]\d*)$>.
21785759b3d2Safresh1
21795759b3d2Safresh1=item CLASS-E<gt>_zero()
21805759b3d2Safresh1
21815759b3d2Safresh1Return an object representing the number zero.
21825759b3d2Safresh1
21835759b3d2Safresh1=item CLASS-E<gt>_one()
21845759b3d2Safresh1
21855759b3d2Safresh1Return an object representing the number one.
21865759b3d2Safresh1
21875759b3d2Safresh1=item CLASS-E<gt>_two()
21885759b3d2Safresh1
21895759b3d2Safresh1Return an object representing the number two.
21905759b3d2Safresh1
21915759b3d2Safresh1=item CLASS-E<gt>_ten()
21925759b3d2Safresh1
21935759b3d2Safresh1Return an object representing the number ten.
21945759b3d2Safresh1
21955759b3d2Safresh1=item CLASS-E<gt>_from_bin(STR)
21965759b3d2Safresh1
21975759b3d2Safresh1Return an object given a string representing a binary number. The input has a
21985759b3d2Safresh1'0b' prefix and matches the regular expression C<^0[bB](0|1[01]*)$>.
21995759b3d2Safresh1
22005759b3d2Safresh1=item CLASS-E<gt>_from_oct(STR)
22015759b3d2Safresh1
22025759b3d2Safresh1Return an object given a string representing an octal number. The input has a
22035759b3d2Safresh1'0' prefix and matches the regular expression C<^0[1-7]*$>.
22045759b3d2Safresh1
22055759b3d2Safresh1=item CLASS-E<gt>_from_hex(STR)
22065759b3d2Safresh1
22075759b3d2Safresh1Return an object given a string representing a hexadecimal number. The input
22085759b3d2Safresh1has a '0x' prefix and matches the regular expression
22095759b3d2Safresh1C<^0x(0|[1-9a-fA-F][\da-fA-F]*)$>.
22105759b3d2Safresh1
22115759b3d2Safresh1=item CLASS-E<gt>_from_bytes(STR)
22125759b3d2Safresh1
22135759b3d2Safresh1Returns an object given a byte string representing the number. The byte string
22145759b3d2Safresh1is in big endian byte order, so the two-byte input string "\x01\x00" should
22155759b3d2Safresh1give an output value representing the number 256.
22165759b3d2Safresh1
2217f3efcd01Safresh1=item CLASS-E<gt>_from_base(STR, BASE, COLLSEQ)
2218f3efcd01Safresh1
2219f3efcd01Safresh1Returns an object given a string STR, a base BASE, and a collation sequence
2220f3efcd01Safresh1COLLSEQ. Each character in STR represents a numerical value identical to the
2221f3efcd01Safresh1character's position in COLLSEQ. All characters in STR must be present in
2222f3efcd01Safresh1COLLSEQ.
2223f3efcd01Safresh1
2224de8cc8edSafresh1If BASE is less than or equal to 94, and a collation sequence is not specified,
2225de8cc8edSafresh1the following default collation sequence is used. It contains of all the 94
2226de8cc8edSafresh1printable ASCII characters except space/blank:
2227de8cc8edSafresh1
2228de8cc8edSafresh1    0123456789                  # ASCII  48 to  57
2229de8cc8edSafresh1    ABCDEFGHIJKLMNOPQRSTUVWXYZ  # ASCII  65 to  90
2230de8cc8edSafresh1    abcdefghijklmnopqrstuvwxyz  # ASCII  97 to 122
2231de8cc8edSafresh1    !"#$%&'()*+,-./             # ASCII  33 to  47
2232de8cc8edSafresh1    :;<=>?@                     # ASCII  58 to  64
2233de8cc8edSafresh1    [\]^_`                      # ASCII  91 to  96
2234de8cc8edSafresh1    {|}~                        # ASCII 123 to 126
2235de8cc8edSafresh1
2236de8cc8edSafresh1If the default collation sequence is used, and the BASE is less than or equal
2237de8cc8edSafresh1to 36, the letter case in STR is ignored.
2238f3efcd01Safresh1
2239f3efcd01Safresh1For instance, with base 3 and collation sequence "-/|", the character "-"
2240f3efcd01Safresh1represents 0, "/" represents 1, and "|" represents 2. So if STR is "/|-", the
2241f3efcd01Safresh1output is 1 * 3**2 + 2 * 3**1 + 0 * 3**0 = 15.
2242f3efcd01Safresh1
2243f3efcd01Safresh1The following examples show standard binary, octal, decimal, and hexadecimal
2244f3efcd01Safresh1conversion. All examples return 250.
2245f3efcd01Safresh1
2246f3efcd01Safresh1    $x = $class -> _from_base("11111010", 2)
2247f3efcd01Safresh1    $x = $class -> _from_base("372", 8)
2248f3efcd01Safresh1    $x = $class -> _from_base("250", 10)
2249f3efcd01Safresh1    $x = $class -> _from_base("FA", 16)
2250f3efcd01Safresh1
2251f3efcd01Safresh1Some more examples, all returning 250:
2252f3efcd01Safresh1
2253de8cc8edSafresh1    $x = $class -> _from_base("100021", 3)
2254de8cc8edSafresh1    $x = $class -> _from_base("3322", 4)
2255de8cc8edSafresh1    $x = $class -> _from_base("2000", 5)
2256f3efcd01Safresh1    $x = $class -> _from_base("caaa", 5, "abcde")
2257de8cc8edSafresh1    $x = $class -> _from_base("42", 62)
2258de8cc8edSafresh1    $x = $class -> _from_base("2!", 94)
2259f3efcd01Safresh1
2260256a93a4Safresh1=item CLASS-E<gt>_from_base_num(ARRAY, BASE)
2261256a93a4Safresh1
2262256a93a4Safresh1Returns an object given an array of values and a base. This method is
2263256a93a4Safresh1equivalent to C<_from_base()>, but works on numbers in an array rather than
2264256a93a4Safresh1characters in a string. Unlike C<_from_base()>, all input values may be
2265256a93a4Safresh1arbitrarily large.
2266256a93a4Safresh1
2267256a93a4Safresh1    $x = $class -> _from_base_num([1, 1, 0, 1], 2)    # $x is 13
2268256a93a4Safresh1    $x = $class -> _from_base_num([3, 125, 39], 128)  # $x is 65191
2269256a93a4Safresh1
22705759b3d2Safresh1=back
22715759b3d2Safresh1
22725759b3d2Safresh1=head3 Mathematical functions
22735759b3d2Safresh1
22745759b3d2Safresh1=over 4
22755759b3d2Safresh1
22765759b3d2Safresh1=item CLASS-E<gt>_add(OBJ1, OBJ2)
22775759b3d2Safresh1
2278256a93a4Safresh1Addition. Returns the result of adding OBJ2 to OBJ1.
22795759b3d2Safresh1
22805759b3d2Safresh1=item CLASS-E<gt>_mul(OBJ1, OBJ2)
22815759b3d2Safresh1
2282256a93a4Safresh1Multiplication. Returns the result of multiplying OBJ2 and OBJ1.
22835759b3d2Safresh1
22845759b3d2Safresh1=item CLASS-E<gt>_div(OBJ1, OBJ2)
22855759b3d2Safresh1
2286256a93a4Safresh1Division. In scalar context, returns the quotient after dividing OBJ1 by OBJ2
2287256a93a4Safresh1and truncating the result to an integer. In list context, return the quotient
2288256a93a4Safresh1and the remainder.
22895759b3d2Safresh1
22905759b3d2Safresh1=item CLASS-E<gt>_sub(OBJ1, OBJ2, FLAG)
22915759b3d2Safresh1
22925759b3d2Safresh1=item CLASS-E<gt>_sub(OBJ1, OBJ2)
22935759b3d2Safresh1
2294256a93a4Safresh1Subtraction. Returns the result of subtracting OBJ2 by OBJ1. If C<flag> is false
2295256a93a4Safresh1or omitted, OBJ1 might be modified. If C<flag> is true, OBJ2 might be modified.
2296256a93a4Safresh1
2297256a93a4Safresh1=item CLASS-E<gt>_sadd(OBJ1, SIGN1, OBJ2, SIGN2)
2298256a93a4Safresh1
2299256a93a4Safresh1Signed addition. Returns the result of adding OBJ2 with sign SIGN2 to OBJ1 with
2300256a93a4Safresh1sign SIGN1.
2301256a93a4Safresh1
2302256a93a4Safresh1    ($obj3, $sign3) = $class -> _sadd($obj1, $sign1, $obj2, $sign2);
2303256a93a4Safresh1
2304256a93a4Safresh1=item CLASS-E<gt>_ssub(OBJ1, SIGN1, OBJ2, SIGN2)
2305256a93a4Safresh1
2306256a93a4Safresh1Signed subtraction. Returns the result of subtracting OBJ2 with sign SIGN2 to
2307256a93a4Safresh1OBJ1 with sign SIGN1.
2308256a93a4Safresh1
2309256a93a4Safresh1    ($obj3, $sign3) = $class -> _sadd($obj1, $sign1, $obj2, $sign2);
23105759b3d2Safresh1
23115759b3d2Safresh1=item CLASS-E<gt>_dec(OBJ)
23125759b3d2Safresh1
23135759b3d2Safresh1Returns the result after decrementing OBJ by one.
23145759b3d2Safresh1
23155759b3d2Safresh1=item CLASS-E<gt>_inc(OBJ)
23165759b3d2Safresh1
23175759b3d2Safresh1Returns the result after incrementing OBJ by one.
23185759b3d2Safresh1
23195759b3d2Safresh1=item CLASS-E<gt>_mod(OBJ1, OBJ2)
23205759b3d2Safresh1
23215759b3d2Safresh1Returns OBJ1 modulo OBJ2, i.e., the remainder after dividing OBJ1 by OBJ2.
23225759b3d2Safresh1
23235759b3d2Safresh1=item CLASS-E<gt>_sqrt(OBJ)
23245759b3d2Safresh1
23255759b3d2Safresh1Returns the square root of OBJ, truncated to an integer.
23265759b3d2Safresh1
23275759b3d2Safresh1=item CLASS-E<gt>_root(OBJ, N)
23285759b3d2Safresh1
23295759b3d2Safresh1Returns the Nth root of OBJ, truncated to an integer.
23305759b3d2Safresh1
23315759b3d2Safresh1=item CLASS-E<gt>_fac(OBJ)
23325759b3d2Safresh1
23335759b3d2Safresh1Returns the factorial of OBJ, i.e., the product of all positive integers up to
23345759b3d2Safresh1and including OBJ.
23355759b3d2Safresh1
23365759b3d2Safresh1=item CLASS-E<gt>_dfac(OBJ)
23375759b3d2Safresh1
23385759b3d2Safresh1Returns the double factorial of OBJ. If OBJ is an even integer, returns the
23395759b3d2Safresh1product of all positive, even integers up to and including OBJ, i.e.,
23405759b3d2Safresh12*4*6*...*OBJ. If OBJ is an odd integer, returns the product of all positive,
23415759b3d2Safresh1odd integers, i.e., 1*3*5*...*OBJ.
23425759b3d2Safresh1
23435759b3d2Safresh1=item CLASS-E<gt>_pow(OBJ1, OBJ2)
23445759b3d2Safresh1
23455759b3d2Safresh1Returns OBJ1 raised to the power of OBJ2. By convention, 0**0 = 1.
23465759b3d2Safresh1
23475759b3d2Safresh1=item CLASS-E<gt>_modinv(OBJ1, OBJ2)
23485759b3d2Safresh1
23495759b3d2Safresh1Returns the modular multiplicative inverse, i.e., return OBJ3 so that
23505759b3d2Safresh1
23515759b3d2Safresh1    (OBJ3 * OBJ1) % OBJ2 = 1 % OBJ2
23525759b3d2Safresh1
23535759b3d2Safresh1The result is returned as two arguments. If the modular multiplicative inverse
23545759b3d2Safresh1does not exist, both arguments are undefined. Otherwise, the arguments are a
23555759b3d2Safresh1number (object) and its sign ("+" or "-").
23565759b3d2Safresh1
23575759b3d2Safresh1The output value, with its sign, must either be a positive value in the range
23585759b3d2Safresh11,2,...,OBJ2-1 or the same value subtracted OBJ2. For instance, if the input
23595759b3d2Safresh1arguments are objects representing the numbers 7 and 5, the method must either
23605759b3d2Safresh1return an object representing the number 3 and a "+" sign, since (3*7) % 5 = 1
23615759b3d2Safresh1% 5, or an object representing the number 2 and a "-" sign, since (-2*7) % 5 = 1
23625759b3d2Safresh1% 5.
23635759b3d2Safresh1
23645759b3d2Safresh1=item CLASS-E<gt>_modpow(OBJ1, OBJ2, OBJ3)
23655759b3d2Safresh1
23665759b3d2Safresh1Returns the modular exponentiation, i.e., (OBJ1 ** OBJ2) % OBJ3.
23675759b3d2Safresh1
23685759b3d2Safresh1=item CLASS-E<gt>_rsft(OBJ, N, B)
23695759b3d2Safresh1
23705759b3d2Safresh1Returns the result after shifting OBJ N digits to thee right in base B. This is
23715759b3d2Safresh1equivalent to performing integer division by B**N and discarding the remainder,
23725759b3d2Safresh1except that it might be much faster.
23735759b3d2Safresh1
23745759b3d2Safresh1For instance, if the object $obj represents the hexadecimal number 0xabcde,
23755759b3d2Safresh1then C<_rsft($obj, 2, 16)> returns an object representing the number 0xabc. The
23765759b3d2Safresh1"remainer", 0xde, is discarded and not returned.
23775759b3d2Safresh1
23785759b3d2Safresh1=item CLASS-E<gt>_lsft(OBJ, N, B)
23795759b3d2Safresh1
23805759b3d2Safresh1Returns the result after shifting OBJ N digits to the left in base B. This is
23815759b3d2Safresh1equivalent to multiplying by B**N, except that it might be much faster.
23825759b3d2Safresh1
23835759b3d2Safresh1=item CLASS-E<gt>_log_int(OBJ, B)
23845759b3d2Safresh1
23855759b3d2Safresh1Returns the logarithm of OBJ to base BASE truncted to an integer. This method
23865759b3d2Safresh1has two output arguments, the OBJECT and a STATUS. The STATUS is Perl scalar;
23875759b3d2Safresh1it is 1 if OBJ is the exact result, 0 if the result was truncted to give OBJ,
23885759b3d2Safresh1and undef if it is unknown whether OBJ is the exact result.
23895759b3d2Safresh1
2390*5486feefSafresh1=item CLASS-E<gt>_ilog2(OBJ)
2391*5486feefSafresh1
2392*5486feefSafresh1Returns the base 2 logarithm of OBJ rounded downwards to the nearest integer,
2393*5486feefSafresh1i.e., C<int(log2(OBJ))>. In list context, this method returns two output
2394*5486feefSafresh1arguments, the OBJECT and a STATUS. The STATUS is Perl scalar; it is 1 if OBJ
2395*5486feefSafresh1is the exact result, 0 if the result was truncted to give OBJ, and undef if it
2396*5486feefSafresh1is unknown whether OBJ is the exact result.
2397*5486feefSafresh1
2398*5486feefSafresh1This method is equivalent to the more general method _log_int() when it is used
2399*5486feefSafresh1with base 2 argument, but _ilog2() method might be faster.
2400*5486feefSafresh1
2401*5486feefSafresh1=item CLASS-E<gt>_ilog10(OBJ)
2402*5486feefSafresh1
2403*5486feefSafresh1Returns the base 10 logarithm of OBJ rounded downwards to the nearest integer,
2404*5486feefSafresh1i.e., C<int(log2(OBJ))>. In list context, this method returns two output
2405*5486feefSafresh1arguments, the OBJECT and a STATUS. The STATUS is Perl scalar; it is 1 if OBJ
2406*5486feefSafresh1is the exact result, 0 if the result was truncted to give OBJ, and undef if it
2407*5486feefSafresh1is unknown whether OBJ is the exact result.
2408*5486feefSafresh1
2409*5486feefSafresh1This method is equivalent to the more general method _log_int() when it is used
2410*5486feefSafresh1with base 10 argument, but _ilog10() method might be faster.
2411*5486feefSafresh1
2412*5486feefSafresh1Also, the output from _ilog10() is always 1 smaller than the output from
2413*5486feefSafresh1_len().
2414*5486feefSafresh1
2415*5486feefSafresh1=item CLASS-E<gt>_clog2(OBJ)
2416*5486feefSafresh1
2417*5486feefSafresh1Returns the base 2 logarithm of OBJ rounded upwards to the nearest integer,
2418*5486feefSafresh1i.e., C<ceil(log2(OBJ))>. In list context, this method returns two output
2419*5486feefSafresh1arguments, the OBJECT and a STATUS. The STATUS is Perl scalar; it is 1 if OBJ
2420*5486feefSafresh1is the exact result, 0 if the result was truncted to give OBJ, and undef if it
2421*5486feefSafresh1is unknown whether OBJ is the exact result.
2422*5486feefSafresh1
2423*5486feefSafresh1=item CLASS-E<gt>_clog10(OBJ)
2424*5486feefSafresh1
2425*5486feefSafresh1Returns the base 10 logarithm of OBJ rounded upnwards to the nearest integer,
2426*5486feefSafresh1i.e., C<ceil(log2(OBJ))>. In list context, this method returns two output
2427*5486feefSafresh1arguments, the OBJECT and a STATUS. The STATUS is Perl scalar; it is 1 if OBJ
2428*5486feefSafresh1is the exact result, 0 if the result was truncted to give OBJ, and undef if it
2429*5486feefSafresh1is unknown whether OBJ is the exact result.
2430*5486feefSafresh1
24315759b3d2Safresh1=item CLASS-E<gt>_gcd(OBJ1, OBJ2)
24325759b3d2Safresh1
24335759b3d2Safresh1Returns the greatest common divisor of OBJ1 and OBJ2.
24345759b3d2Safresh1
24355759b3d2Safresh1=item CLASS-E<gt>_lcm(OBJ1, OBJ2)
24365759b3d2Safresh1
24375759b3d2Safresh1Return the least common multiple of OBJ1 and OBJ2.
24385759b3d2Safresh1
24395759b3d2Safresh1=item CLASS-E<gt>_fib(OBJ)
24405759b3d2Safresh1
24415759b3d2Safresh1In scalar context, returns the nth Fibonacci number: _fib(0) returns 0, _fib(1)
24425759b3d2Safresh1returns 1, _fib(2) returns 1, _fib(3) returns 2 etc. In list context, returns
24435759b3d2Safresh1the Fibonacci numbers from F(0) to F(n): 0, 1, 1, 2, 3, 5, 8, 13, 21, 34, ...
24445759b3d2Safresh1
24455759b3d2Safresh1=item CLASS-E<gt>_lucas(OBJ)
24465759b3d2Safresh1
24475759b3d2Safresh1In scalar context, returns the nth Lucas number: _lucas(0) returns 2, _lucas(1)
24485759b3d2Safresh1returns 1, _lucas(2) returns 3, etc. In list context, returns the Lucas numbers
24495759b3d2Safresh1from L(0) to L(n): 2, 1, 3, 4, 7, 11, 18, 29,47, 76, ...
24505759b3d2Safresh1
24515759b3d2Safresh1=back
24525759b3d2Safresh1
24535759b3d2Safresh1=head3 Bitwise operators
24545759b3d2Safresh1
24555759b3d2Safresh1=over 4
24565759b3d2Safresh1
24575759b3d2Safresh1=item CLASS-E<gt>_and(OBJ1, OBJ2)
24585759b3d2Safresh1
24595759b3d2Safresh1Returns bitwise and.
24605759b3d2Safresh1
24615759b3d2Safresh1=item CLASS-E<gt>_or(OBJ1, OBJ2)
24625759b3d2Safresh1
2463f3efcd01Safresh1Returns bitwise or.
24645759b3d2Safresh1
24655759b3d2Safresh1=item CLASS-E<gt>_xor(OBJ1, OBJ2)
24665759b3d2Safresh1
2467f3efcd01Safresh1Returns bitwise exclusive or.
2468f3efcd01Safresh1
2469f3efcd01Safresh1=item CLASS-E<gt>_sand(OBJ1, OBJ2, SIGN1, SIGN2)
2470f3efcd01Safresh1
2471f3efcd01Safresh1Returns bitwise signed and.
2472f3efcd01Safresh1
2473f3efcd01Safresh1=item CLASS-E<gt>_sor(OBJ1, OBJ2, SIGN1, SIGN2)
2474f3efcd01Safresh1
2475f3efcd01Safresh1Returns bitwise signed or.
2476f3efcd01Safresh1
2477f3efcd01Safresh1=item CLASS-E<gt>_sxor(OBJ1, OBJ2, SIGN1, SIGN2)
2478f3efcd01Safresh1
2479f3efcd01Safresh1Returns bitwise signed exclusive or.
24805759b3d2Safresh1
24815759b3d2Safresh1=back
24825759b3d2Safresh1
24835759b3d2Safresh1=head3 Boolean operators
24845759b3d2Safresh1
24855759b3d2Safresh1=over 4
24865759b3d2Safresh1
24875759b3d2Safresh1=item CLASS-E<gt>_is_zero(OBJ)
24885759b3d2Safresh1
24895759b3d2Safresh1Returns a true value if OBJ is zero, and false value otherwise.
24905759b3d2Safresh1
24915759b3d2Safresh1=item CLASS-E<gt>_is_one(OBJ)
24925759b3d2Safresh1
24935759b3d2Safresh1Returns a true value if OBJ is one, and false value otherwise.
24945759b3d2Safresh1
24955759b3d2Safresh1=item CLASS-E<gt>_is_two(OBJ)
24965759b3d2Safresh1
24975759b3d2Safresh1Returns a true value if OBJ is two, and false value otherwise.
24985759b3d2Safresh1
24995759b3d2Safresh1=item CLASS-E<gt>_is_ten(OBJ)
25005759b3d2Safresh1
25015759b3d2Safresh1Returns a true value if OBJ is ten, and false value otherwise.
25025759b3d2Safresh1
25035759b3d2Safresh1=item CLASS-E<gt>_is_even(OBJ)
25045759b3d2Safresh1
25055759b3d2Safresh1Return a true value if OBJ is an even integer, and a false value otherwise.
25065759b3d2Safresh1
25075759b3d2Safresh1=item CLASS-E<gt>_is_odd(OBJ)
25085759b3d2Safresh1
25095759b3d2Safresh1Return a true value if OBJ is an even integer, and a false value otherwise.
25105759b3d2Safresh1
25115759b3d2Safresh1=item CLASS-E<gt>_acmp(OBJ1, OBJ2)
25125759b3d2Safresh1
25135759b3d2Safresh1Compare OBJ1 and OBJ2 and return -1, 0, or 1, if OBJ1 is numerically less than,
25145759b3d2Safresh1equal to, or larger than OBJ2, respectively.
25155759b3d2Safresh1
25165759b3d2Safresh1=back
25175759b3d2Safresh1
25185759b3d2Safresh1=head3 String conversion
25195759b3d2Safresh1
25205759b3d2Safresh1=over 4
25215759b3d2Safresh1
25225759b3d2Safresh1=item CLASS-E<gt>_str(OBJ)
25235759b3d2Safresh1
25245759b3d2Safresh1Returns a string representing OBJ in decimal notation. The returned string
25255759b3d2Safresh1should have no leading zeros, i.e., it should match C<^(0|[1-9]\d*)$>.
25265759b3d2Safresh1
25275759b3d2Safresh1=item CLASS-E<gt>_to_bin(OBJ)
25285759b3d2Safresh1
25295759b3d2Safresh1Returns the binary string representation of OBJ.
25305759b3d2Safresh1
25315759b3d2Safresh1=item CLASS-E<gt>_to_oct(OBJ)
25325759b3d2Safresh1
25335759b3d2Safresh1Returns the octal string representation of the number.
25345759b3d2Safresh1
25355759b3d2Safresh1=item CLASS-E<gt>_to_hex(OBJ)
25365759b3d2Safresh1
25375759b3d2Safresh1Returns the hexadecimal string representation of the number.
25385759b3d2Safresh1
25395759b3d2Safresh1=item CLASS-E<gt>_to_bytes(OBJ)
25405759b3d2Safresh1
25415759b3d2Safresh1Returns a byte string representation of OBJ. The byte string is in big endian
25425759b3d2Safresh1byte order, so if OBJ represents the number 256, the output should be the
25435759b3d2Safresh1two-byte string "\x01\x00".
25445759b3d2Safresh1
2545f3efcd01Safresh1=item CLASS-E<gt>_to_base(OBJ, BASE, COLLSEQ)
2546f3efcd01Safresh1
2547f3efcd01Safresh1Returns a string representation of OBJ in base BASE with collation sequence
2548f3efcd01Safresh1COLLSEQ.
2549f3efcd01Safresh1
2550f3efcd01Safresh1    $val = $class -> _new("210");
2551f3efcd01Safresh1    $str = $class -> _to_base($val, 10, "xyz")  # $str is "zyx"
2552f3efcd01Safresh1
2553f3efcd01Safresh1    $val = $class -> _new("32");
2554f3efcd01Safresh1    $str = $class -> _to_base($val, 2, "-|")  # $str is "|-----"
2555f3efcd01Safresh1
2556f3efcd01Safresh1See _from_base() for more information.
2557f3efcd01Safresh1
2558256a93a4Safresh1=item CLASS-E<gt>_to_base_num(OBJ, BASE)
2559256a93a4Safresh1
2560256a93a4Safresh1Converts the given number to the given base. This method is equivalent to
2561256a93a4Safresh1C<_to_base()>, but returns numbers in an array rather than characters in a
2562256a93a4Safresh1string. In the output, the first element is the most significant. Unlike
2563256a93a4Safresh1C<_to_base()>, all input values may be arbitrarily large.
2564256a93a4Safresh1
2565256a93a4Safresh1    $x = $class -> _to_base_num(13, 2)        # $x is [1, 1, 0, 1]
2566256a93a4Safresh1    $x = $class -> _to_base_num(65191, 128)   # $x is [3, 125, 39]
2567256a93a4Safresh1
25685759b3d2Safresh1=item CLASS-E<gt>_as_bin(OBJ)
25695759b3d2Safresh1
25705759b3d2Safresh1Like C<_to_bin()> but with a '0b' prefix.
25715759b3d2Safresh1
25725759b3d2Safresh1=item CLASS-E<gt>_as_oct(OBJ)
25735759b3d2Safresh1
25745759b3d2Safresh1Like C<_to_oct()> but with a '0' prefix.
25755759b3d2Safresh1
25765759b3d2Safresh1=item CLASS-E<gt>_as_hex(OBJ)
25775759b3d2Safresh1
25785759b3d2Safresh1Like C<_to_hex()> but with a '0x' prefix.
25795759b3d2Safresh1
25805759b3d2Safresh1=item CLASS-E<gt>_as_bytes(OBJ)
25815759b3d2Safresh1
25825759b3d2Safresh1This is an alias to C<_to_bytes()>.
25835759b3d2Safresh1
25845759b3d2Safresh1=back
25855759b3d2Safresh1
25865759b3d2Safresh1=head3 Numeric conversion
25875759b3d2Safresh1
25885759b3d2Safresh1=over 4
25895759b3d2Safresh1
25905759b3d2Safresh1=item CLASS-E<gt>_num(OBJ)
25915759b3d2Safresh1
25925759b3d2Safresh1Returns a Perl scalar number representing the number OBJ as close as
25935759b3d2Safresh1possible. Since Perl scalars have limited precision, the returned value might
25945759b3d2Safresh1not be exactly the same as OBJ.
25955759b3d2Safresh1
25965759b3d2Safresh1=back
25975759b3d2Safresh1
25985759b3d2Safresh1=head3 Miscellaneous
25995759b3d2Safresh1
26005759b3d2Safresh1=over 4
26015759b3d2Safresh1
26025759b3d2Safresh1=item CLASS-E<gt>_copy(OBJ)
26035759b3d2Safresh1
26045759b3d2Safresh1Returns a true copy OBJ.
26055759b3d2Safresh1
26065759b3d2Safresh1=item CLASS-E<gt>_len(OBJ)
26075759b3d2Safresh1
26085759b3d2Safresh1Returns the number of the decimal digits in OBJ. The output is a Perl scalar.
26095759b3d2Safresh1
26105759b3d2Safresh1=item CLASS-E<gt>_zeros(OBJ)
26115759b3d2Safresh1
26125759b3d2Safresh1Returns the number of trailing decimal zeros. The output is a Perl scalar. The
26135759b3d2Safresh1number zero has no trailing decimal zeros.
26145759b3d2Safresh1
26155759b3d2Safresh1=item CLASS-E<gt>_digit(OBJ, N)
26165759b3d2Safresh1
26175759b3d2Safresh1Returns the Nth digit in OBJ as a Perl scalar. N is a Perl scalar, where zero
26185759b3d2Safresh1refers to the rightmost (least significant) digit, and negative values count
26195759b3d2Safresh1from the left (most significant digit). If $obj represents the number 123, then
26205759b3d2Safresh1
26215759b3d2Safresh1    CLASS->_digit($obj,  0)     # returns 3
26225759b3d2Safresh1    CLASS->_digit($obj,  1)     # returns 2
26235759b3d2Safresh1    CLASS->_digit($obj,  2)     # returns 1
26245759b3d2Safresh1    CLASS->_digit($obj, -1)     # returns 1
26255759b3d2Safresh1
2626de8cc8edSafresh1=item CLASS-E<gt>_digitsum(OBJ)
2627de8cc8edSafresh1
2628de8cc8edSafresh1Returns the sum of the base 10 digits.
2629de8cc8edSafresh1
26305759b3d2Safresh1=item CLASS-E<gt>_check(OBJ)
26315759b3d2Safresh1
26325759b3d2Safresh1Returns true if the object is invalid and false otherwise. Preferably, the true
26335759b3d2Safresh1value is a string describing the problem with the object. This is a check
26345759b3d2Safresh1routine to test the internal state of the object for corruption.
26355759b3d2Safresh1
26365759b3d2Safresh1=item CLASS-E<gt>_set(OBJ)
26375759b3d2Safresh1
26385759b3d2Safresh1xxx
26395759b3d2Safresh1
26405759b3d2Safresh1=back
26415759b3d2Safresh1
26425759b3d2Safresh1=head2 API version 2
26435759b3d2Safresh1
26445759b3d2Safresh1The following methods are required for an API version of 2 or greater.
26455759b3d2Safresh1
26465759b3d2Safresh1=head3 Constructors
26475759b3d2Safresh1
26485759b3d2Safresh1=over 4
26495759b3d2Safresh1
26505759b3d2Safresh1=item CLASS-E<gt>_1ex(N)
26515759b3d2Safresh1
26525759b3d2Safresh1Return an object representing the number 10**N where N E<gt>= 0 is a Perl
26535759b3d2Safresh1scalar.
26545759b3d2Safresh1
26555759b3d2Safresh1=back
26565759b3d2Safresh1
26575759b3d2Safresh1=head3 Mathematical functions
26585759b3d2Safresh1
26595759b3d2Safresh1=over 4
26605759b3d2Safresh1
26615759b3d2Safresh1=item CLASS-E<gt>_nok(OBJ1, OBJ2)
26625759b3d2Safresh1
26635759b3d2Safresh1Return the binomial coefficient OBJ1 over OBJ1.
26645759b3d2Safresh1
26655759b3d2Safresh1=back
26665759b3d2Safresh1
26675759b3d2Safresh1=head3 Miscellaneous
26685759b3d2Safresh1
26695759b3d2Safresh1=over 4
26705759b3d2Safresh1
26715759b3d2Safresh1=item CLASS-E<gt>_alen(OBJ)
26725759b3d2Safresh1
26735759b3d2Safresh1Return the approximate number of decimal digits of the object. The output is a
26745759b3d2Safresh1Perl scalar.
26755759b3d2Safresh1
26765759b3d2Safresh1=back
26775759b3d2Safresh1
26785759b3d2Safresh1=head1 WRAP YOUR OWN
26795759b3d2Safresh1
26805759b3d2Safresh1If you want to port your own favourite C library for big numbers to the
26815759b3d2Safresh1Math::BigInt interface, you can take any of the already existing modules as a
26825759b3d2Safresh1rough guideline. You should really wrap up the latest Math::BigInt and
26835759b3d2Safresh1Math::BigFloat testsuites with your module, and replace in them any of the
26845759b3d2Safresh1following:
26855759b3d2Safresh1
26865759b3d2Safresh1        use Math::BigInt;
26875759b3d2Safresh1
26885759b3d2Safresh1by this:
26895759b3d2Safresh1
26905759b3d2Safresh1        use Math::BigInt lib => 'yourlib';
26915759b3d2Safresh1
26925759b3d2Safresh1This way you ensure that your library really works 100% within Math::BigInt.
26935759b3d2Safresh1
26945759b3d2Safresh1=head1 BUGS
26955759b3d2Safresh1
26965759b3d2Safresh1Please report any bugs or feature requests to
26975759b3d2Safresh1C<bug-math-bigint at rt.cpan.org>, or through the web interface at
26985759b3d2Safresh1L<https://rt.cpan.org/Ticket/Create.html?Queue=Math-BigInt>
26995759b3d2Safresh1(requires login).
27005759b3d2Safresh1We will be notified, and then you'll automatically be notified of progress on
27015759b3d2Safresh1your bug as I make changes.
27025759b3d2Safresh1
27035759b3d2Safresh1=head1 SUPPORT
27045759b3d2Safresh1
27055759b3d2Safresh1You can find documentation for this module with the perldoc command.
27065759b3d2Safresh1
27075759b3d2Safresh1    perldoc Math::BigInt::Calc
27085759b3d2Safresh1
27095759b3d2Safresh1You can also look for information at:
27105759b3d2Safresh1
27115759b3d2Safresh1=over 4
27125759b3d2Safresh1
2713*5486feefSafresh1=item * GitHub Source Repository
2714*5486feefSafresh1
2715*5486feefSafresh1L<https://github.com/pjacklam/p5-Math-BigInt>
2716*5486feefSafresh1
27175759b3d2Safresh1=item * RT: CPAN's request tracker
27185759b3d2Safresh1
27195759b3d2Safresh1L<https://rt.cpan.org/Public/Dist/Display.html?Name=Math-BigInt>
27205759b3d2Safresh1
2721de8cc8edSafresh1=item * MetaCPAN
27225759b3d2Safresh1
2723de8cc8edSafresh1L<https://metacpan.org/release/Math-BigInt>
27245759b3d2Safresh1
27255759b3d2Safresh1=item * CPAN Testers Matrix
27265759b3d2Safresh1
27275759b3d2Safresh1L<http://matrix.cpantesters.org/?dist=Math-BigInt>
27285759b3d2Safresh1
27295759b3d2Safresh1=back
27305759b3d2Safresh1
27315759b3d2Safresh1=head1 LICENSE
27325759b3d2Safresh1
27335759b3d2Safresh1This program is free software; you may redistribute it and/or modify it under
27345759b3d2Safresh1the same terms as Perl itself.
27355759b3d2Safresh1
27365759b3d2Safresh1=head1 AUTHOR
27375759b3d2Safresh1
2738256a93a4Safresh1Peter John Acklam, E<lt>pjacklam@gmail.comE<gt>
27395759b3d2Safresh1
27405759b3d2Safresh1Code and documentation based on the Math::BigInt::Calc module by Tels
27415759b3d2Safresh1E<lt>nospam-abuse@bloodgate.comE<gt>
27425759b3d2Safresh1
27435759b3d2Safresh1=head1 SEE ALSO
27445759b3d2Safresh1
27455759b3d2Safresh1L<Math::BigInt>, L<Math::BigInt::Calc>, L<Math::BigInt::GMP>,
27465759b3d2Safresh1L<Math::BigInt::FastCalc> and L<Math::BigInt::Pari>.
27475759b3d2Safresh1
27485759b3d2Safresh1=cut
2749