===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/int.c,v
retrieving revision 1.1
retrieving revision 1.13
diff -u -p -r1.1 -r1.13
--- OpenXM_contrib2/asir2000/builtin/int.c	1999/12/03 07:39:07	1.1
+++ OpenXM_contrib2/asir2000/builtin/int.c	2015/08/14 13:51:54	1.13
@@ -1,4 +1,52 @@
-/* $OpenXM: OpenXM/src/asir99/builtin/int.c,v 1.1.1.1 1999/11/10 08:12:25 noro Exp $ */
+/*
+ * Copyright (c) 1994-2000 FUJITSU LABORATORIES LIMITED 
+ * All rights reserved.
+ * 
+ * FUJITSU LABORATORIES LIMITED ("FLL") hereby grants you a limited,
+ * non-exclusive and royalty-free license to use, copy, modify and
+ * redistribute, solely for non-commercial and non-profit purposes, the
+ * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and
+ * conditions of this Agreement. For the avoidance of doubt, you acquire
+ * only a limited right to use the SOFTWARE hereunder, and FLL or any
+ * third party developer retains all rights, including but not limited to
+ * copyrights, in and to the SOFTWARE.
+ * 
+ * (1) FLL does not grant you a license in any way for commercial
+ * purposes. You may use the SOFTWARE only for non-commercial and
+ * non-profit purposes only, such as academic, research and internal
+ * business use.
+ * (2) The SOFTWARE is protected by the Copyright Law of Japan and
+ * international copyright treaties. If you make copies of the SOFTWARE,
+ * with or without modification, as permitted hereunder, you shall affix
+ * to all such copies of the SOFTWARE the above copyright notice.
+ * (3) An explicit reference to this SOFTWARE and its copyright owner
+ * shall be made on your publication or presentation in any form of the
+ * results obtained by use of the SOFTWARE.
+ * (4) In the event that you modify the SOFTWARE, you shall notify FLL by
+ * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
+ * for such modification or the source code of the modified part of the
+ * SOFTWARE.
+ * 
+ * THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL
+ * MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND
+ * EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS
+ * FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES'
+ * RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY
+ * MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY.
+ * UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT,
+ * OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY
+ * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL
+ * DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES
+ * ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES
+ * FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY
+ * DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF
+ * SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART
+ * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY
+ * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
+ * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
+ *
+ * $OpenXM: OpenXM_contrib2/asir2000/builtin/int.c,v 1.12 2015/08/06 10:01:52 fujimoto Exp $ 
+*/
 #include "ca.h"
 #include "parse.h"
 #include "base.h"
@@ -9,23 +57,19 @@ void Pup2_init_eg(), Pup2_show_eg();
 void Piqr(), Pprime(), Plprime(), Pinttorat();
 void Piand(), Pior(), Pixor(), Pishift();
 void Pisqrt();
-void iand(), ior(), ixor();
-void isqrt();
 void Plrandom();
 void Pset_upkara(), Pset_uptkara(), Pset_up2kara(), Pset_upfft();
 void Pmt_save(), Pmt_load();
 void Psmall_jacobi();
 void Pdp_set_mpi();
+void Pntoint32(),Pint32ton();
 
-#ifdef HMEXT
 void Pigcdbin(), Pigcdbmod(), PigcdEuc(), Pigcdacc(), Pigcdcntl();
 
 void Pihex();
 void Pimaxrsh(), Pilen();
 void Ptype_t_NB();
 
