X-Git-Url: https://git.distorted.org.uk/~mdw/catacomb-perl/blobdiff_plain/f9952aec1cf6c64a5681308eea817b6113a37433..9b46ee0d9f144189d9df836347402c3b3df97936:/mp.xs

diff --git a/mp.xs b/mp.xs
index 28c22f9..9eb7fe2 100644
--- a/mp.xs
+++ b/mp.xs
@@ -34,8 +34,7 @@ new(me, sv = 0, radix = 0)
 	SV *sv
 	int radix
 	CODE:
-	RETVAL = sv ? mp_fromsv(sv, "sv", 
-				"Catacomb::MP", radix, 1) : MP_ZERO;
+	RETVAL = sv ? mp_fromsv(sv, "sv", radix, 1) : MP_ZERO;
 	OUTPUT:
 	RETVAL
 
@@ -73,6 +72,32 @@ loadl(me, sv)
 	OUTPUT:
 	RETVAL
 
+mp *
+loadb2c(me, sv)
+	SV *me
+	SV *sv
+	PREINIT:
+	char *p;
+	STRLEN len;
+	CODE:
+	p = SvPV(sv, len);
+	RETVAL = mp_loadb2c(MP_NEW, p, len);
+	OUTPUT:
+	RETVAL
+
+mp *
+loadl2c(me, sv)
+	SV *me
+	SV *sv
+	PREINIT:
+	char *p;
+	STRLEN len;
+	CODE:
+	p = SvPV(sv, len);
+	RETVAL = mp_loadl2c(MP_NEW, p, len);
+	OUTPUT:
+	RETVAL
+
 int
 metrics(m)
 	mp *m
@@ -80,7 +105,7 @@ metrics(m)
 	XSINTERFACE_FUNC
 	XSINTERFACE_FUNC_SETMP
 	INTERFACE:
-	octets bits
+	octets bits octets2c
 
 SV *
 storeb(m, i = -1)
@@ -89,7 +114,13 @@ storeb(m, i = -1)
 	PREINIT:
 	size_t sz;
 	CODE:
-	sz = (i < 0) ? mp_octets(m) : i;
+	if (i >= 0)
+	  sz = i;
+	else {
+	  sz = mp_octets(m);
+	  if (!sz) 
+ 	    sz = 1;
+	}
 	RETVAL = NEWSV(0, sz ? sz : 1);
 	mp_storeb(m, SvPVX(RETVAL), sz);
 	SvCUR_set(RETVAL, sz);
@@ -113,6 +144,36 @@ storel(m, i = -1)
 	RETVAL
 
 SV *
+storeb2c(m, i = -1)
+	mp *m
+	int i
+	PREINIT:
+	size_t sz;
+	CODE:
+	sz = (i < 0) ? mp_octets2c(m) : i;
+	RETVAL = NEWSV(0, sz ? sz : 1);
+	mp_storeb(m, SvPVX(RETVAL), sz);
+	SvCUR_set(RETVAL, sz);
+	SvPOK_on(RETVAL);
+	OUTPUT:
+	RETVAL
+
+SV *
+storel2c(m, i = -1)
+	mp *m
+	int i
+	PREINIT:
+	size_t sz;
+	CODE:
+	sz = (i < 0) ? mp_octets2c(m) : i;
+	RETVAL = NEWSV(0, sz ? sz : 1);
+	mp_storel(m, SvPVX(RETVAL), sz);
+	SvCUR_set(RETVAL, sz);
+	SvPOK_on(RETVAL);
+	OUTPUT:
+	RETVAL
+
+SV *
 tostring(m, radix = 10)
 	mp *m
 	int radix
@@ -122,6 +183,25 @@ tostring(m, radix = 10)
 	OUTPUT:
 	RETVAL
 
+void
+fromstring(me, s, radix = 10)
+	SV *me
+	SV *s
+	int radix
+	PREINIT:
+	mptext_stringctx ms;
+	STRLEN len;
+	mp *x;
+	PPCODE:
+	ms.buf = SvPV(s, len);
+	ms.lim = ms.buf + len;
+	x = mp_read(MP_NEW, radix, &mptext_stringops, &ms);
+	if (x) {
+	  XPUSHs(RET_MP(x));
+	  if (GIMME_V == G_ARRAY)
+	    XPUSHs(sv_2mortal(newSVpvn(ms.buf, ms.lim - ms.buf)));
+	}
+
 SV *
 toint(m)
 	mp *m
@@ -146,7 +226,7 @@ unop(a)
 	XSINTERFACE_FUNC
 	XSINTERFACE_FUNC_SETMP
 	INTERFACE:
-	not sqr sqrt
+	not not2c sqr sqrt
 
 mp *
 neg(a)
@@ -176,7 +256,7 @@ binop(a, b)
 	XSINTERFACE_FUNC
 	XSINTERFACE_FUNC_SETMP
 	INTERFACE:
