version 1.2, 2000/08/21 08:31:20 |
version 1.12, 2015/08/14 13:51:54 |
|
|
* shall be made on your publication or presentation in any form of the |
* shall be made on your publication or presentation in any form of the |
* results obtained by use of the SOFTWARE. |
* results obtained by use of the SOFTWARE. |
* (4) In the event that you modify the SOFTWARE, you shall notify FLL by |
* (4) In the event that you modify the SOFTWARE, you shall notify FLL by |
* e-mail at risa-admin@flab.fujitsu.co.jp of the detailed specification |
* e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification |
* for such modification or the source code of the modified part of the |
* for such modification or the source code of the modified part of the |
* SOFTWARE. |
* SOFTWARE. |
* |
* |
|
|
* DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, |
* DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, |
* PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. |
* PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. |
* |
* |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/math.c,v 1.1.1.1 1999/12/03 07:39:07 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/math.c,v 1.11 2015/08/06 10:01:52 fujimoto Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
#include <math.h> |
#include <math.h> |
#include "parse.h" |
#include "parse.h" |
|
#if defined(VISUAL) || defined(__MINGW32__) |
|
#include <float.h> |
|
#endif |
|
|
void Pdsqrt(),Pdsin(),Pdcos(),Pdtan(),Pdasin(),Pdacos(),Pdatan(),Pdlog(),Pdexp(); |
void Pdsqrt(),Pdsin(),Pdcos(),Pdtan(),Pdasin(),Pdacos(),Pdatan(),Pdlog(),Pdexp(); |
void Pabs(),Pdfloor(),Pdceil(),Pdrint(); |
void Pabs(),Pdfloor(),Pdceil(),Pdrint(),Pdisnan(); |
|
|
struct ftab math_tab[] = { |
struct ftab math_tab[] = { |
{"dsqrt",Pdsqrt,1}, |
{"dsqrt",Pdsqrt,1}, |
Line 65 struct ftab math_tab[] = { |
|
Line 68 struct ftab math_tab[] = { |
|
{"dasin",Pdasin,1}, |
{"dasin",Pdasin,1}, |
{"dacos",Pdacos,1}, |
{"dacos",Pdacos,1}, |
{"datan",Pdatan,1}, |
{"datan",Pdatan,1}, |
|
{"floor",Pdfloor,1}, |
{"dfloor",Pdfloor,1}, |
{"dfloor",Pdfloor,1}, |
|
{"ceil",Pdceil,1}, |
{"dceil",Pdceil,1}, |
{"dceil",Pdceil,1}, |
|
{"rint",Pdrint,1}, |
{"drint",Pdrint,1}, |
{"drint",Pdrint,1}, |
|
{"disnan",Pdisnan,1}, |
{0,0,0}, |
{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) |
void Pabs(arg,rp) |
NODE arg; |
NODE arg; |
Real *rp; |
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); |
MKReal(s,*rp); |
} |
} |
|
|
void Pdsqrt(arg,rp) |
void Pdsqrt(arg,rp) |
NODE arg; |
NODE arg; |
Real *rp; |
Num *rp; |
{ |
{ |
double s; |
double s,r,i,a; |
|
C z; |
|
Real real; |
|
|
s = sqrt(ToReal(ARG0(arg))); |
if ( !ARG0(arg) ) { |
MKReal(s,*rp); |
*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) |
void Pdsin(arg,rp) |
|
|
d = floor(ToReal(ARG0(arg))); |
d = floor(ToReal(ARG0(arg))); |
if ( d < -9.223372036854775808e18 || d >= 9.223372036854775808e18 ) |
if ( d < -9.223372036854775808e18 || d >= 9.223372036854775808e18 ) |
error("dfloor : OverFlow"); |
error("dfloor : OverFlow"); |
|
if ( !d ) { |
|
*rp = 0; |
|
return; |
|
} |
a = (L)d; |
a = (L)d; |
if ( a < 0 ) { |
if ( a < 0 ) { |
sgn = -1; |
sgn = -1; |
a = -a; |
a = -a; |
} else |
} else |
sgn = 1; |
sgn = 1; |
#if defined(i386) || defined(__alpha) || defined(VISUAL) |
#if defined(i386) || defined(__alpha) || defined(VISUAL) || defined(__MINGW32__) || defined(__x86_64) |
au = ((unsigned int *)&a)[1]; |
au = ((unsigned int *)&a)[1]; |
al = ((unsigned int *)&a)[0]; |
al = ((unsigned int *)&a)[0]; |
#else |
#else |
|
|
d = ceil(ToReal(ARG0(arg))); |
d = ceil(ToReal(ARG0(arg))); |
if ( d < -9.223372036854775808e18 || d >= 9.223372036854775808e18 ) |
if ( d < -9.223372036854775808e18 || d >= 9.223372036854775808e18 ) |
error("dceil : OverFlow"); |
error("dceil : OverFlow"); |
|
if ( !d ) { |
|
*rp = 0; |
|
return; |
|
} |
a = (L)d; |
a = (L)d; |
if ( a < 0 ) { |
if ( a < 0 ) { |
sgn = -1; |
sgn = -1; |
a = -a; |
a = -a; |
} else |
} else |
sgn = 1; |
sgn = 1; |
#if defined(i386) || defined(__alpha) || defined(VISUAL) |
#if defined(i386) || defined(__alpha) || defined(VISUAL) || defined(__MINGW32__) || defined(__x86_64) |
au = ((unsigned int *)&a)[1]; |
au = ((unsigned int *)&a)[1]; |
al = ((unsigned int *)&a)[0]; |
al = ((unsigned int *)&a)[0]; |
#else |
#else |
|
|
*rp = 0; |
*rp = 0; |
return; |
return; |
} |
} |
#if defined(VISUAL) |
#if defined(VISUAL) || defined(__MINGW32__) |
d = ToReal(ARG0(arg)); |
d = ToReal(ARG0(arg)); |
if ( d > 0 ) |
if ( d > 0 ) |
d = floor(d+0.5); |
d = floor(d+0.5); |
|
|
a = -a; |
a = -a; |
} else |
} else |
sgn = 1; |
sgn = 1; |
#if defined(i386) || defined(__alpha) || defined(VISUAL) |
#if defined(i386) || defined(__alpha) || defined(VISUAL) || defined(__MINGW32__) || defined(__x86_64) |
au = ((unsigned int *)&a)[1]; |
au = ((unsigned int *)&a)[1]; |
al = ((unsigned int *)&a)[0]; |
al = ((unsigned int *)&a)[0]; |
#else |
#else |
|
|
if ( au ) { |
if ( au ) { |
NEWQ(q); SGN(q) = sgn; NM(q)=NALLOC(2); DN(q)=0; |
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; |
PL(NM(q))=2; BD(NM(q))[0]=al; BD(NM(q))[1] = au; |
} else { |
} else if ( al ) { |
UTOQ(al,q); SGN(q) = sgn; |
UTOQ(al,q); SGN(q) = sgn; |
} |
} else |
|
q = 0; |
*rp = q; |
*rp = q; |
|
} |
|
|
|
void Pdisnan(NODE arg,Q *rp) |
|
{ |
|
Real r; |
|
double d; |
|
#if defined(VISUAL) || defined(__MINGW32__) |
|
int c; |
|
#endif |
|
|
|
r = (Real)ARG0(arg); |
|
if ( !r || !NUM(r) || !REAL(r) ) { |
|
*rp = 0; |
|
return; |
|
} |
|
d = ToReal(r); |
|
#if defined(VISUAL) || defined(__MINGW32__) |
|
c = _fpclass(d); |
|
if ( c == _FPCLASS_SNAN || c == _FPCLASS_QNAN ) *rp = ONE; |
|
else if ( c == _FPCLASS_PINF || c == _FPCLASS_NINF ) STOQ(2,*rp); |
|
#else |
|
if ( isnan(d) ) *rp = ONE; |
|
else if ( isinf(d) ) STOQ(2,*rp); |
|
#endif |
|
else *rp = 0; |
} |
} |