-#endif /* HMEXT */
-
 struct ftab int_tab[] = {
 	{"dp_set_mpi",Pdp_set_mpi,-1},
 	{"isqrt",Pisqrt,1},
@@ -56,18 +100,17 @@ struct ftab int_tab[] = {
 	{"ixor",Pixor,2},
 	{"ishift",Pishift,2},
 	{"small_jacobi",Psmall_jacobi,2},
-#ifdef HMEXT
+
 	{"igcdbin",Pigcdbin,2},		/* HM@CCUT extension */
 	{"igcdbmod",Pigcdbmod,2},	/* HM@CCUT extension */
 	{"igcdeuc",PigcdEuc,2},		/* HM@CCUT extension */
 	{"igcdacc",Pigcdacc,2},		/* HM@CCUT extension */
 	{"igcdcntl",Pigcdcntl,-1},	/* HM@CCUT extension */
-	{"ihex",Pihex,1},	/* HM@CCUT extension */
-	{"imaxrsh",Pimaxrsh,1},	/* HM@CCUT extension */
-	{"ilen",Pilen,1},	/* HM@CCUT extension */
-#endif /* HMEXT */
+
 	{"mt_save",Pmt_save,1},
 	{"mt_load",Pmt_load,1},
+	{"ntoint32",Pntoint32,1},
+	{"int32ton",Pint32ton,1},
 	{0,0,0},
 };
 
@@ -76,10 +119,36 @@ static unsigned int gcd_small(unsigned int,unsigned in
 int TypeT_NB_check(unsigned int, unsigned int);
 int mpi_mag;
 
-void Pdp_set_mpi(arg,rp)
-NODE arg;
-Q *rp;
+void Pntoint32(NODE arg,USINT *rp)
 {
+	Q q;
+	unsigned int t;
+
+	asir_assert(ARG0(arg),O_N,"ntoint32");
+	q = (Q)ARG0(arg);
+	if ( !q ) {
+		MKUSINT(*rp,0);
+		return;
+	}
+	if ( NID(q)!=N_Q || !INT(q) || PL(NM(q))>1 )
+		error("ntoint32 : invalid argument");
+	t = BD(NM(q))[0];
+	if ( SGN(q) < 0 )
+		t = -(int)t;
+	MKUSINT(*rp,t);
+}
+
+void Pint32ton(NODE arg,Q *rp)
+{
+	int t;
+
+	asir_assert(ARG0(arg),O_USINT,"int32ton");
+	t = (int)BDY((USINT)ARG0(arg));
+	STOQ(t,*rp);
+}
+
+void Pdp_set_mpi(NODE arg,Q *rp)
+{
 	if ( arg ) {
 		asir_assert(ARG0(arg),O_N,"dp_set_mpi");
 		mpi_mag = QTOS((Q)ARG0(arg));
@@ -87,9 +156,7 @@ Q *rp;
 	STOQ(mpi_mag,*rp);
 }
 
-void Psmall_jacobi(arg,rp)
-NODE arg;
-Q *rp;
+void Psmall_jacobi(NODE arg,Q *rp)
 {
 	Q a,m;
 	int a0,m0,s;
@@ -110,8 +177,7 @@ Q *rp;
 	}
 }
 
-int small_jacobi(a,m)
-int a,m;
+int small_jacobi(int a,int m)
 {
 	int m4,m8,a4,j1,i,s;
 
@@ -137,9 +203,7 @@ int a,m;
 	}  
 }
 
-void Ptype_t_NB(arg,rp)
-NODE arg;
-Q *rp;
+void Ptype_t_NB(NODE arg,Q *rp)
 {
 	if ( TypeT_NB_check(QTOS((Q)ARG0(arg)),QTOS((Q)ARG1(arg))))
 		*rp = ONE;
@@ -210,9 +274,7 @@ static unsigned int gcd_small(unsigned int a,unsigned 
 		}
 }
 
-void Pmt_save(arg,rp)
-NODE arg;
-Q *rp;
+void Pmt_save(NODE arg,Q *rp)
 {
 	int ret;
 
@@ -220,9 +282,7 @@ Q *rp;
 	STOQ(ret,*rp);
 }
 
-void Pmt_load(arg,rp)
-NODE arg;
-Q *rp;
+void Pmt_load(NODE arg,Q *rp)
 {
 	int ret;
 
@@ -230,9 +290,7 @@ Q *rp;
 	STOQ(ret,*rp);
 }
 
-void Pisqrt(arg,rp)
-NODE arg;
-Q *rp;
+void Pisqrt(NODE arg,Q *rp)
 {
 	Q a;
 	N r;
@@ -249,9 +307,7 @@ Q *rp;
 	}
 }
 
-void Pidiv(arg,rp)
-NODE arg;
-Obj *rp;
+void Pidiv(NODE arg,Obj *rp)
 {
 	N q,r;
 	Q a;
@@ -270,9 +326,7 @@ Obj *rp;
 	}
 }
 
-void Pirem(arg,rp)
-NODE arg;
-Obj *rp;
+void Pirem(NODE arg,Obj *rp)
 {
 	N q,r;
 	Q a;
@@ -291,9 +345,7 @@ Obj *rp;
 	}
 }
 
-void Piqr(arg,rp)
-NODE arg;
-LIST *rp;
+void Piqr(NODE arg,LIST *rp)
 {
 	N q,r;
 	Q a,b;
@@ -317,9 +369,7 @@ LIST *rp;
 	MKNODE(node2,b,0); MKNODE(node1,a,node2); MKLIST(*rp,node1);
 }
 
-void Pinttorat(arg,rp)
-NODE arg;
-LIST *rp;
+void Pinttorat(NODE arg,LIST *rp)
 {
 	Q cq,qq,t,u1,v1,r1,nm;
 	N m,b,q,r,c,u2,v2,r2;
@@ -358,9 +408,7 @@ LIST *rp;
 	}
 }
 
