Annotation of OpenXM_contrib2/asir2000/engine/bf.c, Revision 1.1.1.1
1.1 noro 1: /* $OpenXM: OpenXM/src/asir99/engine/bf.c,v 1.1.1.1 1999/11/10 08:12:26 noro Exp $ */
2: #include "ca.h"
3: #if PARI
4: #include "base.h"
5: #include <math.h>
6: #include "genpari.h"
7:
8: extern long prec;
9:
10: void ritopa(Obj,GEN *);
11: void patori(GEN,Obj *);
12:
13: void addbf(a,b,c)
14: Num a,b;
15: Num *c;
16: {
17: GEN pa,pb,z;
18: long ltop,lbot;
19:
20: if ( !a )
21: *c = b;
22: else if ( !b )
23: *c = a;
24: else if ( (NID(a) <= N_A) && (NID(b) <= N_A ) )
25: (*addnumt[MIN(NID(a),NID(b))])(a,b,c);
26: else {
27: ltop = avma; ritopa((Obj)a,&pa);
28: ritopa((Obj)b,&pb); lbot = avma;
29: z = gerepile(ltop,lbot,gadd(pa,pb));
30: patori(z,(Obj *)c); cgiv(z);
31: }
32: }
33:
34: void subbf(a,b,c)
35: Num a,b;
36: Num *c;
37: {
38: GEN pa,pb,z;
39: long ltop,lbot;
40:
41: if ( !a )
42: (*chsgnnumt[NID(b)])(b,c);
43: else if ( !b )
44: *c = a;
45: else if ( (NID(a) <= N_A) && (NID(b) <= N_A ) )
46: (*subnumt[MIN(NID(a),NID(b))])(a,b,c);
47: else {
48: ltop = avma; ritopa((Obj)a,&pa); ritopa((Obj)b,&pb); lbot = avma;
49: z = gerepile(ltop,lbot,gsub(pa,pb));
50: patori(z,(Obj *)c); cgiv(z);
51: }
52: }
53:
54: void mulbf(a,b,c)
55: Num a,b;
56: Num *c;
57: {
58: GEN pa,pb,z;
59: long ltop,lbot;
60:
61: if ( !a || !b )
62: *c = 0;
63: else if ( (NID(a) <= N_A) && (NID(b) <= N_A ) )
64: (*mulnumt[MIN(NID(a),NID(b))])(a,b,c);
65: else {
66: ltop = avma; ritopa((Obj)a,&pa); ritopa((Obj)b,&pb); lbot = avma;
67: z = gerepile(ltop,lbot,gmul(pa,pb));
68: patori(z,(Obj *)c); cgiv(z);
69: }
70: }
71:
72: void divbf(a,b,c)
73: Num a,b;
74: Num *c;
75: {
76: GEN pa,pb,z;
77: long ltop,lbot;
78:
79: if ( !b )
80: error("divbf : division by 0");
81: else if ( !a )
82: *c = 0;
83: else if ( (NID(a) <= N_A) && (NID(b) <= N_A ) )
84: (*divnumt[MIN(NID(a),NID(b))])(a,b,c);
85: else {
86: ltop = avma; ritopa((Obj)a,&pa); ritopa((Obj)b,&pb); lbot = avma;
87: z = gerepile(ltop,lbot,gdiv(pa,pb));
88: patori(z,(Obj *)c); cgiv(z);
89: }
90: }
91:
92: void pwrbf(a,e,c)
93: Num a,e;
94: Num *c;
95: {
96: GEN pa,pe,z;
97: long ltop,lbot;
98:
99: if ( !e )
100: *c = (Num)ONE;
101: else if ( !a )
102: *c = 0;
103: else {
104: ltop = avma; ritopa((Obj)a,&pa); ritopa((Obj)e,&pe); lbot = avma;
105: z = gerepile(ltop,lbot,gpui(pa,pe,prec));
106: patori(z,(Obj *)c); cgiv(z);
107: }
108: }
109:
110: void chsgnbf(a,c)
111: Num a,*c;
112: {
113: BF t;
114: GEN z;
115: int s;
116:
117: if ( !a )
118: *c = 0;
119: else if ( NID(a) <= N_A )
120: (*chsgnnumt[NID(a)])(a,c);
121: else {
122: z = (GEN)((BF)a)->body; s = lg(z); NEWBF(t,s);
123: bcopy((char *)a,(char *)t,sizeof(struct oBF)+((s-1)*sizeof(long)));
124: z = (GEN)((BF)t)->body; setsigne(z,-signe(z));
125: *c = (Num)t;
126: }
127: }
128:
129: int cmpbf(a,b)
130: Num a,b;
131: {
132: GEN pa,pb;
133: int s;
134:
135: if ( !a ) {
136: if ( !b || (NID(b)<=N_A) )
137: return (*cmpnumt[NID(b)])(a,b);
138: else
139: return -signe(((BF)b)->body);
140: } else if ( !b ) {
141: if ( !a || (NID(a)<=N_A) )
142: return (*cmpnumt[NID(a)])(a,b);
143: else
144: return signe(((BF)a)->body);
145: } else {
146: ritopa((Obj)a,&pa); ritopa((Obj)b,&pb);
147: s = gcmp(pa,pb); cgiv(pb); cgiv(pa);
148: return s;
149: }
150: }
151: #endif /* PARI */
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>