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