-void Pigcd(arg,rp)
-NODE arg;
-Q *rp;
+void Pigcd(NODE arg,Q *rp)
 {
 	N g;
 	Q n1,n2,a;
@@ -382,16 +430,12 @@ Q *rp;
 	}
 }
 
-int comp_n(a,b)
-N *a,*b;
+int comp_n(N *a,N *b)
 {
 	return cmpn(*a,*b);
 }
 
-void iqrv(a,dvr,rp)
-VECT a;
-Q dvr;
-LIST *rp;
+void iqrv(VECT a,Q dvr,LIST *rp)
 {
 	int i,n;
 	VECT q,r;
@@ -418,10 +462,35 @@ LIST *rp;
 	MKNODE(n1,r,0); MKNODE(n0,q,n1); MKLIST(*rp,n0);
 }
 
-void igcdv(a,rp)
-VECT a;
-Q *rp;
+/*
+ * gcd = GCD(a,b), ca = a/g, cb = b/g
+ */
+
+void igcd_cofactor(Q a,Q b,Q *gcd,Q *ca,Q *cb)
 {
+	N gn,tn;
+	
+	if ( !a ) {
+		if ( !b )
+			error("igcd_cofactor : invalid input");
+		else {
+			*ca = 0;
+			*cb = ONE;
+			*gcd = b;
+		}
+	} else if ( !b ) {
+		*ca = ONE;
+		*cb = 0;
+		*gcd = a;
+	} else {
+		gcdn(NM(a),NM(b),&gn); NTOQ(gn,1,*gcd);
+		divsn(NM(a),gn,&tn); NTOQ(tn,SGN(a),*ca);
+		divsn(NM(b),gn,&tn); NTOQ(tn,SGN(b),*cb);
+	}
+}
+
+void igcdv(VECT a,Q *rp)
+{
 	int i,j,n,nz;
 	N g,gt,q,r;
 	N *c;
@@ -439,6 +508,7 @@ Q *rp;
 		NTOQ(*c,1,*rp); return;
 	}
 	gcdn(c[0],c[1],&g);
+#if 0
 	for ( i = 2; i < n; i++ ) {
 		divn(c[i],g,&q,&r);
 		gcdn(g,r,&gt);
@@ -451,12 +521,15 @@ Q *rp;
 		} else
 			g = gt;
 	}
+#else
+	for ( i = 2; i < n; i++ ) {
+		gcdn(g,c[i],&gt); g = gt;
+	}
+#endif
 	NTOQ(g,1,*rp);
 }
 
-void igcdv_estimate(a,rp)
-VECT a;
-Q *rp;
+void igcdv_estimate(VECT a,Q *rp)
 {
 	int n,i,m;
 	N s,t,u,g;
@@ -477,9 +550,7 @@ Q *rp;
 	gcdn(s,t,&g); NTOQ(g,1,*rp);
 }
 
-void Pilcm(arg,rp)
-NODE arg;
-Obj *rp;
+void Pilcm(NODE arg,Obj *rp)
 {
 	N g,q,r,l;
 	Q n1,n2,a;
@@ -495,9 +566,7 @@ Obj *rp;
 	}
 }
 
-void Piand(arg,rp)
-NODE arg;
-Q *rp;
+void Piand(NODE arg,Q *rp)
 {
 	N g;
 	Q n1,n2,a;
@@ -513,9 +582,7 @@ Q *rp;
 	}
 }
 
-void Pior(arg,rp)
-NODE arg;
-Q *rp;
+void Pior(NODE arg,Q *rp)
 {
 	N g;
 	Q n1,n2,a;
@@ -533,9 +600,7 @@ Q *rp;
 	}
 }
 
-void Pixor(arg,rp)
-NODE arg;
-Q *rp;
+void Pixor(NODE arg,Q *rp)
 {
 	N g;
 	Q n1,n2,a;
@@ -553,9 +618,7 @@ Q *rp;
 	}
 }
 
-void Pishift(arg,rp)
-NODE arg;
-Q *rp;
+void Pishift(NODE arg,Q *rp)
 {
 	N g;
 	Q n1,s,a;
@@ -573,8 +636,7 @@ Q *rp;
 	}
 }
 
-void isqrt(a,r)
-N a,*r;
+void isqrt(N a,N *r)
 {
 	int k;
 	N x,t,x2,xh,quo,rem;
@@ -602,8 +664,7 @@ N a,*r;
 	}
 }
 
