This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
152eb0bcd19456a6591d5887cb73a19011c760b8
[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 #define CONSTANT_OBJ(int)               \
234     RETVAL = newAV();                   \
235     sv_2mortal((SV*)RETVAL);            \
236     av_push (RETVAL, newSViv( int ));
237
238 AV *
239 _zero(class)
240   CODE:
241     CONSTANT_OBJ(0)
242   OUTPUT:
243     RETVAL
244
245 ##############################################################################
246
247 AV *
248 _one(class)
249   CODE:
250     CONSTANT_OBJ(1)
251   OUTPUT:
252     RETVAL
253
254 ##############################################################################
255
256 AV *
257 _two(class)
258   CODE:
259     CONSTANT_OBJ(2)
260   OUTPUT:
261     RETVAL
262
263 ##############################################################################
264
265 AV *
266 _ten(class)
267   CODE:
268     CONSTANT_OBJ(10)
269   OUTPUT:
270     RETVAL
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;
384     NV  elems;
385     STRLEN len;
386
387   CODE:
388     a = (AV*)SvRV(x);                   /* ref to aray, don't check ref */
389     elems = (NV) av_len(a);             /* number of elems in array */
390     temp = *av_fetch(a, elems, 0);      /* fetch last element */
391     SvPV(temp, len);                    /* convert to string & store length */
392     len += XS_BASE_LEN * elems;
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