-	add sub mul and2c or2c nand2c nor2c xor2c and or nand nor xor
+	add sub mul and2c or2c nand2c nor2c xor2c and or nand nor xor exp
 
 mp *
 shiftop(a, n)
@@ -237,6 +317,11 @@ mp *
 mp_modsqrt(p, x)
 	mp *p
 	mp *x
+	INIT:
+	if (!MP_POSP(p) || !MP_ODDP(p))
+	  croak("p is not positive and odd");
+	if (mp_jacobi(x, p) != 1)
+	  croak("x not a quadratic residue mod p");
 	C_ARGS:
 	MP_NEW, x, p
 
@@ -261,7 +346,7 @@ div(a, b)
 	  case G_VOID:
 	    break;
 	  default:
-	    mp_div(&q, &r, a, b);
+	    mp_div(&q, 0, a, b);
 	    EXTEND(SP, 1);
 	    PUSHs(RET_MP(q));
 	    break;
@@ -300,64 +385,21 @@ odd(m)
 	PPCODE:
 	t = mp_odd(MP_NEW, m, &s);
 	EXTEND(SP, 2);
-	PUSHs(RET_MP(t));
 	PUSHs(sv_2mortal(newSViv(s)));
+	PUSHs(RET_MP(t));
 
-int
-smallfactor(x)
-	mp *x
-	CODE:
-	RETVAL = pfilt_smallfactor(x);
-	OUTPUT:
-	RETVAL
+MODULE = Catacomb PACKAGE = Catacomb::MP PREFIX = pgen_
 
-MP_Reduce *
-makereduce(x)
+bool
+pgen_primep(x, r = &rand_global)
 	mp *x
-	CODE:
-	if (!MP_POSP(x))
-	  croak("Argument to Catacomb::MP::makereduce must be positive");
-	RETVAL = CREATE(MP_Reduce);	
-	mpreduce_create(RETVAL, x);
-	OUTPUT:
-	RETVAL
+	grand *r
 
-MP_Mont *
-mont(x)
-	mp *x
-	CODE:
-	if (!MP_POSP(x))
-	  croak("Argument to Catacomb::MP::mont must be positive");
-	if (!MP_ODDP(x))
-	  croak("Argument to Catacomb::MP::mont must be odd");
-	RETVAL = CREATE(MP_Mont);	
-	mpmont_create(RETVAL, x);
-	OUTPUT:
-	RETVAL
+MODULE = Catacomb PACKAGE = Catacomb::MP PREFIX = pfilt_
 
-MP_Barrett *
-barrett(x)
+int
+pfilt_smallfactor(x)
 	mp *x
-	CODE:
-	if (!MP_POSP(x))
-	  croak("Argument to Catacomb::MP::barrett must be positive");
-	RETVAL = CREATE(mpbarrett);
-	mpbarrett_create(RETVAL, x);
-	OUTPUT:
-	RETVAL
-
-MP_Prime_Rabin *
-rabin(x)
-	mp *x
-	CODE:
-	if (!MP_POSP(x))
-	  croak("Argument to Catacomb::MP::rabin must be positive");
-	if (!MP_ODDP(x))
-	  croak("Argument to Catacomb::MP::rabin must be odd");
-	RETVAL = CREATE(MP_Prime_Rabin);
-	rabin_create(RETVAL, x);
-	OUTPUT:
-	RETVAL
 
 MODULE = Catacomb PACKAGE = Catacomb::MP::Mont PREFIX = mpmont_
 
@@ -366,12 +408,11 @@ new(me, x)
 	SV *me
 	mp *x
 	CODE:
-	if (!MP_POSP(x))
-	  croak("Argument to Catacomb::MP::Mont::new must be positive");
-	if (!MP_ODDP(x))
-	  croak("Argument to Catacomb::MP::Mont::new must be odd");
-	RETVAL = CREATE(MP_Mont);	
-	mpmont_create(RETVAL, x);
+	RETVAL = CREATE(MP_Mont);
+	if (mpmont_create(RETVAL, x)) {
+	  DESTROY(RETVAL);
+	  RETVAL = 0;
+	}
 	OUTPUT:
 	RETVAL
 
@@ -399,6 +440,17 @@ mpmont_mul(mm, x, y)
 	mm, MP_NEW, x, y
 
 mp *
+in(mm, x)
+	MP_Mont *mm
+	mp *x
+	CODE:
+	RETVAL = MP_NEW;
+	mp_div(0, &RETVAL, x, mm->m);
+	RETVAL = mpmont_mul(mm, RETVAL, RETVAL, mm->r2);
+	OUTPUT:
+	RETVAL
+
+mp *
 mpmont_expr(mm, g, x)
 	MP_Mont *mm
 	mp *g
