=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/engine/bf.c,v retrieving revision 1.8 retrieving revision 1.12 diff -u -p -r1.8 -r1.12 --- OpenXM_contrib2/asir2000/engine/bf.c 2015/08/05 03:46:35 1.8 +++ OpenXM_contrib2/asir2000/engine/bf.c 2015/08/20 08:42:07 1.12 @@ -1,10 +1,12 @@ /* - * $OpenXM: OpenXM_contrib2/asir2000/engine/bf.c,v 1.7 2015/08/04 06:20:45 noro Exp $ + * $OpenXM: OpenXM_contrib2/asir2000/engine/bf.c,v 1.11 2015/08/06 23:41:52 noro Exp $ */ #include "ca.h" #include "base.h" #include +extern int mpfr_roundmode; + Num tobf(Num,int); #define BFPREC(a) (((BF)(a))->body->_mpfr_prec) @@ -14,13 +16,13 @@ void strtobf(char *s,BF *p) BF r; NEWBF(r); mpfr_init(r->body); - mpfr_set_str(r->body,s,10,MPFR_RNDN); + mpfr_set_str(r->body,s,10,mpfr_roundmode); *p = r; } double mpfrtodbl(mpfr_t a) { - return mpfr_get_d(a,MPFR_RNDN); + return mpfr_get_d(a,mpfr_roundmode); } Num tobf(Num a,int prec) @@ -30,6 +32,8 @@ Num tobf(Num a,int prec) mpq_t q; BF d; N nm,dn; + C c; + Num re,im; int sgn; if ( !a ) { @@ -44,7 +48,7 @@ Num tobf(Num a,int prec) break; case N_R: prec ? mpfr_init2(r,prec) : mpfr_init(r); - mpfr_init_set_d(r,((Real)a)->body,MPFR_RNDN); + mpfr_init_set_d(r,((Real)a)->body,mpfr_roundmode); MPFRTOBF(r,d); return (Num)d; break; @@ -54,17 +58,22 @@ Num tobf(Num a,int prec) mpz_init(z); mpz_import(z,PL(nm),-1,sizeof(BD(nm)[0]),0,0,BD(nm)); if ( sgn < 0 ) mpz_neg(z,z); - mpfr_init_set_z(r,z,MPFR_RNDN); + mpfr_init_set_z(r,z,mpfr_roundmode); } else { mpq_init(q); mpz_import(mpq_numref(q),PL(nm),-1,sizeof(BD(nm)[0]),0,0,BD(nm)); mpz_import(mpq_denref(q),PL(dn),-1,sizeof(BD(dn)[0]),0,0,BD(dn)); if ( sgn < 0 ) mpq_neg(q,q); - mpfr_init_set_q(r,q,MPFR_RNDN); + mpfr_init_set_q(r,q,mpfr_roundmode); } MPFRTOBF(r,d); return (Num)d; break; + case N_C: + re = tobf(((C)a)->r,prec); im = tobf(((C)a)->i,prec); + NEWC(c); c->r = re; c->i = im; + return (Num)c; + break; default: error("tobf : invalid argument"); break; @@ -85,51 +94,52 @@ void addbf(Num a,Num b,Num *c) *c = a; else if ( (NID(a) <= N_A) && (NID(b) <= N_A ) ) (*addnumt[MIN(NID(a),NID(b))])(a,b,c); - else { - if ( NID(a) == N_B ) { - switch ( NID(b) ) { - case N_Q: - mpfr_init2(r,BFPREC(a)); - if ( INT((Q)b) ) { - z = ztogz((Q)b); - mpfr_add_z(r,((BF)a)->body,z->body,MPFR_RNDN); - } else { - q = qtogq((Q)b); - mpfr_add_q(r,((BF)a)->body,q->body,MPFR_RNDN); - } - break; - case N_R: - /* double precision = 53 */ - mpfr_init2(r,MIN(BFPREC(a),53)); - mpfr_add_d(r,((BF)a)->body,((Real)b)->body,MPFR_RNDN); - break; - case N_B: - mpfr_init2(r,MIN(BFPREC(a),BFPREC(b))); - mpfr_add(r,((BF)a)->body,((BF)b)->body,MPFR_RNDN); - break; + else if ( NID(a) == N_B ) { + switch ( NID(b) ) { + case N_Q: + mpfr_init2(r,BFPREC(a)); + if ( INT((Q)b) ) { + z = ztogz((Q)b); + mpfr_add_z(r,((BF)a)->body,z->body,mpfr_roundmode); + } else { + q = qtogq((Q)b); + mpfr_add_q(r,((BF)a)->body,q->body,mpfr_roundmode); } - } else { /* NID(b)==N_B */ - switch ( NID(a) ) { - case N_Q: - mpfr_init2(r,BFPREC(b)); - if ( INT((Q)a) ) { - z = ztogz((Q)a); - mpfr_add_z(r,((BF)b)->body,z->body,MPFR_RNDN); - } else { - q = qtogq((Q)a); - mpfr_add_q(r,((BF)b)->body,q->body,MPFR_RNDN); - } - break; - case N_R: - /* double precision = 53 */ - mpfr_init2(r,MIN(BFPREC(b),53)); - mpfr_add_d(r,((BF)b)->body,((Real)a)->body,MPFR_RNDN); - break; + break; + case N_R: + /* double precision = 53 */ + mpfr_init2(r,MAX(BFPREC(a),53)); + mpfr_add_d(r,((BF)a)->body,((Real)b)->body,mpfr_roundmode); + break; + case N_B: + mpfr_init2(r,MAX(BFPREC(a),BFPREC(b))); + mpfr_add(r,((BF)a)->body,((BF)b)->body,mpfr_roundmode); + break; + } + MPFRTOBF(r,d); + *c = (Num)d; + } else { /* NID(b)==N_B */ + switch ( NID(a) ) { + case N_Q: + mpfr_init2(r,BFPREC(b)); + if ( INT((Q)a) ) { + z = ztogz((Q)a); + mpfr_add_z(r,((BF)b)->body,z->body,mpfr_roundmode); + } else { + q = qtogq((Q)a); + mpfr_add_q(r,((BF)b)->body,q->body,mpfr_roundmode); } + break; + case N_R: + /* double precision = 53 */ + mpfr_init2(r,MAX(BFPREC(b),53)); + mpfr_add_d(r,((BF)b)->body,((Real)a)->body,mpfr_roundmode); + break; } MPFRTOBF(r,d); *c = (Num)d; } + if ( !cmpbf(*c,0) ) *c = 0; } void subbf(Num a,Num b,Num *c) @@ -145,53 +155,53 @@ void subbf(Num a,Num b,Num *c) *c = a; else if ( (NID(a) <= N_A) && (NID(b) <= N_A ) ) (*subnumt[MIN(NID(a),NID(b))])(a,b,c); - else { - if ( NID(a) == N_B ) { - switch ( NID(b) ) { - case N_Q: - mpfr_init2(r,BFPREC(a)); - if ( INT((Q)b) ) { - z = ztogz((Q)b); - mpfr_sub_z(r,((BF)a)->body,z->body,MPFR_RNDN); - } else { - q = qtogq((Q)b); - mpfr_sub_q(r,((BF)a)->body,q->body,MPFR_RNDN); - } - break; - case N_R: - /* double precision = 53 */ - mpfr_init2(r,MIN(BFPREC(a),53)); - mpfr_sub_d(r,((BF)a)->body,((Real)b)->body,MPFR_RNDN); - break; - case N_B: - mpfr_init2(r,MIN(BFPREC(a),BFPREC(b))); - mpfr_sub(r,((BF)a)->body,((BF)b)->body,MPFR_RNDN); - break; + else if ( NID(a) == N_B ) { + switch ( NID(b) ) { + case N_Q: + mpfr_init2(r,BFPREC(a)); + if ( INT((Q)b) ) { + z = ztogz((Q)b); + mpfr_sub_z(r,((BF)a)->body,z->body,mpfr_roundmode); + } else { + q = qtogq((Q)b); + mpfr_sub_q(r,((BF)a)->body,q->body,mpfr_roundmode); } - } else { /* NID(b)==N_B */ - switch ( NID(a) ) { - case N_Q: - mpfr_init2(s,BFPREC(b)); - mpfr_init2(r,BFPREC(b)); - if ( INT((Q)a) ) { - z = ztogz((Q)a); - mpfr_sub_z(s,((BF)b)->body,z->body,MPFR_RNDN); - } else { - q = qtogq((Q)a); - mpfr_sub_q(s,((BF)b)->body,q->body,MPFR_RNDN); - } - mpfr_neg(r,s,MPFR_RNDN); - break; - case N_R: - /* double precision = 53 */ - mpfr_init2(r,MIN(BFPREC(b),53)); - mpfr_d_sub(r,((Real)a)->body,((BF)b)->body,MPFR_RNDN); - break; + break; + case N_R: + /* double precision = 53 */ + mpfr_init2(r,MAX(BFPREC(a),53)); + mpfr_sub_d(r,((BF)a)->body,((Real)b)->body,mpfr_roundmode); + break; + case N_B: + mpfr_init2(r,MAX(BFPREC(a),BFPREC(b))); + mpfr_sub(r,((BF)a)->body,((BF)b)->body,mpfr_roundmode); + break; + } + MPFRTOBF(r,d); + *c = (Num)d; + } else { /* NID(b)==N_B */ + switch ( NID(a) ) { + case N_Q: + mpfr_init2(r,BFPREC(b)); + if ( INT((Q)a) ) { + z = ztogz((Q)a); + mpfr_sub_z(r,((BF)b)->body,z->body,mpfr_roundmode); + } else { + q = qtogq((Q)a); + mpfr_sub_q(r,((BF)b)->body,q->body,mpfr_roundmode); } + mpfr_neg(r,r,mpfr_roundmode); + break; + case N_R: + /* double precision = 53 */ + mpfr_init2(r,MAX(BFPREC(b),53)); + mpfr_d_sub(r,((Real)a)->body,((BF)b)->body,mpfr_roundmode); + break; } MPFRTOBF(r,d); *c = (Num)d; } + if ( !cmpbf(*c,0) ) *c = 0; } void mulbf(Num a,Num b,Num *c) @@ -206,51 +216,52 @@ void mulbf(Num a,Num b,Num *c) *c = 0; else if ( (NID(a) <= N_A) && (NID(b) <= N_A ) ) (*mulnumt[MIN(NID(a),NID(b))])(a,b,c); - else { - if ( NID(a) == N_B ) { - switch ( NID(b) ) { - case N_Q: - mpfr_init2(r,BFPREC(a)); - if ( INT((Q)b) ) { - z = ztogz((Q)b); - mpfr_mul_z(r,((BF)a)->body,z->body,MPFR_RNDN); - } else { - q = qtogq((Q)b); - mpfr_mul_q(r,((BF)a)->body,q->body,MPFR_RNDN); - } - break; - case N_R: - /* double precision = 53 */ - mpfr_init2(r,MIN(BFPREC(a),53)); - mpfr_mul_d(r,((BF)a)->body,((Real)b)->body,MPFR_RNDN); - break; - case N_B: - mpfr_init2(r,MIN(BFPREC(a),BFPREC(b))); - mpfr_mul(r,((BF)a)->body,((BF)b)->body,MPFR_RNDN); - break; + else if ( NID(a) == N_B ) { + switch ( NID(b) ) { + case N_Q: + mpfr_init2(r,BFPREC(a)); + if ( INT((Q)b) ) { + z = ztogz((Q)b); + mpfr_mul_z(r,((BF)a)->body,z->body,mpfr_roundmode); + } else { + q = qtogq((Q)b); + mpfr_mul_q(r,((BF)a)->body,q->body,mpfr_roundmode); } - } else { /* NID(b)==N_B */ - switch ( NID(a) ) { - case N_Q: - mpfr_init2(r,BFPREC(b)); - if ( INT((Q)a) ) { - z = ztogz((Q)a); - mpfr_mul_z(r,((BF)b)->body,z->body,MPFR_RNDN); - } else { - q = qtogq((Q)a); - mpfr_mul_q(r,((BF)b)->body,q->body,MPFR_RNDN); - } - break; - case N_R: - /* double precision = 53 */ - mpfr_init2(r,MIN(BFPREC(b),53)); - mpfr_mul_d(r,((BF)b)->body,((Real)a)->body,MPFR_RNDN); - break; + break; + case N_R: + /* double precision = 53 */ + mpfr_init2(r,MAX(BFPREC(a),53)); + mpfr_mul_d(r,((BF)a)->body,((Real)b)->body,mpfr_roundmode); + break; + case N_B: + mpfr_init2(r,MAX(BFPREC(a),BFPREC(b))); + mpfr_mul(r,((BF)a)->body,((BF)b)->body,mpfr_roundmode); + break; + } + MPFRTOBF(r,d); + *c = (Num)d; + } else { /* NID(b)==N_B */ + switch ( NID(a) ) { + case N_Q: + mpfr_init2(r,BFPREC(b)); + if ( INT((Q)a) ) { + z = ztogz((Q)a); + mpfr_mul_z(r,((BF)b)->body,z->body,mpfr_roundmode); + } else { + q = qtogq((Q)a); + mpfr_mul_q(r,((BF)b)->body,q->body,mpfr_roundmode); } + break; + case N_R: + /* double precision = 53 */ + mpfr_init2(r,MAX(BFPREC(b),53)); + mpfr_mul_d(r,((BF)b)->body,((Real)a)->body,mpfr_roundmode); + break; } MPFRTOBF(r,d); *c = (Num)d; } + if ( !cmpbf(*c,0) ) *c = 0; } void divbf(Num a,Num b,Num *c) @@ -266,47 +277,48 @@ void divbf(Num a,Num b,Num *c) *c = 0; else if ( (NID(a) <= N_A) && (NID(b) <= N_A ) ) (*divnumt[MIN(NID(a),NID(b))])(a,b,c); - else { - if ( NID(a) == N_B ) { - switch ( NID(b) ) { - case N_Q: - mpfr_init2(r,BFPREC(a)); - if ( INT((Q)b) ) { - z = ztogz((Q)b); - mpfr_div_z(r,((BF)a)->body,z->body,MPFR_RNDN); - } else { - q = qtogq((Q)b); - mpfr_div_q(r,((BF)a)->body,q->body,MPFR_RNDN); - } - break; - case N_R: - /* double precision = 53 */ - mpfr_init2(r,MIN(BFPREC(a),53)); - mpfr_div_d(r,((BF)a)->body,((Real)b)->body,MPFR_RNDN); - break; - case N_B: - mpfr_init2(r,MIN(BFPREC(a),BFPREC(b))); - mpfr_div(r,((BF)a)->body,((BF)b)->body,MPFR_RNDN); - break; + else if ( NID(a) == N_B ) { + switch ( NID(b) ) { + case N_Q: + mpfr_init2(r,BFPREC(a)); + if ( INT((Q)b) ) { + z = ztogz((Q)b); + mpfr_div_z(r,((BF)a)->body,z->body,mpfr_roundmode); + } else { + q = qtogq((Q)b); + mpfr_div_q(r,((BF)a)->body,q->body,mpfr_roundmode); } - } else { /* NID(b)==N_B */ - switch ( NID(a) ) { - case N_Q: - /* XXX : mpfr_z_div and mpfr_q_div are not implemented */ - a = tobf(a,BFPREC(b)); - mpfr_init2(r,BFPREC(b)); - mpfr_div(r,((BF)a)->body,((BF)b)->body,MPFR_RNDN); - break; - case N_R: - /* double precision = 53 */ - mpfr_init2(r,MIN(BFPREC(b),53)); - mpfr_d_div(r,((Real)a)->body,((BF)b)->body,MPFR_RNDN); - break; - } + break; + case N_R: + /* double precision = 53 */ + mpfr_init2(r,MAX(BFPREC(a),53)); + mpfr_div_d(r,((BF)a)->body,((Real)b)->body,mpfr_roundmode); + break; + case N_B: + mpfr_init2(r,MAX(BFPREC(a),BFPREC(b))); + mpfr_div(r,((BF)a)->body,((BF)b)->body,mpfr_roundmode); + break; } MPFRTOBF(r,d); *c = (Num)d; + } else { /* NID(b)==N_B */ + switch ( NID(a) ) { + case N_Q: + /* XXX : mpfr_z_div and mpfr_q_div are not implemented */ + a = tobf(a,BFPREC(b)); + mpfr_init2(r,BFPREC(b)); + mpfr_div(r,((BF)a)->body,((BF)b)->body,mpfr_roundmode); + break; + case N_R: + /* double precision = 53 */ + mpfr_init2(r,MAX(BFPREC(b),53)); + mpfr_d_div(r,((Real)a)->body,((BF)b)->body,mpfr_roundmode); + break; + } + MPFRTOBF(r,d); + *c = (Num)d; } + if ( !cmpbf(*c,0) ) *c = 0; } void pwrbf(Num a,Num b,Num *c) @@ -322,50 +334,51 @@ void pwrbf(Num a,Num b,Num *c) *c = 0; else if ( (NID(a) <= N_A) && (NID(b) <= N_A ) ) (*pwrnumt[MIN(NID(a),NID(b))])(a,b,c); - else { - if ( NID(a) == N_B ) { - switch ( NID(b) ) { - case N_Q: - mpfr_init2(r,BFPREC(a)); - if ( INT((Q)b) ) { - z = ztogz((Q)b); - mpfr_pow_z(r,((BF)a)->body,z->body,MPFR_RNDN); - } else { - b = tobf(b,BFPREC(a)); - mpfr_pow(r,((BF)a)->body,((BF)b)->body,MPFR_RNDN); - } - break; - case N_R: - /* double precision = 53 */ - prec = MIN(BFPREC(a),53); - mpfr_init2(r,prec); - b = tobf(b,prec); - mpfr_pow(r,((BF)a)->body,((BF)b)->body,MPFR_RNDN); - break; - case N_B: - mpfr_init2(r,MIN(BFPREC(a),BFPREC(b))); - mpfr_pow(r,((BF)a)->body,((BF)b)->body,MPFR_RNDN); - break; + else if ( NID(a) == N_B ) { + switch ( NID(b) ) { + case N_Q: + mpfr_init2(r,BFPREC(a)); + if ( INT((Q)b) ) { + z = ztogz((Q)b); + mpfr_pow_z(r,((BF)a)->body,z->body,mpfr_roundmode); + } else { + b = tobf(b,BFPREC(a)); + mpfr_pow(r,((BF)a)->body,((BF)b)->body,mpfr_roundmode); } - } else { /* NID(b)==N_B */ - switch ( NID(a) ) { - case N_Q: - mpfr_init2(r,BFPREC(b)); - a = tobf(a,BFPREC(b)); - mpfr_pow(r,((BF)a)->body,((BF)b)->body,MPFR_RNDN); - break; - case N_R: - /* double precision = 53 */ - prec = MIN(BFPREC(a),53); - mpfr_init2(r,prec); - a = tobf(a,prec); - mpfr_pow(r,((BF)a)->body,((BF)b)->body,MPFR_RNDN); - break; - } + break; + case N_R: + /* double precision = 53 */ + prec = MAX(BFPREC(a),53); + mpfr_init2(r,prec); + b = tobf(b,prec); + mpfr_pow(r,((BF)a)->body,((BF)b)->body,mpfr_roundmode); + break; + case N_B: + mpfr_init2(r,MAX(BFPREC(a),BFPREC(b))); + mpfr_pow(r,((BF)a)->body,((BF)b)->body,mpfr_roundmode); + break; } MPFRTOBF(r,d); *c = (Num)d; + } else { /* NID(b)==N_B */ + switch ( NID(a) ) { + case N_Q: + mpfr_init2(r,BFPREC(b)); + a = tobf(a,BFPREC(b)); + mpfr_pow(r,((BF)a)->body,((BF)b)->body,mpfr_roundmode); + break; + case N_R: + /* double precision = 53 */ + prec = MAX(BFPREC(a),53); + mpfr_init2(r,prec); + a = tobf(a,prec); + mpfr_pow(r,((BF)a)->body,((BF)b)->body,mpfr_roundmode); + break; + } + MPFRTOBF(r,d); + *c = (Num)d; } + if ( !cmpbf(*c,0) ) *c = 0; } void chsgnbf(Num a,Num *c) @@ -379,7 +392,7 @@ void chsgnbf(Num a,Num *c) (*chsgnnumt[NID(a)])(a,c); else { mpfr_init2(r,BFPREC(a)); - mpfr_neg(r,((BF)a)->body,MPFR_RNDN); + mpfr_neg(r,((BF)a)->body,mpfr_roundmode); MPFRTOBF(r,d); *c = (Num)d; } @@ -387,8 +400,13 @@ void chsgnbf(Num a,Num *c) int cmpbf(Num a,Num b) { + int ret; + GZ z; + GQ q; + if ( !a ) { - if ( !b || (NID(b)<=N_A) ) + if ( !b ) return 0; + else if ((NID(b)<=N_A) ) return (*cmpnumt[NID(b)])(a,b); else return -mpfr_sgn(((BF)a)->body); @@ -397,9 +415,42 @@ int cmpbf(Num a,Num b) return (*cmpnumt[NID(a)])(a,b); else return mpfr_sgn(((BF)a)->body); - } else { - if ( NID(a) != N_B ) a = tobf(a,0); - if ( NID(b) != N_B ) b = tobf(b,0); - return mpfr_cmp(((BF)a)->body,((BF)b)->body); + } else if ( NID(a) == N_B ) { + switch ( NID(b) ) { + case N_Q: + if ( INT((Q)b) ) { + z = ztogz((Q)b); + ret = mpfr_cmp_z(((BF)a)->body,z->body); + } else { + q = qtogq((Q)b); + ret = mpfr_cmp_q(((BF)a)->body,q->body); + } + break; + case N_R: + /* double precision = 53 */ + ret = mpfr_cmp_d(((BF)a)->body,((Real)b)->body); + break; + case N_B: + ret = mpfr_cmp(((BF)a)->body,((BF)b)->body); + break; + } + return ret; + } else { /* NID(b)==N_B */ + switch ( NID(a) ) { + case N_Q: + if ( INT((Q)a) ) { + z = ztogz((Q)a); + ret = mpfr_cmp_z(((BF)b)->body,z->body); + } else { + q = qtogq((Q)a); + ret = mpfr_cmp_q(((BF)b)->body,q->body); + } + break; + case N_R: + /* double precision = 53 */ + ret = mpfr_cmp_d(((BF)b)->body,((Real)a)->body); + break; + } + return -ret; } }