1###############################################################################
2# core math lib for BigInt, representing big numbers by normal int/float's
3# for testing only, will fail any bignum test if range is exceeded
4
5package Math::BigInt::Scalar;
6
7use 5.006;
8use strict;
9use warnings;
10
11require Exporter;
12
13our @ISA = qw(Exporter);
14
15our $VERSION = '0.13';
16
17##############################################################################
18# global constants, flags and accessory
19
20# constants for easier life
21my $nan = 'NaN';
22
23##############################################################################
24# create objects from various representations
25
26sub _new {
27    # create scalar ref from string
28    my $d = $_[1];
29    my $x = $d;                 # make copy
30    \$x;
31}
32
33sub _from_hex {
34    # not used
35}
36
37sub _from_oct {
38    # not used
39}
40
41sub _from_bin {
42    # not used
43}
44
45sub _zero {
46    my $x = 0; \$x;
47}
48
49sub _one {
50    my $x = 1; \$x;
51}
52
53sub _two {
54    my $x = 2; \$x;
55}
56
57sub _ten {
58    my $x = 10; \$x;
59}
60
61sub _copy {
62    my $x = $_[1];
63    my $z = $$x;
64    \$z;
65}
66
67# catch and throw away
68sub import { }
69
70##############################################################################
71# convert back to string and number
72
73sub _str {
74    # make string
75    "${$_[1]}";
76}
77
78sub _num {
79    # make a number
80    0+${$_[1]};
81}
82
83sub _zeros {
84    my $x = $_[1];
85
86    $x =~ /\d(0*)$/;
87    length($1 || '');
88}
89
90sub _rsft {
91    # not used
92}
93
94sub _lsft {
95    # not used
96}
97
98sub _mod {
99    # not used
100}
101
102sub _gcd {
103    # not used
104}
105
106sub _sqrt {
107    # not used
108}
109
110sub _root {
111    # not used
112}
113
114sub _fac {
115    # not used
116}
117
118sub _modinv {
119    # not used
120}
121
122sub _modpow {
123    # not used
124}
125
126sub _log_int {
127    # not used
128}
129
130sub _as_hex {
131    sprintf("0x%x", ${$_[1]});
132}
133
134sub _as_bin {
135    sprintf("0b%b", ${$_[1]});
136}
137
138sub _as_oct {
139    sprintf("0%o", ${$_[1]});
140}
141
142##############################################################################
143# actual math code
144
145sub _add {
146    my ($c, $x, $y) = @_;
147    $$x += $$y;
148    return $x;
149}
150
151sub _sub {
152    my ($c, $x, $y) = @_;
153    $$x -= $$y;
154    return $x;
155}
156
157sub _mul {
158    my ($c, $x, $y) = @_;
159    $$x *= $$y;
160    return $x;
161}
162
163sub _div {
164    my ($c, $x, $y) = @_;
165
166    my $u = int($$x / $$y); my $r = $$x % $$y; $$x = $u;
167    return ($x, \$r) if wantarray;
168    return $x;
169}
170
171sub _pow {
172    my ($c, $x, $y) = @_;
173    my $u = $$x ** $$y; $$x = $u;
174    return $x;
175}
176
177sub _and {
178    my ($c, $x, $y) = @_;
179    my $u = int($$x) & int($$y); $$x = $u;
180    return $x;
181}
182
183sub _xor {
184    my ($c, $x, $y) = @_;
185    my $u = int($$x) ^ int($$y); $$x = $u;
186    return $x;
187}
188
189sub _or {
190    my ($c, $x, $y) = @_;
191    my $u = int($$x) | int($$y); $$x = $u;
192    return $x;
193}
194
195sub _inc {
196    my ($c, $x) = @_;
197    my $u = int($$x)+1; $$x = $u;
198    return $x;
199}
200
201sub _dec {
202    my ($c, $x) = @_;
203    my $u = int($$x)-1; $$x = $u;
204    return $x;
205}
206
207##############################################################################
208# testing
209
210sub _acmp {
211    my ($c, $x, $y) = @_;
212    return ($$x <=> $$y);
213}
214
215sub _len {
216    return length("${$_[1]}");
217}
218
219sub _digit {
220    # return the nth digit, negative values count backward
221    # 0 is the rightmost digit
222    my ($c, $x, $n) = @_;
223
224    $n ++;                      # 0 => 1, 1 => 2
225    return substr($$x, -$n, 1); # 1 => -1, -2 => 2 etc
226}
227
228##############################################################################
229# _is_* routines
230
231sub _is_zero {
232    # return true if arg is zero
233    my ($c, $x) = @_;
234    ($$x == 0) <=> 0;
235}
236
237sub _is_even {
238    # return true if arg is even
239    my ($c, $x) = @_;
240    (!($$x & 1)) <=> 0;
241}
242
243sub _is_odd {
244    # return true if arg is odd
245    my ($c, $x) = @_;
246    ($$x & 1) <=> 0;
247}
248
249sub _is_one {
250    # return true if arg is one
251    my ($c, $x) = @_;
252    ($$x == 1) <=> 0;
253}
254
255sub _is_two {
256    # return true if arg is one
257    my ($c, $x) = @_;
258    ($$x == 2) <=> 0;
259}
260
261sub _is_ten {
262    # return true if arg is one
263    my ($c, $x) = @_;
264    ($$x == 10) <=> 0;
265}
266
267###############################################################################
268# check routine to test internal state of corruptions
269
270sub _check {
271    # no checks yet, pull it out from the test suite
272    my ($c, $x) = @_;
273    return "$x is not a reference" if !ref($x);
274    return 0;
275}
276
2771;
278
279__END__
280
281=head1 NAME
282
283Math::BigInt::Scalar - Pure Perl module to test Math::BigInt with scalars
284
285=head1 SYNOPSIS
286
287Provides support for big integer calculations via means of 'small' int/floats.
288Only for testing purposes, since it will fail at large values. But it is simple
289enough not to introduce bugs on it's own and to serve as a testbed.
290
291=head1 DESCRIPTION
292
293Please see Math::BigInt::Calc.
294
295=head1 LICENSE
296
297This program is free software; you may redistribute it and/or modify it under
298the same terms as Perl itself.
299
300=head1 AUTHOR
301
302Tels http://bloodgate.com in 2001 - 2007.
303
304=head1 SEE ALSO
305
306L<Math::BigInt>, L<Math::BigInt::Calc>.
307
308=cut
309