@@ -428,8 +480,8 @@ mpmont_mexpr(mm, ...)
 	n = (items - 1)/2;
 	v = xmalloc(n * sizeof(mp_expfactor));
 	for (i = 1, j = 0; i < items; i += 2, j++) {
-	  v[j].base = mp_fromsv(ST(i), "g_i", "Catacomb::MP", 0, 0);
-	  v[j].exp = mp_fromsv(ST(i + 1), "x_i", "Catacomb::MP", 0, 0);
+	  v[j].base = mp_fromsv(ST(i), "g_i", 0, 0);
+	  v[j].exp = mp_fromsv(ST(i + 1), "x_i", 0, 0);
 	}
 	RETVAL = mpmont_mexpr(mm, MP_NEW, v, n);
 	xfree(v);
@@ -450,10 +502,8 @@ mpmont_mexp(mm, ...)
 	n = (items - 1)/2;
 	v = xmalloc(n * sizeof(mp_expfactor));
 	for (i = 1, j = 0; i < items; i += 2, j++) {
-	  v[j].base = mp_fromsv(ST(i), "g_%lu",
-				"Catacomb::MP", 0, 0, (unsigned long)i);
-	  v[j].exp = mp_fromsv(ST(i + 1), "x_%lu",
-			       "Catacomb::MP", 0, 0, (unsigned long)i);
+	  v[j].base = mp_fromsv(ST(i), "g_%lu", 0, 0, (unsigned long)i);
+	  v[j].exp = mp_fromsv(ST(i + 1), "x_%lu", 0, 0, (unsigned long)i);
 	}
 	RETVAL = mpmont_mexp(mm, MP_NEW, v, n);
 	xfree(v);
@@ -491,10 +541,11 @@ new(me, x)
 	SV *me
 	mp *x
 	CODE:
-	if (!MP_POSP(x))
-	  croak("Argument to Catacomb::MP::Barrett::new must be positive");
 	RETVAL = CREATE(mpbarrett);
-	mpbarrett_create(RETVAL, x);
+	if (mpbarrett_create(RETVAL, x)) {
+	  DESTROY(RETVAL);
+	  RETVAL = 0;
+	}
 	OUTPUT:
 	RETVAL
 
@@ -536,10 +587,11 @@ new(me, x)
 	SV *me
 	mp *x
 	CODE:
-	if (!MP_POSP(x))
-	  croak("Argument to Catacomb::MP::Reduce::new must be positive");
-	RETVAL = CREATE(mpreduce);
-	mpreduce_create(RETVAL, x);
+	RETVAL = CREATE(MP_Reduce);	
+	if (mpreduce_create(RETVAL, x)) {
+	  DESTROY(RETVAL);
+	  RETVAL = 0;
+	}
 	OUTPUT:
 	RETVAL
 
@@ -591,14 +643,34 @@ new(me, ...)
 	v = xmalloc(n * sizeof(mpcrt_mod));
 	for (i = 0; i < n; i++) {
 	  v[i].m = mp_copy(mp_fromsv(ST(i + 1), "n_%lu", 
-			   "Catacomb::MP", 0, 0, 
-			   (unsigned long)i));
+			   0, 0, (unsigned long)i));
+	  v[i].n = v[i].ni = v[i].nni = 0;
 	}
 	RETVAL = CREATE(MP_CRT);
 	mpcrt_create(RETVAL, v, n, 0);
 	OUTPUT:
 	RETVAL
 
+mp *
+product(mc)
+	MP_CRT *mc
+	CODE:
+	RETVAL = MP_COPY(mc->mb.m);
+	OUTPUT:
+	RETVAL
+
+void
+moduli(mc)
+	MP_CRT *mc
+	PREINIT:
+	size_t n, i;
+	PPCODE:
+	n = mc->k;
+	if (GIMME_V == G_SCALAR)
+	  XPUSHs(sv_2mortal(newSViv(n)));
+	else for (i = 0; i < n; i++)
+	  XPUSHs(RET_MP(MP_COPY(mc->v[i].m)));
+
 SV *
 DESTROY(mc)
 	MP_CRT *mc
@@ -618,10 +690,9 @@ solve(mc, ...)
 	n = mc->k;
 	if (items - 1 != n)
 	  croak("Wrong number of residues for this CRT context");
-	for (i = 0; i < n; i++) {
-	  v[i] = mp_fromsv(ST(i + 1), "r_%lu", "Catacomb::MP", 
-			   0, 0, (unsigned long)i);
-	}
+	v = xmalloc(n * sizeof(mp *));
+	for (i = 0; i < n; i++)
+	  v[i] = mp_fromsv(ST(i + 1), "r_%lu", 0, 0, (unsigned long)i);
 	RETVAL = mpcrt_solve(mc, MP_NEW, v);
 	xfree(v);
 	OUTPUT: