Commit | Line | Data |
---|---|---|
920dae64 AT |
1 | package Math::BigInt::CalcEmu; |
2 | ||
3 | use 5.005; | |
4 | use strict; | |
5 | # use warnings; # dont use warnings for older Perls | |
6 | use vars qw/$VERSION/; | |
7 | ||
8 | $VERSION = '0.05'; | |
9 | ||
10 | package Math::BigInt; | |
11 | ||
12 | # See SYNOPSIS below. | |
13 | ||
14 | my $CALC_EMU; | |
15 | ||
16 | BEGIN | |
17 | { | |
18 | $CALC_EMU = Math::BigInt->config()->{'lib'}; | |
19 | # register us with MBI to get notified of future lib changes | |
20 | Math::BigInt::_register_callback( __PACKAGE__, sub { $CALC_EMU = $_[0]; } ); | |
21 | } | |
22 | ||
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 | ||
64 | # padd the shorter string | |
65 | my $xx = "\x00"; $xx = "\x0f" if $sx == -1; | |
66 | my $yy = "\x00"; $yy = "\x0f" if $sy == -1; | |
67 | my $diff = CORE::length($bx) - CORE::length($by); | |
68 | if ($diff > 0) | |
69 | { | |
70 | # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by | |
71 | $by .= $yy x $diff; | |
72 | } | |
73 | elsif ($diff < 0) | |
74 | { | |
75 | # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx | |
76 | $bx .= $xx x abs($diff); | |
77 | } | |
78 | ||
79 | # and the strings together | |
80 | my $r = $bx & $by; | |
81 | ||
82 | # and reverse the result again | |
83 | $bx = reverse $r; | |
84 | ||
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 | |
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 | ||
97 | # leading zeros will be stripped by _from_hex() | |
98 | $bx = '0x' . $bx; | |
99 | $x->{value} = $CALC_EMU->_from_hex( $bx ); | |
100 | ||
101 | # calculate sign of result | |
102 | $x->{sign} = '+'; | |
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 | ||
182 | # leading zeros will be stripped by _from_hex() | |
183 | $bx = '0x' . $bx; | |
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(); | |
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 | ||
268 | # leading zeros will be stripped by _from_hex() | |
269 | $bx = '0x' . $bx; | |
270 | $x->{value} = $CALC_EMU->_from_hex( $bx ); | |
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 | ||
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 | ||
293 | use Math::BigInt::CalcEmu; | |
294 | ||
295 | =head1 DESCRIPTION | |
296 | ||
297 | Contains routines that emulate low-level math functions in BigInt, e.g. | |
298 | optional routines the low-level math package does not provide on it's own. | |
299 | ||
300 | Will be loaded on demand and called automatically by BigInt. | |
301 | ||
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. | |
305 | ||
306 | =head1 METHODS | |
307 | ||
308 | =head2 __emu_bxor | |
309 | ||
310 | =head2 __emu_band | |
311 | ||
312 | =head2 __emu_bior | |
313 | ||
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 | ||
321 | (c) Tels http://bloodgate.com 2003, 2004 - based on BigInt code by | |
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 |