===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/poly.c,v
retrieving revision 1.4
retrieving revision 1.11
diff -u -p -r1.4 -r1.11
--- OpenXM_contrib2/asir2000/builtin/poly.c	2000/08/21 08:31:21	1.4
+++ OpenXM_contrib2/asir2000/builtin/poly.c	2001/05/28 08:22:00	1.11
@@ -23,7 +23,7 @@
  * 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@flab.fujitsu.co.jp of the detailed specification
+ * 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.
  * 
@@ -45,7 +45,7 @@
  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
  * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
  *
- * $OpenXM: OpenXM_contrib2/asir2000/builtin/poly.c,v 1.3 2000/01/11 06:43:35 noro Exp $ 
+ * $OpenXM: OpenXM_contrib2/asir2000/builtin/poly.c,v 1.10 2001/05/09 01:41:41 noro Exp $ 
 */
 #include "ca.h"
 #include "parse.h"
@@ -63,6 +63,7 @@ void Pp_mag(),Pmaxblen();
 void Pmergelist(), Pch_mv(), Pre_mv(), Pdeglist();
 void Pptomp(),Pmptop();
 void Pptolmp(),Plmptop();
+void Pptosfp(),Psfptop(),Psf_galois_action();
 void Pptogf2n(),Pgf2ntop(),Pgf2ntovect();
 void Pptogfpn(),Pgfpntop();
 void Pfind_root_gf2n();
@@ -99,6 +100,9 @@ void Pis_irred_gf2();
 void Pis_irred_ddd_gf2();
 void Pget_next_fft_prime();
 void Puadj_coef();
+void Preorder();
+void Phomogeneous_part();
+void Phomogeneous_deg();
 void simp_ff(Obj,Obj *);
 void ranp(int,UP *);
 void field_order_ff(N *);
