[catacomb-perl] / gf.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::GF PREFIX = gf_

gf *
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

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

gf *
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

gf *
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 *
gf_sqr(a)
	gf *a
	C_ARGS:
	MP_NEW, a
	INTERFACE_MACRO:
	XSINTERFACE_FUNC
	XSINTERFACE_FUNC_SETGF
	INTERFACE:
	sqr

mp *
binop(a, b)
	gf *a
	gf *b
	C_ARGS:
	MP_NEW, a, b
	INTERFACE_MACRO:
	XSINTERFACE_FUNC
	XSINTERFACE_FUNC_SETGF
	INTERFACE:
	add sub mul

mp *
logop(a, b)
	gf *a
	gf *b
	C_ARGS:
	MP_NEW, a, b
	INTERFACE_MACRO:
	XSINTERFACE_FUNC
	XSINTERFACE_FUNC_SETMP
	INTERFACE:
	and or xor nand nor

mp *
unop(a)
	gf *a
	C_ARGS:
	MP_NEW, a
	INTERFACE_MACRO:
	XSINTERFACE_FUNC
	XSINTERFACE_FUNC_SETMP
	INTERFACE:
	not

gf *
shiftop(a, n)
	gf *a
	int n
	C_ARGS:
	MP_NEW, a, n
	INTERFACE_MACRO:
	XSINTERFACE_FUNC
	XSINTERFACE_FUNC_SETMP
	INTERFACE:
	lsl lsr

gf *
flipbits(a, n)
	gf *a
	unsigned long n
	C_ARGS:
	MP_NEW, a, n
	INTERFACE_MACRO:
	XSINTERFACE_FUNC
	XSINTERFACE_FUNC_SETMP
	INTERFACE:
	setbit clearbit

int
gf_irreduciblep(a)
	gf *a

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::GF::div");
	q = MP_NEW;
	switch (GIMME_V) {
	  case G_ARRAY:
	    r = MP_NEW;
	    mp_div(&q, &r, a, b);
	    EXTEND(SP, 2);
	    PUSHs(RET_GF(q));
	    PUSHs(RET_GF(r));
	    break;
	  case G_VOID:
	    break;
	  default:
	    mp_div(&q, &r, a, b);
	    EXTEND(SP, 1);
	    PUSHs(RET_GF(q));
	    break;
	}

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

MODULE = Catacomb PACKAGE = Catacomb::GF::Reduce PREFIX = gfreduce_

GF_Reduce *
new(me, x)
	gf *x
	CODE:
	RETVAL = CREATE(GF_Reduce);
	gfreduce_create(RETVAL, x);
	OUTPUT:
	RETVAL

SV *
DESTROY(r)
	GF_Reduce *r
	CODE:
	gfreduce_destroy(r);
	DESTROY(r);
	XSRETURN_UNDEF;

gf *
reduce(r, x)
	GF_Reduce *r
	gf *x
	CODE:
	RETVAL = gfreduce_do(r, MP_NEW, x);
	OUTPUT:
	RETVAL

gf *
sqrt(r, x)
	GF_Reduce *r
	gf *x
	CODE:
	if ((RETVAL = gfreduce_sqrt(r, MP_NEW, x)) == 0)
	  XSRETURN_UNDEF;
	OUTPUT:
	RETVAL

int
gfreduce_trace(r, x)
	GF_Reduce *r
	gf *x

gf *
gfreduce_halftrace(r, x)
	GF_Reduce *r
	gf *x
	C_ARGS:
	r, MP_NEW, x

gf *
quadsolve(r, x)
	GF_Reduce *r
	gf *x
	CODE:
	if ((RETVAL = gfreduce_quadsolve(r, MP_NEW, x)) == 0)
	  XSRETURN_UNDEF;
	OUTPUT:
	RETVAL

gf *
m(r)
	GF_Reduce *r
	CODE:
	RETVAL = MP_COPY(r->p);
	OUTPUT:
	RETVAL

