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