Much wider support for Catacomb in all its glory.

[catacomb-perl] / mp.xs

# ---?---
#
# $Id$
#
# Multiprecision interface
#
# (c) 2000 Straylight/Edgeware
#

#----- Licensing notice -----------------------------------------------------
#
# This file is part of the Perl interface to Catacomb.
#
# Catacomb/Perl is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# 
# Catacomb/Perl is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with Catacomb/Perl; if not, write to the Free Software Foundation,
# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#

MODULE = Catacomb PACKAGE = Catacomb::MP PREFIX = mp_

mp *
new(me, sv = 0, radix = 0)
	SV *me
	SV *sv
	int radix
	CODE:
	RETVAL = sv ? mp_fromsv(sv, "sv", radix, 1) : MP_ZERO;
	OUTPUT:
	RETVAL

mp *
copy(x)
	mp *x
	CODE:
	RETVAL = MP_COPY(x);
	OUTPUT:
	RETVAL

mp *
loadb(me, sv)
	SV *me
	SV *sv
	PREINIT:
	char *p;
	STRLEN len;
	CODE:
	p = SvPV(sv, len);
	RETVAL = mp_loadb(MP_NEW, p, len);
	OUTPUT:
	RETVAL

mp *
loadl(me, sv)
	SV *me
	SV *sv
	PREINIT:
	char *p;
	STRLEN len;
	CODE:
	p = SvPV(sv, len);
	RETVAL = mp_loadl(MP_NEW, p, len);
	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
	INTERFACE_MACRO:
	XSINTERFACE_FUNC
	XSINTERFACE_FUNC_SETMP
	INTERFACE:
	octets bits octets2c

SV *
storeb(m, i = -1)
	mp *m
	int i
	PREINIT:
	size_t sz;
	CODE:
	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);
	SvPOK_on(RETVAL);
	OUTPUT:
	RETVAL

SV *
storel(m, i = -1)
	mp *m
	int i
	PREINIT:
	size_t sz;
	CODE:
	sz = (i < 0) ? mp_octets(m) : i;
	RETVAL = NEWSV(0, sz ? sz : 1);
	mp_storel(m, SvPVX(RETVAL), sz);
	SvCUR_set(RETVAL, sz);
	SvPOK_on(RETVAL);
	OUTPUT:
	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
	CODE:
	RETVAL = NEWSV(0, 0);
	mp_writesv(m, RETVAL, radix);
	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
	CODE:
	RETVAL = newSViv(mp_toiv(m));
	OUTPUT:
	RETVAL

SV *
DESTROY(m)
	mp *m
	CODE:
	mp_drop(m);
	XSRETURN_UNDEF;

mp *
unop(a)
	mp *a
	C_ARGS:
	MP_NEW, a
	INTERFACE_MACRO:
	XSINTERFACE_FUNC
	XSINTERFACE_FUNC_SETMP
	INTERFACE:
	not not2c sqr sqrt

mp *
neg(a)
	mp *a
	CODE:
	MP_COPY(a);
	RETVAL = mp_split(a);
	if (RETVAL->v < RETVAL->vl)
	  RETVAL->f ^= MP_NEG;
	OUTPUT:
	RETVAL

mp *
mp_factorial(me, x)
	SV *me
	IV x
	C_ARGS:
	x

mp *
binop(a, b)
	mp *a
	mp *b
	C_ARGS:
	MP_NEW, a, b
	INTERFACE_MACRO:
	XSINTERFACE_FUNC
	XSINTERFACE_FUNC_SETMP
	INTERFACE:
	add sub mul and2c or2c nand2c nor2c xor2c and or nand nor xor exp

mp *
shiftop(a, n)
	mp *a
	int n
	C_ARGS:
	MP_NEW, a, n
	INTERFACE_MACRO:
	XSINTERFACE_FUNC
	XSINTERFACE_FUNC_SETMP
	INTERFACE:
	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)
	mp *a
	mp *b

int
mp_eq(a, b)
	mp *a
	mp *b

int
jacobi(a, n)
	mp *a
	mp *n
	CODE:
	if (!MP_LEN(n) || !(n->v[0] & 1))
	  croak("n must be odd in Catacomb::MP::jacobi");
	RETVAL = mp_jacobi(a, n);
	OUTPUT:
	RETVAL

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

void
div(a, b)
	mp *a
	mp *b
	PREINIT:
	mp *q = MP_NEW, *r = MP_NEW;
	PPCODE:
	if (MP_EQ(b, MP_ZERO))
	  croak("Divide by zero in Catacomb::MP::div");
	q = MP_NEW;
	switch (GIMME_V) {
	  case G_ARRAY:
	    r = MP_NEW;
	    mp_div(&q, &r, a, b);
	    EXTEND(SP, 2);
	    PUSHs(RET_MP(q));
	    PUSHs(RET_MP(r));
	    break;
	  case G_VOID:
	    break;
	  default:
	    mp_div(&q, 0, a, b);
	    EXTEND(SP, 1);
	    PUSHs(RET_MP(q));
	    break;
	}

