Commit | Line | Data |
---|---|---|
062a4e99 T |
1 | #include "EXTERN.h" |
2 | #include "perl.h" | |
3 | #include "XSUB.h" | |
4 | ||
5 | double XS_BASE = 0; | |
6 | double XS_BASE_LEN = 0; | |
7 | ||
8 | MODULE = Math::BigInt::FastCalc PACKAGE = Math::BigInt::FastCalc | |
9 | ||
10 | ############################################################################# | |
11 | # 2002-08-12 0.03 Tels unreleased | |
12 | # * is_zero/is_one/is_odd/is_even/len work now (pass v1.61 tests) | |
13 | # 2002-08-13 0.04 Tels unreleased | |
14 | # * returns no/yes for is_foo() methods to be faster | |
15 | # 2002-08-18 0.06alpha | |
16 | # * added _num(), _inc() and _dec() | |
17 | # 2002-08-25 0.06 Tels | |
18 | # * added __strip_zeros(), _copy() | |
19 | # 2004-08-13 0.07 Tels | |
20 | # * added _is_two(), _is_ten(), _ten() | |
21 | ||
22 | void | |
23 | _set_XS_BASE(BASE, BASE_LEN) | |
24 | SV* BASE | |
25 | SV* BASE_LEN | |
26 | ||
27 | CODE: | |
28 | XS_BASE = SvNV(BASE); | |
29 | XS_BASE_LEN = SvIV(BASE_LEN); | |
30 | ||
31 | ############################################################################## | |
32 | # _copy | |
33 | ||
34 | void | |
35 | _copy(class, x) | |
36 | SV* x | |
37 | INIT: | |
38 | AV* a; | |
39 | AV* a2; | |
40 | I32 elems; | |
41 | ||
42 | CODE: | |
43 | a = (AV*)SvRV(x); /* ref to aray, don't check ref */ | |
44 | elems = av_len(a); /* number of elems in array */ | |
45 | a2 = (AV*)sv_2mortal((SV*)newAV()); | |
46 | av_extend (a2, elems); /* prepadd */ | |
47 | while (elems >= 0) | |
48 | { | |
49 | /* av_store( a2, elems, newSVsv( (SV*)*av_fetch(a, elems, 0) ) ); */ | |
50 | ||
51 | /* looking and trying to preserve IV is actually slower when copying */ | |
52 | /* temp = (SV*)*av_fetch(a, elems, 0); | |
53 | if (SvIOK(temp)) | |
54 | { | |
55 | av_store( a2, elems, newSViv( SvIV( (SV*)*av_fetch(a, elems, 0) ))); | |
56 | } | |
57 | else | |
58 | { | |
59 | av_store( a2, elems, newSVnv( SvNV( (SV*)*av_fetch(a, elems, 0) ))); | |
60 | } | |
61 | */ | |
62 | av_store( a2, elems, newSVnv( SvNV( (SV*)*av_fetch(a, elems, 0) ))); | |
63 | elems--; | |
64 | } | |
65 | ST(0) = sv_2mortal( newRV_inc((SV*) a2) ); | |
66 | ||
67 | ############################################################################## | |
68 | # __strip_zeros (also check for empty arrays from div) | |
69 | ||
70 | void | |
71 | __strip_zeros(x) | |
72 | SV* x | |
73 | INIT: | |
74 | AV* a; | |
75 | SV* temp; | |
76 | I32 elems; | |
77 | I32 index; | |
78 | ||
79 | CODE: | |
80 | a = (AV*)SvRV(x); /* ref to aray, don't check ref */ | |
81 | elems = av_len(a); /* number of elems in array */ | |
82 | ST(0) = x; /* we return x */ | |
83 | if (elems == -1) | |
84 | { | |
85 | av_push (a, newSViv(0)); /* correct empty arrays */ | |
86 | XSRETURN(1); | |
87 | } | |
88 | if (elems == 0) | |
89 | { | |
90 | XSRETURN(1); /* nothing to do since only one elem */ | |
91 | } | |
92 | index = elems; | |
93 | while (index > 0) | |
94 | { | |
95 | temp = *av_fetch(a, index, 0); /* fetch ptr to current element */ | |
96 | if (SvNV(temp) != 0) | |
97 | { | |
98 | break; | |
99 | } | |
100 | index--; | |
101 | } | |
102 | if (index < elems) | |
103 | { | |
104 | index = elems - index; | |
105 | while (index-- > 0) | |
106 | { | |
107 | av_pop (a); | |
108 | } | |
109 | } | |
110 | XSRETURN(1); | |
111 | ||
112 | ############################################################################## | |
113 | # decrement (subtract one) | |
114 | ||
115 | void | |
116 | _dec(class,x) | |
117 | SV* x | |
118 | INIT: | |
119 | AV* a; | |
120 | SV* temp; | |
121 | I32 elems; | |
122 | I32 index; | |
123 | NV MAX; | |
124 | ||
125 | CODE: | |
126 | a = (AV*)SvRV(x); /* ref to aray, don't check ref */ | |
127 | elems = av_len(a); /* number of elems in array */ | |
128 | ST(0) = x; /* we return x */ | |
129 | ||
130 | MAX = XS_BASE - 1; | |
131 | index = 0; | |
132 | while (index <= elems) | |
133 | { | |
134 | temp = *av_fetch(a, index, 0); /* fetch ptr to current element */ | |
135 | sv_setnv (temp, SvNV(temp)-1); | |
136 | if (SvNV(temp) >= 0) | |
137 | { | |
138 | break; /* early out */ | |
139 | } | |
140 | sv_setnv (temp, MAX); /* overflow, so set this to $MAX */ | |
141 | index++; | |
142 | } | |
143 | /* do have more than one element? */ | |
144 | /* (more than one because [0] should be kept as single-element) */ | |
145 | if (elems > 0) | |
146 | { | |
147 | temp = *av_fetch(a, elems, 0); /* fetch last element */ | |
148 | if (SvIV(temp) == 0) /* did last elem overflow? */ | |
149 | { | |
150 | av_pop(a); /* yes, so shrink array */ | |
151 | /* aka remove leading zeros */ | |
152 | } | |
153 | } | |
154 | XSRETURN(1); /* return x */ | |
155 | ||
156 | ############################################################################## | |
157 | # increment (add one) | |
158 | ||
159 | void | |
160 | _inc(class,x) | |
161 | SV* x | |
162 | INIT: | |
163 | AV* a; | |
164 | SV* temp; | |
165 | I32 elems; | |
166 | I32 index; | |
167 | NV BASE; | |
168 | ||
169 | CODE: | |
170 | a = (AV*)SvRV(x); /* ref to aray, don't check ref */ | |
171 | elems = av_len(a); /* number of elems in array */ | |
172 | ST(0) = x; /* we return x */ | |
173 | ||
174 | BASE = XS_BASE; | |
175 | index = 0; | |
176 | while (index <= elems) | |
177 | { | |
178 | temp = *av_fetch(a, index, 0); /* fetch ptr to current element */ | |
179 | sv_setnv (temp, SvNV(temp)+1); | |
180 | if (SvNV(temp) < BASE) | |
181 | { | |
182 | XSRETURN(1); /* return (early out) */ | |
183 | } | |
184 | sv_setiv (temp, 0); /* overflow, so set this elem to 0 */ | |
185 | index++; | |
186 | } | |
187 | temp = *av_fetch(a, elems, 0); /* fetch last element */ | |
188 | if (SvIV(temp) == 0) /* did last elem overflow? */ | |
189 | { | |
190 | av_push(a, newSViv(1)); /* yes, so extend array by 1 */ | |
191 | } | |
192 | XSRETURN(1); /* return x */ | |
193 | ||
194 | ############################################################################## | |
195 | # Make a number (scalar int/float) from a BigInt object | |
196 | ||
197 | void | |
198 | _num(class,x) | |
199 | SV* x | |
200 | INIT: | |
201 | AV* a; | |
202 | NV fac; | |
203 | SV* temp; | |
204 | NV num; | |
205 | I32 elems; | |
206 | I32 index; | |
207 | NV BASE; | |
208 | ||
209 | CODE: | |
210 | a = (AV*)SvRV(x); /* ref to aray, don't check ref */ | |
211 | elems = av_len(a); /* number of elems in array */ | |
212 | ||
213 | if (elems == 0) /* only one element? */ | |
214 | { | |
215 | ST(0) = *av_fetch(a, 0, 0); /* fetch first (only) element */ | |
216 | XSRETURN(1); /* return it */ | |
217 | } | |
218 | fac = 1.0; /* factor */ | |
219 | index = 0; | |
220 | num = 0.0; | |
221 | BASE = XS_BASE; | |
222 | while (index <= elems) | |
223 | { | |
224 | temp = *av_fetch(a, index, 0); /* fetch current element */ | |
225 | num += fac * SvNV(temp); | |
226 | fac *= BASE; | |
227 | index++; | |
228 | } | |
229 | ST(0) = newSVnv(num); | |
230 | ||
231 | ############################################################################## | |
232 | ||
caa64001 T |
233 | #define CONSTANT_OBJ(int) \ |
234 | RETVAL = newAV(); \ | |
235 | sv_2mortal((SV*)RETVAL); \ | |
236 | av_push (RETVAL, newSViv( int )); | |
062a4e99 | 237 | |
caa64001 T |
238 | AV * |
239 | _zero(class) | |
062a4e99 | 240 | CODE: |
caa64001 T |
241 | CONSTANT_OBJ(0) |
242 | OUTPUT: | |
243 | RETVAL | |
062a4e99 T |
244 | |
245 | ############################################################################## | |
246 | ||
caa64001 | 247 | AV * |
062a4e99 | 248 | _one(class) |
062a4e99 | 249 | CODE: |
caa64001 T |
250 | CONSTANT_OBJ(1) |
251 | OUTPUT: | |
252 | RETVAL | |
062a4e99 T |
253 | |
254 | ############################################################################## | |
255 | ||
caa64001 | 256 | AV * |
062a4e99 | 257 | _two(class) |
062a4e99 | 258 | CODE: |
caa64001 T |
259 | CONSTANT_OBJ(2) |
260 | OUTPUT: | |
261 | RETVAL | |
062a4e99 T |
262 | |
263 | ############################################################################## | |
264 | ||
caa64001 | 265 | AV * |
062a4e99 | 266 | _ten(class) |
062a4e99 | 267 | CODE: |
caa64001 T |
268 | CONSTANT_OBJ(10) |
269 | OUTPUT: | |
270 | RETVAL | |
062a4e99 T |
271 | |
272 | ############################################################################## | |
273 | ||
274 | void | |
275 | _is_even(class, x) | |
276 | SV* x | |
277 | INIT: | |
278 | AV* a; | |
279 | SV* temp; | |
280 | ||
281 | CODE: | |
282 | a = (AV*)SvRV(x); /* ref to aray, don't check ref */ | |
283 | temp = *av_fetch(a, 0, 0); /* fetch first element */ | |
284 | ST(0) = boolSV((SvIV(temp) & 1) == 0); | |
285 | ||
286 | ############################################################################## | |
287 | ||
288 | void | |
289 | _is_odd(class, x) | |
290 | SV* x | |
291 | INIT: | |
292 | AV* a; | |
293 | SV* temp; | |
294 | ||
295 | CODE: | |
296 | a = (AV*)SvRV(x); /* ref to aray, don't check ref */ | |
297 | temp = *av_fetch(a, 0, 0); /* fetch first element */ | |
298 | ST(0) = boolSV((SvIV(temp) & 1) != 0); | |
299 | ||
300 | ############################################################################## | |
301 | ||
302 | void | |
303 | _is_one(class, x) | |
304 | SV* x | |
305 | INIT: | |
306 | AV* a; | |
307 | SV* temp; | |
308 | ||
309 | CODE: | |
310 | a = (AV*)SvRV(x); /* ref to aray, don't check ref */ | |
311 | if ( av_len(a) != 0) | |
312 | { | |
313 | ST(0) = &PL_sv_no; | |
314 | XSRETURN(1); /* len != 1, can't be '1' */ | |
315 | } | |
316 | temp = *av_fetch(a, 0, 0); /* fetch first element */ | |
317 | ST(0) = boolSV((SvIV(temp) == 1)); | |
318 | ||
319 | ############################################################################## | |
320 | ||
321 | void | |
322 | _is_two(class, x) | |
323 | SV* x | |
324 | INIT: | |
325 | AV* a; | |
326 | SV* temp; | |
327 | ||
328 | CODE: | |
329 | a = (AV*)SvRV(x); /* ref to aray, don't check ref */ | |
330 | if ( av_len(a) != 0) | |
331 | { | |
332 | ST(0) = &PL_sv_no; | |
333 | XSRETURN(1); /* len != 1, can't be '2' */ | |
334 | } | |
335 | temp = *av_fetch(a, 0, 0); /* fetch first element */ | |
336 | ST(0) = boolSV((SvIV(temp) == 2)); | |
337 | ||
338 | ############################################################################## | |
339 | ||
340 | void | |
341 | _is_ten(class, x) | |
342 | SV* x | |
343 | INIT: | |
344 | AV* a; | |
345 | SV* temp; | |
346 | ||
347 | CODE: | |
348 | a = (AV*)SvRV(x); /* ref to aray, don't check ref */ | |
349 | if ( av_len(a) != 0) | |
350 | { | |
351 | ST(0) = &PL_sv_no; | |
352 | XSRETURN(1); /* len != 1, can't be '10' */ | |
353 | } | |
354 | temp = *av_fetch(a, 0, 0); /* fetch first element */ | |
355 | ST(0) = boolSV((SvIV(temp) == 10)); | |
356 | ||
357 | ############################################################################## | |
358 | ||
359 | void | |
360 | _is_zero(class, x) | |
361 | SV* x | |
362 | INIT: | |
363 | AV* a; | |
364 | SV* temp; | |
365 | ||
366 | CODE: | |
367 | a = (AV*)SvRV(x); /* ref to aray, don't check ref */ | |
368 | if ( av_len(a) != 0) | |
369 | { | |
370 | ST(0) = &PL_sv_no; | |
371 | XSRETURN(1); /* len != 1, can't be '0' */ | |
372 | } | |
373 | temp = *av_fetch(a, 0, 0); /* fetch first element */ | |
374 | ST(0) = boolSV((SvIV(temp) == 0)); | |
375 | ||
376 | ############################################################################## | |
377 | ||
378 | void | |
379 | _len(class,x) | |
380 | SV* x | |
381 | INIT: | |
382 | AV* a; | |
383 | SV* temp; | |
6c0b8e73 | 384 | IV elems; |
062a4e99 T |
385 | STRLEN len; |
386 | ||
387 | CODE: | |
388 | a = (AV*)SvRV(x); /* ref to aray, don't check ref */ | |
6c0b8e73 | 389 | elems = av_len(a); /* number of elems in array */ |
062a4e99 T |
390 | temp = *av_fetch(a, elems, 0); /* fetch last element */ |
391 | SvPV(temp, len); /* convert to string & store length */ | |
6c0b8e73 | 392 | len += (IV) XS_BASE_LEN * elems; |
062a4e99 T |
393 | ST(0) = newSViv(len); |
394 | ||
395 | ############################################################################## | |
396 | ||
397 | void | |
398 | _acmp(class, cx, cy); | |
399 | SV* cx | |
400 | SV* cy | |
401 | INIT: | |
402 | AV* array_x; | |
403 | AV* array_y; | |
404 | I32 elemsx, elemsy, diff; | |
405 | SV* tempx; | |
406 | SV* tempy; | |
407 | STRLEN lenx; | |
408 | STRLEN leny; | |
409 | NV diff_nv; | |
410 | I32 diff_str; | |
411 | ||
412 | CODE: | |
413 | array_x = (AV*)SvRV(cx); /* ref to aray, don't check ref */ | |
414 | array_y = (AV*)SvRV(cy); /* ref to aray, don't check ref */ | |
415 | elemsx = av_len(array_x); | |
416 | elemsy = av_len(array_y); | |
417 | diff = elemsx - elemsy; /* difference */ | |
418 | ||
419 | if (diff > 0) | |
420 | { | |
421 | ST(0) = newSViv(1); /* len differs: X > Y */ | |
422 | XSRETURN(1); | |
423 | } | |
424 | if (diff < 0) | |
425 | { | |
426 | ST(0) = newSViv(-1); /* len differs: X < Y */ | |
427 | XSRETURN(1); | |
428 | } | |
429 | /* both have same number of elements, so check length of last element | |
430 | and see if it differes */ | |
431 | tempx = *av_fetch(array_x, elemsx, 0); /* fetch last element */ | |
432 | tempy = *av_fetch(array_y, elemsx, 0); /* fetch last element */ | |
433 | SvPV(tempx, lenx); /* convert to string & store length */ | |
434 | SvPV(tempy, leny); /* convert to string & store length */ | |
435 | diff_str = (I32)lenx - (I32)leny; | |
436 | if (diff_str > 0) | |
437 | { | |
438 | ST(0) = newSViv(1); /* same len, but first elems differs in len */ | |
439 | XSRETURN(1); | |
440 | } | |
441 | if (diff_str < 0) | |
442 | { | |
443 | ST(0) = newSViv(-1); /* same len, but first elems differs in len */ | |
444 | XSRETURN(1); | |
445 | } | |
446 | /* same number of digits, so need to make a full compare */ | |
447 | diff_nv = 0; | |
448 | while (elemsx >= 0) | |
449 | { | |
450 | tempx = *av_fetch(array_x, elemsx, 0); /* fetch curr x element */ | |
451 | tempy = *av_fetch(array_y, elemsx, 0); /* fetch curr y element */ | |
452 | diff_nv = SvNV(tempx) - SvNV(tempy); | |
453 | if (diff_nv != 0) | |
454 | { | |
455 | break; | |
456 | } | |
457 | elemsx--; | |
458 | } | |
459 | if (diff_nv > 0) | |
460 | { | |
461 | ST(0) = newSViv(1); | |
462 | XSRETURN(1); | |
463 | } | |
464 | if (diff_nv < 0) | |
465 | { | |
466 | ST(0) = newSViv(-1); | |
467 | XSRETURN(1); | |
468 | } | |
469 | ST(0) = newSViv(0); /* equal */ | |
470 |