Annotation of OpenXM_contrib2/asir2000/engine/gfpn.c, Revision 1.1.1.1
1.1 noro 1: /* $OpenXM: OpenXM/src/asir99/engine/gfpn.c,v 1.1.1.1 1999/11/10 08:12:26 noro Exp $ */
2: #include "ca.h"
3: #include "base.h"
4:
5: void chsgngfpn(GFPN,GFPN *);
6:
7: UP current_mod_gfpn;
8:
9: void setmod_gfpn(p)
10: P p;
11: {
12: UP t;
13:
14: ptoup(p,&t); uptolmup(t,¤t_mod_gfpn);
15: }
16:
17: void getmod_gfpn(up)
18: UP *up;
19: {
20: *up = current_mod_gfpn;
21: }
22:
23: void ptogfpn(q,l)
24: Obj q;
25: GFPN *l;
26: {
27: UP q1,q2;
28:
29: if ( !q || (OID(q)==O_N && NID(q)==N_GFPN) ) {
30: *l = (GFPN)q;
31: } else if ( (OID(q)==O_N && NID(q)==N_Q) || OID(q)==O_P ) {
32: ptoup((P)q,&q1); uptolmup(q1,&q2);
33: MKGFPN(q2,*l);
34: } else
35: error("ptogfpn : invalid argument");
36: }
37:
38: void gfpntop(q,l)
39: GFPN q;
40: P *l;
41: {
42: if ( !q )
43: *l = 0;
44: else if ( NID(q) == N_GFPN )
45: uptop(q->body,l);
46: else
47: *l = (P)q;
48: }
49:
50: void simpgfpn(n,r)
51: GFPN n;
52: GFPN *r;
53: {
54: UP rem,t;
55:
56: if ( !n )
57: *r = 0;
58: else if ( NID(n) != N_GFPN )
59: *r = n;
60: else {
61: simpup(n->body,&t);
62: remup(t,current_mod_gfpn,&rem);
63: MKGFPN(rem,*r);
64: }
65: }
66:
67: #define NZGFPN(a) ((a)&&(OID(a)==O_N)&&(NID(a)==N_GFPN))
68:
69: void ntogfpn(a,b)
70: Obj a;
71: GFPN *b;
72: {
73: UP t;
74: LM lm;
75:
76: if ( !a || (OID(a)==O_N && NID(a) == N_GFPN) )
77: *b = (GFPN)a;
78: else if ( OID(a) == O_N && (NID(a) == N_LM || NID(a) == N_Q) ) {
79: qtolm((Q)a,&lm);
80: if ( !lm )
81: *b = 0;
82: else {
83: t = UPALLOC(0); t->d = 0; t->c[0] = (Num)lm;
84: MKGFPN(t,*b);
85: }
86: } else
87: error("ntogfpn : invalid argument");
88: }
89:
90: void addgfpn(a,b,c)
91: GFPN a,b;
92: GFPN *c;
93: {
94: UP t,t1,t2;
95: GFPN z;
96:
97: ntogfpn((Obj)a,&z); a = z; ntogfpn((Obj)b,&z); b = z;
98: if ( !a )
99: *c = b;
100: else if ( !b )
101: *c = a;
102: else {
103: addup(a->body,b->body,&t);
104: simpup(t,&t1);
105: remup(t1,current_mod_gfpn,&t2);
106: MKGFPN(t2,*c);
107: }
108: }
109:
110: void subgfpn(a,b,c)
111: GFPN a,b;
112: GFPN *c;
113: {
114: UP t,t1,t2;
115: GFPN z;
116:
117: ntogfpn((Obj)a,&z); a = z; ntogfpn((Obj)b,&z); b = z;
118: if ( !a )
119: chsgngfpn(b,c);
120: else if ( !b )
121: *c = a;
122: else {
123: subup(a->body,b->body,&t);
124: simpup(t,&t1);
125: remup(t1,current_mod_gfpn,&t2);
126: MKGFPN(t2,*c);
127: }
128: }
129:
130: extern int up_lazy;
131:
132: void mulgfpn(a,b,c)
133: GFPN a,b;
134: GFPN *c;
135: {
136: UP t,t1,t2;
137: GFPN z;
138:
139: ntogfpn((Obj)a,&z); a = z; ntogfpn((Obj)b,&z); b = z;
140: if ( !a || !b )
141: *c = 0;
142: else {
143: up_lazy=1;
144: mulup(a->body,b->body,&t);
145: up_lazy=0;
146: simpup(t,&t1);
147: remup(t1,current_mod_gfpn,&t2);
148: MKGFPN(t2,*c);
149: }
150: }
151:
152: void squaregfpn(a,c)
153: GFPN a;
154: GFPN *c;
155: {
156: UP t,t1,t2;
157: GFPN z;
158:
159: ntogfpn((Obj)a,&z); a = z;
160: if ( !a )
161: *c = 0;
162: else {
163: squareup(a->body,&t);
164: simpup(t,&t1);
165: remup(t1,current_mod_gfpn,&t2);
166: MKGFPN(t2,*c);
167: }
168: }
169:
170: void divgfpn(a,b,c)
171: GFPN a,b;
172: GFPN *c;
173: {
174: UP t,t1,i,s;
175: GFPN z;
176:
177: ntogfpn((Obj)a,&z); a = z; ntogfpn((Obj)b,&z); b = z;
178: if ( !b )
179: error("divgfpn: division by 0");
180: else if ( !a )
181: *c = 0;
182: else {
183: extended_gcdup(b->body,current_mod_gfpn,&i);
184: mulup(a->body,i,&t);
185: simpup(t,&t1);
186: remup(t1,current_mod_gfpn,&s);
187: MKGFPN(s,*c);
188: }
189: }
190:
191: void invgfpn(b,c)
192: GFPN b;
193: GFPN *c;
194: {
195: UP i,t;
196: GFPN z;
197:
198: ntogfpn((Obj)b,&z); b = z;
199: if ( !b )
200: error("divgfpn: division by 0");
201: else {
202: simpup(b->body,&t);
203: extended_gcdup(t,current_mod_gfpn,&i);
204: MKGFPN(i,*c);
205: }
206: }
207:
208: void chsgngfpn(a,c)
209: GFPN a,*c;
210: {
211: GFPN z;
212: UP t,t1;
213:
214: ntogfpn((Obj)a,&z); a = z;
215: if ( !a )
216: *c = 0;
217: else {
218: simpup(a->body,&t);
219: chsgnup(t,&t1);
220: MKGFPN(t1,*c);
221: }
222: }
223:
224: void pwrgfpn(a,b,c)
225: GFPN a;
226: Q b;
227: GFPN *c;
228: {
229: UP t,s;
230: GFPN r;
231: Q b0;
232:
233: if ( !b ) {
234: t = UPALLOC(0); t->d = 0; t->c[0] = (Num)ONELM; MKGFPN(t,*c);
235: } else if ( !a )
236: *c = 0;
237: else {
238: DUPQ(b,b0); SGN(b0)=1;
239: simpup(a->body,&s);
240: hybrid_generic_powermodup(s,current_mod_gfpn,b0,&t);
241: MKGFPN(t,r);
242: if ( SGN(b) < 0 )
243: invgfpn(r,c);
244: else
245: *c = r;
246: }
247: }
248:
249: int cmpgfpn(a,b)
250: GFPN a,b;
251: {
252: GFPN z;
253:
254: ntogfpn((Obj)a,&z); a = z; ntogfpn((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 compup(a->body,b->body);
264: }
265:
266: void randomgfpn(r)
267: GFPN *r;
268: {
269: int i,d;
270: LM *tb;
271: UP t;
272:
273: if ( !current_mod_gfpn )
274: error("randomgfpn : current_mod_gfpn is not set");
275: d = current_mod_gfpn->d;
276: t = UPALLOC(d-1);
277: for ( i = 0, tb = (LM *)t->c; i < d; i++ )
278: random_lm(&tb[i]);
279: for ( i = d-1; i >= 0 && !tb[i]; i-- );
280: if ( i < 0 )
281: *r = 0;
282: else {
283: t->d = i; MKGFPN(t,*r);
284: }
285: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>