X-Git-Url: https://git.distorted.org.uk/~mdw/catacomb-perl/blobdiff_plain/660b443cc58d4dd4e92730104429fb64d78c7075..fcd15e0b7a3d0f0ca2f30953573f8d1f6b8e8bd2:/mp.xs

diff --git a/mp.xs b/mp.xs
index e405339..9eb7fe2 100644
--- a/mp.xs
+++ b/mp.xs
@@ -1,6 +1,6 @@
 # ---?---
 #
-# $Id: mp.xs,v 1.1 2004/04/02 18:04:01 mdw Exp $
+# $Id$
 #
 # Multiprecision interface
 #
@@ -26,13 +26,6 @@
 # Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 #
 
-#----- Revision history -----------------------------------------------------
-#
-# $Log: mp.xs,v $
-# Revision 1.1  2004/04/02 18:04:01  mdw
-# Initial checkin.
-#
-
 MODULE = Catacomb PACKAGE = Catacomb::MP PREFIX = mp_
 
 mp *
@@ -46,8 +39,12 @@ new(me, sv = 0, radix = 0)
 	RETVAL
 
 mp *
-mp_copy(x)
+copy(x)
 	mp *x
+	CODE:
+	RETVAL = MP_COPY(x);
+	OUTPUT:
+	RETVAL
 
 mp *
 loadb(me, sv)
@@ -75,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
@@ -82,7 +105,7 @@ metrics(m)
 	XSINTERFACE_FUNC
 	XSINTERFACE_FUNC_SETMP
 	INTERFACE:
-	octets bits
+	octets bits octets2c
 
 SV *
 storeb(m, i = -1)
@@ -91,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);
@@ -115,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
@@ -124,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
@@ -148,13 +226,13 @@ unop(a)
 	XSINTERFACE_FUNC
 	XSINTERFACE_FUNC_SETMP
 	INTERFACE:
-	not sqr sqrt
+	not not2c sqr sqrt
 
 mp *
 neg(a)
 	mp *a
 	CODE:
-	mp_copy(a);
+	MP_COPY(a);
 	RETVAL = mp_split(a);
 	if (RETVAL->v < RETVAL->vl)
 	  RETVAL->f ^= MP_NEG;
@@ -178,7 +256,7 @@ binop(a, b)
 	XSINTERFACE_FUNC
 	XSINTERFACE_FUNC_SETMP
 	INTERFACE:
-	add sub mul and or xor
+	add sub mul and2c or2c nand2c nor2c xor2c and or nand nor xor exp
 
 mp *
 shiftop(a, n)
@@ -190,7 +268,29 @@ shiftop(a, n)
 	XSINTERFACE_FUNC
 	XSINTERFACE_FUNC_SETMP
 	INTERFACE:
-	lsl lsr
+	lsl lsr lsl2c lsr2c
+
+bool
+testbitop(a, n)
+	mp *a
+	unsigned long n
+	INTERFACE_MACRO:
+	XSINTERFACE_FUNC
+	XSINTERFACE_FUNC_SETMP
+	INTERFACE:
+	testbit testbit2c
+
+mp *
+flipbits(a, n)
+	mp *a
+	unsigned long n
+	C_ARGS:
+	MP_NEW, a, n
+	INTERFACE_MACRO:
+	XSINTERFACE_FUNC
+	XSINTERFACE_FUNC_SETMP
+	INTERFACE:
+	setbit clearbit setbit2c clearbit2c
 
 int
 mp_cmp(a, b)
@@ -217,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
 
@@ -241,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;
@@ -280,53 +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_Mont *
-mont(x)
+bool
+pgen_primep(x, r = &rand_global)
 	mp *x
-	CODE:
-	if (x->f & MP_NEG)
-	  croak("Argument to Catacomb::MP::mont must be positive");
-	if (x->v == x->vl || !(x->v[0] & 1u))
-	  croak("Argument to Catacomb::MP::mont must be odd");
-	RETVAL = CREATE(MP_Mont);	
-	mpmont_create(RETVAL, x);
-	OUTPUT:
-	RETVAL
+	grand *r
 
