This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
New core module, Math::BigInt::FastCalc
[perl5.git] / ext / Math / BigInt / FastCalc / FastCalc.xs
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
233 void
234 _zero(class)
235   INIT:
236     AV* a;
237
238   CODE:
239     a = newAV();
240     av_push (a, newSViv( 0 ));          /* zero */
241     ST(0) = newRV_noinc((SV*) a);
242
243 ##############################################################################
244
245 void
246 _one(class)
247   INIT:
248     AV* a;
249
250   CODE:
251     a = newAV();
252     av_push (a, newSViv( 1 ));          /* one */
253     ST(0) = newRV_noinc((SV*) a);
254
255 ##############################################################################
256
257 void
258 _two(class)
259   INIT:
260     AV* a;
261
262   CODE:
263     a = newAV();
264     av_push (a, newSViv( 2 ));          /* two */
265     ST(0) = newRV_noinc((SV*) a);
266
267 ##############################################################################
268
269 void
270 _ten(class)
271   INIT:
272     AV* a;
273
274   CODE:
275     a = newAV();
276     av_push (a, newSViv( 10 ));         /* ten */
277     ST(0) = newRV_noinc((SV*) a);
278
279 ##############################################################################
280
281 void
282 _is_even(class, x)
283   SV*   x
284   INIT:
285     AV* a;
286     SV* temp;
287
288   CODE:
289     a = (AV*)SvRV(x);           /* ref to aray, don't check ref */
290     temp = *av_fetch(a, 0, 0);  /* fetch first element */
291     ST(0) = boolSV((SvIV(temp) & 1) == 0);
292
293 ##############################################################################
294
295 void
296 _is_odd(class, x)
297   SV*   x
298   INIT:
299     AV* a;
300     SV* temp;
301
302   CODE:
303     a = (AV*)SvRV(x);           /* ref to aray, don't check ref */
304     temp = *av_fetch(a, 0, 0);  /* fetch first element */
305     ST(0) = boolSV((SvIV(temp) & 1) != 0);
306
307 ##############################################################################
308
309 void
310 _is_one(class, x)
311   SV*   x
312   INIT:
313     AV* a;
314     SV* temp;
315
316   CODE:
317     a = (AV*)SvRV(x);                   /* ref to aray, don't check ref */
318     if ( av_len(a) != 0)
319       {
320       ST(0) = &PL_sv_no;
321       XSRETURN(1);                      /* len != 1, can't be '1' */
322       }
323     temp = *av_fetch(a, 0, 0);          /* fetch first element */
324     ST(0) = boolSV((SvIV(temp) == 1));
325
326 ##############################################################################
327
328 void
329 _is_two(class, x)
330   SV*   x
331   INIT:
332     AV* a;
333     SV* temp;
334
335   CODE:
336     a = (AV*)SvRV(x);                   /* ref to aray, don't check ref */
337     if ( av_len(a) != 0)
338       {
339       ST(0) = &PL_sv_no;
340       XSRETURN(1);                      /* len != 1, can't be '2' */
341       }
342     temp = *av_fetch(a, 0, 0);          /* fetch first element */
343     ST(0) = boolSV((SvIV(temp) == 2));
344
345 ##############################################################################
346
347 void
348 _is_ten(class, x)
349   SV*   x
350   INIT:
351     AV* a;
352     SV* temp;
353
354   CODE:
355     a = (AV*)SvRV(x);                   /* ref to aray, don't check ref */
356     if ( av_len(a) != 0)
357       {
358       ST(0) = &PL_sv_no;
359       XSRETURN(1);                      /* len != 1, can't be '10' */
360       }
361     temp = *av_fetch(a, 0, 0);          /* fetch first element */
362     ST(0) = boolSV((SvIV(temp) == 10));
363
364 ##############################################################################
365
366 void
367 _is_zero(class, x)
368   SV*   x
369   INIT:
370     AV* a;
371     SV* temp;
372
373   CODE:
374     a = (AV*)SvRV(x);                   /* ref to aray, don't check ref */
375     if ( av_len(a) != 0)
376       {
377       ST(0) = &PL_sv_no;
378       XSRETURN(1);                      /* len != 1, can't be '0' */
379       }
380     temp = *av_fetch(a, 0, 0);          /* fetch first element */
381     ST(0) = boolSV((SvIV(temp) == 0));
382
383 ##############################################################################
384
385 void
386 _len(class,x)
387   SV*   x
388   INIT:
389     AV* a;
390     SV* temp;
391     NV  elems;
392     STRLEN len;
393
394   CODE:
395     a = (AV*)SvRV(x);                   /* ref to aray, don't check ref */
396     elems = (NV) av_len(a);             /* number of elems in array */
397     temp = *av_fetch(a, elems, 0);      /* fetch last element */
398     SvPV(temp, len);                    /* convert to string & store length */
399     len += XS_BASE_LEN * elems;
400     ST(0) = newSViv(len);
401
402 ##############################################################################
403
404 void
405 _acmp(class, cx, cy);
406   SV*  cx
407   SV*  cy
408   INIT:
409     AV* array_x;
410     AV* array_y;
411     I32 elemsx, elemsy, diff;
412     SV* tempx;
413     SV* tempy;
414     STRLEN lenx;
415     STRLEN leny;
416     NV diff_nv;
417     I32 diff_str;
418
419   CODE:
420     array_x = (AV*)SvRV(cx);            /* ref to aray, don't check ref */
421     array_y = (AV*)SvRV(cy);            /* ref to aray, don't check ref */
422     elemsx =  av_len(array_x);
423     elemsy =  av_len(array_y);
424     diff = elemsx - elemsy;             /* difference */
425
426     if (diff > 0)
427       {
428       ST(0) = newSViv(1);               /* len differs: X > Y */
429       XSRETURN(1);
430       }
431     if (diff < 0)
432       {
433       ST(0) = newSViv(-1);              /* len differs: X < Y */
434       XSRETURN(1);
435       }
436     /* both have same number of elements, so check length of last element
437        and see if it differes */
438     tempx = *av_fetch(array_x, elemsx, 0);      /* fetch last element */
439     tempy = *av_fetch(array_y, elemsx, 0);      /* fetch last element */
440     SvPV(tempx, lenx);                  /* convert to string & store length */
441     SvPV(tempy, leny);                  /* convert to string & store length */
442     diff_str = (I32)lenx - (I32)leny;
443     if (diff_str > 0)
444       {
445       ST(0) = newSViv(1);               /* same len, but first elems differs in len */
446       XSRETURN(1);
447       }
448     if (diff_str < 0)
449       {
450       ST(0) = newSViv(-1);              /* same len, but first elems differs in len */
451       XSRETURN(1);
452       }
453     /* same number of digits, so need to make a full compare */
454     diff_nv = 0;
455     while (elemsx >= 0)
456       {
457       tempx = *av_fetch(array_x, elemsx, 0);    /* fetch curr x element */
458       tempy = *av_fetch(array_y, elemsx, 0);    /* fetch curr y element */
459       diff_nv = SvNV(tempx) - SvNV(tempy);
460       if (diff_nv != 0)
461         {
462         break; 
463         }
464       elemsx--;
465       } 
466     if (diff_nv > 0)
467       {
468       ST(0) = newSViv(1);
469       XSRETURN(1);
470       }
471     if (diff_nv < 0)
472       {
473       ST(0) = newSViv(-1);
474       XSRETURN(1);
475       }
476     ST(0) = newSViv(0);         /* equal */
477