our
$VERSION
=
'0.075_003'
;
sub
CLONE_SKIP { 1 }
sub
api_version() { 2 }
sub
import
{ }
'+'
=>
sub
{
my
$class
=
ref
$_
[0];
my
$x
=
$class
-> _copy(
$_
[0]);
my
$y
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
return
$class
-> _add(
$x
,
$y
);
},
'-'
=>
sub
{
my
$class
=
ref
$_
[0];
my
(
$x
,
$y
);
if
(
$_
[2]) {
$y
=
$_
[0];
$x
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
}
else
{
$x
=
$class
-> _copy(
$_
[0]);
$y
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
}
return
$class
-> _sub(
$x
,
$y
);
},
'*'
=>
sub
{
my
$class
=
ref
$_
[0];
my
$x
=
$class
-> _copy(
$_
[0]);
my
$y
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
return
$class
-> _mul(
$x
,
$y
);
},
'/'
=>
sub
{
my
$class
=
ref
$_
[0];
my
(
$x
,
$y
);
if
(
$_
[2]) {
$y
=
$_
[0];
$x
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
}
else
{
$x
=
$class
-> _copy(
$_
[0]);
$y
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
}
return
$class
-> _div(
$x
,
$y
);
},
'%'
=>
sub
{
my
$class
=
ref
$_
[0];
my
(
$x
,
$y
);
if
(
$_
[2]) {
$y
=
$_
[0];
$x
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
}
else
{
$x
=
$class
-> _copy(
$_
[0]);
$y
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
}
return
$class
-> _mod(
$x
,
$y
);
},
'**'
=>
sub
{
my
$class
=
ref
$_
[0];
my
(
$x
,
$y
);
if
(
$_
[2]) {
$y
=
$_
[0];
$x
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
}
else
{
$x
=
$class
-> _copy(
$_
[0]);
$y
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
}
return
$class
-> _pow(
$x
,
$y
);
},
'<<'
=>
sub
{
my
$class
=
ref
$_
[0];
my
(
$x
,
$y
);
if
(
$_
[2]) {
$y
=
$class
-> _num(
$_
[0]);
$x
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
}
else
{
$x
=
$_
[0];
$y
=
ref
(
$_
[1]) ?
$class
-> _num(
$_
[1]) :
$_
[1];
}
return
$class
-> _blsft(
$x
,
$y
);
},
'>>'
=>
sub
{
my
$class
=
ref
$_
[0];
my
(
$x
,
$y
);
if
(
$_
[2]) {
$y
=
$_
[0];
$x
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
}
else
{
$x
=
$class
-> _copy(
$_
[0]);
$y
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
}
return
$class
-> _brsft(
$x
,
$y
);
},
'<'
=>
sub
{
my
$class
=
ref
$_
[0];
my
(
$x
,
$y
);
if
(
$_
[2]) {
$y
=
$_
[0];
$x
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
}
else
{
$x
=
$class
-> _copy(
$_
[0]);
$y
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
}
return
$class
-> _acmp(
$x
,
$y
) < 0;
},
'<='
=>
sub
{
my
$class
=
ref
$_
[0];
my
(
$x
,
$y
);
if
(
$_
[2]) {
$y
=
$_
[0];
$x
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
}
else
{
$x
=
$class
-> _copy(
$_
[0]);
$y
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
}
return
$class
-> _acmp(
$x
,
$y
) <= 0;
},
'>'
=>
sub
{
my
$class
=
ref
$_
[0];
my
(
$x
,
$y
);
if
(
$_
[2]) {
$y
=
$_
[0];
$x
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
}
else
{
$x
=
$class
-> _copy(
$_
[0]);
$y
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
}
return
$class
-> _acmp(
$x
,
$y
) > 0;
},
'>='
=>
sub
{
my
$class
=
ref
$_
[0];
my
(
$x
,
$y
);
if
(
$_
[2]) {
$y
=
$_
[0];
$x
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
}
else
{
$x
=
$class
-> _copy(
$_
[0]);
$y
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
}
return
$class
-> _acmp(
$x
,
$y
) >= 0;
},
'=='
=>
sub
{
my
$class
=
ref
$_
[0];
my
$x
=
$class
-> _copy(
$_
[0]);
my
$y
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
return
$class
-> _acmp(
$x
,
$y
) == 0;
},
'!='
=>
sub
{
my
$class
=
ref
$_
[0];
my
$x
=
$class
-> _copy(
$_
[0]);
my
$y
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
return
$class
-> _acmp(
$x
,
$y
) != 0;
},
'<=>'
=>
sub
{
my
$class
=
ref
$_
[0];
my
(
$x
,
$y
);
if
(
$_
[2]) {
$y
=
$_
[0];
$x
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
}
else
{
$x
=
$class
-> _copy(
$_
[0]);
$y
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
}
return
$class
-> _acmp(
$x
,
$y
);
},
'&'
=>
sub
{
my
$class
=
ref
$_
[0];
my
(
$x
,
$y
);
if
(
$_
[2]) {
$y
=
$_
[0];
$x
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
}
else
{
$x
=
$class
-> _copy(
$_
[0]);
$y
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
}
return
$class
-> _and(
$x
,
$y
);
},
'|'
=>
sub
{
my
$class
=
ref
$_
[0];
my
(
$x
,
$y
);
if
(
$_
[2]) {
$y
=
$_
[0];
$x
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
}
else
{
$x
=
$class
-> _copy(
$_
[0]);
$y
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
}
return
$class
-> _or(
$x
,
$y
);
},
'^'
=>
sub
{
my
$class
=
ref
$_
[0];
my
(
$x
,
$y
);
if
(
$_
[2]) {
$y
=
$_
[0];
$x
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
}
else
{
$x
=
$class
-> _copy(
$_
[0]);
$y
=
ref
(
$_
[1]) ?
$_
[1] :
$class
-> _new(
$_
[1]);
}
return
$class
-> _xor(
$x
,
$y
);
},
'abs'
=>
sub
{
$_
[0] },
'sqrt'
=>
sub
{
my
$class
=
ref
$_
[0];
return
$class
-> _sqrt(
$class
-> _copy(
$_
[0]));
},
'int'
=>
sub
{
$_
[0] },
'bool'
=>
sub
{
ref
(
$_
[0]) -> _is_zero(
$_
[0]) ?
''
: 1; },
'""'
=>
sub
{
ref
(
$_
[0]) -> _str(
$_
[0]); },
'0+'
=>
sub
{
ref
(
$_
[0]) -> _num(
$_
[0]); },
'='
=>
sub
{
ref
(
$_
[0]) -> _copy(
$_
[0]); },
;
sub
_check {
my
(
$class
,
$x
) =
@_
;
return
"Input is undefined"
unless
defined
$x
;
return
"$x is not a reference"
unless
ref
(
$x
);
return
0;
}
sub
_digit {
my
(
$class
,
$x
,
$n
) =
@_
;
substr
(
$class
->_str(
$x
), -(
$n
+1), 1);
}
sub
_num {
my
(
$class
,
$x
) =
@_
;
0 +
$class
-> _str(
$x
);
}
sub
_fac {
my
(
$class
,
$x
) =
@_
;
my
$two
=
$class
-> _two();
if
(
$class
-> _acmp(
$x
,
$two
) < 0) {
$class
->_set(
$x
, 1);
return
$x
}
my
$i
=
$class
-> _copy(
$x
);
while
(
$class
-> _acmp(
$i
,
$two
) > 0) {
$i
=
$class
-> _dec(
$i
);
$x
=
$class
-> _mul(
$x
,
$i
);
}
return
$x
;
}
sub
_dfac {
my
(
$class
,
$x
) =
@_
;
my
$two
=
$class
-> _two();
if
(
$class
-> _acmp(
$x
,
$two
) < 0) {
$class
->_set(
$x
, 1);
return
$x
}
my
$i
=
$class
-> _copy(
$x
);
while
(
$class
-> _acmp(
$i
,
$two
) > 0) {
$i
=
$class
-> _sub(
$i
,
$two
);
$x
=
$class
-> _mul(
$x
,
$i
);
}
return
$x
;
}
sub
_nok {
my
(
$class
,
$n
,
$k
) =
@_
;
{
my
$twok
=
$class
-> _mul(
$class
-> _two(),
$class
-> _copy(
$k
));
if
(
$class
-> _acmp(
$twok
,
$n
) > 0) {
$k
=
$class
-> _sub(
$class
-> _copy(
$n
),
$k
);
}
}
if
(
$class
-> _is_zero(
$k
)) {
return
$class
-> _one();
}
my
$n_orig
=
$class
-> _copy(
$n
);
$n
=
$class
-> _sub(
$n
,
$k
);
$n
=
$class
-> _inc(
$n
);
my
$f
=
$class
-> _copy(
$n
);
$f
=
$class
-> _inc(
$f
);
my
$d
=
$class
-> _two();
while
(
$class
-> _acmp(
$f
,
$n_orig
) <= 0) {
$n
=
$class
-> _mul(
$n
,
$f
);
$n
=
$class
-> _div(
$n
,
$d
);
$f
=
$class
-> _inc(
$f
);
$d
=
$class
-> _inc(
$d
);
}
return
$n
;
}
sub
_sadd {
my
$class
=
shift
;
my
(
$xa
,
$xs
,
$ya
,
$ys
,
$flag
) =
@_
;
my
(
$za
,
$zs
);
if
(
$xs
eq
$ys
) {
if
(
$flag
) {
$za
=
$class
-> _add(
$ya
,
$xa
);
}
else
{
$za
=
$class
-> _add(
$xa
,
$ya
);
}
$zs
=
$class
-> _is_zero(
$za
) ?
'+'
:
$xs
;
return
$za
,
$zs
;
}
my
$acmp
=
$class
-> _acmp(
$xa
,
$ya
);
if
(
$acmp
== 0) {
$za
=
$class
-> _zero();
$zs
=
'+'
;
return
$za
,
$zs
;
}
if
(
$acmp
> 0) {
$za
=
$class
-> _sub(
$xa
,
$ya
,
$flag
);
$zs
=
$xs
;
}
else
{
$za
=
$class
-> _sub(
$ya
,
$xa
, !
$flag
);
$zs
=
$ys
;
}
return
$za
,
$zs
;
}
sub
_ssub {
my
$class
=
shift
;
my
(
$xa
,
$xs
,
$ya
,
$ys
,
$flag
) =
@_
;
$ys
=
$ys
eq
'+'
?
'-'
:
'+'
;
$class
-> _sadd(
$xa
,
$xs
,
$ya
,
$ys
,
$flag
);
}
sub
_log_int {
my
(
$class
,
$x
,
$base
) =
@_
;
return
if
$class
-> _is_zero(
$x
);
$base
=
$class
-> _new(2)
unless
defined
(
$base
);
$base
=
$class
-> _new(
$base
)
unless
ref
(
$base
);
return
if
$class
-> _is_zero(
$base
) ||
$class
-> _is_one(
$base
);
if
(
$class
-> _is_one(
$x
)) {
return
$class
-> _zero(), 1;
}
my
$cmp
=
$class
-> _acmp(
$x
,
$base
);
if
(
$cmp
== 0) {
return
$class
-> _one(), 1;
}
if
(
$cmp
< 0) {
return
$class
-> _zero(), 0;
}
my
$y
;
{
my
$x_str
=
$class
-> _str(
$x
);
my
$b_str
=
$class
-> _str(
$base
);
my
$xm
=
"."
.
$x_str
;
my
$bm
=
"."
.
$b_str
;
my
$xe
=
length
(
$x_str
);
my
$be
=
length
(
$b_str
);
my
$log10
=
log
(10);
my
$guess
=
int
((
log
(
$xm
) +
$xe
*
$log10
) / (
log
(
$bm
) +
$be
*
$log10
));
$y
=
$class
-> _new(
$guess
);
}
my
$trial
=
$class
-> _pow(
$class
-> _copy(
$base
),
$y
);
my
$acmp
=
$class
-> _acmp(
$trial
,
$x
);
return
$y
, 1
if
$acmp
== 0;
while
(
$acmp
< 0) {
$trial
=
$class
-> _mul(
$trial
,
$base
);
$y
=
$class
-> _inc(
$y
);
$acmp
=
$class
-> _acmp(
$trial
,
$x
);
}
while
(
$acmp
> 0) {
$trial
=
$class
-> _div(
$trial
,
$base
);
$y
=
$class
-> _dec(
$y
);
$acmp
=
$class
-> _acmp(
$trial
,
$x
);
}
return
$y
, 1
if
$acmp
== 0;
return
$y
, 0;
}
sub
_lucas {
my
(
$class
,
$n
) =
@_
;
$n
=
$class
-> _num(
$n
)
if
ref
$n
;
if
(
wantarray
) {
my
@y
;
push
@y
,
$class
-> _two();
return
@y
if
$n
== 0;
push
@y
,
$class
-> _one();
return
@y
if
$n
== 1;
for
(
my
$i
= 2 ;
$i
<=
$n
; ++
$i
) {
$y
[
$i
] =
$class
-> _add(
$class
-> _copy(
$y
[
$i
- 1]),
$y
[
$i
- 2]);
}
return
@y
;
}
return
$class
-> _two()
if
$n
== 0;
return
$class
-> _add(
scalar
$class
-> _fib(
$n
- 1),
scalar
$class
-> _fib(
$n
+ 1));
}
sub
_fib {
my
(
$class
,
$n
) =
@_
;
$n
=
$class
-> _num(
$n
)
if
ref
$n
;
if
(
wantarray
) {
my
@y
;
push
@y
,
$class
-> _zero();
return
@y
if
$n
== 0;
push
@y
,
$class
-> _one();
return
@y
if
$n
== 1;
for
(
my
$i
= 2 ;
$i
<=
$n
; ++
$i
) {
$y
[
$i
] =
$class
-> _add(
$class
-> _copy(
$y
[
$i
- 1]),
$y
[
$i
- 2]);
}
return
@y
;
}
my
$cache
= {};
my
$two
=
$class
-> _two();
my
$fib
;
$fib
=
sub
{
my
$n
=
shift
;
return
$class
-> _zero()
if
$n
<= 0;
return
$class
-> _one()
if
$n
<= 2;
return
$cache
-> {
$n
}
if
exists
$cache
-> {
$n
};
my
$k
=
int
(
$n
/ 2);
my
$a
=
$fib
-> (
$k
+ 1);
my
$b
=
$fib
-> (
$k
);
my
$y
;
if
(
$n
% 2 == 1) {
$y
=
$class
-> _add(
$class
-> _mul(
$class
-> _copy(
$a
),
$a
),
$class
-> _mul(
$class
-> _copy(
$b
),
$b
));
}
else
{
$y
=
$class
-> _mul(
$class
-> _sub(
$class
-> _mul(
$class
-> _copy(
$two
),
$a
),
$b
),
$b
);
}
$cache
-> {
$n
} =
$y
;
return
$y
;
};
return
$fib
-> (
$n
);
}
sub
_sand {
my
(
$class
,
$x
,
$sx
,
$y
,
$sy
) =
@_
;
return
(
$class
-> _zero(),
'+'
)
if
$class
-> _is_zero(
$x
) ||
$class
-> _is_zero(
$y
);
my
$sign
=
$sx
eq
'-'
&&
$sy
eq
'-'
?
'-'
:
'+'
;
my
(
$bx
,
$by
);
if
(
$sx
eq
'-'
) {
$bx
=
$class
-> _copy(
$x
);
$bx
=
$class
-> _dec(
$bx
);
$bx
=
$class
-> _as_hex(
$bx
);
$bx
=~ s/^-?0x//;
$bx
=~
tr
<0123456789abcdef>
<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
}
else
{
$bx
=
$class
-> _as_hex(
$x
);
$bx
=~ s/^-?0x//;
$bx
=~
tr
<fedcba9876543210>
<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
}
if
(
$sy
eq
'-'
) {
$by
=
$class
-> _copy(
$y
);
$by
=
$class
-> _dec(
$by
);
$by
=
$class
-> _as_hex(
$by
);
$by
=~ s/^-?0x//;
$by
=~
tr
<0123456789abcdef>
<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
}
else
{
$by
=
$class
-> _as_hex(
$y
);
$by
=~ s/^-?0x//;
$by
=~
tr
<fedcba9876543210>
<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
}
$bx
=
reverse
$bx
;
$by
=
reverse
$by
;
my
$xx
=
"\x00"
;
$xx
=
"\x0f"
if
$sx
eq
'-'
;
my
$yy
=
"\x00"
;
$yy
=
"\x0f"
if
$sy
eq
'-'
;
my
$diff
= CORE::
length
(
$bx
) - CORE::
length
(
$by
);
if
(
$diff
> 0) {
$by
.=
$yy
x
$diff
;
}
elsif
(
$diff
< 0) {
$bx
.=
$xx
x
abs
(
$diff
);
}
my
$r
=
$bx
&
$by
;
$bx
=
reverse
$r
;
if
(
$sign
eq
'-'
) {
$bx
=~
tr
<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
<0123456789abcdef>;
}
else
{
$bx
=~
tr
<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
<fedcba9876543210>;
}
$bx
=
'0x'
.
$bx
;
$bx
=
$class
-> _from_hex(
$bx
);
$bx
=
$class
-> _inc(
$bx
)
if
$sign
eq
'-'
;
$sign
=
'+'
if
$class
-> _is_zero(
$bx
);
return
$bx
,
$sign
;
}
sub
_sxor {
my
(
$class
,
$x
,
$sx
,
$y
,
$sy
) =
@_
;
return
(
$class
-> _zero(),
'+'
)
if
$class
-> _is_zero(
$x
) &&
$class
-> _is_zero(
$y
);
my
$sign
=
$sx
ne
$sy
?
'-'
:
'+'
;
my
(
$bx
,
$by
);
if
(
$sx
eq
'-'
) {
$bx
=
$class
-> _copy(
$x
);
$bx
=
$class
-> _dec(
$bx
);
$bx
=
$class
-> _as_hex(
$bx
);
$bx
=~ s/^-?0x//;
$bx
=~
tr
<0123456789abcdef>
<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
}
else
{
$bx
=
$class
-> _as_hex(
$x
);
$bx
=~ s/^-?0x//;
$bx
=~
tr
<fedcba9876543210>
<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
}
if
(
$sy
eq
'-'
) {
$by
=
$class
-> _copy(
$y
);
$by
=
$class
-> _dec(
$by
);
$by
=
$class
-> _as_hex(
$by
);
$by
=~ s/^-?0x//;
$by
=~
tr
<0123456789abcdef>
<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
}
else
{
$by
=
$class
-> _as_hex(
$y
);
$by
=~ s/^-?0x//;
$by
=~
tr
<fedcba9876543210>
<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
}
$bx
=
reverse
$bx
;
$by
=
reverse
$by
;
my
$xx
=
"\x00"
;
$xx
=
"\x0f"
if
$sx
eq
'-'
;
my
$yy
=
"\x00"
;
$yy
=
"\x0f"
if
$sy
eq
'-'
;
my
$diff
= CORE::
length
(
$bx
) - CORE::
length
(
$by
);
if
(
$diff
> 0) {
$by
.=
$yy
x
$diff
;
}
elsif
(
$diff
< 0) {
$bx
.=
$xx
x
abs
(
$diff
);
}
my
$r
=
$bx
^
$by
;
$bx
=
reverse
$r
;
if
(
$sign
eq
'-'
) {
$bx
=~
tr
<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
<0123456789abcdef>;
}
else
{
$bx
=~
tr
<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
<fedcba9876543210>;
}
$bx
=
'0x'
.
$bx
;
$bx
=
$class
-> _from_hex(
$bx
);
$bx
=
$class
-> _inc(
$bx
)
if
$sign
eq
'-'
;
$sign
=
'+'
if
$class
-> _is_zero(
$bx
);
return
$bx
,
$sign
;
}
sub
_sor {
my
(
$class
,
$x
,
$sx
,
$y
,
$sy
) =
@_
;
return
(
$class
-> _zero(),
'+'
)
if
$class
-> _is_zero(
$x
) &&
$class
-> _is_zero(
$y
);
my
$sign
=
$sx
eq
'-'
||
$sy
eq
'-'
?
'-'
:
'+'
;
my
(
$bx
,
$by
);
if
(
$sx
eq
'-'
) {
$bx
=
$class
-> _copy(
$x
);
$bx
=
$class
-> _dec(
$bx
);
$bx
=
$class
-> _as_hex(
$bx
);
$bx
=~ s/^-?0x//;
$bx
=~
tr
<0123456789abcdef>
<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
}
else
{
$bx
=
$class
-> _as_hex(
$x
);
$bx
=~ s/^-?0x//;
$bx
=~
tr
<fedcba9876543210>
<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
}
if
(
$sy
eq
'-'
) {
$by
=
$class
-> _copy(
$y
);
$by
=
$class
-> _dec(
$by
);
$by
=
$class
-> _as_hex(
$by
);
$by
=~ s/^-?0x//;
$by
=~
tr
<0123456789abcdef>
<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
}
else
{
$by
=
$class
-> _as_hex(
$y
);
$by
=~ s/^-?0x//;
$by
=~
tr
<fedcba9876543210>
<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
}
$bx
=
reverse
$bx
;
$by
=
reverse
$by
;
my
$xx
=
"\x00"
;
$xx
=
"\x0f"
if
$sx
eq
'-'
;
my
$yy
=
"\x00"
;
$yy
=
"\x0f"
if
$sy
eq
'-'
;
my
$diff
= CORE::
length
(
$bx
) - CORE::
length
(
$by
);
if
(
$diff
> 0) {
$by
.=
$yy
x
$diff
;
}
elsif
(
$diff
< 0) {
$bx
.=
$xx
x
abs
(
$diff
);
}
my
$r
=
$bx
|
$by
;
$bx
=
reverse
$r
;
if
(
$sign
eq
'-'
) {
$bx
=~
tr
<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
<0123456789abcdef>;
}
else
{
$bx
=~
tr
<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
<fedcba9876543210>;
}
$bx
=
'0x'
.
$bx
;
$bx
=
$class
-> _from_hex(
$bx
);
$bx
=
$class
-> _inc(
$bx
)
if
$sign
eq
'-'
;
$sign
=
'+'
if
$class
-> _is_zero(
$bx
);
return
$bx
,
$sign
;
}
sub
_as_bin {
my
(
$class
,
$x
) =
@_
;
return
'0b'
.
$class
-> _to_bin(
$x
);
}
sub
_as_oct {
my
(
$class
,
$x
) =
@_
;
return
'0'
.
$class
-> _to_oct(
$x
);
}
sub
_as_hex {
my
(
$class
,
$x
) =
@_
;
return
'0x'
.
$class
-> _to_hex(
$x
);
}
1;