-void iand(n1,n2,r)
-N n1,n2,*r;
+void iand(N n1,N n2,N *r)
 {
 	int d1,d2,d,i;
 	N nr;
@@ -622,8 +683,7 @@ N n1,n2,*r;
 	}
 }
 
-void ior(n1,n2,r)
-N n1,n2,*r;
+void ior(N n1,N n2,N *r)
 {
 	int d1,d2,i;
 	N nr;
@@ -646,8 +706,7 @@ N n1,n2,*r;
 	}
 }
 
-void ixor(n1,n2,r)
-N n1,n2,*r;
+void ixor(N n1,N n2,N *r)
 {
 	int d1,d2,i;
 	N nr;
@@ -670,23 +729,19 @@ N n1,n2,*r;
 	}
 }
 
-void Pup2_init_eg(rp)
-Obj *rp;
+void Pup2_init_eg(Obj *rp)
 {
 	up2_init_eg();
 	*rp = 0;
 }
 
-void Pup2_show_eg(rp)
-Obj *rp;
+void Pup2_show_eg(Obj *rp)
 {
 	up2_show_eg();
 	*rp = 0;
 }
 
-void Pgf2nton(arg,rp)
-NODE arg;
-Q *rp;
+void Pgf2nton(NODE arg,Q *rp)
 {
 	if ( !ARG0(arg) )
 		*rp = 0;
@@ -694,9 +749,7 @@ Q *rp;
 		up2ton(((GF2N)ARG0(arg))->body,rp);
 }
 
-void Pntogf2n(arg,rp)
-NODE arg;
-GF2N *rp;
+void Pntogf2n(NODE arg,GF2N *rp)
 {
 	UP2 t;
 
@@ -704,9 +757,7 @@ GF2N *rp;
 	MKGF2N(t,*rp);
 }
 
-void Pup2_inv(arg,rp)
-NODE arg;
-P *rp;
+void Pup2_inv(NODE arg,P *rp)
 {
 	UP2 a,b,t;
 
@@ -716,9 +767,7 @@ P *rp;
 	up2top(t,rp);
 }
 
-void Pinv(arg,rp)
-NODE arg;
-Num *rp;
+void Pinv(NODE arg,Num *rp)
 {
 	Num n;
 	Q mod;
@@ -745,17 +794,13 @@ Num *rp;
 		}
 }
 
-void Pfac(arg,rp)
-NODE arg;
-Q *rp;
+void Pfac(NODE arg,Q *rp)
 { 
 	asir_assert(ARG0(arg),O_N,"fac");
 	factorial(QTOS((Q)ARG0(arg)),rp); 
 }
 
-void Plrandom(arg,rp)
-NODE arg;
-Q *rp;
+void Plrandom(NODE arg,Q *rp)
 {
 	N r;
 
@@ -764,9 +809,7 @@ Q *rp;
 	NTOQ(r,1,*rp);
 }
 
-void Prandom(arg,rp)
-NODE arg;
-Q *rp;
+void Prandom(NODE arg,Q *rp)
 {
 	unsigned int r;
 
@@ -785,7 +828,7 @@ Q *rp;
 	UTOQ(r,*rp);
 }
 
-#if defined(VISUAL) || defined(THINK_C)
+#if defined(VISUAL) || defined(__MINGW32__)
 void srandom(unsigned int);
 
 static unsigned int R_Next;
@@ -796,8 +839,7 @@ unsigned int random() {
         return R_Next = (R_Next * 1103515245 + 12345);
 }
 
-void srandom(s)
-unsigned int s;
+void srandom(unsigned int s)
 {
 		if ( s )
 			R_Next = s;
@@ -806,9 +848,7 @@ unsigned int s;
 }
 #endif
 
-void Pprime(arg,rp)
-NODE arg;
-Q *rp;
+void Pprime(NODE arg,Q *rp)
 {
 	int i;
 
@@ -820,25 +860,22 @@ Q *rp;
 		STOQ(sprime[i],*rp);
 }
 
-void Plprime(arg,rp)
-NODE arg;
-Q *rp;
+void Plprime(NODE arg,Q *rp)
 {
-	int i;
+	int i,p;
 
 	asir_assert(ARG0(arg),O_N,"lprime");
 	i = QTOS((Q)ARG0(arg));
-	if ( i < 0 || i >= 1000 )
+	if ( i < 0 )
 		*rp = 0;
-	else
-		STOQ(lprime[i],*rp);
+	else 
+		p = get_lprime(i);
+	STOQ(p,*rp);
 }
 
 extern int up_kara_mag, up_tkara_mag, up_fft_mag;
 
