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
17static double XS_BASE = 0;
18static double XS_BASE_LEN = 0;
19
20MODULE = Math::BigInt::FastCalc		PACKAGE = Math::BigInt::FastCalc
21
22PROTOTYPES: 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
44BOOT:
45{
46    if (items < 4)
47	croak("Usage: Math::BigInt::FastCalc::BOOT(package, version, base_len, base)");
48    XS_BASE_LEN = SvIV(ST(2));
49    XS_BASE = SvNV(ST(3));
50}
51
52##############################################################################
53# _new
54
55SV *
56_new(class, x)
57  SV*	x
58  INIT:
59    STRLEN len;
60    char* cur;
61    STRLEN part_len;
62    AV *av = newAV();
63
64  CODE:
65    if (SvUOK(x) && SvUV(x) < XS_BASE)
66      {
67      /* shortcut for integer arguments */
68      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      cur = SvPV(x, len);			/* convert to string & store length */
78      cur += len;				/* doing "cur = SvEND(x)" does not work! */
79      # process the string from the back
80      while (len > 0)
81        {
82        /* use either BASE_LEN or the amount of remaining digits */
83        part_len = (STRLEN) XS_BASE_LEN;
84        if (part_len > len)
85          {
86          part_len = len;
87          }
88        /* processed so many digits */
89        cur -= part_len;
90        len -= part_len;
91        /* 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	  {
94	  av_push (av, newSVpvn(cur, part_len) );
95	  }
96        }
97      }
98    RETVAL = newRV_noinc((SV *)av);
99  OUTPUT:
100    RETVAL
101
102##############################################################################
103# _copy
104
105void
106_copy(class, x)
107  SV*	x
108  INIT:
109    AV*	a;
110    AV*	a2;
111    SSize_t elems;
112
113  CODE:
114    a = (AV*)SvRV(x);			/* ref to aray, don't check ref */
115    elems = av_len(a);			/* number of elems in array */
116    a2 = (AV*)sv_2mortal((SV*)newAV());
117    av_extend (a2, elems);		/* pre-padd */
118    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      av_store( a2,  elems, newSVnv( SvNV( (SV*)*av_fetch(a, elems, 0) )));
134      elems--;
135      }
136    ST(0) = sv_2mortal( newRV_inc((SV*) a2) );
137
138##############################################################################
139# __strip_zeros (also check for empty arrays from div)
140
141void
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    a = (AV*)SvRV(x);			/* ref to aray, don't check ref */
152    elems = av_len(a);			/* number of elems in array */
153    ST(0) = x;				/* we return x */
154    if (elems == -1)
155      {
156      av_push (a, newSViv(0));		/* correct empty arrays */
157      XSRETURN(1);
158      }
159    if (elems == 0)
160      {
161      XSRETURN(1);			/* nothing to do since only one elem */
162      }
163    index = elems;
164    while (index > 0)
165      {
166      temp = *av_fetch(a, index, 0);	/* fetch ptr to current element */
167      if (SvNV(temp) != 0)
168        {
169        break;
170        }
171      index--;
172      }
173    if (index < elems)
174      {
175      index = elems - index;
176      while (index-- > 0)
177        {
178        av_pop (a);
179        }
180      }
181    XSRETURN(1);
182
183##############################################################################
184# decrement (subtract one)
185
186void
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    a = (AV*)SvRV(x);			/* ref to aray, don't check ref */
198    elems = av_len(a);			/* number of elems in array */
199    ST(0) = x;				/* we return x */
200
201    MAX = XS_BASE - 1;
202    index = 0;
203    while (index <= elems)
204      {
205      temp = *av_fetch(a, index, 0);	/* fetch ptr to current element */
206      sv_setnv (temp, SvNV(temp)-1);	/* decrement */
207      if (SvNV(temp) >= 0)
208        {
209        break;				/* early out */
210        }
211      sv_setnv (temp, MAX);		/* overflow, so set this to $MAX */
212      index++;
213      }
214    /* do have more than one element? */
215    /* (more than one because [0] should be kept as single-element) */
216    if (elems > 0)
217      {
218      temp = *av_fetch(a, elems, 0);	/* fetch last element */
219      if (SvIV(temp) == 0)		/* did last elem overflow? */
220        {
221        av_pop(a);			/* yes, so shrink array */
222        				/* aka remove leading zeros */
223        }
224      }
225    XSRETURN(1);			/* return x */
226
227##############################################################################
228# increment (add one)
229
230void
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    a = (AV*)SvRV(x);			/* ref to aray, don't check ref */
242    elems = av_len(a);			/* number of elems in array */
243    ST(0) = x;				/* we return x */
244
245    BASE = XS_BASE;
246    index = 0;
247    while (index <= elems)
248      {
249      temp = *av_fetch(a, index, 0);	/* fetch ptr to current element */
250      sv_setnv (temp, SvNV(temp)+1);
251      if (SvNV(temp) < BASE)
252        {
253        XSRETURN(1);			/* return (early out) */
254        }
255      sv_setiv (temp, 0);		/* overflow, so set this elem to 0 */
256      index++;
257      }
258    temp = *av_fetch(a, elems, 0);	/* fetch last element */
259    if (SvIV(temp) == 0)		/* did last elem overflow? */
260      {
261      av_push(a, newSViv(1));		/* yes, so extend array by 1 */
262      }
263    XSRETURN(1);			/* return x */
264
265##############################################################################
266
267SV *
268_zero(class)
269  ALIAS:
270    _one = 1
271    _two = 2
272    _ten = 10
273  PREINIT:
274    AV *av = newAV();
275  CODE:
276    av_push (av, newSViv( ix ));
277    RETVAL = newRV_noinc((SV *)av);
278  OUTPUT:
279    RETVAL
280
281##############################################################################
282
283void
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    a = (AV*)SvRV(x);		/* ref to aray, don't check ref */
294    temp = *av_fetch(a, 0, 0);	/* fetch first element */
295    ST(0) = sv_2mortal(boolSV((SvIV(temp) & 1) == ix));
296
297##############################################################################
298
299void
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    a = (AV*)SvRV(x);			/* ref to aray, don't check ref */
311    if ( av_len(a) != 0)
312      {
313      ST(0) = &PL_sv_no;		/* len != 1, can't be '0' */
314      }
315    else
316      {
317      SV *const temp = *av_fetch(a, 0, 0);	/* fetch first element */
318      ST(0) = boolSV(SvIV(temp) == ix);
319      }
320    XSRETURN(1);
321
322##############################################################################
323
324void
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    a = (AV*)SvRV(x);			/* ref to aray, don't check ref */
335    elems = av_len(a);			/* number of elems in array */
336    temp = *av_fetch(a, elems, 0);	/* fetch last element */
337    SvPV(temp, len);			/* convert to string & store length */
338    len += (IV) XS_BASE_LEN * elems;
339    ST(0) = sv_2mortal(newSViv(len));
340
341##############################################################################
342
343void
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    array_x = (AV*)SvRV(cx);		/* ref to aray, don't check ref */
360    array_y = (AV*)SvRV(cy);		/* ref to aray, don't check ref */
361    elemsx =  av_len(array_x);
362    elemsy =  av_len(array_y);
363    diff = elemsx - elemsy;		/* difference */
364
365    if (diff > 0)
366      {
367      RETURN_MORTAL_INT(1);		/* len differs: X > Y */
368      }
369    else if (diff < 0)
370      {
371      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    tempx = *av_fetch(array_x, elemsx, 0);	/* fetch last element */
376    tempy = *av_fetch(array_y, elemsx, 0);	/* fetch last element */
377    SvPV(tempx, lenx);			/* convert to string & store length */
378    SvPV(tempy, leny);			/* convert to string & store length */
379    diff_str = (SSize_t)lenx - (SSize_t)leny;
380    if (diff_str > 0)
381      {
382      RETURN_MORTAL_INT(1);		/* same len, but first elems differs in len */
383      }
384    if (diff_str < 0)
385      {
386      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    while (elemsx >= 0)
391      {
392      tempx = *av_fetch(array_x, elemsx, 0);	/* fetch curr x element */
393      tempy = *av_fetch(array_y, elemsx, 0);	/* fetch curr y element */
394      diff_nv = SvNV(tempx) - SvNV(tempy);
395      if (diff_nv != 0)
396        {
397        break;
398        }
399      elemsx--;
400      }
401    if (diff_nv > 0)
402      {
403      RETURN_MORTAL_INT(1);
404      }
405    if (diff_nv < 0)
406      {
407      RETURN_MORTAL_INT(-1);
408      }
409    ST(0) = sv_2mortal(newSViv(0));		/* X and Y are equal */
410