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