Various changes. Kinda in the middle of it here, but it seems to work.
[catacomb-perl] / mp.xs
1 # ---?---
2 #
3 # $Id$
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
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",
38 "Catacomb::MP", radix, 1) : MP_ZERO;
39 OUTPUT:
40 RETVAL
41
42 mp *
43 copy(x)
44 mp *x
45 CODE:
46 RETVAL = MP_COPY(x);
47 OUTPUT:
48 RETVAL
49
50 mp *
51 loadb(me, sv)
52 SV *me
53 SV *sv
54 PREINIT:
55 char *p;
56 STRLEN len;
57 CODE:
58 p = SvPV(sv, len);
59 RETVAL = mp_loadb(MP_NEW, p, len);
60 OUTPUT:
61 RETVAL
62
63 mp *
64 loadl(me, sv)
65 SV *me
66 SV *sv
67 PREINIT:
68 char *p;
69 STRLEN len;
70 CODE:
71 p = SvPV(sv, len);
72 RETVAL = mp_loadl(MP_NEW, p, len);
73 OUTPUT:
74 RETVAL
75
76 int
77 metrics(m)
78 mp *m
79 INTERFACE_MACRO:
80 XSINTERFACE_FUNC
81 XSINTERFACE_FUNC_SETMP
82 INTERFACE:
83 octets bits
84
85 SV *
86 storeb(m, i = -1)
87 mp *m
88 int i
89 PREINIT:
90 size_t sz;
91 CODE:
92 sz = (i < 0) ? mp_octets(m) : i;
93 RETVAL = NEWSV(0, sz ? sz : 1);
94 mp_storeb(m, SvPVX(RETVAL), sz);
95 SvCUR_set(RETVAL, sz);
96 SvPOK_on(RETVAL);
97 OUTPUT:
98 RETVAL
99
100 SV *
101 storel(m, i = -1)
102 mp *m
103 int i
104 PREINIT:
105 size_t sz;
106 CODE:
107 sz = (i < 0) ? mp_octets(m) : i;
108 RETVAL = NEWSV(0, sz ? sz : 1);
109 mp_storel(m, SvPVX(RETVAL), sz);
110 SvCUR_set(RETVAL, sz);
111 SvPOK_on(RETVAL);
112 OUTPUT:
113 RETVAL
114
115 SV *
116 tostring(m, radix = 10)
117 mp *m
118 int radix
119 CODE:
120 RETVAL = NEWSV(0, 0);
121 mp_writesv(m, RETVAL, radix);
122 OUTPUT:
123 RETVAL
124
125 SV *
126 toint(m)
127 mp *m
128 CODE:
129 RETVAL = newSViv(mp_toiv(m));
130 OUTPUT:
131 RETVAL
132
133 SV *
134 DESTROY(m)
135 mp *m
136 CODE:
137 mp_drop(m);
138 XSRETURN_UNDEF;
139
140 mp *
141 unop(a)
142 mp *a
143 C_ARGS:
144 MP_NEW, a
145 INTERFACE_MACRO:
146 XSINTERFACE_FUNC
147 XSINTERFACE_FUNC_SETMP
148 INTERFACE:
149 not sqr sqrt
150
151 mp *
152 neg(a)
153 mp *a
154 CODE:
155 MP_COPY(a);
156 RETVAL = mp_split(a);
157 if (RETVAL->v < RETVAL->vl)
158 RETVAL->f ^= MP_NEG;
159 OUTPUT:
160 RETVAL
161
162 mp *
163 mp_factorial(me, x)
164 SV *me
165 IV x
166 C_ARGS:
167 x
168
169 mp *
170 binop(a, b)
171 mp *a
172 mp *b
173 C_ARGS:
174 MP_NEW, a, b
175 INTERFACE_MACRO:
176 XSINTERFACE_FUNC
177 XSINTERFACE_FUNC_SETMP
178 INTERFACE:
179 add sub mul and2c or2c nand2c nor2c xor2c and or nand nor xor
180
181 mp *
182 shiftop(a, n)
183 mp *a
184 int n
185 C_ARGS:
186 MP_NEW, a, n
187 INTERFACE_MACRO:
188 XSINTERFACE_FUNC
189 XSINTERFACE_FUNC_SETMP
190 INTERFACE:
191 lsl lsr lsl2c lsr2c
192
193 bool
194 testbitop(a, n)
195 mp *a
196 unsigned long n
197 INTERFACE_MACRO:
198 XSINTERFACE_FUNC
199 XSINTERFACE_FUNC_SETMP
200 INTERFACE:
201 testbit testbit2c
202
203 mp *
204 flipbits(a, n)
205 mp *a
206 unsigned long n
207 C_ARGS:
208 MP_NEW, a, n
209 INTERFACE_MACRO:
210 XSINTERFACE_FUNC
211 XSINTERFACE_FUNC_SETMP
212 INTERFACE:
213 setbit clearbit setbit2c clearbit2c
214
215 int
216 mp_cmp(a, b)
217 mp *a
218 mp *b
219
220 int
221 mp_eq(a, b)
222 mp *a
223 mp *b
224
225 int
226 jacobi(a, n)
227 mp *a
228 mp *n
229 CODE:
230 if (!MP_LEN(n) || !(n->v[0] & 1))
231 croak("n must be odd in Catacomb::MP::jacobi");
232 RETVAL = mp_jacobi(a, n);
233 OUTPUT:
234 RETVAL
235
236 mp *
237 mp_modsqrt(p, x)
238 mp *p
239 mp *x
240 C_ARGS:
241 MP_NEW, x, p
242
243 void
244 div(a, b)
245 mp *a
246 mp *b
247 PREINIT:
248 mp *q = MP_NEW, *r = MP_NEW;
249 PPCODE:
250 if (MP_EQ(b, MP_ZERO))
251 croak("Divide by zero in Catacomb::MP::div");
252 q = MP_NEW;
253 switch (GIMME_V) {
254 case G_ARRAY:
255 r = MP_NEW;
256 mp_div(&q, &r, a, b);
257 EXTEND(SP, 2);
258 PUSHs(RET_MP(q));
259 PUSHs(RET_MP(r));
260 break;
261 case G_VOID:
262 break;
263 default:
264 mp_div(&q, &r, a, b);
265 EXTEND(SP, 1);
266 PUSHs(RET_MP(q));
267 break;
268 }
269
270 void
271 gcd(a, b)
272 mp *a
273 mp *b
274 PREINIT:
275 mp *g = MP_NEW, *x = MP_NEW, *y = MP_NEW;
276 PPCODE:
277 switch (GIMME_V) {
278 case G_ARRAY:
279 mp_gcd(&g, &x, &y, a, b);
280 EXTEND(SP, 3);
281 PUSHs(RET_MP(g));
282 PUSHs(RET_MP(x));
283 PUSHs(RET_MP(y));
284 break;
285 case G_VOID:
286 break;
287 default:
288 mp_gcd(&g, 0, 0, a, b);
289 EXTEND(SP, 1);
290 PUSHs(RET_MP(g));
291 break;
292 }
293
294 void
295 odd(m)
296 mp *m
297 PREINIT:
298 mp *t;
299 size_t s;
300 PPCODE:
301 t = mp_odd(MP_NEW, m, &s);
302 EXTEND(SP, 2);
303 PUSHs(RET_MP(t));
304 PUSHs(sv_2mortal(newSViv(s)));
305
306 int
307 smallfactor(x)
308 mp *x
309 CODE:
310 RETVAL = pfilt_smallfactor(x);
311 OUTPUT:
312 RETVAL
313
314 MP_Reduce *
315 makereduce(x)
316 mp *x
317 CODE:
318 if (!MP_POSP(x))
319 croak("Argument to Catacomb::MP::makereduce must be positive");
320 RETVAL = CREATE(MP_Reduce);
321 mpreduce_create(RETVAL, x);
322 OUTPUT:
323 RETVAL
324
325 MP_Mont *
326 mont(x)
327 mp *x
328 CODE:
329 if (!MP_POSP(x))
330 croak("Argument to Catacomb::MP::mont must be positive");
331 if (!MP_ODDP(x))
332 croak("Argument to Catacomb::MP::mont must be odd");
333 RETVAL = CREATE(MP_Mont);
334 mpmont_create(RETVAL, x);
335 OUTPUT:
336 RETVAL
337
338 MP_Barrett *
339 barrett(x)
340 mp *x
341 CODE:
342 if (!MP_POSP(x))
343 croak("Argument to Catacomb::MP::barrett must be positive");
344 RETVAL = CREATE(mpbarrett);
345 mpbarrett_create(RETVAL, x);
346 OUTPUT:
347 RETVAL
348
349 MP_Prime_Rabin *
350 rabin(x)
351 mp *x
352 CODE:
353 if (!MP_POSP(x))
354 croak("Argument to Catacomb::MP::rabin must be positive");
355 if (!MP_ODDP(x))
356 croak("Argument to Catacomb::MP::rabin must be odd");
357 RETVAL = CREATE(MP_Prime_Rabin);
358 rabin_create(RETVAL, x);
359 OUTPUT:
360 RETVAL
361
362 MODULE = Catacomb PACKAGE = Catacomb::MP::Mont PREFIX = mpmont_
363
364 MP_Mont *
365 new(me, x)
366 SV *me
367 mp *x
368 CODE:
369 if (!MP_POSP(x))
370 croak("Argument to Catacomb::MP::Mont::new must be positive");
371 if (!MP_ODDP(x))
372 croak("Argument to Catacomb::MP::Mont::new must be odd");
373 RETVAL = CREATE(MP_Mont);
374 mpmont_create(RETVAL, x);
375 OUTPUT:
376 RETVAL
377
378 SV *
379 DESTROY(mm)
380 MP_Mont *mm
381 CODE:
382 mpmont_destroy(mm);
383 DESTROY(mm);
384 XSRETURN_UNDEF;
385
386 mp *
387 mpmont_reduce(mm, x)
388 MP_Mont *mm
389 mp *x
390 C_ARGS:
391 mm, MP_NEW, x
392
393 mp *
394 mpmont_mul(mm, x, y)
395 MP_Mont *mm
396 mp *x
397 mp *y
398 C_ARGS:
399 mm, MP_NEW, x, y
400
401 mp *
402 mpmont_expr(mm, g, x)
403 MP_Mont *mm
404 mp *g
405 mp *x
406 C_ARGS:
407 mm, MP_NEW, g, x
408
409 mp *
410 mpmont_exp(mm, g, x)
411 MP_Mont *mm
412 mp *g
413 mp *x
414 C_ARGS:
415 mm, MP_NEW, g, x
416
417 mp *
418 mpmont_mexpr(mm, ...)
419 MP_Mont *mm
420 PREINIT:
421 mp_expfactor *v;
422 size_t i, j, n;
423 CODE:
424 if (items < 3 || !(items & 1)) {
425 croak("Usage: Catacomb::MP::Mont::mexpr"
426 "(mm, g_0, x_0, g_1, x_1, ...");
427 }
428 n = (items - 1)/2;
429 v = xmalloc(n * sizeof(mp_expfactor));
430 for (i = 1, j = 0; i < items; i += 2, j++) {
431 v[j].base = mp_fromsv(ST(i), "g_i", "Catacomb::MP", 0, 0);
432 v[j].exp = mp_fromsv(ST(i + 1), "x_i", "Catacomb::MP", 0, 0);
433 }
434 RETVAL = mpmont_mexpr(mm, MP_NEW, v, n);
435 xfree(v);
436 OUTPUT:
437 RETVAL
438
439 mp *
440 mpmont_mexp(mm, ...)
441 MP_Mont *mm
442 PREINIT:
443 mp_expfactor *v;
444 size_t i, j, n;
445 CODE:
446 if (items < 3 || !(items & 1)) {
447 croak("Usage: Catacomb::MP::Mont::mexp"
448 "(mm, g_0, x_0, g_1, x_1, ...");
449 }
450 n = (items - 1)/2;
451 v = xmalloc(n * sizeof(mp_expfactor));
452 for (i = 1, j = 0; i < items; i += 2, j++) {
453 v[j].base = mp_fromsv(ST(i), "g_%lu",
454 "Catacomb::MP", 0, 0, (unsigned long)i);
455 v[j].exp = mp_fromsv(ST(i + 1), "x_%lu",
456 "Catacomb::MP", 0, 0, (unsigned long)i);
457 }
458 RETVAL = mpmont_mexp(mm, MP_NEW, v, n);
459 xfree(v);
460 OUTPUT:
461 RETVAL
462
463 mp *
464 r(mm)
465 MP_Mont *mm
466 CODE:
467 RETVAL = MP_COPY(mm->r);
468 OUTPUT:
469 RETVAL
470
471 mp *
472 r2(mm)
473 MP_Mont *mm
474 CODE:
475 RETVAL = MP_COPY(mm->r2);
476 OUTPUT:
477 RETVAL
478
479 mp *
480 m(mm)
481 MP_Mont *mm
482 CODE:
483 RETVAL = MP_COPY(mm->m);
484 OUTPUT:
485 RETVAL
486
487 MODULE = Catacomb PACKAGE = Catacomb::MP::Barrett PREFIX = mpbarrett_
488
489 MP_Barrett *
490 new(me, x)
491 SV *me
492 mp *x
493 CODE:
494 if (!MP_POSP(x))
495 croak("Argument to Catacomb::MP::Barrett::new must be positive");
496 RETVAL = CREATE(mpbarrett);
497 mpbarrett_create(RETVAL, x);
498 OUTPUT:
499 RETVAL
500
501 SV *
502 DESTROY(mb)
503 MP_Barrett *mb
504 CODE:
505 mpbarrett_destroy(mb);
506 DESTROY(mb);
507 XSRETURN_UNDEF;
508
509 mp *
510 mpbarrett_reduce(mb, x)
511 MP_Barrett *mb
512 mp *x
513 C_ARGS:
514 mb, MP_NEW, x
515
516 mp *
517 mpbarrett_exp(mb, g, x)
518 MP_Barrett *mb
519 mp *g
520 mp *x
521 C_ARGS:
522 mb, MP_NEW, g, x
523
524 mp *
525 m(mb)
526 MP_Barrett *mb
527 CODE:
528 RETVAL = MP_COPY(mb->m);
529 OUTPUT:
530 RETVAL
531
532 MODULE = Catacomb PACKAGE = Catacomb::MP::Reduce PREFIX = mpreduce_
533
534 MP_Reduce *
535 new(me, x)
536 SV *me
537 mp *x
538 CODE:
539 if (!MP_POSP(x))
540 croak("Argument to Catacomb::MP::Reduce::new must be positive");
541 RETVAL = CREATE(mpreduce);
542 mpreduce_create(RETVAL, x);
543 OUTPUT:
544 RETVAL
545
546 SV *
547 DESTROY(r)
548 MP_Reduce *r
549 CODE:
550 mpreduce_destroy(r);
551 DESTROY(r);
552 XSRETURN_UNDEF;
553
554 mp *
555 reduce(r, x)
556 MP_Reduce *r
557 mp *x
558 CODE:
559 RETVAL = mpreduce_do(r, MP_NEW, x);
560 OUTPUT:
561 RETVAL
562
563 mp *
564 mpreduce_exp(r, x, y)
565 MP_Reduce *r
566 mp *x
567 mp *y
568 C_ARGS:
569 r, MP_NEW, x, y
570
571 mp *
572 m(r)
573 MP_Reduce *r
574 CODE:
575 RETVAL = MP_COPY(r->p);
576 OUTPUT:
577 RETVAL
578
579 MODULE = Catacomb PACKAGE = Catacomb::MP::CRT
580
581 MP_CRT *
582 new(me, ...)
583 SV *me
584 PREINIT:
585 mpcrt_mod *v;
586 size_t n, i;
587 CODE:
588 if (items < 1)
589 croak("Usage: Catacomb::MP::CRT::new(me, n_0, n_1, ...)");
590 n = items - 1;
591 v = xmalloc(n * sizeof(mpcrt_mod));
592 for (i = 0; i < n; i++) {
593 v[i].m = mp_copy(mp_fromsv(ST(i + 1), "n_%lu",
594 "Catacomb::MP", 0, 0,
595 (unsigned long)i));
596 }
597 RETVAL = CREATE(MP_CRT);
598 mpcrt_create(RETVAL, v, n, 0);
599 OUTPUT:
600 RETVAL
601
602 SV *
603 DESTROY(mc)
604 MP_CRT *mc
605 CODE:
606 mpcrt_destroy(mc);
607 xfree(mc->v);
608 DESTROY(mc);
609 XSRETURN_UNDEF;
610
611 mp *
612 solve(mc, ...)
613 MP_CRT *mc
614 PREINIT:
615 mp **v;
616 size_t n, i;
617 CODE:
618 n = mc->k;
619 if (items - 1 != n)
620 croak("Wrong number of residues for this CRT context");
621 for (i = 0; i < n; i++) {
622 v[i] = mp_fromsv(ST(i + 1), "r_%lu", "Catacomb::MP",
623 0, 0, (unsigned long)i);
624 }
625 RETVAL = mpcrt_solve(mc, MP_NEW, v);
626 xfree(v);
627 OUTPUT:
628 RETVAL
629
630 #----- That's all, folks ----------------------------------------------------