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