Commit | Line | Data |
062a4e99 |
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; |
8a722a80 |
391 | IV elems; |
062a4e99 |
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 |
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 |
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 | |