=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/math.c,v retrieving revision 1.5 retrieving revision 1.8 diff -u -p -r1.5 -r1.8 --- OpenXM_contrib2/asir2000/builtin/math.c 2003/11/08 01:12:02 1.5 +++ OpenXM_contrib2/asir2000/builtin/math.c 2003/12/26 05:47:37 1.8 @@ -45,7 +45,7 @@ * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. * - * $OpenXM: OpenXM_contrib2/asir2000/builtin/math.c,v 1.4 2000/12/07 07:06:41 noro Exp $ + * $OpenXM: OpenXM_contrib2/asir2000/builtin/math.c,v 1.7 2003/12/24 08:00:38 noro Exp $ */ #include "ca.h" #include @@ -74,24 +74,77 @@ struct ftab math_tab[] = { {0,0,0}, }; +void get_ri(Num z,double *r,double *i) +{ + if ( !z ) { + *r = 0; *i = 0; return; + } + if ( OID(z) != O_N ) + error("get_ri : invalid argument"); + switch ( NID(z) ) { + case N_Q: case N_R: case N_B: + *r = ToReal(z); *i = 0; + break; + case N_C: + *r = ToReal(((C)z)->r); + *i = ToReal(((C)z)->i); + break; + default: + error("get_ri : invalid argument"); + break; + } +} + void Pabs(arg,rp) NODE arg; Real *rp; { - double s; + double s,r,i; - s = fabs(ToReal(ARG0(arg))); + if ( !ARG0(arg) ) { + *rp = 0; return; + } + get_ri((Num)ARG0(arg),&r,&i); + if ( i == 0 ) + s = fabs(r); + else if ( r == 0 ) + s = fabs(i); + else + s = sqrt(r*r+i*i); MKReal(s,*rp); } void Pdsqrt(arg,rp) NODE arg; -Real *rp; +Num *rp; { - double s; + double s,r,i,a; + C z; + Real real; - s = sqrt(ToReal(ARG0(arg))); - MKReal(s,*rp); + if ( !ARG0(arg) ) { + *rp = 0; return; + } + get_ri((Num)ARG0(arg),&r,&i); + if ( i == 0 ) + if ( r > 0 ) { + s = sqrt(r); + MKReal(s,real); + *rp = (Num)real; + } else { + NEWC(z); + z->r = 0; + s = sqrt(-r); MKReal(s,real); z->i = (Num)real; + *rp = (Num)z; + } + else { + a = sqrt(r*r+i*i); + NEWC(z); + s = sqrt((r+a)/2); MKReal(s,real); z->r = (Num)real; + s = i>0?sqrt((-r+a)/2):-sqrt((-r+a)/2); + MKReal(s,real); z->i = (Num)real; + *rp = (Num)z; + } } void Pdsin(arg,rp) @@ -201,7 +254,7 @@ Q *rp; a = -a; } else sgn = 1; -#if defined(i386) || defined(__alpha) || defined(VISUAL) +#if defined(i386) || defined(__alpha) || defined(VISUAL) || defined(__x86_64) au = ((unsigned int *)&a)[1]; al = ((unsigned int *)&a)[0]; #else @@ -244,7 +297,7 @@ Q *rp; a = -a; } else sgn = 1; -#if defined(i386) || defined(__alpha) || defined(VISUAL) +#if defined(i386) || defined(__alpha) || defined(VISUAL) || defined(__x86_64) au = ((unsigned int *)&a)[1]; al = ((unsigned int *)&a)[0]; #else @@ -291,7 +344,7 @@ Q *rp; a = -a; } else sgn = 1; -#if defined(i386) || defined(__alpha) || defined(VISUAL) +#if defined(i386) || defined(__alpha) || defined(VISUAL) || defined(__x86_64) au = ((unsigned int *)&a)[1]; al = ((unsigned int *)&a)[0]; #else @@ -301,8 +354,9 @@ Q *rp; if ( au ) { NEWQ(q); SGN(q) = sgn; NM(q)=NALLOC(2); DN(q)=0; PL(NM(q))=2; BD(NM(q))[0]=al; BD(NM(q))[1] = au; - } else { + } else if ( al ) { UTOQ(al,q); SGN(q) = sgn; - } + } else + q = 0; *rp = q; }