Commit | Line | Data |
ef9466ea |
1 | package Math::BigInt::CalcEmu; |
b282a552 |
2 | |
a0ac753d |
3 | use 5.006002; |
b282a552 |
4 | use strict; |
5 | # use warnings; # dont use warnings for older Perls |
b282a552 |
6 | use vars qw/$VERSION/; |
7 | |
b68b7ab1 |
8 | $VERSION = '0.05'; |
ef9466ea |
9 | |
10 | package Math::BigInt; |
b282a552 |
11 | |
12 | # See SYNOPSIS below. |
13 | |
14 | my $CALC_EMU; |
15 | |
16 | BEGIN |
17 | { |
18 | $CALC_EMU = Math::BigInt->config()->{'lib'}; |
b68b7ab1 |
19 | # register us with MBI to get notified of future lib changes |
20 | Math::BigInt::_register_callback( __PACKAGE__, sub { $CALC_EMU = $_[0]; } ); |
b282a552 |
21 | } |
22 | |
b282a552 |
23 | sub __emu_band |
24 | { |
25 | my ($self,$x,$y,$sx,$sy,@r) = @_; |
26 | |
27 | return $x->bzero(@r) if $y->is_zero() || $x->is_zero(); |
28 | |
29 | my $sign = 0; # sign of result |
30 | $sign = 1 if $sx == -1 && $sy == -1; |
31 | |
32 | my ($bx,$by); |
33 | |
34 | if ($sx == -1) # if x is negative |
35 | { |
36 | # two's complement: inc and flip all "bits" in $bx |
37 | $bx = $x->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc |
38 | $bx =~ s/-?0x//; |
39 | $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; |
40 | } |
41 | else |
42 | { |
43 | $bx = $x->as_hex(); # get binary representation |
44 | $bx =~ s/-?0x//; |
45 | $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; |
46 | } |
47 | if ($sy == -1) # if y is negative |
48 | { |
49 | # two's complement: inc and flip all "bits" in $by |
50 | $by = $y->copy()->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc |
51 | $by =~ s/-?0x//; |
52 | $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; |
53 | } |
54 | else |
55 | { |
56 | $by = $y->as_hex(); # get binary representation |
57 | $by =~ s/-?0x//; |
58 | $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; |
59 | } |
60 | # now we have bit-strings from X and Y, reverse them for padding |
61 | $bx = reverse $bx; |
62 | $by = reverse $by; |
63 | |
9b924220 |
64 | # padd the shorter string |
65 | my $xx = "\x00"; $xx = "\x0f" if $sx == -1; |
66 | my $yy = "\x00"; $yy = "\x0f" if $sy == -1; |
b282a552 |
67 | my $diff = CORE::length($bx) - CORE::length($by); |
68 | if ($diff > 0) |
69 | { |
9b924220 |
70 | # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by |
71 | $by .= $yy x $diff; |
b282a552 |
72 | } |
73 | elsif ($diff < 0) |
74 | { |
9b924220 |
75 | # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx |
76 | $bx .= $xx x abs($diff); |
b282a552 |
77 | } |
9b924220 |
78 | |
b282a552 |
79 | # and the strings together |
80 | my $r = $bx & $by; |
81 | |
82 | # and reverse the result again |
83 | $bx = reverse $r; |
84 | |
9b924220 |
85 | # One of $x or $y was negative, so need to flip bits in the result. |
86 | # In both cases (one or two of them negative, or both positive) we need |
b282a552 |
87 | # to get the characters back. |
88 | if ($sign == 1) |
89 | { |
90 | $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/; |
91 | } |
92 | else |
93 | { |
94 | $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/; |
95 | } |
96 | |
9b924220 |
97 | # leading zeros will be stripped by _from_hex() |
b282a552 |
98 | $bx = '0x' . $bx; |
9b924220 |
99 | $x->{value} = $CALC_EMU->_from_hex( $bx ); |
b282a552 |
100 | |
101 | # calculate sign of result |
102 | $x->{sign} = '+'; |
b282a552 |
103 | $x->{sign} = '-' if $sign == 1 && !$x->is_zero(); |
104 | |
105 | $x->bdec() if $sign == 1; |
106 | |
107 | $x->round(@r); |
108 | } |
109 | |
110 | sub __emu_bior |
111 | { |
112 | my ($self,$x,$y,$sx,$sy,@r) = @_; |
113 | |
114 | return $x->round(@r) if $y->is_zero(); |
115 | |
116 | my $sign = 0; # sign of result |
117 | $sign = 1 if ($sx == -1) || ($sy == -1); |
118 | |
119 | my ($bx,$by); |
120 | |
121 | if ($sx == -1) # if x is negative |
122 | { |
123 | # two's complement: inc and flip all "bits" in $bx |
124 | $bx = $x->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc |
125 | $bx =~ s/-?0x//; |
126 | $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; |
127 | } |
128 | else |
129 | { |
130 | $bx = $x->as_hex(); # get binary representation |
131 | $bx =~ s/-?0x//; |
132 | $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; |
133 | } |
134 | if ($sy == -1) # if y is negative |
135 | { |
136 | # two's complement: inc and flip all "bits" in $by |
137 | $by = $y->copy()->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc |
138 | $by =~ s/-?0x//; |
139 | $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; |
140 | } |
141 | else |
142 | { |
143 | $by = $y->as_hex(); # get binary representation |
144 | $by =~ s/-?0x//; |
145 | $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; |
146 | } |
147 | # now we have bit-strings from X and Y, reverse them for padding |
148 | $bx = reverse $bx; |
149 | $by = reverse $by; |
150 | |
151 | # padd the shorter string |
152 | my $xx = "\x00"; $xx = "\x0f" if $sx == -1; |
153 | my $yy = "\x00"; $yy = "\x0f" if $sy == -1; |
154 | my $diff = CORE::length($bx) - CORE::length($by); |
155 | if ($diff > 0) |
156 | { |
157 | $by .= $yy x $diff; |
158 | } |
159 | elsif ($diff < 0) |
160 | { |
161 | $bx .= $xx x abs($diff); |
162 | } |
163 | |
164 | # or the strings together |
165 | my $r = $bx | $by; |
166 | |
167 | # and reverse the result again |
168 | $bx = reverse $r; |
169 | |
170 | # one of $x or $y was negative, so need to flip bits in the result |
171 | # in both cases (one or two of them negative, or both positive) we need |
172 | # to get the characters back. |
173 | if ($sign == 1) |
174 | { |
175 | $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/; |
176 | } |
177 | else |
178 | { |
179 | $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/; |
180 | } |
181 | |
9b924220 |
182 | # leading zeros will be stripped by _from_hex() |
b282a552 |
183 | $bx = '0x' . $bx; |
9b924220 |
184 | $x->{value} = $CALC_EMU->_from_hex( $bx ); |
185 | |
186 | # calculate sign of result |
187 | $x->{sign} = '+'; |
188 | $x->{sign} = '-' if $sign == 1 && !$x->is_zero(); |
b282a552 |
189 | |
190 | # if one of X or Y was negative, we need to decrement result |
191 | $x->bdec() if $sign == 1; |
192 | |
193 | $x->round(@r); |
194 | } |
195 | |
196 | sub __emu_bxor |
197 | { |
198 | my ($self,$x,$y,$sx,$sy,@r) = @_; |
199 | |
200 | return $x->round(@r) if $y->is_zero(); |
201 | |
202 | my $sign = 0; # sign of result |
203 | $sign = 1 if $x->{sign} ne $y->{sign}; |
204 | |
205 | my ($bx,$by); |
206 | |
207 | if ($sx == -1) # if x is negative |
208 | { |
209 | # two's complement: inc and flip all "bits" in $bx |
210 | $bx = $x->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc |
211 | $bx =~ s/-?0x//; |
212 | $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; |
213 | } |
214 | else |
215 | { |
216 | $bx = $x->as_hex(); # get binary representation |
217 | $bx =~ s/-?0x//; |
218 | $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; |
219 | } |
220 | if ($sy == -1) # if y is negative |
221 | { |
222 | # two's complement: inc and flip all "bits" in $by |
223 | $by = $y->copy()->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc |
224 | $by =~ s/-?0x//; |
225 | $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; |
226 | } |
227 | else |
228 | { |
229 | $by = $y->as_hex(); # get binary representation |
230 | $by =~ s/-?0x//; |
231 | $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; |
232 | } |
233 | # now we have bit-strings from X and Y, reverse them for padding |
234 | $bx = reverse $bx; |
235 | $by = reverse $by; |
236 | |
237 | # padd the shorter string |
238 | my $xx = "\x00"; $xx = "\x0f" if $sx == -1; |
239 | my $yy = "\x00"; $yy = "\x0f" if $sy == -1; |
240 | my $diff = CORE::length($bx) - CORE::length($by); |
241 | if ($diff > 0) |
242 | { |
243 | $by .= $yy x $diff; |
244 | } |
245 | elsif ($diff < 0) |
246 | { |
247 | $bx .= $xx x abs($diff); |
248 | } |
249 | |
250 | # xor the strings together |
251 | my $r = $bx ^ $by; |
252 | |
253 | # and reverse the result again |
254 | $bx = reverse $r; |
255 | |
256 | # one of $x or $y was negative, so need to flip bits in the result |
257 | # in both cases (one or two of them negative, or both positive) we need |
258 | # to get the characters back. |
259 | if ($sign == 1) |
260 | { |
261 | $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/; |
262 | } |
263 | else |
264 | { |
265 | $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/; |
266 | } |
267 | |
9b924220 |
268 | # leading zeros will be stripped by _from_hex() |
b282a552 |
269 | $bx = '0x' . $bx; |
9b924220 |
270 | $x->{value} = $CALC_EMU->_from_hex( $bx ); |
b282a552 |
271 | |
272 | # calculate sign of result |
273 | $x->{sign} = '+'; |
274 | $x->{sign} = '-' if $sx != $sy && !$x->is_zero(); |
275 | |
276 | $x->bdec() if $sign == 1; |
277 | |
278 | $x->round(@r); |
279 | } |
280 | |
b282a552 |
281 | ############################################################################## |
282 | ############################################################################## |
283 | |
284 | 1; |
285 | __END__ |
286 | |
287 | =head1 NAME |
288 | |
289 | Math::BigInt::CalcEmu - Emulate low-level math with BigInt code |
290 | |
291 | =head1 SYNOPSIS |
292 | |
b68b7ab1 |
293 | use Math::BigInt::CalcEmu; |
294 | |
295 | =head1 DESCRIPTION |
296 | |
b282a552 |
297 | Contains routines that emulate low-level math functions in BigInt, e.g. |
384f06ae |
298 | optional routines the low-level math package does not provide on its own. |
b282a552 |
299 | |
b68b7ab1 |
300 | Will be loaded on demand and called automatically by BigInt. |
b282a552 |
301 | |
b68b7ab1 |
302 | Stuff here is really low-priority to optimize, since it is far better to |
303 | implement the operation in the low-level math libary directly, possible even |
304 | using a call to the native lib. |
b282a552 |
305 | |
306 | =head1 METHODS |
307 | |
b68b7ab1 |
308 | =head2 __emu_bxor |
309 | |
310 | =head2 __emu_band |
311 | |
312 | =head2 __emu_bior |
313 | |
b282a552 |
314 | =head1 LICENSE |
315 | |
316 | This program is free software; you may redistribute it and/or modify it under |
317 | the same terms as Perl itself. |
318 | |
319 | =head1 AUTHORS |
320 | |
9b924220 |
321 | (c) Tels http://bloodgate.com 2003, 2004 - based on BigInt code by |
b282a552 |
322 | Tels from 2001-2003. |
323 | |
324 | =head1 SEE ALSO |
325 | |
326 | L<Math::BigInt>, L<Math::BigFloat>, L<Math::BigInt::BitVect>, |
327 | L<Math::BigInt::GMP> and L<Math::BigInt::Pari>. |
328 | |
329 | =cut |