Annotation of OpenXM_contrib2/asir2000/engine/bf.c, Revision 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>