=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/poly.c,v retrieving revision 1.8 retrieving revision 1.12 diff -u -p -r1.8 -r1.12 --- OpenXM_contrib2/asir2000/builtin/poly.c 2001/03/29 09:49:56 1.8 +++ OpenXM_contrib2/asir2000/builtin/poly.c 2001/06/29 09:08:52 1.12 @@ -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.7 2001/03/14 06:04:52 noro Exp $ + * $OpenXM: OpenXM_contrib2/asir2000/builtin/poly.c,v 1.11 2001/05/28 08:22:00 noro Exp $ */ #include "ca.h" #include "parse.h" @@ -63,7 +63,8 @@ void Pp_mag(),Pmaxblen(); void Pmergelist(), Pch_mv(), Pre_mv(), Pdeglist(); void Pptomp(),Pmptop(); void Pptolmp(),Plmptop(); -void Psfptop(); +void Pptosfp(),Psfptop(),Psf_galois_action(),Psf_embed(),Psf_find_root(); +void Psf_minipoly(); void Pptogf2n(),Pgf2ntop(),Pgf2ntovect(); void Pptogfpn(),Pgfpntop(); void Pfind_root_gf2n(); @@ -100,6 +101,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 *); @@ -111,6 +115,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}, @@ -144,8 +151,12 @@ struct ftab poly_tab[] = { {"ptolmp",Pptolmp,1}, {"lmptop",Plmptop,1}, + {"sf_galois_action",Psf_galois_action,2}, + {"sf_find_root",Psf_find_root,1}, + {"sf_minipoly",Psf_minipoly,2}, + {"sf_embed",Psf_embed,3}, + {"ptosfp",Pptosfp,1}, {"sfptop",Psfptop,1}, - {"ptogf2n",Pptogf2n,1}, {"gf2ntop",Pgf2ntop,-2}, {"gf2ntovect",Pgf2ntovect,1}, @@ -215,6 +226,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 ) @@ -738,7 +803,10 @@ Obj *rp; VR(current_gfs_ext),&p); n0 = mknode(3,q,current_gfs_ext,p); } else { - STOQ(current_gfs_iton[1],r); + 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); @@ -762,6 +830,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"); } @@ -778,6 +852,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"); } @@ -820,6 +896,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"); } @@ -1106,6 +1184,78 @@ 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); +} + +/* + sf_embed(F,B,PM) + F : an element of GF(pn) + B : the image of the primitive root of GF(pn) + PM : order of GF(pm) +*/ + +void Psf_embed(arg,rp) +NODE arg; +P *rp; +{ + int k,pm; + + /* GF(pn)={0,1,a,a^2,...}->GF(pm)={0,1,b,b^2,...}; a->b^k */ + k = CONT((GFS)ARG1(arg)); + pm = QTOS((Q)ARG2(arg)); + sf_embed((P)ARG0(arg),k,pm,rp); +} + +void Psf_find_root(arg,rp) +NODE arg; +GFS *rp; +{ + P p; + Obj t; + int d; + UM u; + int *root; + + p = (P)ARG0(arg); + simp_ff((Obj)p,&t); p = (P)t; + d = getdeg(VR(p),p); + u = W_UMALLOC(d); + ptosfum(p,u); + root = (int *)ALLOCA(d*sizeof(int)); + find_rootsf(u,root); + MKGFS(IFTOF(root[0]),*rp); +} + +void Psf_minipoly(arg,rp) +NODE arg; +P *rp; +{ + Obj t; + P p1,p2; + int d1,d2; + UM up1,up2,m; + + p1 = (P)ARG0(arg); simp_ff((Obj)p1,&t); p1 = (P)t; + p2 = (P)ARG1(arg); simp_ff((Obj)p2,&t); p2 = (P)t; + d1 = getdeg(VR(p1),p1); up1 = W_UMALLOC(d1); ptosfum(p1,up1); + d2 = getdeg(VR(p2),p2); up2 = W_UMALLOC(d2); ptosfum(p2,up2); + m = W_UMALLOC(d2); + minipolysf(up1,up2,m); + sfumtop(VR(p2),m,&p1); + sfptop(p1,rp); +} + +void Pptosfp(arg,rp) +NODE arg; +P *rp; +{ + ptosfp(ARG0(arg),rp); +} + void Psfptop(arg,rp) NODE arg; P *rp; @@ -1277,6 +1427,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"); @@ -1298,6 +1449,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"); @@ -1325,6 +1477,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");