gf *
gfreduce_exp(r, x, y)
	GF_Reduce *r
	gf *x
	gf *y
	C_ARGS:
	r, MP_NEW, x, y

#----- That's all, folks ----------------------------------------------------
Commit	Line	Data
a1a90aaf	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::GF PREFIX = gf_
	30
	31	gf *
	32	new(me, sv = 0, radix = 0)
	33	SV *me
	34	SV *sv
	35	int radix
	36	CODE:
fcd15e0b	37	RETVAL = sv ? mp_fromsv(sv, "sv", radix, 1) : MP_ZERO;
a1a90aaf	38	OUTPUT:
	39	RETVAL
	40
	41	gf *
	42	copy(x)
	43	gf *x
	44	CODE:
	45	RETVAL = MP_COPY(x);
	46	OUTPUT:
	47	RETVAL
	48
	49	gf *
	50	loadb(me, sv)
	51	SV *me
	52	SV *sv
	53	PREINIT:
	54	char *p;
	55	STRLEN len;
	56	CODE:
	57	p = SvPV(sv, len);
	58	RETVAL = mp_loadb(MP_NEW, p, len);
	59	OUTPUT:
	60	RETVAL
	61
	62	gf *
	63	loadl(me, sv)
	64	SV *me
	65	SV *sv
	66	PREINIT:
	67	char *p;
	68	STRLEN len;
	69	CODE:
	70	p = SvPV(sv, len);
	71	RETVAL = mp_loadl(MP_NEW, p, len);
	72	OUTPUT:
	73	RETVAL
	74
a1a90aaf	75	mp *
	76	gf_sqr(a)
	77	gf *a
	78	C_ARGS:
	79	MP_NEW, a
	80	INTERFACE_MACRO:
	81	XSINTERFACE_FUNC
	82	XSINTERFACE_FUNC_SETGF
	83	INTERFACE:
	84	sqr
	85
	86	mp *
	87	binop(a, b)
	88	gf *a
	89	gf *b
	90	C_ARGS:
	91	MP_NEW, a, b
	92	INTERFACE_MACRO:
	93	XSINTERFACE_FUNC
	94	XSINTERFACE_FUNC_SETGF
	95	INTERFACE:
	96	add sub mul
	97
fcd15e0b	98	mp *
	99	logop(a, b)
	100	gf *a
	101	gf *b
	102	C_ARGS:
	103	MP_NEW, a, b
	104	INTERFACE_MACRO:
	105	XSINTERFACE_FUNC
	106	XSINTERFACE_FUNC_SETMP
	107	INTERFACE:
	108	and or xor nand nor
	109
	110	mp *
	111	unop(a)
	112	gf *a
	113	C_ARGS:
	114	MP_NEW, a
	115	INTERFACE_MACRO:
	116	XSINTERFACE_FUNC
	117	XSINTERFACE_FUNC_SETMP
	118	INTERFACE:
	119	not
	120
a1a90aaf	121	gf *
a1a90aaf	122	shiftop(a, n)
fcd15e0b	123	gf *a
a1a90aaf	124	int n
	125	C_ARGS:
	126	MP_NEW, a, n
	127	INTERFACE_MACRO:
	128	XSINTERFACE_FUNC
	129	XSINTERFACE_FUNC_SETMP
	130	INTERFACE:
	131	lsl lsr
	132
fcd15e0b	133	gf *
fcd15e0b	134	flipbits(a, n)
a1a90aaf	135	gf *a
fcd15e0b	136	unsigned long n
	137	C_ARGS:
	138	MP_NEW, a, n
	139	INTERFACE_MACRO:
	140	XSINTERFACE_FUNC
	141	XSINTERFACE_FUNC_SETMP
	142	INTERFACE:
	143	setbit clearbit