-MP_Barrett *
-barrett(x)
-	mp *x
-	CODE:
-	if (x->f & MP_NEG)
-	  croak("Argument to Catacomb::MP::barrett must be positive");
-	RETVAL = CREATE(mpbarrett);
-	mpbarrett_create(RETVAL, x);
-	OUTPUT:
-	RETVAL
+MODULE = Catacomb PACKAGE = Catacomb::MP PREFIX = pfilt_
 
-MP_Prime_Rabin *
-rabin(x)
+int
+pfilt_smallfactor(x)
 	mp *x
-	CODE:
-	if (x->f & MP_NEG)
-	  croak("Argument to Catacomb::MP::rabin must be positive");
-	if (x->v == x->vl || !(x->v[0] & 1u))
-	  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_
 
@@ -335,12 +408,11 @@ new(me, x)
 	SV *me
 	mp *x
 	CODE:
-	if (x->f & MP_NEG)
-	  croak("Argument to Catacomb::MP::Mont::new must be positive");
-	if (x->v == x->vl || !(x->v[0] & 1u))
-	  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
 
@@ -368,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
@@ -431,7 +514,7 @@ mp *
 r(mm)
 	MP_Mont *mm
 	CODE:
-	RETVAL = mp_copy(mm->r);
+	RETVAL = MP_COPY(mm->r);
 	OUTPUT:
 	RETVAL
 
@@ -439,7 +522,7 @@ mp *
 r2(mm)
 	MP_Mont *mm
 	CODE:
-	RETVAL = mp_copy(mm->r2);
+	RETVAL = MP_COPY(mm->r2);
 	OUTPUT:
 	RETVAL
 
@@ -447,7 +530,7 @@ mp *
 m(mm)
 	MP_Mont *mm
 	CODE:
-	RETVAL = mp_copy(mm->m);
+	RETVAL = MP_COPY(mm->m);
 	OUTPUT:
 	RETVAL
 
@@ -458,10 +541,11 @@ new(me, x)
 	SV *me
 	mp *x
 	CODE:
-	if (x->f & MP_NEG)
-	  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
 
@@ -492,7 +576,55 @@ mp *
 m(mb)
 	MP_Barrett *mb
 	CODE:
-	RETVAL = mp_copy(mb->m);
+	RETVAL = MP_COPY(mb->m);
+	OUTPUT:
+	RETVAL
+
+MODULE = Catacomb PACKAGE = Catacomb::MP::Reduce PREFIX = mpreduce_
+
+MP_Reduce *
+new(me, x)
+	SV *me
+	mp *x
+	CODE:
+	RETVAL = CREATE(MP_Reduce);	
+	if (mpreduce_create(RETVAL, x)) {
+	  DESTROY(RETVAL);
+	  RETVAL = 0;
+	}
+	OUTPUT:
+	RETVAL
+
+SV *
+DESTROY(r)
+	MP_Reduce *r
+	CODE:
+	mpreduce_destroy(r);
+	DESTROY(r);
+	XSRETURN_UNDEF;
+
+mp *
+reduce(r, x)
+	MP_Reduce *r
+	mp *x
+	CODE:
+	RETVAL = mpreduce_do(r, MP_NEW, x);
+	OUTPUT:
+	RETVAL
+
+mp *
+mpreduce_exp(r, x, y)
+	MP_Reduce *r
+	mp *x
+	mp *y
+	C_ARGS:
+	r, MP_NEW, x, y
+
+mp *
+m(r)
+	MP_Reduce *r
+	CODE:
+	RETVAL = MP_COPY(r->p);
 	OUTPUT:
 	RETVAL
 
@@ -510,14 +642,35 @@ new(me, ...)
 	n = items - 1;
 	v = xmalloc(n * sizeof(mpcrt_mod));
 	for (i = 0; i < n; i++) {
-	  v[i].m = mp_copy(mp_fromsv(ST(i + 1), "n_%lu", 0, 0, 
-			   (unsigned long)i));
+	  v[i].m = mp_copy(mp_fromsv(ST(i + 1), "n_%lu", 
+			   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
@@ -537,6 +690,7 @@ solve(mc, ...)
 	n = mc->k;
 	if (items - 1 != n)
 	  croak("Wrong number of residues for this CRT context");
+	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);