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