void
gcd(a, b)
	mp *a
	mp *b
	PREINIT:
	mp *g = MP_NEW, *x = MP_NEW, *y = MP_NEW;
	PPCODE:
	switch (GIMME_V) {
	  case G_ARRAY:
	    mp_gcd(&g, &x, &y, a, b);
	    EXTEND(SP, 3);
	    PUSHs(RET_MP(g));
	    PUSHs(RET_MP(x));
	    PUSHs(RET_MP(y));
	    break;
	  case G_VOID:
	    break;
	  default:
	    mp_gcd(&g, 0, 0, a, b);
	    EXTEND(SP, 1);
	    PUSHs(RET_MP(g));
	    break;
	}

void 
odd(m)
	mp *m
	PREINIT:
	mp *t;
	size_t s;
	PPCODE:
	t = mp_odd(MP_NEW, m, &s);
	EXTEND(SP, 2);
	PUSHs(sv_2mortal(newSViv(s)));
	PUSHs(RET_MP(t));

MODULE = Catacomb PACKAGE = Catacomb::MP PREFIX = pgen_

bool
pgen_primep(x, r = &rand_global)
	mp *x
	grand *r

MODULE = Catacomb PACKAGE = Catacomb::MP PREFIX = pfilt_

int
pfilt_smallfactor(x)
	mp *x

MODULE = Catacomb PACKAGE = Catacomb::MP::Mont PREFIX = mpmont_

MP_Mont *
new(me, x)
	SV *me
	mp *x
	CODE:
	RETVAL = CREATE(MP_Mont);
	if (mpmont_create(RETVAL, x)) {
	  DESTROY(RETVAL);
	  RETVAL = 0;
	}
	OUTPUT:
	RETVAL

SV *
DESTROY(mm)
	MP_Mont *mm
	CODE:
	mpmont_destroy(mm);
	DESTROY(mm);
	XSRETURN_UNDEF;

mp *
mpmont_reduce(mm, x)
	MP_Mont *mm
	mp *x
	C_ARGS:
	mm, MP_NEW, x

mp *
mpmont_mul(mm, x, y)
	MP_Mont *mm
	mp *x
	mp *y
	C_ARGS:
	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
	mp *x
	C_ARGS:
	mm, MP_NEW, g, x

mp *
mpmont_exp(mm, g, x)
	MP_Mont *mm
	mp *g
	mp *x
	C_ARGS:
	mm, MP_NEW, g, x

mp *
mpmont_mexpr(mm, ...)
	MP_Mont *mm
	PREINIT:
	mp_expfactor *v;
	size_t i, j, n;
	CODE:
	if (items < 3 || !(items & 1)) {
	  croak("Usage: Catacomb::MP::Mont::mexpr"
		"(mm, g_0, x_0, g_1, x_1, ...");
	}
	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", 0, 0);
	  v[j].exp = mp_fromsv(ST(i + 1), "x_i", 0, 0);
	}
	RETVAL = mpmont_mexpr(mm, MP_NEW, v, n);
	xfree(v);
	OUTPUT:
	RETVAL

mp *
mpmont_mexp(mm, ...)
	MP_Mont *mm
	PREINIT:
	mp_expfactor *v;
	size_t i, j, n;
	CODE:
	if (items < 3 || !(items & 1)) {
	  croak("Usage: Catacomb::MP::Mont::mexp"
		"(mm, g_0, x_0, g_1, x_1, ...");
	}
	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", 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);
	OUTPUT:
	RETVAL

mp *
r(mm)
	MP_Mont *mm
	CODE:
	RETVAL = MP_COPY(mm->r);
	OUTPUT:
	RETVAL

mp *
r2(mm)
	MP_Mont *mm
	CODE:
	RETVAL = MP_COPY(mm->r2);
	OUTPUT:
	RETVAL

mp *
m(mm)
	MP_Mont *mm
	CODE:
	RETVAL = MP_COPY(mm->m);
	OUTPUT:
	RETVAL

MODULE = Catacomb PACKAGE = Catacomb::MP::Barrett PREFIX = mpbarrett_

MP_Barrett *
new(me, x)
	SV *me
	mp *x
	CODE:
	RETVAL = CREATE(mpbarrett);
	if (mpbarrett_create(RETVAL, x)) {
	  DESTROY(RETVAL);
	  RETVAL = 0;
	}
	OUTPUT:
	RETVAL

SV *
DESTROY(mb)
	MP_Barrett *mb
	CODE:
	mpbarrett_destroy(mb);
	DESTROY(mb);
	XSRETURN_UNDEF;

mp *
mpbarrett_reduce(mb, x)
	MP_Barrett *mb
	mp *x
	C_ARGS:
	mb, MP_NEW, x

mp *
mpbarrett_exp(mb, g, x)
	MP_Barrett *mb
	mp *g
	mp *x
	C_ARGS:
	mb, MP_NEW, g, x

mp *
m(mb)
	MP_Barrett *mb
	CODE:
	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

MODULE = Catacomb PACKAGE = Catacomb::MP::CRT

MP_CRT *
new(me, ...)
	SV *me
	PREINIT:
	mpcrt_mod *v;
	size_t n, i;
	CODE:
	if (items < 1)
	  croak("Usage: Catacomb::MP::CRT::new(me, n_0, n_1, ...)");
	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].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
	CODE:
	mpcrt_destroy(mc);
	xfree(mc->v);
	DESTROY(mc);
	XSRETURN_UNDEF;

mp *
solve(mc, ...)
	MP_CRT *mc
	PREINIT:
	mp **v;
	size_t n, i;
	CODE:
	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);
	xfree(v);
	OUTPUT:
	RETVAL

#----- That's all, folks ----------------------------------------------------