This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Must only use dynamic extensions in the Dynaloader test. If the
[perl5.git] / ext / Math / BigInt / FastCalc / FastCalc.xs
CommitLineData
062a4e99
T
1#include "EXTERN.h"
2#include "perl.h"
3#include "XSUB.h"
4
5double XS_BASE = 0;
6double XS_BASE_LEN = 0;
7
8MODULE = 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
22void
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
34void
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
70void
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
115void
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
159void
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
197void
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
233void
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
245void
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
257void
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
269void
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
281void
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
295void
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
309void
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
328void
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
347void
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
366void
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
385void
386_len(class,x)
387 SV* x
388 INIT:
389 AV* a;
390 SV* temp;
8a722a80 391 IV elems;
062a4e99
T
392 STRLEN len;
393
394 CODE:
395 a = (AV*)SvRV(x); /* ref to aray, don't check ref */
8a722a80 396 elems = av_len(a); /* number of elems in array */
062a4e99
T
397 temp = *av_fetch(a, elems, 0); /* fetch last element */
398 SvPV(temp, len); /* convert to string & store length */
8a722a80 399 len += (IV) XS_BASE_LEN * elems;
062a4e99
T
400 ST(0) = newSViv(len);
401
402##############################################################################
403
404void
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