5 /* for Perl prior to v5.7.1 */
7 # define SvUOK(sv) SvIOK_UV(sv)
11 double XS_BASE_LEN = 0;
13 MODULE = Math::BigInt::FastCalc PACKAGE = Math::BigInt::FastCalc
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()
28 # 2007-04-02 0.08 Tels
29 # * plug leaks by creating mortals
30 # 2007-05-27 0.09 Tels
33 #define RETURN_MORTAL_INT(value) \
34 ST(0) = sv_2mortal(newSViv(value)); \
37 #define RETURN_MORTAL_BOOL(temp, comp) \
38 ST(0) = sv_2mortal(boolSV( SvIV(temp) == comp));
40 #define CONSTANT_OBJ(int) \
42 sv_2mortal((SV*)RETVAL); \
43 av_push (RETVAL, newSViv( int ));
46 _set_XS_BASE(BASE, BASE_LEN)
52 XS_BASE_LEN = SvIV(BASE_LEN);
54 ##############################################################################
66 /* create the array */
68 sv_2mortal((SV*)RETVAL);
69 if (SvUOK(x) && SvUV(x) < XS_BASE)
71 /* shortcut for integer arguments */
72 av_push (RETVAL, newSVuv( SvUV(x) ));
76 /* split the input (as string) into XS_BASE_LEN long parts */
78 [ reverse(unpack("a" . ($il % $BASE_LEN+1)
79 . ("a$BASE_LEN" x ($il / $BASE_LEN)), $_[1])) ];
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
86 /* use either BASE_LEN or the amount of remaining digits */
87 part_len = (STRLEN) XS_BASE_LEN;
92 /* processed so many digits */
95 /* printf ("part '%s' (part_len: %i, len: %i, BASE_LEN: %i)\n", cur, part_len, len, XS_BASE_LEN); */
98 av_push (RETVAL, newSVpvn(cur, part_len) );
105 ##############################################################################
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());
120 av_extend (a2, elems); /* pre-padd */
123 /* av_store( a2, elems, newSVsv( (SV*)*av_fetch(a, elems, 0) ) ); */
125 /* looking and trying to preserve IV is actually slower when copying */
126 /* temp = (SV*)*av_fetch(a, elems, 0);
129 av_store( a2, elems, newSViv( SvIV( (SV*)*av_fetch(a, elems, 0) )));
133 av_store( a2, elems, newSVnv( SvNV( (SV*)*av_fetch(a, elems, 0) )));
136 av_store( a2, elems, newSVnv( SvNV( (SV*)*av_fetch(a, elems, 0) )));
139 ST(0) = sv_2mortal( newRV_inc((SV*) a2) );
141 ##############################################################################
142 # __strip_zeros (also check for empty arrays from div)
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 */
159 av_push (a, newSViv(0)); /* correct empty arrays */
164 XSRETURN(1); /* nothing to do since only one elem */
169 temp = *av_fetch(a, index, 0); /* fetch ptr to current element */
178 index = elems - index;
186 ##############################################################################
187 # decrement (subtract one)
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 */
206 while (index <= elems)
208 temp = *av_fetch(a, index, 0); /* fetch ptr to current element */
209 sv_setnv (temp, SvNV(temp)-1); /* decrement */
212 break; /* early out */
214 sv_setnv (temp, MAX); /* overflow, so set this to $MAX */
217 /* do have more than one element? */
218 /* (more than one because [0] should be kept as single-element) */
221 temp = *av_fetch(a, elems, 0); /* fetch last element */
222 if (SvIV(temp) == 0) /* did last elem overflow? */
224 av_pop(a); /* yes, so shrink array */
225 /* aka remove leading zeros */
228 XSRETURN(1); /* return x */
230 ##############################################################################
231 # increment (add one)
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 */
250 while (index <= elems)
252 temp = *av_fetch(a, index, 0); /* fetch ptr to current element */
253 sv_setnv (temp, SvNV(temp)+1);
254 if (SvNV(temp) < BASE)
256 XSRETURN(1); /* return (early out) */
258 sv_setiv (temp, 0); /* overflow, so set this elem to 0 */
261 temp = *av_fetch(a, elems, 0); /* fetch last element */
262 if (SvIV(temp) == 0) /* did last elem overflow? */
264 av_push(a, newSViv(1)); /* yes, so extend array by 1 */
266 XSRETURN(1); /* return x */
268 ##############################################################################
269 # Make a number (scalar int/float) from a BigInt object
284 a = (AV*)SvRV(x); /* ref to aray, don't check ref */
285 elems = av_len(a); /* number of elems in array */
287 if (elems == 0) /* only one element? */
289 ST(0) = *av_fetch(a, 0, 0); /* fetch first (only) element */
290 XSRETURN(1); /* return it */
292 fac = 1.0; /* factor */
296 while (index <= elems)
298 temp = *av_fetch(a, index, 0); /* fetch current element */
299 num += fac * SvNV(temp);
303 ST(0) = newSVnv(num);
305 ##############################################################################
314 ##############################################################################
323 ##############################################################################
332 ##############################################################################
341 ##############################################################################
351 a = (AV*)SvRV(x); /* ref to aray, don't check ref */
352 temp = *av_fetch(a, 0, 0); /* fetch first element */
353 ST(0) = sv_2mortal(boolSV((SvIV(temp) & 1) == 0));
355 ##############################################################################
365 a = (AV*)SvRV(x); /* ref to aray, don't check ref */
366 temp = *av_fetch(a, 0, 0); /* fetch first element */
367 ST(0) = sv_2mortal(boolSV((SvIV(temp) & 1) != 0));
369 ##############################################################################
379 a = (AV*)SvRV(x); /* ref to aray, don't check ref */
383 XSRETURN(1); /* len != 1, can't be '1' */
385 temp = *av_fetch(a, 0, 0); /* fetch first element */
386 RETURN_MORTAL_BOOL(temp, 1);
388 ##############################################################################
398 a = (AV*)SvRV(x); /* ref to aray, don't check ref */
402 XSRETURN(1); /* len != 1, can't be '2' */
404 temp = *av_fetch(a, 0, 0); /* fetch first element */
405 RETURN_MORTAL_BOOL(temp, 2);
407 ##############################################################################
417 a = (AV*)SvRV(x); /* ref to aray, don't check ref */
421 XSRETURN(1); /* len != 1, can't be '10' */
423 temp = *av_fetch(a, 0, 0); /* fetch first element */
424 RETURN_MORTAL_BOOL(temp, 10);
426 ##############################################################################
436 a = (AV*)SvRV(x); /* ref to aray, don't check ref */
440 XSRETURN(1); /* len != 1, can't be '0' */
442 temp = *av_fetch(a, 0, 0); /* fetch first element */
443 RETURN_MORTAL_BOOL(temp, 0);
445 ##############################################################################
457 a = (AV*)SvRV(x); /* ref to aray, don't check ref */
458 elems = av_len(a); /* number of elems in array */
459 temp = *av_fetch(a, elems, 0); /* fetch last element */
460 SvPV(temp, len); /* convert to string & store length */
461 len += (IV) XS_BASE_LEN * elems;
462 ST(0) = sv_2mortal(newSViv(len));
464 ##############################################################################
467 _acmp(class, cx, cy);
473 I32 elemsx, elemsy, diff;
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 */
490 RETURN_MORTAL_INT(1); /* len differs: X > Y */
494 RETURN_MORTAL_INT(-1); /* len differs: X < Y */
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;
505 RETURN_MORTAL_INT(1); /* same len, but first elems differs in len */
509 RETURN_MORTAL_INT(-1); /* same len, but first elems differs in len */
511 /* same number of digits, so need to make a full compare */
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);
526 RETURN_MORTAL_INT(1);
530 RETURN_MORTAL_INT(-1);
532 ST(0) = sv_2mortal(newSViv(0)); /* X and Y are equal */