Annotation of OpenXM_contrib2/asir2000/engine/dalg.c, Revision 1.1
1.1 ! noro 1: /*
! 2: * $OpenXM$
! 3: */
! 4:
! 5: #include "ca.h"
! 6: #include "base.h"
! 7:
! 8: typedef struct oNumberField {
! 9: int n;
! 10: int dim;
! 11: VL vl;
! 12: P *defpoly;
! 13: DP *mb;
! 14: DP *ps;
! 15: NODE ind;
! 16: struct order_spec *spec;
! 17: } *NumberField;
! 18:
! 19: typedef struct oDAlg {
! 20: short id;
! 21: char nid;
! 22: char pad;
! 23: DP nm;
! 24: Q dn;
! 25: } *DAlg;
! 26:
! 27: #define N_DA 11
! 28: #define NEWDAlg(r) ((r)=(DAlg)MALLOC(sizeof(struct oDAlg)),OID(r)=O_N,NID(r)=N_DA)
! 29: #define MKDAlg(dp,dn,r) (NEWDAlg(r),(r)->nm = (dp),(r)->dn=(dn))
! 30:
! 31: static NumberField current_numberfield;
! 32: extern struct order_spec *dp_current_spec;
! 33:
! 34: void setfield_dalg(NODE alist)
! 35: {
! 36: NumberField nf;
! 37: VL vl,vl1,vl2;
! 38: int n,i,dim;
! 39: Alg *gen;
! 40: P *defpoly;
! 41: P p;
! 42: Q c,iq,two;
! 43: DP *ps,*mb;
! 44: NODE t,b,b1,b2,hlist,mblist;
! 45: struct order_spec *current_spec;
! 46:
! 47: nf = (NumberField)MALLOC(sizeof(struct oNumberField));
! 48: current_numberfield = nf;
! 49: vl = 0;
! 50: for ( t = alist; t; t = NEXT(t) ) {
! 51: clctalg(BDY((Alg)BDY(t)),&vl1);
! 52: mergev(ALG,vl,vl1,&vl2); vl = vl2;
! 53: }
! 54: for ( n = 0, vl1 = vl; vl1; vl1 = NEXT(vl1), n++ );
! 55: nf->n = n;
! 56: nf->vl = vl;
! 57: nf->defpoly = defpoly = (P *)MALLOC(n*sizeof(P));
! 58: nf->ps = ps = (DP *)MALLOC(n*sizeof(DP));
! 59: current_spec = dp_current_spec;
! 60: STOQ(2,two);
! 61: create_order_spec(0,(Obj)two,&nf->spec);
! 62: initd(nf->spec);
! 63: for ( b = hlist = 0, i = 0, vl1 = vl; i < n; vl1 = NEXT(vl1), i++ ) {
! 64: ptozp(vl1->v->attr,1,&c,&defpoly[i]);
! 65: ptod(ALG,vl,defpoly[i],&ps[i]);
! 66: STOQ(i,iq); MKNODE(b1,(pointer)iq,b); b = b1;
! 67: MKNODE(b2,(pointer)ps[i],&hlist); hlist = b2;
! 68: }
! 69: initd(current_spec);
! 70: nf->ind = b;
! 71: dp_base(hlist,&mblist);
! 72: nf->dim = dim = length(mblist);
! 73: nf->mb = mb = (DP *)MALLOC(dim*sizeof(DP));
! 74: for ( i = 0, t = mblist; t; t = NEXT(t), i++ )
! 75: mb[i] = (DP)BDY(mblist);
! 76: }
! 77:
! 78: void algtodalg(Alg a,DAlg *r)
! 79: {
! 80: P ap,p,p1;
! 81: Q c,dn,nm;
! 82: DP dp;
! 83: DAlg da;
! 84: NumberField nf;
! 85: struct order_spec *current_spec;
! 86:
! 87: if ( !(nf=current_numberfield) )
! 88: error("algtodalg : current_numberfield is not set");
! 89: ap = (P)BDY(a);
! 90: ptozp(ap,1,&c,&p);
! 91: if ( INT(c) ) {
! 92: p = ap;
! 93: dn = ONE;
! 94: } else {
! 95: NTOQ(NM(c),SGN(c),nm);
! 96: NTOQ(DN(c),1,dn);
! 97: mulpq(p,(P)nm,&p1); p = p1;
! 98: }
! 99: current_spec = dp_current_spec;
! 100: initd(nf->spec);
! 101: ptod(ALG,nf->vl,p,&dp);
! 102: MKDAlg(dp,dn,da);
! 103: *r = da;
! 104: }
! 105:
! 106: void dalgtoalg(DAlg da,Num *a)
! 107: {
! 108: if ( !current_numberfield )
! 109: error("algtodalg : current_numberfield is not set");
! 110: }
! 111:
! 112: void simpdalg(DAlg da,DAlg *r)
! 113: {
! 114: if ( !current_numberfield )
! 115: error("algtodalg : current_numberfield is not set");
! 116: }
! 117:
! 118: void adddalg(DAlg a,DAlg b,DAlg *c)
! 119: {
! 120: if ( !current_numberfield )
! 121: error("algtodalg : current_numberfield is not set");
! 122: }
! 123:
! 124: void subdalg(DAlg a,DAlg b,DAlg *c)
! 125: {
! 126: if ( !current_numberfield )
! 127: error("algtodalg : current_numberfield is not set");
! 128: }
! 129:
! 130: void divdalg(DAlg a,DAlg b,DAlg *c)
! 131: {
! 132: if ( !current_numberfield )
! 133: error("algtodalg : current_numberfield is not set");
! 134: }
! 135:
! 136: void invdalg(DAlg a,DAlg *c)
! 137: {
! 138: if ( !current_numberfield )
! 139: error("algtodalg : current_numberfield is not set");
! 140: }
! 141:
! 142: void chsgndalg(DAlg a,DAlg *c)
! 143: {
! 144: }
! 145:
! 146: void pwrdalg(DAlg a,Q b,DAlg *c)
! 147: {
! 148: if ( !current_numberfield )
! 149: error("algtodalg : current_numberfield is not set");
! 150: }
! 151:
! 152: int cmpgdalg(DAlg a,DAlg b)
! 153: {
! 154: if ( !current_numberfield )
! 155: error("algtodalg : current_numberfield is not set");
! 156: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>