File Coverage

dist/Math-BigInt-FastCalc/FastCalc.xs
Criterion Covered Total %
statement 118 120 98.3
branch n/a
condition n/a
subroutine n/a
total 118 120 98.3


line stmt bran cond sub time code
1           #define PERL_NO_GET_CONTEXT
2            
3           #include "EXTERN.h"
4           #include "perl.h"
5           #include "XSUB.h"
6            
7           /* for Perl prior to v5.7.1 */
8           #ifndef SvUOK
9           # define SvUOK(sv) SvIOK_UV(sv)
10           #endif
11            
12           /* for Perl v5.6 (RT #63859) */
13           #ifndef croak_xs_usage
14           # define croak_xs_usage croak
15           #endif
16            
17           double XS_BASE = 0;
18           double XS_BASE_LEN = 0;
19            
20           MODULE = Math::BigInt::FastCalc PACKAGE = Math::BigInt::FastCalc
21            
22           PROTOTYPES: DISABLE
23            
24           #############################################################################
25           # 2002-08-12 0.03 Tels unreleased
26           # * is_zero/is_one/is_odd/is_even/len work now (pass v1.61 tests)
27           # 2002-08-13 0.04 Tels unreleased
28           # * returns no/yes for is_foo() methods to be faster
29           # 2002-08-18 0.06alpha
30           # * added _num(), _inc() and _dec()
31           # 2002-08-25 0.06 Tels
32           # * added __strip_zeros(), _copy()
33           # 2004-08-13 0.07 Tels
34           # * added _is_two(), _is_ten(), _ten()
35           # 2007-04-02 0.08 Tels
36           # * plug leaks by creating mortals
37           # 2007-05-27 0.09 Tels
38           # * add _new()
39            
40           #define RETURN_MORTAL_INT(value) \
41           ST(0) = sv_2mortal(newSViv(value)); \
42           XSRETURN(1);
43            
44           BOOT:
45           {
46 8         if (items < 4)
47 0         croak("Usage: Math::BigInt::FastCalc::BOOT(package, version, base_len, base)");
48 8         XS_BASE_LEN = SvIV(ST(2));
49 8         XS_BASE = SvNV(ST(3));
50           }
51            
52           ##############################################################################
53           # _new
54            
55           SV *
56           _new(class, x)
57           SV* x
58           INIT:
59           STRLEN len;
60           char* cur;
61           STRLEN part_len;
62 1016         AV *av = newAV();
63            
64           CODE:
65 1016         if (SvUOK(x) && SvUV(x) < XS_BASE)
66           {
67           /* shortcut for integer arguments */
68 0         av_push (av, newSVuv( SvUV(x) ));
69           }
70           else
71           {
72           /* split the input (as string) into XS_BASE_LEN long parts */
73           /* in perl:
74           [ reverse(unpack("a" . ($il % $BASE_LEN+1)
75           . ("a$BASE_LEN" x ($il / $BASE_LEN)), $_[1])) ];
76           */
77 1016         cur = SvPV(x, len); /* convert to string & store length */
78 1016         cur += len; /* doing "cur = SvEND(x)" does not work! */
79 6918         # process the string from the back
80           while (len > 0)
81           {
82 4886         /* use either BASE_LEN or the amount of remaining digits */
83 4886         part_len = (STRLEN) XS_BASE_LEN;
84           if (part_len > len)
85 918         {
86           part_len = len;
87           }
88 4886         /* processed so many digits */
89 4886         cur -= part_len;
90           len -= part_len;
91 4886         /* printf ("part '%s' (part_len: %i, len: %i, BASE_LEN: %i)\n", cur, part_len, len, XS_BASE_LEN); */
92           if (part_len > 0)
93 4886         {
94           av_push (av, newSVpvn(cur, part_len) );
95           }
96           }
97 1016         }
98           RETVAL = newRV_noinc((SV *)av);
99           OUTPUT:
100           RETVAL
101            
102           ##############################################################################
103           # _copy
104            
105           void
106           _copy(class, x)
107           SV* x
108           INIT:
109           AV* a;
110           AV* a2;
111           SSize_t elems;
112            
113           CODE:
114 2578         a = (AV*)SvRV(x); /* ref to aray, don't check ref */
115 2578         elems = av_len(a); /* number of elems in array */
116 2578         a2 = (AV*)sv_2mortal((SV*)newAV());
117 2578         av_extend (a2, elems); /* pre-padd */
118 18886         while (elems >= 0)
119           {
120           /* av_store( a2, elems, newSVsv( (SV*)*av_fetch(a, elems, 0) ) ); */
121            
122           /* looking and trying to preserve IV is actually slower when copying */
123           /* temp = (SV*)*av_fetch(a, elems, 0);
124           if (SvIOK(temp))
125           {
126           av_store( a2, elems, newSViv( SvIV( (SV*)*av_fetch(a, elems, 0) )));
127           }
128           else
129           {
130           av_store( a2, elems, newSVnv( SvNV( (SV*)*av_fetch(a, elems, 0) )));
131           }
132           */
133 13730         av_store( a2, elems, newSVnv( SvNV( (SV*)*av_fetch(a, elems, 0) )));
134 13730         elems--;
135           }
136 2578         ST(0) = sv_2mortal( newRV_inc((SV*) a2) );
137            
138           ##############################################################################
139           # __strip_zeros (also check for empty arrays from div)
140            
141           void
142           __strip_zeros(x)
143           SV* x
144           INIT:
145           AV* a;
146           SV* temp;
147           SSize_t elems;
148           SSize_t index;
149            
150           CODE:
151 18         a = (AV*)SvRV(x); /* ref to aray, don't check ref */
152 18         elems = av_len(a); /* number of elems in array */
153 18         ST(0) = x; /* we return x */
154 18         if (elems == -1)
155           {
156 2         av_push (a, newSViv(0)); /* correct empty arrays */
157 2         XSRETURN(1);
158           }
159 16         if (elems == 0)
160           {
161 4         XSRETURN(1); /* nothing to do since only one elem */
162           }
163           index = elems;
164 30         while (index > 0)
165           {
166 28         temp = *av_fetch(a, index, 0); /* fetch ptr to current element */
167 28         if (SvNV(temp) != 0)
168           {
169           break;
170           }
171 18         index--;
172           }
173 12         if (index < elems)
174           {
175 8         index = elems - index;
176 34         while (index-- > 0)
177           {
178 18         av_pop (a);
179           }
180           }
181 12         XSRETURN(1);
182            
183           ##############################################################################
184           # decrement (subtract one)
185            
186           void
187           _dec(class,x)
188           SV* x
189           INIT:
190           AV* a;
191           SV* temp;
192           SSize_t elems;
193           SSize_t index;
194           NV MAX;
195            
196           CODE:
197 54         a = (AV*)SvRV(x); /* ref to aray, don't check ref */
198 54         elems = av_len(a); /* number of elems in array */
199 54         ST(0) = x; /* we return x */
200            
201 54         MAX = XS_BASE - 1;
202           index = 0;
203 116         while (index <= elems)
204           {
205 62         temp = *av_fetch(a, index, 0); /* fetch ptr to current element */
206 62         sv_setnv (temp, SvNV(temp)-1); /* decrement */
207 62         if (SvNV(temp) >= 0)
208           {
209           break; /* early out */
210           }
211 8         sv_setnv (temp, MAX); /* overflow, so set this to $MAX */
212 8         index++;
213           }
214           /* do have more than one element? */
215           /* (more than one because [0] should be kept as single-element) */
216 54         if (elems > 0)
217           {
218 12         temp = *av_fetch(a, elems, 0); /* fetch last element */
219 12         if (SvIV(temp) == 0) /* did last elem overflow? */
220           {
221 4         av_pop(a); /* yes, so shrink array */
222           /* aka remove leading zeros */
223           }
224           }
225 54         XSRETURN(1); /* return x */
226            
227           ##############################################################################
228           # increment (add one)
229            
230           void
231           _inc(class,x)
232           SV* x
233           INIT:
234           AV* a;
235           SV* temp;
236           SSize_t elems;
237           SSize_t index;
238           NV BASE;
239            
240           CODE:
241 56         a = (AV*)SvRV(x); /* ref to aray, don't check ref */
242 56         elems = av_len(a); /* number of elems in array */
243 56         ST(0) = x; /* we return x */
244            
245 56         BASE = XS_BASE;
246           index = 0;
247 118         while (index <= elems)
248           {
249 60         temp = *av_fetch(a, index, 0); /* fetch ptr to current element */
250 60         sv_setnv (temp, SvNV(temp)+1);
251 60         if (SvNV(temp) < BASE)
252           {
253 54         XSRETURN(1); /* return (early out) */
254           }
255 6         sv_setiv (temp, 0); /* overflow, so set this elem to 0 */
256 6         index++;
257           }
258 2         temp = *av_fetch(a, elems, 0); /* fetch last element */
259 2         if (SvIV(temp) == 0) /* did last elem overflow? */
260           {
261 2         av_push(a, newSViv(1)); /* yes, so extend array by 1 */
262           }
263 2         XSRETURN(1); /* return x */
264            
265           ##############################################################################
266            
267           SV *
268           _zero(class)
269           ALIAS:
270           _one = 1
271           _two = 2
272           _ten = 10
273           PREINIT:
274 562         AV *av = newAV();
275           CODE:
276 562         av_push (av, newSViv( ix ));
277 562         RETVAL = newRV_noinc((SV *)av);
278           OUTPUT:
279           RETVAL
280            
281           ##############################################################################
282            
283           void
284           _is_even(class, x)
285           SV* x
286           ALIAS:
287           _is_odd = 1
288           INIT:
289           AV* a;
290           SV* temp;
291            
292           CODE:
293 8         a = (AV*)SvRV(x); /* ref to aray, don't check ref */
294 8         temp = *av_fetch(a, 0, 0); /* fetch first element */
295 8         ST(0) = sv_2mortal(boolSV((SvIV(temp) & 1) == ix));
296            
297           ##############################################################################
298            
299           void
300           _is_zero(class, x)
301           SV* x
302           ALIAS:
303           _is_one = 1
304           _is_two = 2
305           _is_ten = 10
306           INIT:
307           AV* a;
308            
309           CODE:
310 3616         a = (AV*)SvRV(x); /* ref to aray, don't check ref */
311 3616         if ( av_len(a) != 0)
312           {
313 2974         ST(0) = &PL_sv_no; /* len != 1, can't be '0' */
314           }
315           else
316           {
317 642         SV *const temp = *av_fetch(a, 0, 0); /* fetch first element */
318 642         ST(0) = boolSV(SvIV(temp) == ix);
319           }
320 3616         XSRETURN(1);
321            
322           ##############################################################################
323            
324           void
325           _len(class,x)
326           SV* x
327           INIT:
328           AV* a;
329           SV* temp;
330           IV elems;
331           STRLEN len;
332            
333           CODE:
334 86         a = (AV*)SvRV(x); /* ref to aray, don't check ref */
335 86         elems = av_len(a); /* number of elems in array */
336 86         temp = *av_fetch(a, elems, 0); /* fetch last element */
337 86         SvPV(temp, len); /* convert to string & store length */
338 86         len += (IV) XS_BASE_LEN * elems;
339 86         ST(0) = sv_2mortal(newSViv(len));
340            
341           ##############################################################################
342            
343           void
344           _acmp(class, cx, cy);
345           SV* cx
346           SV* cy
347           INIT:
348           AV* array_x;
349           AV* array_y;
350           SSize_t elemsx, elemsy, diff;
351           SV* tempx;
352           SV* tempy;
353           STRLEN lenx;
354           STRLEN leny;
355           NV diff_nv;
356           SSize_t diff_str;
357            
358           CODE:
359 568         array_x = (AV*)SvRV(cx); /* ref to aray, don't check ref */
360 568         array_y = (AV*)SvRV(cy); /* ref to aray, don't check ref */
361 568         elemsx = av_len(array_x);
362 568         elemsy = av_len(array_y);
363 568         diff = elemsx - elemsy; /* difference */
364            
365 568         if (diff > 0)
366           {
367 10         RETURN_MORTAL_INT(1); /* len differs: X > Y */
368           }
369 558         else if (diff < 0)
370           {
371 272         RETURN_MORTAL_INT(-1); /* len differs: X < Y */
372           }
373           /* both have same number of elements, so check length of last element
374           and see if it differs */
375 286         tempx = *av_fetch(array_x, elemsx, 0); /* fetch last element */
376 286         tempy = *av_fetch(array_y, elemsx, 0); /* fetch last element */
377 286         SvPV(tempx, lenx); /* convert to string & store length */
378 286         SvPV(tempy, leny); /* convert to string & store length */
379 286         diff_str = (SSize_t)lenx - (SSize_t)leny;
380 286         if (diff_str > 0)
381           {
382 2         RETURN_MORTAL_INT(1); /* same len, but first elems differs in len */
383           }
384 284         if (diff_str < 0)
385           {
386 142         RETURN_MORTAL_INT(-1); /* same len, but first elems differs in len */
387           }
388           /* same number of digits, so need to make a full compare */
389           diff_nv = 0;
390 172         while (elemsx >= 0)
391           {
392 152         tempx = *av_fetch(array_x, elemsx, 0); /* fetch curr x element */
393 152         tempy = *av_fetch(array_y, elemsx, 0); /* fetch curr y element */
394 152         diff_nv = SvNV(tempx) - SvNV(tempy);
395 152         if (diff_nv != 0)
396           {
397           break;
398           }
399 30         elemsx--;
400           }
401 142         if (diff_nv > 0)
402           {
403 6         RETURN_MORTAL_INT(1);
404           }
405 136         if (diff_nv < 0)
406           {
407 116         RETURN_MORTAL_INT(-1);
408           }
409 20         ST(0) = sv_2mortal(newSViv(0)); /* X and Y are equal */
410