660b443c |
1 | # ---?--- |
2 | # |
a24b5cfd |
3 | # $Id: mp.xs,v 1.2 2004/04/08 01:36:21 mdw Exp $ |
660b443c |
4 | # |
5 | # Multiprecision interface |
6 | # |
7 | # (c) 2000 Straylight/Edgeware |
8 | # |
9 | |
10 | #----- Licensing notice ----------------------------------------------------- |
11 | # |
12 | # This file is part of the Perl interface to Catacomb. |
13 | # |
14 | # Catacomb/Perl is free software; you can redistribute it and/or modify |
15 | # it under the terms of the GNU General Public License as published by |
16 | # the Free Software Foundation; either version 2 of the License, or |
17 | # (at your option) any later version. |
18 | # |
19 | # Catacomb/Perl is distributed in the hope that it will be useful, |
20 | # but WITHOUT ANY WARRANTY; without even the implied warranty of |
21 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
22 | # GNU General Public License for more details. |
23 | # |
24 | # You should have received a copy of the GNU General Public License |
25 | # along with Catacomb/Perl; if not, write to the Free Software Foundation, |
26 | # Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. |
27 | # |
28 | |
660b443c |
29 | MODULE = Catacomb PACKAGE = Catacomb::MP PREFIX = mp_ |
30 | |
31 | mp * |
32 | new(me, sv = 0, radix = 0) |
33 | SV *me |
34 | SV *sv |
35 | int radix |
36 | CODE: |
37 | RETVAL = sv ? mp_fromsv(sv, "sv", radix, 1) : MP_ZERO; |
38 | OUTPUT: |
39 | RETVAL |
40 | |
41 | mp * |
42 | mp_copy(x) |
43 | mp *x |
44 | |
45 | mp * |
46 | loadb(me, sv) |
47 | SV *me |
48 | SV *sv |
49 | PREINIT: |
50 | char *p; |
51 | STRLEN len; |
52 | CODE: |
53 | p = SvPV(sv, len); |
54 | RETVAL = mp_loadb(MP_NEW, p, len); |
55 | OUTPUT: |
56 | RETVAL |
57 | |
58 | mp * |
59 | loadl(me, sv) |
60 | SV *me |
61 | SV *sv |
62 | PREINIT: |
63 | char *p; |
64 | STRLEN len; |
65 | CODE: |
66 | p = SvPV(sv, len); |
67 | RETVAL = mp_loadl(MP_NEW, p, len); |
68 | OUTPUT: |
69 | RETVAL |
70 | |
71 | int |
72 | metrics(m) |
73 | mp *m |
74 | INTERFACE_MACRO: |
75 | XSINTERFACE_FUNC |
76 | XSINTERFACE_FUNC_SETMP |
77 | INTERFACE: |
78 | octets bits |
79 | |
80 | SV * |
81 | storeb(m, i = -1) |
82 | mp *m |
83 | int i |
84 | PREINIT: |
85 | size_t sz; |
86 | CODE: |
87 | sz = (i < 0) ? mp_octets(m) : i; |
88 | RETVAL = NEWSV(0, sz ? sz : 1); |
89 | mp_storeb(m, SvPVX(RETVAL), sz); |
90 | SvCUR_set(RETVAL, sz); |
91 | SvPOK_on(RETVAL); |
92 | OUTPUT: |
93 | RETVAL |
94 | |
95 | SV * |
96 | storel(m, i = -1) |
97 | mp *m |
98 | int i |
99 | PREINIT: |
100 | size_t sz; |
101 | CODE: |
102 | sz = (i < 0) ? mp_octets(m) : i; |
103 | RETVAL = NEWSV(0, sz ? sz : 1); |
104 | mp_storel(m, SvPVX(RETVAL), sz); |
105 | SvCUR_set(RETVAL, sz); |
106 | SvPOK_on(RETVAL); |
107 | OUTPUT: |
108 | RETVAL |
109 | |
110 | SV * |
111 | tostring(m, radix = 10) |
112 | mp *m |
113 | int radix |
114 | CODE: |
115 | RETVAL = NEWSV(0, 0); |
116 | mp_writesv(m, RETVAL, radix); |
117 | OUTPUT: |
118 | RETVAL |
119 | |
120 | SV * |
121 | toint(m) |
122 | mp *m |
123 | CODE: |
124 | RETVAL = newSViv(mp_toiv(m)); |
125 | OUTPUT: |
126 | RETVAL |
127 | |
128 | SV * |
129 | DESTROY(m) |
130 | mp *m |
131 | CODE: |
132 | mp_drop(m); |
133 | XSRETURN_UNDEF; |
134 | |
135 | mp * |
136 | unop(a) |
137 | mp *a |
138 | C_ARGS: |
139 | MP_NEW, a |
140 | INTERFACE_MACRO: |
141 | XSINTERFACE_FUNC |
142 | XSINTERFACE_FUNC_SETMP |
143 | INTERFACE: |
144 | not sqr sqrt |
145 | |
146 | mp * |
147 | neg(a) |
148 | mp *a |
149 | CODE: |
150 | mp_copy(a); |
151 | RETVAL = mp_split(a); |
152 | if (RETVAL->v < RETVAL->vl) |
153 | RETVAL->f ^= MP_NEG; |
154 | OUTPUT: |
155 | RETVAL |
156 | |
157 | mp * |
158 | mp_factorial(me, x) |
159 | SV *me |
160 | IV x |
161 | C_ARGS: |
162 | x |
163 | |
164 | mp * |
165 | binop(a, b) |
166 | mp *a |
167 | mp *b |
168 | C_ARGS: |
169 | MP_NEW, a, b |
170 | INTERFACE_MACRO: |
171 | XSINTERFACE_FUNC |
172 | XSINTERFACE_FUNC_SETMP |
173 | INTERFACE: |
174 | add sub mul and or xor |
175 | |
176 | mp * |
177 | shiftop(a, n) |
178 | mp *a |
179 | int n |
180 | C_ARGS: |
181 | MP_NEW, a, n |
182 | INTERFACE_MACRO: |
183 | XSINTERFACE_FUNC |
184 | XSINTERFACE_FUNC_SETMP |
185 | INTERFACE: |
186 | lsl lsr |
187 | |
188 | int |
189 | mp_cmp(a, b) |
190 | mp *a |
191 | mp *b |
192 | |
193 | int |
194 | mp_eq(a, b) |
195 | mp *a |
196 | mp *b |
197 | |
198 | int |
199 | jacobi(a, n) |
200 | mp *a |
201 | mp *n |
202 | CODE: |
203 | if (!MP_LEN(n) || !(n->v[0] & 1)) |
204 | croak("n must be odd in Catacomb::MP::jacobi"); |
205 | RETVAL = mp_jacobi(a, n); |
206 | OUTPUT: |
207 | RETVAL |
208 | |
209 | mp * |
210 | mp_modsqrt(p, x) |
211 | mp *p |
212 | mp *x |
213 | C_ARGS: |
214 | MP_NEW, x, p |
215 | |
216 | void |
217 | div(a, b) |
218 | mp *a |
219 | mp *b |
220 | PREINIT: |
221 | mp *q = MP_NEW, *r = MP_NEW; |
222 | PPCODE: |
223 | if (MP_EQ(b, MP_ZERO)) |
224 | croak("Divide by zero in Catacomb::MP::div"); |
225 | q = MP_NEW; |
226 | switch (GIMME_V) { |
227 | case G_ARRAY: |
228 | r = MP_NEW; |
229 | mp_div(&q, &r, a, b); |
230 | EXTEND(SP, 2); |
231 | PUSHs(RET_MP(q)); |
232 | PUSHs(RET_MP(r)); |
233 | break; |
234 | case G_VOID: |
235 | break; |
236 | default: |
237 | mp_div(&q, &r, a, b); |
238 | EXTEND(SP, 1); |
239 | PUSHs(RET_MP(q)); |
240 | break; |
241 | } |
242 | |
243 | void |
244 | gcd(a, b) |
245 | mp *a |
246 | mp *b |
247 | PREINIT: |
248 | mp *g = MP_NEW, *x = MP_NEW, *y = MP_NEW; |
249 | PPCODE: |
250 | switch (GIMME_V) { |
251 | case G_ARRAY: |
252 | mp_gcd(&g, &x, &y, a, b); |
253 | EXTEND(SP, 3); |
254 | PUSHs(RET_MP(g)); |
255 | PUSHs(RET_MP(x)); |
256 | PUSHs(RET_MP(y)); |
257 | break; |
258 | case G_VOID: |
259 | break; |
260 | default: |
261 | mp_gcd(&g, 0, 0, a, b); |
262 | EXTEND(SP, 1); |
263 | PUSHs(RET_MP(g)); |
264 | break; |
265 | } |
266 | |
267 | void |
268 | odd(m) |
269 | mp *m |
270 | PREINIT: |
271 | mp *t; |
272 | size_t s; |
273 | PPCODE: |
274 | t = mp_odd(MP_NEW, m, &s); |
275 | EXTEND(SP, 2); |
276 | PUSHs(RET_MP(t)); |
277 | PUSHs(sv_2mortal(newSViv(s))); |
278 | |
279 | int |
280 | smallfactor(x) |
281 | mp *x |
282 | CODE: |
283 | RETVAL = pfilt_smallfactor(x); |
284 | OUTPUT: |
285 | RETVAL |
286 | |
287 | MP_Mont * |
288 | mont(x) |
289 | mp *x |
290 | CODE: |
291 | if (x->f & MP_NEG) |
292 | croak("Argument to Catacomb::MP::mont must be positive"); |
293 | if (x->v == x->vl || !(x->v[0] & 1u)) |
294 | croak("Argument to Catacomb::MP::mont must be odd"); |
295 | RETVAL = CREATE(MP_Mont); |
296 | mpmont_create(RETVAL, x); |
297 | OUTPUT: |
298 | RETVAL |
299 | |
300 | MP_Barrett * |
301 | barrett(x) |
302 | mp *x |
303 | CODE: |
304 | if (x->f & MP_NEG) |
305 | croak("Argument to Catacomb::MP::barrett must be positive"); |
306 | RETVAL = CREATE(mpbarrett); |
307 | mpbarrett_create(RETVAL, x); |
308 | OUTPUT: |
309 | RETVAL |
310 | |
311 | MP_Prime_Rabin * |
312 | rabin(x) |
313 | mp *x |
314 | CODE: |
315 | if (x->f & MP_NEG) |
316 | croak("Argument to Catacomb::MP::rabin must be positive"); |
317 | if (x->v == x->vl || !(x->v[0] & 1u)) |
318 | croak("Argument to Catacomb::MP::rabin must be odd"); |
319 | RETVAL = CREATE(MP_Prime_Rabin); |
320 | rabin_create(RETVAL, x); |
321 | OUTPUT: |
322 | RETVAL |
323 | |
324 | MODULE = Catacomb PACKAGE = Catacomb::MP::Mont PREFIX = mpmont_ |
325 | |
326 | MP_Mont * |
327 | new(me, x) |
328 | SV *me |
329 | mp *x |
330 | CODE: |
331 | if (x->f & MP_NEG) |
332 | croak("Argument to Catacomb::MP::Mont::new must be positive"); |
333 | if (x->v == x->vl || !(x->v[0] & 1u)) |
334 | croak("Argument to Catacomb::MP::Mont::new must be odd"); |
335 | RETVAL = CREATE(MP_Mont); |
336 | mpmont_create(RETVAL, x); |
337 | OUTPUT: |
338 | RETVAL |
339 | |
340 | SV * |
341 | DESTROY(mm) |
342 | MP_Mont *mm |
343 | CODE: |
344 | mpmont_destroy(mm); |
345 | DESTROY(mm); |
346 | XSRETURN_UNDEF; |
347 | |
348 | mp * |
349 | mpmont_reduce(mm, x) |
350 | MP_Mont *mm |
351 | mp *x |
352 | C_ARGS: |
353 | mm, MP_NEW, x |
354 | |
355 | mp * |
356 | mpmont_mul(mm, x, y) |
357 | MP_Mont *mm |
358 | mp *x |
359 | mp *y |
360 | C_ARGS: |
361 | mm, MP_NEW, x, y |
362 | |
363 | mp * |
364 | mpmont_expr(mm, g, x) |
365 | MP_Mont *mm |
366 | mp *g |
367 | mp *x |
368 | C_ARGS: |
369 | mm, MP_NEW, g, x |
370 | |
371 | mp * |
372 | mpmont_exp(mm, g, x) |
373 | MP_Mont *mm |
374 | mp *g |
375 | mp *x |
376 | C_ARGS: |
377 | mm, MP_NEW, g, x |
378 | |
379 | mp * |
380 | mpmont_mexpr(mm, ...) |
381 | MP_Mont *mm |
382 | PREINIT: |
383 | mp_expfactor *v; |
384 | size_t i, j, n; |
385 | CODE: |
386 | if (items < 3 || !(items & 1)) { |
387 | croak("Usage: Catacomb::MP::Mont::mexpr" |
388 | "(mm, g_0, x_0, g_1, x_1, ..."); |
389 | } |
390 | n = (items - 1)/2; |
391 | v = xmalloc(n * sizeof(mp_expfactor)); |
392 | for (i = 1, j = 0; i < items; i += 2, j++) { |
393 | v[j].base = mp_fromsv(ST(i), "g_i", 0, 0); |
394 | v[j].exp = mp_fromsv(ST(i + 1), "x_i", 0, 0); |
395 | } |
396 | RETVAL = mpmont_mexpr(mm, MP_NEW, v, n); |
397 | xfree(v); |
398 | OUTPUT: |
399 | RETVAL |
400 | |
401 | mp * |
402 | mpmont_mexp(mm, ...) |
403 | MP_Mont *mm |
404 | PREINIT: |
405 | mp_expfactor *v; |
406 | size_t i, j, n; |
407 | CODE: |
408 | if (items < 3 || !(items & 1)) { |
409 | croak("Usage: Catacomb::MP::Mont::mexp" |
410 | "(mm, g_0, x_0, g_1, x_1, ..."); |
411 | } |
412 | n = (items - 1)/2; |
413 | v = xmalloc(n * sizeof(mp_expfactor)); |
414 | for (i = 1, j = 0; i < items; i += 2, j++) { |
415 | v[j].base = mp_fromsv(ST(i), "g_%lu", 0, 0, (unsigned long)i); |
416 | v[j].exp = mp_fromsv(ST(i + 1), "x_%lu", 0, 0, (unsigned long)i); |
417 | } |
418 | RETVAL = mpmont_mexp(mm, MP_NEW, v, n); |
419 | xfree(v); |
420 | OUTPUT: |
421 | RETVAL |
422 | |
423 | mp * |
424 | r(mm) |
425 | MP_Mont *mm |
426 | CODE: |
427 | RETVAL = mp_copy(mm->r); |
428 | OUTPUT: |
429 | RETVAL |
430 | |
431 | mp * |
432 | r2(mm) |
433 | MP_Mont *mm |
434 | CODE: |
435 | RETVAL = mp_copy(mm->r2); |
436 | OUTPUT: |
437 | RETVAL |
438 | |
439 | mp * |
440 | m(mm) |
441 | MP_Mont *mm |
442 | CODE: |
443 | RETVAL = mp_copy(mm->m); |
444 | OUTPUT: |
445 | RETVAL |
446 | |
447 | MODULE = Catacomb PACKAGE = Catacomb::MP::Barrett PREFIX = mpbarrett_ |
448 | |
449 | MP_Barrett * |
450 | new(me, x) |
451 | SV *me |
452 | mp *x |
453 | CODE: |
454 | if (x->f & MP_NEG) |
455 | croak("Argument to Catacomb::MP::Barrett::new must be positive"); |
456 | RETVAL = CREATE(mpbarrett); |
457 | mpbarrett_create(RETVAL, x); |
458 | OUTPUT: |
459 | RETVAL |
460 | |
461 | SV * |
462 | DESTROY(mb) |
463 | MP_Barrett *mb |
464 | CODE: |
465 | mpbarrett_destroy(mb); |
466 | DESTROY(mb); |
467 | XSRETURN_UNDEF; |
468 | |
469 | mp * |
470 | mpbarrett_reduce(mb, x) |
471 | MP_Barrett *mb |
472 | mp *x |
473 | C_ARGS: |
474 | mb, MP_NEW, x |
475 | |
476 | mp * |
477 | mpbarrett_exp(mb, g, x) |
478 | MP_Barrett *mb |
479 | mp *g |
480 | mp *x |
481 | C_ARGS: |
482 | mb, MP_NEW, g, x |
483 | |
484 | mp * |
485 | m(mb) |
486 | MP_Barrett *mb |
487 | CODE: |
488 | RETVAL = mp_copy(mb->m); |
489 | OUTPUT: |
490 | RETVAL |
491 | |
492 | MODULE = Catacomb PACKAGE = Catacomb::MP::CRT |
493 | |
494 | MP_CRT * |
495 | new(me, ...) |
496 | SV *me |
497 | PREINIT: |
498 | mpcrt_mod *v; |
499 | size_t n, i; |
500 | CODE: |
501 | if (items < 1) |
502 | croak("Usage: Catacomb::MP::CRT::new(me, n_0, n_1, ...)"); |
503 | n = items - 1; |
504 | v = xmalloc(n * sizeof(mpcrt_mod)); |
505 | for (i = 0; i < n; i++) { |
506 | v[i].m = mp_copy(mp_fromsv(ST(i + 1), "n_%lu", 0, 0, |
507 | (unsigned long)i)); |
508 | } |
509 | RETVAL = CREATE(MP_CRT); |
510 | mpcrt_create(RETVAL, v, n, 0); |
511 | OUTPUT: |
512 | RETVAL |
513 | |
514 | SV * |
515 | DESTROY(mc) |
516 | MP_CRT *mc |
517 | CODE: |
518 | mpcrt_destroy(mc); |
519 | xfree(mc->v); |
520 | DESTROY(mc); |
521 | XSRETURN_UNDEF; |
522 | |
523 | mp * |
524 | solve(mc, ...) |
525 | MP_CRT *mc |
526 | PREINIT: |
527 | mp **v; |
528 | size_t n, i; |
529 | CODE: |
530 | n = mc->k; |
531 | if (items - 1 != n) |
532 | croak("Wrong number of residues for this CRT context"); |
533 | for (i = 0; i < n; i++) |
534 | v[i] = mp_fromsv(ST(i + 1), "r_%lu", 0, 0, (unsigned long)i); |
535 | RETVAL = mpcrt_solve(mc, MP_NEW, v); |
536 | xfree(v); |
537 | OUTPUT: |
538 | RETVAL |
539 | |
540 | #----- That's all, folks ---------------------------------------------------- |