2 * IBM Accurate Mathematical Library
3 * written by International Business Machines Corp.
4 * Copyright (C) 2001, 2009 Free Software Foundation
6 * This program is free software; you can redistribute it and/or modify
7 * it under the terms of the GNU Lesser General Public License as published by
8 * the Free Software Foundation; either version 2.1 of the License, or
9 * (at your option) any later version.
11 * This program is distributed in the hope that it will be useful,
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 * GNU Lesser General Public License for more details.
16 * You should have received a copy of the GNU Lesser General Public License
17 * along with this program; if not, write to the Free Software
18 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
20 /****************************************************************************/
22 /* MODULE_NAME:usncs.c */
39 /* FILES NEEDED: dla.h endian.h mpa.h mydefs.h usncs.h */
40 /* branred.c sincos32.c dosincos.c mpa.c */
43 /* An ultimate sin and routine. Given an IEEE double machine number x */
44 /* it computes the correctly rounded (to nearest) value of sin(x) or cos(x) */
45 /* Assumption: Machine arithmetic operations are performed in */
46 /* round to nearest mode of IEEE 754 standard. */
48 /****************************************************************************/
57 #include "math_private.h"
60 sn3
= -1.66666666666664880952546298448555E-01,
61 sn5
= 8.33333214285722277379541354343671E-03,
62 cs2
= 4.99999999999999999999950396842453E-01,
63 cs4
= -4.16666666666664434524222570944589E-02,
64 cs6
= 1.38888874007937613028114285595617E-03;
66 void __dubsin(double x
, double dx
, double w
[]);
67 void __docos(double x
, double dx
, double w
[]);
68 double __mpsin(double x
, double dx
);
69 double __mpcos(double x
, double dx
);
70 double __mpsin1(double x
);
71 double __mpcos1(double x
);
72 static double slow(double x
);
73 static double slow1(double x
);
74 static double slow2(double x
);
75 static double sloww(double x
, double dx
, double orig
);
76 static double sloww1(double x
, double dx
, double orig
);
77 static double sloww2(double x
, double dx
, double orig
, int n
);
78 static double bsloww(double x
, double dx
, double orig
, int n
);
79 static double bsloww1(double x
, double dx
, double orig
, int n
);
80 static double bsloww2(double x
, double dx
, double orig
, int n
);
81 int __branred(double x
, double *a
, double *aa
);
82 static double cslow2(double x
);
83 static double csloww(double x
, double dx
, double orig
);
84 static double csloww1(double x
, double dx
, double orig
);
85 static double csloww2(double x
, double dx
, double orig
, int n
);
86 /*******************************************************************/
87 /* An ultimate sin routine. Given an IEEE double machine number x */
88 /* it computes the correctly rounded (to nearest) value of sin(x) */
89 /*******************************************************************/
90 double __sin(double x
){
91 double xx
,res
,t
,cor
,y
,s
,c
,sn
,ssn
,cs
,ccs
,xn
,a
,da
,db
,eps
,xn1
,xn2
;
103 k
= 0x7fffffff&m
; /* no sign */
104 if (k
< 0x3e500000) /* if x->0 =>sin(x)=x */
106 /*---------------------------- 2^-26 < |x|< 0.25 ----------------------*/
107 else if (k
< 0x3fd00000){
110 t
= ((((s5
.x
*xx
+ s4
.x
)*xx
+ s3
.x
)*xx
+ s2
.x
)*xx
+ s1
.x
)*(xx
*x
);
113 return (res
== res
+ 1.07*cor
)? res
: slow(x
);
114 } /* else if (k < 0x3fd00000) */
115 /*---------------------------- 0.25<|x|< 0.855469---------------------- */
116 else if (k
< 0x3feb6000) {
117 u
.x
=(m
>0)?big
.x
+x
:big
.x
-x
;
118 y
=(m
>0)?x
-(u
.x
-big
.x
):x
+(u
.x
-big
.x
);
120 s
= y
+ y
*xx
*(sn3
+xx
*sn5
);
121 c
= xx
*(cs2
+xx
*(cs4
+ xx
*cs6
));
123 sn
=(m
>0)?sincos
.x
[k
]:-sincos
.x
[k
];
124 ssn
=(m
>0)?sincos
.x
[k
+1]:-sincos
.x
[k
+1];
127 cor
=(ssn
+s
*ccs
-sn
*c
)+cs
*s
;
130 return (res
==res
+1.025*cor
)? res
: slow1(x
);
131 } /* else if (k < 0x3feb6000) */
133 /*----------------------- 0.855469 <|x|<2.426265 ----------------------*/
134 else if (k
< 0x400368fd ) {
136 y
= (m
>0)? hp0
.x
-x
:hp0
.x
+x
;
139 y
= (y
-(u
.x
-big
.x
))+hp1
.x
;
143 y
= (-hp1
.x
) - (y
+(u
.x
-big
.x
));
146 s
= y
+ y
*xx
*(sn3
+xx
*sn5
);
147 c
= xx
*(cs2
+xx
*(cs4
+ xx
*cs6
));
153 cor
=(ccs
-s
*ssn
-cs
*c
)-sn
*s
;
156 return (res
==res
+1.020*cor
)? ((m
>0)?res
:-res
) : slow2(x
);
157 } /* else if (k < 0x400368fd) */
159 /*-------------------------- 2.426265<|x|< 105414350 ----------------------*/
160 else if (k
< 0x419921FB ) {
161 t
= (x
*hpinv
.x
+ toint
.x
);
164 y
= (x
- xn
*mp1
.x
) - xn
*mp2
.x
;
169 eps
= ABS(x
)*1.2e-30;
171 switch (n
) { /* quarter of unit circle */
175 if (n
) {a
=-a
;da
=-da
;}
178 t
= (((((s5
.x
*xx
+ s4
.x
)*xx
+ s3
.x
)*xx
+ s2
.x
)*xx
+ s1
.x
)*a
- 0.5*da
)*xx
+da
;
181 cor
= (cor
>0)? 1.02*cor
+eps
: 1.02*cor
-eps
;
182 return (res
== res
+ cor
)? res
: sloww(a
,da
,x
);
192 s
= y
+ (db
+y
*xx
*(sn3
+xx
*sn5
));
193 c
= y
*db
+xx
*(cs2
+xx
*(cs4
+ xx
*cs6
));
199 cor
=(ssn
+s
*ccs
-sn
*c
)+cs
*s
;
202 cor
= (cor
>0)? 1.035*cor
+eps
: 1.035*cor
-eps
;
203 return (res
==res
+cor
)? ((m
)?res
:-res
) : sloww1(a
,da
,x
);
219 s
= y
+ y
*xx
*(sn3
+xx
*sn5
);
220 c
= xx
*(cs2
+xx
*(cs4
+ xx
*cs6
));
221 cor
=(ccs
-s
*ssn
-cs
*c
)-sn
*s
;
224 cor
= (cor
>0)? 1.025*cor
+eps
: 1.025*cor
-eps
;
225 return (res
==res
+cor
)? ((n
&2)?-res
:res
) : sloww2(a
,da
,x
,n
);
231 } /* else if (k < 0x419921FB ) */
233 /*---------------------105414350 <|x|< 281474976710656 --------------------*/
234 else if (k
< 0x42F00000 ) {
235 t
= (x
*hpinv
.x
+ toint
.x
);
238 xn1
= (xn
+8.0e22
)-8.0e22
;
240 y
= ((((x
- xn1
*mp1
.x
) - xn1
*mp2
.x
)-xn2
*mp1
.x
)-xn2
*mp2
.x
);
245 da
= (da
- xn2
*pp3
.x
) -xn
*pp4
.x
;
254 if (n
) {a
=-a
;da
=-da
;}
257 t
= (((((s5
.x
*xx
+ s4
.x
)*xx
+ s3
.x
)*xx
+ s2
.x
)*xx
+ s1
.x
)*a
- 0.5*da
)*xx
+da
;
260 cor
= (cor
>0)? 1.02*cor
+eps
: 1.02*cor
-eps
;
261 return (res
== res
+ cor
)? res
: bsloww(a
,da
,x
,n
);
264 if (a
>0) {m
=1;t
=a
;db
=da
;}
265 else {m
=0;t
=-a
;db
=-da
;}
269 s
= y
+ (db
+y
*xx
*(sn3
+xx
*sn5
));
270 c
= y
*db
+xx
*(cs2
+xx
*(cs4
+ xx
*cs6
));
276 cor
=(ssn
+s
*ccs
-sn
*c
)+cs
*s
;
279 cor
= (cor
>0)? 1.035*cor
+eps
: 1.035*cor
-eps
;
280 return (res
==res
+cor
)? ((m
)?res
:-res
) : bsloww1(a
,da
,x
,n
);
296 s
= y
+ y
*xx
*(sn3
+xx
*sn5
);
297 c
= xx
*(cs2
+xx
*(cs4
+ xx
*cs6
));
298 cor
=(ccs
-s
*ssn
-cs
*c
)-sn
*s
;
301 cor
= (cor
>0)? 1.025*cor
+eps
: 1.025*cor
-eps
;
302 return (res
==res
+cor
)? ((n
&2)?-res
:res
) : bsloww2(a
,da
,x
,n
);
308 } /* else if (k < 0x42F00000 ) */
310 /* -----------------281474976710656 <|x| <2^1024----------------------------*/
311 else if (k
< 0x7ff00000) {
313 n
= __branred(x
,&a
,&da
);
316 if (a
*a
< 0.01588) return bsloww(a
,da
,x
,n
);
317 else return bsloww1(a
,da
,x
,n
);
320 if (a
*a
< 0.01588) return bsloww(-a
,-da
,x
,n
);
321 else return bsloww1(-a
,-da
,x
,n
);
326 return bsloww2(a
,da
,x
,n
);
330 } /* else if (k < 0x7ff00000 ) */
332 /*--------------------- |x| > 2^1024 ----------------------------------*/
334 if (k
== 0x7ff00000 && u
.i
[LOW_HALF
] == 0)
338 return 0; /* unreachable */
342 /*******************************************************************/
343 /* An ultimate cos routine. Given an IEEE double machine number x */
344 /* it computes the correctly rounded (to nearest) value of cos(x) */
345 /*******************************************************************/
347 double __cos(double x
)
349 double y
,xx
,res
,t
,cor
,s
,c
,sn
,ssn
,cs
,ccs
,xn
,a
,da
,db
,eps
,xn1
,xn2
;
357 if (k
< 0x3e400000 ) return 1.0; /* |x|<2^-27 => cos(x)=1 */
359 else if (k
< 0x3feb6000 ) {/* 2^-27 < |x| < 0.855469 */
364 s
= y
+ y
*xx
*(sn3
+xx
*sn5
);
365 c
= xx
*(cs2
+xx
*(cs4
+ xx
*cs6
));
371 cor
=(ccs
-s
*ssn
-cs
*c
)-sn
*s
;
374 return (res
==res
+1.020*cor
)? res
: cslow2(x
);
376 } /* else if (k < 0x3feb6000) */
378 else if (k
< 0x400368fd ) {/* 0.855469 <|x|<2.426265 */;
384 t
= (((((s5
.x
*xx
+ s4
.x
)*xx
+ s3
.x
)*xx
+ s2
.x
)*xx
+ s1
.x
)*a
- 0.5*da
)*xx
+da
;
387 cor
= (cor
>0)? 1.02*cor
+1.0e-31 : 1.02*cor
-1.0e-31;
388 return (res
== res
+ cor
)? res
: csloww(a
,da
,x
);
391 if (a
>0) {m
=1;t
=a
;db
=da
;}
392 else {m
=0;t
=-a
;db
=-da
;}
396 s
= y
+ (db
+y
*xx
*(sn3
+xx
*sn5
));
397 c
= y
*db
+xx
*(cs2
+xx
*(cs4
+ xx
*cs6
));
403 cor
=(ssn
+s
*ccs
-sn
*c
)+cs
*s
;
406 cor
= (cor
>0)? 1.035*cor
+1.0e-31 : 1.035*cor
-1.0e-31;
407 return (res
==res
+cor
)? ((m
)?res
:-res
) : csloww1(a
,da
,x
);
410 } /* else if (k < 0x400368fd) */
413 else if (k
< 0x419921FB ) {/* 2.426265<|x|< 105414350 */
414 t
= (x
*hpinv
.x
+ toint
.x
);
417 y
= (x
- xn
*mp1
.x
) - xn
*mp2
.x
;
422 eps
= ABS(x
)*1.2e-30;
428 if (n
== 1) {a
=-a
;da
=-da
;}
430 t
= (((((s5
.x
*xx
+ s4
.x
)*xx
+ s3
.x
)*xx
+ s2
.x
)*xx
+ s1
.x
)*a
- 0.5*da
)*xx
+da
;
433 cor
= (cor
>0)? 1.02*cor
+eps
: 1.02*cor
-eps
;
434 return (res
== res
+ cor
)? res
: csloww(a
,da
,x
);
437 if (a
>0) {m
=1;t
=a
;db
=da
;}
438 else {m
=0;t
=-a
;db
=-da
;}
442 s
= y
+ (db
+y
*xx
*(sn3
+xx
*sn5
));
443 c
= y
*db
+xx
*(cs2
+xx
*(cs4
+ xx
*cs6
));
449 cor
=(ssn
+s
*ccs
-sn
*c
)+cs
*s
;
452 cor
= (cor
>0)? 1.035*cor
+eps
: 1.035*cor
-eps
;
453 return (res
==res
+cor
)? ((m
)?res
:-res
) : csloww1(a
,da
,x
);
459 if (a
<0) {a
=-a
;da
=-da
;}
468 s
= y
+ y
*xx
*(sn3
+xx
*sn5
);
469 c
= xx
*(cs2
+xx
*(cs4
+ xx
*cs6
));
470 cor
=(ccs
-s
*ssn
-cs
*c
)-sn
*s
;
473 cor
= (cor
>0)? 1.025*cor
+eps
: 1.025*cor
-eps
;
474 return (res
==res
+cor
)? ((n
)?-res
:res
) : csloww2(a
,da
,x
,n
);
480 } /* else if (k < 0x419921FB ) */
483 else if (k
< 0x42F00000 ) {
484 t
= (x
*hpinv
.x
+ toint
.x
);
487 xn1
= (xn
+8.0e22
)-8.0e22
;
489 y
= ((((x
- xn1
*mp1
.x
) - xn1
*mp2
.x
)-xn2
*mp1
.x
)-xn2
*mp2
.x
);
494 da
= (da
- xn2
*pp3
.x
) -xn
*pp4
.x
;
503 if (n
==1) {a
=-a
;da
=-da
;}
505 t
= (((((s5
.x
*xx
+ s4
.x
)*xx
+ s3
.x
)*xx
+ s2
.x
)*xx
+ s1
.x
)*a
- 0.5*da
)*xx
+da
;
508 cor
= (cor
>0)? 1.02*cor
+eps
: 1.02*cor
-eps
;
509 return (res
== res
+ cor
)? res
: bsloww(a
,da
,x
,n
);
512 if (a
>0) {m
=1;t
=a
;db
=da
;}
513 else {m
=0;t
=-a
;db
=-da
;}
517 s
= y
+ (db
+y
*xx
*(sn3
+xx
*sn5
));
518 c
= y
*db
+xx
*(cs2
+xx
*(cs4
+ xx
*cs6
));
524 cor
=(ssn
+s
*ccs
-sn
*c
)+cs
*s
;
527 cor
= (cor
>0)? 1.035*cor
+eps
: 1.035*cor
-eps
;
528 return (res
==res
+cor
)? ((m
)?res
:-res
) : bsloww1(a
,da
,x
,n
);
534 if (a
<0) {a
=-a
;da
=-da
;}
543 s
= y
+ y
*xx
*(sn3
+xx
*sn5
);
544 c
= xx
*(cs2
+xx
*(cs4
+ xx
*cs6
));
545 cor
=(ccs
-s
*ssn
-cs
*c
)-sn
*s
;
548 cor
= (cor
>0)? 1.025*cor
+eps
: 1.025*cor
-eps
;
549 return (res
==res
+cor
)? ((n
)?-res
:res
) : bsloww2(a
,da
,x
,n
);
554 } /* else if (k < 0x42F00000 ) */
556 else if (k
< 0x7ff00000) {/* 281474976710656 <|x| <2^1024 */
558 n
= __branred(x
,&a
,&da
);
561 if (a
*a
< 0.01588) return bsloww(-a
,-da
,x
,n
);
562 else return bsloww1(-a
,-da
,x
,n
);
565 if (a
*a
< 0.01588) return bsloww(a
,da
,x
,n
);
566 else return bsloww1(a
,da
,x
,n
);
571 return bsloww2(a
,da
,x
,n
);
575 } /* else if (k < 0x7ff00000 ) */
581 if (k
== 0x7ff00000 && u
.i
[LOW_HALF
] == 0)
583 return x
/ x
; /* |x| > 2^1024 */
589 /************************************************************************/
590 /* Routine compute sin(x) for 2^-26 < |x|< 0.25 by Taylor with more */
591 /* precision and if still doesn't accurate enough by mpsin or dubsin */
592 /************************************************************************/
594 static double slow(double x
) {
595 static const double th2_36
= 206158430208.0; /* 1.5*2**37 */
596 double y
,x1
,x2
,xx
,r
,t
,res
,cor
,w
[2];
597 x1
=(x
+th2_36
)-th2_36
;
602 t
= (((((s5
.x
*xx
+ s4
.x
)*xx
+ s3
.x
)*xx
+ s2
.x
)*xx
+ bb
.x
)*xx
+ 3.0*aa
.x
*x1
*x2
)*x
+aa
.x
*x2
*x2
*x2
;
606 if (res
== res
+ 1.0007*cor
) return res
;
608 __dubsin(ABS(x
),0,w
);
609 if (w
[0] == w
[0]+1.000000001*w
[1]) return (x
>0)?w
[0]:-w
[0];
610 else return (x
>0)?__mpsin(x
,0):-__mpsin(-x
,0);
613 /*******************************************************************************/
614 /* Routine compute sin(x) for 0.25<|x|< 0.855469 by sincos.tbl and Taylor */
615 /* and if result still doesn't accurate enough by mpsin or dubsin */
616 /*******************************************************************************/
618 static double slow1(double x
) {
620 double sn
,ssn
,cs
,ccs
,s
,c
,w
[2],y
,y1
,y2
,c1
,c2
,xx
,cor
,res
;
621 static const double t22
= 6291456.0;
627 s
= y
*xx
*(sn3
+xx
*sn5
);
628 c
= xx
*(cs2
+xx
*(cs4
+ xx
*cs6
));
630 sn
=sincos
.x
[k
]; /* Data */
631 ssn
=sincos
.x
[k
+1]; /* from */
632 cs
=sincos
.x
[k
+2]; /* tables */
633 ccs
=sincos
.x
[k
+3]; /* sincos.tbl */
638 cor
=(ssn
+s
*ccs
+cs
*s
+c2
*y
+c1
*y2
)-sn
*c
;
640 cor
= cor
+((sn
-y
)+c1
*y1
);
643 if (res
== res
+1.0005*cor
) return (x
>0)?res
:-res
;
645 __dubsin(ABS(x
),0,w
);
646 if (w
[0] == w
[0]+1.000000005*w
[1]) return (x
>0)?w
[0]:-w
[0];
647 else return (x
>0)?__mpsin(x
,0):-__mpsin(-x
,0);
650 /**************************************************************************/
651 /* Routine compute sin(x) for 0.855469 <|x|<2.426265 by sincos.tbl */
652 /* and if result still doesn't accurate enough by mpsin or dubsin */
653 /**************************************************************************/
654 static double slow2(double x
) {
656 double sn
,ssn
,cs
,ccs
,s
,c
,w
[2],y
,y1
,y2
,e1
,e2
,xx
,cor
,res
,del
;
657 static const double t22
= 6291456.0;
668 y
= -(y
+(u
.x
-big
.x
));
672 s
= y
*xx
*(sn3
+xx
*sn5
);
673 c
= y
*del
+xx
*(cs2
+xx
*(cs4
+ xx
*cs6
));
683 cor
=(ccs
-cs
*c
-e1
*y2
-e2
*y
)-sn
*s
;
685 cor
= cor
+((cs
-y
)-e1
*y1
);
688 if (res
== res
+1.0005*cor
) return (x
>0)?res
:-res
;
694 if (w
[0] == w
[0]+1.000000005*w
[1]) return (x
>0)?w
[0]:-w
[0];
695 else return (x
>0)?__mpsin(x
,0):-__mpsin(-x
,0);
698 /***************************************************************************/
699 /* Routine compute sin(x+dx) (Double-Length number) where x is small enough*/
700 /* to use Taylor series around zero and (x+dx) */
701 /* in first or third quarter of unit circle.Routine receive also */
702 /* (right argument) the original value of x for computing error of */
703 /* result.And if result not accurate enough routine calls mpsin1 or dubsin */
704 /***************************************************************************/
706 static double sloww(double x
,double dx
, double orig
) {
707 static const double th2_36
= 206158430208.0; /* 1.5*2**37 */
708 double y
,x1
,x2
,xx
,r
,t
,res
,cor
,w
[2],a
,da
,xn
;
709 union {int4 i
[2]; double x
;} v
;
711 x1
=(x
+th2_36
)-th2_36
;
716 t
= (((((s5
.x
*xx
+ s4
.x
)*xx
+ s3
.x
)*xx
+ s2
.x
)*xx
+ bb
.x
)*xx
+ 3.0*aa
.x
*x1
*x2
)*x
+aa
.x
*x2
*x2
*x2
+dx
;
720 cor
= (cor
>0)? 1.0005*cor
+ABS(orig
)*3.1e-30 : 1.0005*cor
-ABS(orig
)*3.1e-30;
721 if (res
== res
+ cor
) return res
;
723 (x
>0)? __dubsin(x
,dx
,w
) : __dubsin(-x
,-dx
,w
);
724 cor
= (w
[1]>0)? 1.000000001*w
[1] + ABS(orig
)*1.1e-30 : 1.000000001*w
[1] - ABS(orig
)*1.1e-30;
725 if (w
[0] == w
[0]+cor
) return (x
>0)?w
[0]:-w
[0];
727 t
= (orig
*hpinv
.x
+ toint
.x
);
730 y
= (orig
- xn
*mp1
.x
) - xn
*mp2
.x
;
738 if (n
&2) {a
=-a
; da
=-da
;}
739 (a
>0)? __dubsin(a
,da
,w
) : __dubsin(-a
,-da
,w
);
740 cor
= (w
[1]>0)? 1.000000001*w
[1] + ABS(orig
)*1.1e-40 : 1.000000001*w
[1] - ABS(orig
)*1.1e-40;
741 if (w
[0] == w
[0]+cor
) return (a
>0)?w
[0]:-w
[0];
742 else return __mpsin1(orig
);
746 /***************************************************************************/
747 /* Routine compute sin(x+dx) (Double-Length number) where x in first or */
748 /* third quarter of unit circle.Routine receive also (right argument) the */
749 /* original value of x for computing error of result.And if result not */
750 /* accurate enough routine calls mpsin1 or dubsin */
751 /***************************************************************************/
753 static double sloww1(double x
, double dx
, double orig
) {
755 double sn
,ssn
,cs
,ccs
,s
,c
,w
[2],y
,y1
,y2
,c1
,c2
,xx
,cor
,res
;
756 static const double t22
= 6291456.0;
763 s
= y
*xx
*(sn3
+xx
*sn5
);
764 c
= xx
*(cs2
+xx
*(cs4
+ xx
*cs6
));
774 cor
=(ssn
+s
*ccs
+cs
*s
+c2
*y
+c1
*y2
-sn
*y
*dx
)-sn
*c
;
776 cor
= cor
+((sn
-y
)+c1
*y1
);
779 cor
= (cor
>0)? 1.0005*cor
+3.1e-30*ABS(orig
) : 1.0005*cor
-3.1e-30*ABS(orig
);
780 if (res
== res
+ cor
) return (x
>0)?res
:-res
;
782 __dubsin(ABS(x
),dx
,w
);
783 cor
= (w
[1]>0)? 1.000000005*w
[1]+1.1e-30*ABS(orig
) : 1.000000005*w
[1]-1.1e-30*ABS(orig
);
784 if (w
[0] == w
[0]+cor
) return (x
>0)?w
[0]:-w
[0];
785 else return __mpsin1(orig
);
788 /***************************************************************************/
789 /* Routine compute sin(x+dx) (Double-Length number) where x in second or */
790 /* fourth quarter of unit circle.Routine receive also the original value */
791 /* and quarter(n= 1or 3)of x for computing error of result.And if result not*/
792 /* accurate enough routine calls mpsin1 or dubsin */
793 /***************************************************************************/
795 static double sloww2(double x
, double dx
, double orig
, int n
) {
797 double sn
,ssn
,cs
,ccs
,s
,c
,w
[2],y
,y1
,y2
,e1
,e2
,xx
,cor
,res
;
798 static const double t22
= 6291456.0;
805 s
= y
*xx
*(sn3
+xx
*sn5
);
806 c
= y
*dx
+xx
*(cs2
+xx
*(cs4
+ xx
*cs6
));
817 cor
=(ccs
-cs
*c
-e1
*y2
-e2
*y
)-sn
*s
;
819 cor
= cor
+((cs
-y
)-e1
*y1
);
822 cor
= (cor
>0)? 1.0005*cor
+3.1e-30*ABS(orig
) : 1.0005*cor
-3.1e-30*ABS(orig
);
823 if (res
== res
+ cor
) return (n
&2)?-res
:res
;
825 __docos(ABS(x
),dx
,w
);
826 cor
= (w
[1]>0)? 1.000000005*w
[1]+1.1e-30*ABS(orig
) : 1.000000005*w
[1]-1.1e-30*ABS(orig
);
827 if (w
[0] == w
[0]+cor
) return (n
&2)?-w
[0]:w
[0];
828 else return __mpsin1(orig
);
831 /***************************************************************************/
832 /* Routine compute sin(x+dx) or cos(x+dx) (Double-Length number) where x */
833 /* is small enough to use Taylor series around zero and (x+dx) */
834 /* in first or third quarter of unit circle.Routine receive also */
835 /* (right argument) the original value of x for computing error of */
836 /* result.And if result not accurate enough routine calls other routines */
837 /***************************************************************************/
839 static double bsloww(double x
,double dx
, double orig
,int n
) {
840 static const double th2_36
= 206158430208.0; /* 1.5*2**37 */
841 double y
,x1
,x2
,xx
,r
,t
,res
,cor
,w
[2];
844 union {int4 i
[2]; double x
;} v
;
846 x1
=(x
+th2_36
)-th2_36
;
851 t
= (((((s5
.x
*xx
+ s4
.x
)*xx
+ s3
.x
)*xx
+ s2
.x
)*xx
+ bb
.x
)*xx
+ 3.0*aa
.x
*x1
*x2
)*x
+aa
.x
*x2
*x2
*x2
+dx
;
855 cor
= (cor
>0)? 1.0005*cor
+1.1e-24 : 1.0005*cor
-1.1e-24;
856 if (res
== res
+ cor
) return res
;
858 (x
>0)? __dubsin(x
,dx
,w
) : __dubsin(-x
,-dx
,w
);
859 cor
= (w
[1]>0)? 1.000000001*w
[1] + 1.1e-24 : 1.000000001*w
[1] - 1.1e-24;
860 if (w
[0] == w
[0]+cor
) return (x
>0)?w
[0]:-w
[0];
861 else return (n
&1)?__mpcos1(orig
):__mpsin1(orig
);
865 /***************************************************************************/
866 /* Routine compute sin(x+dx) or cos(x+dx) (Double-Length number) where x */
867 /* in first or third quarter of unit circle.Routine receive also */
868 /* (right argument) the original value of x for computing error of result.*/
869 /* And if result not accurate enough routine calls other routines */
870 /***************************************************************************/
872 static double bsloww1(double x
, double dx
, double orig
,int n
) {
874 double sn
,ssn
,cs
,ccs
,s
,c
,w
[2],y
,y1
,y2
,c1
,c2
,xx
,cor
,res
;
875 static const double t22
= 6291456.0;
882 s
= y
*xx
*(sn3
+xx
*sn5
);
883 c
= xx
*(cs2
+xx
*(cs4
+ xx
*cs6
));
893 cor
=(ssn
+s
*ccs
+cs
*s
+c2
*y
+c1
*y2
-sn
*y
*dx
)-sn
*c
;
895 cor
= cor
+((sn
-y
)+c1
*y1
);
898 cor
= (cor
>0)? 1.0005*cor
+1.1e-24 : 1.0005*cor
-1.1e-24;
899 if (res
== res
+ cor
) return (x
>0)?res
:-res
;
901 __dubsin(ABS(x
),dx
,w
);
902 cor
= (w
[1]>0)? 1.000000005*w
[1]+1.1e-24: 1.000000005*w
[1]-1.1e-24;
903 if (w
[0] == w
[0]+cor
) return (x
>0)?w
[0]:-w
[0];
904 else return (n
&1)?__mpcos1(orig
):__mpsin1(orig
);
908 /***************************************************************************/
909 /* Routine compute sin(x+dx) or cos(x+dx) (Double-Length number) where x */
910 /* in second or fourth quarter of unit circle.Routine receive also the */
911 /* original value and quarter(n= 1or 3)of x for computing error of result. */
912 /* And if result not accurate enough routine calls other routines */
913 /***************************************************************************/
915 static double bsloww2(double x
, double dx
, double orig
, int n
) {
917 double sn
,ssn
,cs
,ccs
,s
,c
,w
[2],y
,y1
,y2
,e1
,e2
,xx
,cor
,res
;
918 static const double t22
= 6291456.0;
925 s
= y
*xx
*(sn3
+xx
*sn5
);
926 c
= y
*dx
+xx
*(cs2
+xx
*(cs4
+ xx
*cs6
));
937 cor
=(ccs
-cs
*c
-e1
*y2
-e2
*y
)-sn
*s
;
939 cor
= cor
+((cs
-y
)-e1
*y1
);
942 cor
= (cor
>0)? 1.0005*cor
+1.1e-24 : 1.0005*cor
-1.1e-24;
943 if (res
== res
+ cor
) return (n
&2)?-res
:res
;
945 __docos(ABS(x
),dx
,w
);
946 cor
= (w
[1]>0)? 1.000000005*w
[1]+1.1e-24 : 1.000000005*w
[1]-1.1e-24;
947 if (w
[0] == w
[0]+cor
) return (n
&2)?-w
[0]:w
[0];
948 else return (n
&1)?__mpsin1(orig
):__mpcos1(orig
);
952 /************************************************************************/
953 /* Routine compute cos(x) for 2^-27 < |x|< 0.25 by Taylor with more */
954 /* precision and if still doesn't accurate enough by mpcos or docos */
955 /************************************************************************/
957 static double cslow2(double x
) {
959 double sn
,ssn
,cs
,ccs
,s
,c
,w
[2],y
,y1
,y2
,e1
,e2
,xx
,cor
,res
;
960 static const double t22
= 6291456.0;
966 s
= y
*xx
*(sn3
+xx
*sn5
);
967 c
= xx
*(cs2
+xx
*(cs4
+ xx
*cs6
));
977 cor
=(ccs
-cs
*c
-e1
*y2
-e2
*y
)-sn
*s
;
979 cor
= cor
+((cs
-y
)-e1
*y1
);
982 if (res
== res
+1.0005*cor
)
987 if (w
[0] == w
[0]+1.000000005*w
[1]) return w
[0];
988 else return __mpcos(x
,0);
992 /***************************************************************************/
993 /* Routine compute cos(x+dx) (Double-Length number) where x is small enough*/
994 /* to use Taylor series around zero and (x+dx) .Routine receive also */
995 /* (right argument) the original value of x for computing error of */
996 /* result.And if result not accurate enough routine calls other routines */
997 /***************************************************************************/
1000 static double csloww(double x
,double dx
, double orig
) {
1001 static const double th2_36
= 206158430208.0; /* 1.5*2**37 */
1002 double y
,x1
,x2
,xx
,r
,t
,res
,cor
,w
[2],a
,da
,xn
;
1003 union {int4 i
[2]; double x
;} v
;
1005 x1
=(x
+th2_36
)-th2_36
;
1011 t
= (((((s5
.x
*xx
+ s4
.x
)*xx
+ s3
.x
)*xx
+ s2
.x
)*xx
+ bb
.x
)*xx
+ 3.0*aa
.x
*x1
*x2
)*x
+aa
.x
*x2
*x2
*x2
+dx
;
1015 cor
= (cor
>0)? 1.0005*cor
+ABS(orig
)*3.1e-30 : 1.0005*cor
-ABS(orig
)*3.1e-30;
1016 if (res
== res
+ cor
) return res
;
1018 (x
>0)? __dubsin(x
,dx
,w
) : __dubsin(-x
,-dx
,w
);
1019 cor
= (w
[1]>0)? 1.000000001*w
[1] + ABS(orig
)*1.1e-30 : 1.000000001*w
[1] - ABS(orig
)*1.1e-30;
1020 if (w
[0] == w
[0]+cor
) return (x
>0)?w
[0]:-w
[0];
1022 t
= (orig
*hpinv
.x
+ toint
.x
);
1025 y
= (orig
- xn
*mp1
.x
) - xn
*mp2
.x
;
1033 if (n
==1) {a
=-a
; da
=-da
;}
1034 (a
>0)? __dubsin(a
,da
,w
) : __dubsin(-a
,-da
,w
);
1035 cor
= (w
[1]>0)? 1.000000001*w
[1] + ABS(orig
)*1.1e-40 : 1.000000001*w
[1] - ABS(orig
)*1.1e-40;
1036 if (w
[0] == w
[0]+cor
) return (a
>0)?w
[0]:-w
[0];
1037 else return __mpcos1(orig
);
1042 /***************************************************************************/
1043 /* Routine compute sin(x+dx) (Double-Length number) where x in first or */
1044 /* third quarter of unit circle.Routine receive also (right argument) the */
1045 /* original value of x for computing error of result.And if result not */
1046 /* accurate enough routine calls other routines */
1047 /***************************************************************************/
1049 static double csloww1(double x
, double dx
, double orig
) {
1051 double sn
,ssn
,cs
,ccs
,s
,c
,w
[2],y
,y1
,y2
,c1
,c2
,xx
,cor
,res
;
1052 static const double t22
= 6291456.0;
1059 s
= y
*xx
*(sn3
+xx
*sn5
);
1060 c
= xx
*(cs2
+xx
*(cs4
+ xx
*cs6
));
1070 cor
=(ssn
+s
*ccs
+cs
*s
+c2
*y
+c1
*y2
-sn
*y
*dx
)-sn
*c
;
1072 cor
= cor
+((sn
-y
)+c1
*y1
);
1075 cor
= (cor
>0)? 1.0005*cor
+3.1e-30*ABS(orig
) : 1.0005*cor
-3.1e-30*ABS(orig
);
1076 if (res
== res
+ cor
) return (x
>0)?res
:-res
;
1078 __dubsin(ABS(x
),dx
,w
);
1079 cor
= (w
[1]>0)? 1.000000005*w
[1]+1.1e-30*ABS(orig
) : 1.000000005*w
[1]-1.1e-30*ABS(orig
);
1080 if (w
[0] == w
[0]+cor
) return (x
>0)?w
[0]:-w
[0];
1081 else return __mpcos1(orig
);
1086 /***************************************************************************/
1087 /* Routine compute sin(x+dx) (Double-Length number) where x in second or */
1088 /* fourth quarter of unit circle.Routine receive also the original value */
1089 /* and quarter(n= 1or 3)of x for computing error of result.And if result not*/
1090 /* accurate enough routine calls other routines */
1091 /***************************************************************************/
1093 static double csloww2(double x
, double dx
, double orig
, int n
) {
1095 double sn
,ssn
,cs
,ccs
,s
,c
,w
[2],y
,y1
,y2
,e1
,e2
,xx
,cor
,res
;
1096 static const double t22
= 6291456.0;
1103 s
= y
*xx
*(sn3
+xx
*sn5
);
1104 c
= y
*dx
+xx
*(cs2
+xx
*(cs4
+ xx
*cs6
));
1115 cor
=(ccs
-cs
*c
-e1
*y2
-e2
*y
)-sn
*s
;
1117 cor
= cor
+((cs
-y
)-e1
*y1
);
1120 cor
= (cor
>0)? 1.0005*cor
+3.1e-30*ABS(orig
) : 1.0005*cor
-3.1e-30*ABS(orig
);
1121 if (res
== res
+ cor
) return (n
)?-res
:res
;
1123 __docos(ABS(x
),dx
,w
);
1124 cor
= (w
[1]>0)? 1.000000005*w
[1]+1.1e-30*ABS(orig
) : 1.000000005*w
[1]-1.1e-30*ABS(orig
);
1125 if (w
[0] == w
[0]+cor
) return (n
)?-w
[0]:w
[0];
1126 else return __mpcos1(orig
);
1130 weak_alias (__cos
, cos
)
1131 weak_alias (__sin
, sin
)
1133 #ifdef NO_LONG_DOUBLE
1134 strong_alias (__sin
, __sinl
)
1135 weak_alias (__sin
, sinl
)
1136 strong_alias (__cos
, __cosl
)
1137 weak_alias (__cos
, cosl
)