Annotation of OpenXM_contrib2/asir2000/engine/gfspn.c, Revision 1.1
1.1 ! noro 1: #include "ca.h"
! 2: #include "base.h"
! 3:
! 4: UM current_mod_gfspn;
! 5:
! 6: void setmod_gfspn(p)
! 7: UM p;
! 8: {
! 9: current_mod_gfspn = p;
! 10: }
! 11:
! 12: void getmod_gfspn(up)
! 13: UM *up;
! 14: {
! 15: *up = current_mod_gfspn;
! 16: }
! 17:
! 18: void simpgfspn(n,r)
! 19: GFSPN n;
! 20: GFSPN *r;
! 21: {
! 22: UM t,q;
! 23:
! 24: if ( !n )
! 25: *r = 0;
! 26: else if ( NID(n) != N_GFSPN )
! 27: *r = n;
! 28: else {
! 29: t = UMALLOC(DEG(BDY(n)));
! 30: q = W_UMALLOC(DEG(BDY(n)));
! 31: cpyum(BDY(n),t);
! 32: divsfum(t,current_mod_gfspn,q);
! 33: MKGFSPN(t,*r);
! 34: }
! 35: }
! 36:
! 37: #define NZGFSPN(a) ((a)&&(OID(a)==O_N)&&(NID(a)==N_GFSPN))
! 38:
! 39: void ntogfspn(a,b)
! 40: Obj a;
! 41: GFSPN *b;
! 42: {
! 43: UM t;
! 44: GFS c;
! 45:
! 46: if ( !a || (OID(a)==O_N && NID(a) == N_GFSPN) )
! 47: *b = (GFSPN)a;
! 48: else if ( OID(a) == O_N && (NID(a) == N_GFS || NID(a) == N_Q) ) {
! 49: ntogfs((Num)a,&c);
! 50: if ( !b )
! 51: *b = 0;
! 52: else {
! 53: t = UMALLOC(0); ptosfum((P)c,t);
! 54: MKGFSPN(t,*b);
! 55: }
! 56: } else
! 57: error("ntogfspn : invalid argument");
! 58: }
! 59:
! 60: void addgfspn(a,b,c)
! 61: GFSPN a,b;
! 62: GFSPN *c;
! 63: {
! 64: UM t,q;
! 65: GFSPN z;
! 66: int d;
! 67:
! 68: ntogfspn((Obj)a,&z); a = z; ntogfspn((Obj)b,&z); b = z;
! 69: if ( !a )
! 70: *c = b;
! 71: else if ( !b )
! 72: *c = a;
! 73: else {
! 74: d = MAX(DEG(BDY(a)),DEG(BDY(b)));
! 75: t = UMALLOC(d);
! 76: q = W_UMALLOC(d);
! 77: addsfum(BDY(a),BDY(b),t);
! 78: divsfum(t,current_mod_gfspn,q);
! 79: MKGFSPN(t,*c);
! 80: }
! 81: }
! 82:
! 83: void subgfspn(a,b,c)
! 84: GFSPN a,b;
! 85: GFSPN *c;
! 86: {
! 87: UM t,q;
! 88: GFSPN z;
! 89: int d;
! 90:
! 91: ntogfspn((Obj)a,&z); a = z; ntogfspn((Obj)b,&z); b = z;
! 92: if ( !a )
! 93: chsgngfspn(b,c);
! 94: else if ( !b )
! 95: *c = a;
! 96: else {
! 97: d = MAX(DEG(BDY(a)),DEG(BDY(b)));
! 98: t = UMALLOC(d);
! 99: q = W_UMALLOC(d);
! 100: subsfum(BDY(a),BDY(b),t);
! 101: divsfum(t,current_mod_gfspn,q);
! 102: MKGFSPN(t,*c);
! 103: }
! 104: }
! 105:
! 106: extern int up_lazy;
! 107:
! 108: void mulgfspn(a,b,c)
! 109: GFSPN a,b;
! 110: GFSPN *c;
! 111: {
! 112: UM t,q;
! 113: GFSPN z;
! 114: int d;
! 115:
! 116: ntogfspn((Obj)a,&z); a = z; ntogfspn((Obj)b,&z); b = z;
! 117: if ( !a || !b )
! 118: *c = 0;
! 119: else {
! 120: d = DEG(BDY(a))+DEG(BDY(b));
! 121: t = UMALLOC(d);
! 122: q = W_UMALLOC(d);
! 123: mulsfum(BDY(a),BDY(b),t);
! 124: divsfum(t,current_mod_gfspn,q);
! 125: MKGFSPN(t,*c);
! 126: }
! 127: }
! 128:
! 129: void divgfspn(a,b,c)
! 130: GFSPN a,b;
! 131: GFSPN *c;
! 132: {
! 133: GFSPN z;
! 134: int d;
! 135: UM wb,wc,wd,we,t,q;
! 136:
! 137: ntogfspn((Obj)a,&z); a = z; ntogfspn((Obj)b,&z); b = z;
! 138: if ( !b )
! 139: error("divgfspn: division by 0");
! 140: else if ( !a )
! 141: *c = 0;
! 142: else {
! 143: wb = W_UMALLOC(DEG(BDY(b))); cpyum(BDY(b),wb);
! 144: d = DEG(current_mod_gfspn);
! 145: wc = W_UMALLOC(d); cpyum(current_mod_gfspn,wc);
! 146: wd = W_UMALLOC(2*d); we = W_UMALLOC(2*d);
! 147: /* wd*wb+we*wc=1 */
! 148: eucsfum(wb,wc,wd,we);
! 149: d = DEG(BDY(a))+DEG(wd);
! 150: t = UMALLOC(d);
! 151: q = W_UMALLOC(d);
! 152: mulsfum(a,wd,t);
! 153: divsfum(t,current_mod_gfspn,q);
! 154: MKGFSPN(t,*c);
! 155: }
! 156: }
! 157:
! 158: void invgfspn(b,c)
! 159: GFSPN b;
! 160: GFSPN *c;
! 161: {
! 162: GFSPN z;
! 163: int d;
! 164: UM wb,wc,wd,we,t;
! 165:
! 166: ntogfspn((Obj)b,&z); b = z;
! 167: if ( !b )
! 168: error("divgfspn: division by 0");
! 169: else {
! 170: wb = W_UMALLOC(DEG(BDY(b))); cpyum(BDY(b),wb);
! 171: d = DEG(current_mod_gfspn);
! 172: wc = W_UMALLOC(d); cpyum(current_mod_gfspn,wc);
! 173: wd = W_UMALLOC(2*d); we = W_UMALLOC(2*d);
! 174: /* wd*wb+we*wc=1 */
! 175: eucsfum(wb,wc,wd,we);
! 176: d = DEG(wd);
! 177: t = UMALLOC(d);
! 178: cpyum(wd,t);
! 179: MKGFSPN(t,*c);
! 180: }
! 181: }
! 182:
! 183: void chsgngfspn(a,c)
! 184: GFSPN a,*c;
! 185: {
! 186: GFSPN z;
! 187: int d;
! 188: struct oUM zero;
! 189: UM t;
! 190:
! 191: ntogfspn((Obj)a,&z); a = z;
! 192: if ( !a )
! 193: *c = 0;
! 194: else {
! 195: d = DEG(BDY(a));
! 196: t = UMALLOC(d);
! 197: DEG(&zero) = -1;
! 198: subsfum(&zero,BDY(a),t);
! 199: MKGFSPN(t,*c);
! 200: }
! 201: }
! 202:
! 203: void pwrgfspn(a,b,c)
! 204: GFSPN a;
! 205: Q b;
! 206: GFSPN *c;
! 207: {
! 208: GFSPN z;
! 209: UM t,x,y,q;
! 210: int d,k;
! 211: N e;
! 212:
! 213: ntogfspn((Obj)a,&z); a = z;
! 214: if ( !b ) {
! 215: t = UMALLOC(0); DEG(t) = 0; COEF(t)[0] = _onesf();
! 216: MKGFSPN(t,*c);
! 217: } else if ( !a )
! 218: *c = 0;
! 219: else {
! 220: d = DEG(current_mod_gfspn);
! 221:
! 222: /* y = 1 */
! 223: y = UMALLOC(d); DEG(y) = 0; COEF(y)[0] = _onesf();
! 224:
! 225: t = W_UMALLOC(2*d); q = W_UMALLOC(2*d);
! 226:
! 227: /* x = simplify(a) */
! 228: x = W_UMALLOC(DEG(BDY(a))); cpyum(BDY(a),x);
! 229: divsfum(x,current_mod_gfspn,q);
! 230: if ( DEG(x) < 0 ) {
! 231: *c = 0;
! 232: } else {
! 233: e = NM(b);
! 234: for ( k = n_bits(e)-1; k >= 0; k-- ) {
! 235: mulsfum(y,y,t);
! 236: divsfum(t,current_mod_gfspn,q);
! 237: cpyum(t,y);
! 238: if ( e->b[k/32] & (1<<(k%32)) ) {
! 239: mulsfum(y,x,t);
! 240: divsfum(t,current_mod_gfspn,q);
! 241: cpyum(t,y);
! 242: }
! 243: }
! 244: MKGFSPN(y,*c);
! 245: }
! 246: }
! 247: }
! 248:
! 249: int cmpgfspn(a,b)
! 250: GFSPN a,b;
! 251: {
! 252: GFSPN z;
! 253:
! 254: ntogfspn((Obj)a,&z); a = z; ntogfspn((Obj)b,&z); b = z;
! 255: if ( !a )
! 256: if ( !b )
! 257: return 0;
! 258: else
! 259: return -1;
! 260: else if ( !b )
! 261: return 1;
! 262: else
! 263: return compsfum(BDY(a),BDY(b));
! 264: }
! 265:
! 266: void randomgfspn(r)
! 267: GFSPN *r;
! 268: {
! 269: int i,d;
! 270: UM t;
! 271:
! 272: if ( !current_mod_gfspn )
! 273: error("randomgfspn : current_mod_gfspn is not set");
! 274: d = DEG(current_mod_gfspn);
! 275: t = UMALLOC(d-1);
! 276: randsfum(d,t);
! 277: degum(t,d-1);
! 278: if ( DEG(t) < 0 )
! 279: *r = 0;
! 280: else {
! 281: MKGFSPN(t,*r);
! 282: }
! 283: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>