@@ -110,6 +114,9 @@ extern int lm_lazy;
 int current_ff;
 
 struct ftab poly_tab[] = {
+	{"homogeneous_deg",Phomogeneous_deg,-2},
+	{"homogeneous_part",Phomogeneous_part,-3},
+	{"reorder",Preorder,3},
 	{"uadj_coef",Puadj_coef,3},
 	{"ranp",Pranp,2},
 	{"p_mag",Pp_mag,1},
@@ -143,6 +150,10 @@ struct ftab poly_tab[] = {
 	{"ptolmp",Pptolmp,1},
 	{"lmptop",Plmptop,1},
 
+	{"sf_galois_action",Psf_galois_action,2},
+	{"ptosfp",Pptosfp,1},
+	{"sfptop",Psfptop,1},
+
 	{"ptogf2n",Pptogf2n,1},
 	{"gf2ntop",Pgf2ntop,-2},
 	{"gf2ntovect",Pgf2ntovect,1},
@@ -212,6 +223,60 @@ struct ftab poly_tab[] = {
 
 extern V up_var;
 
+void Phomogeneous_part(arg,rp)
+NODE arg;
+P *rp;
+{
+	if ( argc(arg) == 2 )
+		exthp(CO,(P)ARG0(arg),QTOS((Q)ARG1(arg)),rp);
+	else
+		exthpc_generic(CO,(P)ARG0(arg),QTOS((Q)ARG2(arg)),
+			VR((P)ARG1(arg)),rp);
+}
+
+void Phomogeneous_deg(arg,rp)
+NODE arg;
+Q *rp;
+{
+	int d;
+
+	if ( argc(arg) == 1 )
+		d = homdeg((P)ARG0(arg));
+	else
+		d = getchomdeg(VR((P)ARG1(arg)),(P)ARG0(arg));
+	STOQ(d,*rp);
+}
+
+/* 
+	p1 = reorder(p,ovl,nvl) => p1 is 'sorted accoding to nvl.
+*/
+
+void Preorder(arg,rp)
+NODE arg;
+P *rp;
+{
+	VL ovl,nvl,tvl;
+	NODE n;
+
+	for ( ovl = 0, n = BDY((LIST)ARG1(arg)); n; n = NEXT(n) ) {
+		if ( !ovl ) {
+			NEWVL(ovl); tvl = ovl;
+		} else {
+			NEWVL(NEXT(tvl)); tvl = NEXT(tvl);
+		}
+			VR(tvl) = VR((P)BDY(n));
+	}
+	for ( nvl = 0, n = BDY((LIST)ARG2(arg)); n; n = NEXT(n) ) {
+		if ( !nvl ) {
+			NEWVL(nvl); tvl = nvl;
+		} else {
+			NEWVL(NEXT(tvl)); tvl = NEXT(tvl);
+		}
+			VR(tvl) = VR((P)BDY(n));
+	}
+	reorderp(nvl,ovl,(P)ARG0(arg),rp);
+}
+
 /*
 	uadj_coef(F,M,M2)
 	if ( F is a non-negative integer )
@@ -663,16 +728,25 @@ Q *rp;
 	STOQ(ret,*rp);
 }
 
+extern P current_gfs_ext;
+extern int current_gfs_p;
+extern int current_gfs_q;
+extern int current_gfs_q1;
+extern int *current_gfs_plus1;
+extern int *current_gfs_ntoi;
+extern int *current_gfs_iton;
+
 void Psetmod_ff(arg,rp)
 NODE arg;
 Obj *rp;
 {
 	int ac;
+	int d;
 	Obj mod,defpoly;
 	N n;
 	UP up;
 	UP2 up2;
-	Q q;
+	Q q,r;
 	P p;
 	NODE n0,n1;
 	LIST list;
@@ -685,7 +759,8 @@ Obj *rp;
 		switch ( OID(mod) ) {
 			case O_N:
 				current_ff = FF_GFP;
-				setmod_lm(NM((Q)mod)); break;
+				setmod_lm(NM((Q)mod));
+				break;
 			case O_P:
 				current_ff = FF_GF2N;
 				setmod_gf2n((P)mod); break;
@@ -693,13 +768,19 @@ Obj *rp;
 				error("setmod_ff : invalid argument");
 		}
 	} else if ( ac == 2 ) {
-		current_ff = FF_GFPN;
-		defpoly = (Obj)ARG0(arg);
-		mod = (Obj)ARG1(arg);
-		if ( !mod || !defpoly )
-			error("setmod_ff : invalid argument");
-		setmod_lm(NM((Q)mod));
-		setmod_gfpn((P)defpoly);
+		if ( OID(ARG0(arg)) == O_N ) {
+			/* small finite field; primitive root representation */
+			current_ff = FF_GFS;
+			setmod_sf(QTOS((Q)ARG0(arg)),QTOS((Q)ARG1(arg)));
+		} else {
+			mod = (Obj)ARG1(arg);
+			current_ff = FF_GFPN;
+			defpoly = (Obj)ARG0(arg);
+			if ( !mod || !defpoly )
+				error("setmod_ff : invalid argument");
+			setmod_lm(NM((Q)mod));
+			setmod_gfpn((P)defpoly);
+		}
 	}
 	switch ( current_ff ) {
 		case FF_GFP:
@@ -712,6 +793,21 @@ Obj *rp;
 			MKNODE(n1,q,0); MKNODE(n0,p,n1);
 			MKLIST(list,n0);
 			*rp = (Obj)list; break;
+		case FF_GFS:
+			STOQ(current_gfs_p,q);
+			if ( current_gfs_ext ) {
+				enc_to_p(current_gfs_p,current_gfs_iton[1],
+					VR(current_gfs_ext),&p);
+				n0 = mknode(3,q,current_gfs_ext,p);
+			} else {
+				if ( current_gfs_p == 2 )
+					r = ONE;
+				else
+					STOQ(current_gfs_iton[1],r);
+				n0 = mknode(3,q,current_gfs_ext,r);
+			}
+			MKLIST(list,n0);
+			*rp = (Obj)list; break;
 		default:
 			*rp = 0; break;
 	}
@@ -731,6 +827,12 @@ Q *rp;
 			getmod_gf2n(&up2); d = degup2(up2); STOQ(d,*rp); break;
 		case FF_GFPN:
 			getmod_gfpn(&up); STOQ(up->d,*rp); break;
+		case FF_GFS:
+			if ( !current_gfs_ext )
+				*rp = ONE;
+			else
+				*rp = DEG(DC(current_gfs_ext));
+			break;
 		default:
 			error("extdeg_ff : current_ff is not set");
 	}
