This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Reinstate part of #28744 that was accidentally reverted in #30454
[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
caa64001
T
233#define CONSTANT_OBJ(int) \
234 RETVAL = newAV(); \
235 sv_2mortal((SV*)RETVAL); \
236 av_push (RETVAL, newSViv( int ));
062a4e99 237
caa64001
T
238AV *
239_zero(class)
062a4e99 240 CODE:
caa64001
T
241 CONSTANT_OBJ(0)
242 OUTPUT:
243 RETVAL
062a4e99
T
244
245##############################################################################
246
caa64001 247AV *
062a4e99 248_one(class)
062a4e99 249 CODE:
caa64001
T
250 CONSTANT_OBJ(1)
251 OUTPUT:
252 RETVAL
062a4e99
T
253
254##############################################################################
255
caa64001 256AV *
062a4e99 257_two(class)
062a4e99 258 CODE:
caa64001
T
259 CONSTANT_OBJ(2)
260 OUTPUT:
261 RETVAL
062a4e99
T
262
263##############################################################################
264
caa64001 265AV *
062a4e99 266_ten(class)
062a4e99 267 CODE:
caa64001
T
268 CONSTANT_OBJ(10)
269 OUTPUT:
270 RETVAL
062a4e99
T
271
272##############################################################################
273
274void
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
288void
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
302void
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
321void
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
340void
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
359void
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
378void
379_len(class,x)
380 SV* x
381 INIT:
382 AV* a;
383 SV* temp;
6c0b8e73 384 IV elems;
062a4e99
T
385 STRLEN len;
386
387 CODE:
388 a = (AV*)SvRV(x); /* ref to aray, don't check ref */
6c0b8e73 389 elems = av_len(a); /* number of elems in array */
062a4e99
T
390 temp = *av_fetch(a, elems, 0); /* fetch last element */
391 SvPV(temp, len); /* convert to string & store length */
6c0b8e73 392 len += (IV) XS_BASE_LEN * elems;
062a4e99
T
393 ST(0) = newSViv(len);
394
395##############################################################################
396
397void
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