a1a90aaf	144
	145	int
	146	gf_irreduciblep(a)
	147	gf *a
	148
	149	void
	150	div(a, b)
	151	mp *a
	152	mp *b
	153	PREINIT:
	154	mp q = MP_NEW, r = MP_NEW;
	155	PPCODE:
	156	if (MP_EQ(b, MP_ZERO))
	157	croak("Divide by zero in Catacomb::GF::div");
	158	q = MP_NEW;
	159	switch (GIMME_V) {
	160	case G_ARRAY:
	161	r = MP_NEW;
	162	mp_div(&q, &r, a, b);
	163	EXTEND(SP, 2);
	164	PUSHs(RET_GF(q));
	165	PUSHs(RET_GF(r));
	166	break;
	167	case G_VOID:
	168	break;
	169	default:
	170	mp_div(&q, &r, a, b);
	171	EXTEND(SP, 1);
	172	PUSHs(RET_GF(q));
	173	break;
	174	}
	175
	176	void
	177	gcd(a, b)
	178	gf *a
	179	gf *b
	180	PREINIT:
	181	gf g = MP_NEW, x = MP_NEW, *y = MP_NEW;
	182	PPCODE:
	183	switch (GIMME_V) {
	184	case G_ARRAY:
	185	gf_gcd(&g, &x, &y, a, b);
	186	EXTEND(SP, 3);
	187	PUSHs(RET_GF(g));
	188	PUSHs(RET_GF(x));
	189	PUSHs(RET_GF(y));
	190	break;
	191	case G_VOID:
	192	break;
	193	default:
	194	gf_gcd(&g, 0, 0, a, b);
	195	EXTEND(SP, 1);
	196	PUSHs(RET_GF(g));
	197	break;
	198	}
	199
a1a90aaf	200	MODULE = Catacomb PACKAGE = Catacomb::GF::Reduce PREFIX = gfreduce_
	201
	202	GF_Reduce *
	203	new(me, x)
	204	gf *x
	205	CODE:
	206	RETVAL = CREATE(GF_Reduce);
	207	gfreduce_create(RETVAL, x);
	208	OUTPUT:
	209	RETVAL
	210
	211	SV *
	212	DESTROY(r)
	213	GF_Reduce *r
	214	CODE:
	215	gfreduce_destroy(r);
	216	DESTROY(r);
	217	XSRETURN_UNDEF;
	218
	219	gf *
	220	reduce(r, x)
	221	GF_Reduce *r
	222	gf *x
	223	CODE:
	224	RETVAL = gfreduce_do(r, MP_NEW, x);
	225	OUTPUT:
	226	RETVAL
	227
	228	gf *
	229	sqrt(r, x)
	230	GF_Reduce *r
	231	gf *x
	232	CODE:
	233	if ((RETVAL = gfreduce_sqrt(r, MP_NEW, x)) == 0)
	234	XSRETURN_UNDEF;
	235	OUTPUT:
	236	RETVAL
	237
	238	int
	239	gfreduce_trace(r, x)
	240	GF_Reduce *r
	241	gf *x
	242
	243	gf *
	244	gfreduce_halftrace(r, x)
	245	GF_Reduce *r
	246	gf *x
	247	C_ARGS:
	248	r, MP_NEW, x
	249
	250	gf *
	251	quadsolve(r, x)
	252	GF_Reduce *r
	253	gf *x
	254	CODE:
	255	if ((RETVAL = gfreduce_quadsolve(r, MP_NEW, x)) == 0)
	256	XSRETURN_UNDEF;
	257	OUTPUT:
	258	RETVAL
	259
	260	gf *
	261	m(r)
	262	GF_Reduce *r
	263	CODE:
264	RETVAL = MP_COPY(r->p);
265	OUTPUT:
266	RETVAL
267
268	gf *
269	gfreduce_exp(r, x, y)
270	GF_Reduce *r
271	gf *x
272	gf *y
273	C_ARGS:
274	r, MP_NEW, x, y
275
276	#----- That's all, folks ----------------------------------------------------