@@ -747,6 +849,8 @@ Q *rp;
 			getmod_lm(&lm); NTOQ(lm,1,*rp); break;
 		case FF_GF2N:
 			STOQ(2,*rp); break;
+		case FF_GFS:
+			STOQ(current_gfs_p,*rp); break;
 		default:
 			error("characteristic_ff : current_ff is not set");
 	}
@@ -789,6 +893,8 @@ N *order;
 		case FF_GFPN:
 			getmod_lm(&m);
 			getmod_gfpn(&up); pwrn(m,up->d,order); break;
+		case FF_GFS:
+			STON(current_gfs_q,*order); break;
 		default:
 			error("field_order_ff : current_ff is not set");
 	}
@@ -800,6 +906,7 @@ Obj *rp;
 	LM l;
 	GF2N g;
 	GFPN p;
+	GFS s;
 
 	switch ( current_ff ) {
 		case FF_GFP:
@@ -808,6 +915,8 @@ Obj *rp;
 			randomgf2n(&g); *rp = (Obj)g; break;
 		case FF_GFPN:
 			randomgfpn(&p); *rp = (Obj)p; break;
+		case FF_GFS:
+			randomgfs(&s); *rp = (Obj)s; break;
 		default:
 			error("random_ff : current_ff is not set");
 	}
@@ -833,6 +942,7 @@ Obj *rp;
 	DCP dc,dcr0,dcr;
 	GF2N rg,sg;
 	GFPN rpn,spn;
+	GFS rs;
 	P t;
 	Obj obj;
 
@@ -850,6 +960,14 @@ Obj *rp;
 			case FF_GFPN:
 				ntogfpn((Obj)p,&rpn); simpgfpn((GFPN)rpn,&spn); *rp = (Obj)spn;
 				break;
+			case FF_GFS:
+				if ( NID((Num)p) == N_GFS )
+					*rp = p;
+				else {
+					ptomp(current_gfs_p,(P)p,&t); mqtogfs(t,&rs);
+					*rp = (Obj)rs;
+				} 
+				break;
 			default:
 				*rp = (Obj)p;
 				break;
@@ -1063,6 +1181,27 @@ P *rp;
 	lmptop((P)ARG0(arg),rp);
 }
 
+void Psf_galois_action(arg,rp)
+NODE arg;
+P *rp;
+{
+	sf_galois_action(ARG0(arg),ARG1(arg),rp);
+}
+
+void Pptosfp(arg,rp)
+NODE arg;
+P *rp;
+{
+	ptosfp(ARG0(arg),rp);
+}
+
+void Psfptop(arg,rp)
+NODE arg;
+P *rp;
+{
+	sfptop((P)ARG0(arg),rp);
+}
+
 void Pptogf2n(arg,rp)
 NODE arg;
 GF2N *rp;
@@ -1227,6 +1366,7 @@ P *rp;
 		case FF_GF2N:
 			powermodup_gf2n(p1,&p2); break;
 		case FF_GFPN:
+		case FF_GFS:
 			powermodup(p1,&p2); break;
 		default:
 			error("pwrmod_ff : current_ff is not set");
@@ -1248,6 +1388,7 @@ P *rp;
 		case FF_GF2N:
 			generic_powermodup_gf2n(g,f,(Q)ARG2(arg),&r); break;
 		case FF_GFPN:
+		case FF_GFS:
 			generic_powermodup(g,f,(Q)ARG2(arg),&r); break;
 		default:
 			error("generic_pwrmod_ff : current_ff is not set");
@@ -1275,6 +1416,7 @@ VECT *rp;
 		case FF_GF2N:
 			powertabup_gf2n(f,xp,tab); break;
 		case FF_GFPN:
+		case FF_GFS:
 			powertabup(f,xp,tab); break;
 		default:
 			error("pwrtab_ff : current_ff is not set");