-void Pset_upfft(arg,rp)
-NODE arg;
-Q *rp;
+void Pset_upfft(NODE arg,Q *rp)
 {
 	if ( arg ) {
 		asir_assert(ARG0(arg),O_N,"set_upfft");
@@ -847,9 +884,7 @@ Q *rp;
 	STOQ(up_fft_mag,*rp);
 }
 
-void Pset_upkara(arg,rp)
-NODE arg;
-Q *rp;
+void Pset_upkara(NODE arg,Q *rp)
 {
 	if ( arg ) {
 		asir_assert(ARG0(arg),O_N,"set_upkara");
@@ -858,9 +893,7 @@ Q *rp;
 	STOQ(up_kara_mag,*rp);
 }
 
-void Pset_uptkara(arg,rp)
-NODE arg;
-Q *rp;
+void Pset_uptkara(NODE arg,Q *rp)
 {
 	if ( arg ) {
 		asir_assert(ARG0(arg),O_N,"set_uptkara");
@@ -871,9 +904,7 @@ Q *rp;
 
 extern int up2_kara_mag;
 
-void Pset_up2kara(arg,rp)
-NODE arg;
-Q *rp;
+void Pset_up2kara(NODE arg,Q *rp)
 {
 	if ( arg ) {
 		asir_assert(ARG0(arg),O_N,"set_up2kara");
@@ -882,10 +913,7 @@ Q *rp;
 	STOQ(up2_kara_mag,*rp);
 }
 
-#ifdef HMEXT
-void Pigcdbin(arg,rp)
-NODE arg;
-Obj *rp;
+void Pigcdbin(NODE arg,Obj *rp)
 {
 	N g;
 	Q n1,n2,a;
@@ -903,9 +931,7 @@ Obj *rp;
 	}
 }
 
-void Pigcdbmod(arg,rp)
-NODE arg;
-Obj *rp;
+void Pigcdbmod(NODE arg,Obj *rp)
 {
 	N g;
 	Q n1,n2,a;
@@ -923,9 +949,7 @@ Obj *rp;
 	}
 }
 
-void Pigcdacc(arg,rp)
-NODE arg;
-Obj *rp;
+void Pigcdacc(NODE arg,Obj *rp)
 {
 	N g;
 	Q n1,n2,a;
@@ -943,9 +967,7 @@ Obj *rp;
 	}
 }
 
-void PigcdEuc(arg,rp)
-NODE arg;
-Obj *rp;
+void PigcdEuc(NODE arg,Obj *rp)
 {
 	N g;
 	Q n1,n2,a;
@@ -982,9 +1004,7 @@ extern int igcdacc_thre;
      *  > igcdacc_thre, "bmod" reduction is done.
      */
 
-void Pigcdcntl(arg,rp)
-NODE arg;
-Obj *rp;
+void Pigcdcntl(NODE arg,Obj *rp)
 {
 	Obj p;
 	Q a;
@@ -1033,60 +1053,3 @@ Obj *rp;
 	*rp = (Obj)a;
 	return;
 }
-
-
-void Pimaxrsh(arg,rp)
-NODE arg;
-LIST *rp;
-{
-	N n1, n2;
-	Q q;
-	NODE node1, node2;
-	int bits;
-	N maxrshn();
-	
-	q = (Q)ARG0(arg);
-	asir_assert(q,O_N,"imaxrsh");
-	if ( !q ) n1 = n2 = 0;
-	else {
-		n1 = maxrshn( NM(q), &bits );
-		STON( bits, n2 );
-	}
-	NTOQ( n2, 1, q );
-	MKNODE( node2, q, 0 );
-	NTOQ( n1, 1, q );
-	MKNODE( node1, q, node2 );
-	MKLIST( *rp, node1 );
-}
-void Pilen(arg,rp)
-NODE arg;
-Obj *rp;
-{
-	Q q;
-	int l;
-	
-	q = (Q)ARG0(arg);
-	asir_assert(q,O_N,"ilenh");
-	if ( !q ) l = 0;
-	else l = PL(NM(q));
-	STOQ(l,q);
-	*rp = (Obj)q;
-}
-
-void Pihex(arg,rp)
-NODE arg;
-Obj *rp;
-{
-	Q n1;
-	
-	n1 = (Q)ARG0(arg);
-	asir_assert(n1,O_N,"ihex");
-	if ( n1 ) {
-		int i, l = PL(NM(n1)), *p = BD(NM(n1));
-
-		for ( i = 0; i < l; i++ ) printf( " 0x%08x", p[i] );
-		printf( "\n" );
-	} else printf( " 0x%08x\n", 0 );
-	*rp = (Obj)n1;
-}
-#endif /* HMEXT */