Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
cmucl
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Package registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Carl Shapiro
cmucl
Commits
58589c23
Commit
58589c23
authored
18 years ago
by
rtoy
Browse files
Options
Downloads
Patches
Plain Diff
Initial import.
parent
dab61253
No related branches found
Branches containing commit
No related tags found
Tags containing commit
No related merge requests found
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
lisp/e_rem_pio2.c
+175
-0
175 additions, 0 deletions
lisp/e_rem_pio2.c
lisp/fdlibm.h
+216
-0
216 additions, 0 deletions
lisp/fdlibm.h
lisp/k_rem_pio2.c
+316
-0
316 additions, 0 deletions
lisp/k_rem_pio2.c
with
707 additions
and
0 deletions
lisp/e_rem_pio2.c
0 → 100644
+
175
−
0
View file @
58589c23
/* @(#)e_rem_pio2.c 1.4 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*
*/
/* __ieee754_rem_pio2(x,y)
*
* return the remainder of x rem pi/2 in y[0]+y[1]
* use __kernel_rem_pio2()
*/
#include
"fdlibm.h"
/*
* Table of constants for 2/pi, 396 Hex digits (476 decimal) of 2/pi
*/
#ifdef __STDC__
static
const
int
two_over_pi
[]
=
{
#else
static
int
two_over_pi
[]
=
{
#endif
0xA2F983
,
0x6E4E44
,
0x1529FC
,
0x2757D1
,
0xF534DD
,
0xC0DB62
,
0x95993C
,
0x439041
,
0xFE5163
,
0xABDEBB
,
0xC561B7
,
0x246E3A
,
0x424DD2
,
0xE00649
,
0x2EEA09
,
0xD1921C
,
0xFE1DEB
,
0x1CB129
,
0xA73EE8
,
0x8235F5
,
0x2EBB44
,
0x84E99C
,
0x7026B4
,
0x5F7E41
,
0x3991D6
,
0x398353
,
0x39F49C
,
0x845F8B
,
0xBDF928
,
0x3B1FF8
,
0x97FFDE
,
0x05980F
,
0xEF2F11
,
0x8B5A0A
,
0x6D1F6D
,
0x367ECF
,
0x27CB09
,
0xB74F46
,
0x3F669E
,
0x5FEA2D
,
0x7527BA
,
0xC7EBE5
,
0xF17B3D
,
0x0739F7
,
0x8A5292
,
0xEA6BFB
,
0x5FB11F
,
0x8D5D08
,
0x560330
,
0x46FC7B
,
0x6BABF0
,
0xCFBC20
,
0x9AF436
,
0x1DA9E3
,
0x91615E
,
0xE61B08
,
0x659985
,
0x5F14A0
,
0x68408D
,
0xFFD880
,
0x4D7327
,
0x310606
,
0x1556CA
,
0x73A8C9
,
0x60E27B
,
0xC08C6B
,
};
#ifdef __STDC__
static
const
int
npio2_hw
[]
=
{
#else
static
int
npio2_hw
[]
=
{
#endif
0x3FF921FB
,
0x400921FB
,
0x4012D97C
,
0x401921FB
,
0x401F6A7A
,
0x4022D97C
,
0x4025FDBB
,
0x402921FB
,
0x402C463A
,
0x402F6A7A
,
0x4031475C
,
0x4032D97C
,
0x40346B9C
,
0x4035FDBB
,
0x40378FDB
,
0x403921FB
,
0x403AB41B
,
0x403C463A
,
0x403DD85A
,
0x403F6A7A
,
0x40407E4C
,
0x4041475C
,
0x4042106C
,
0x4042D97C
,
0x4043A28C
,
0x40446B9C
,
0x404534AC
,
0x4045FDBB
,
0x4046C6CB
,
0x40478FDB
,
0x404858EB
,
0x404921FB
,
};
/*
* invpio2: 53 bits of 2/pi
* pio2_1: first 33 bit of pi/2
* pio2_1t: pi/2 - pio2_1
* pio2_2: second 33 bit of pi/2
* pio2_2t: pi/2 - (pio2_1+pio2_2)
* pio2_3: third 33 bit of pi/2
* pio2_3t: pi/2 - (pio2_1+pio2_2+pio2_3)
*/
#ifdef __STDC__
static
const
double
#else
static
double
#endif
zero
=
0.00000000000000000000e+00
,
/* 0x00000000, 0x00000000 */
half
=
5.00000000000000000000e-01
,
/* 0x3FE00000, 0x00000000 */
two24
=
1.67772160000000000000e+07
,
/* 0x41700000, 0x00000000 */
invpio2
=
6.36619772367581382433e-01
,
/* 0x3FE45F30, 0x6DC9C883 */
pio2_1
=
1.57079632673412561417e+00
,
/* 0x3FF921FB, 0x54400000 */
pio2_1t
=
6.07710050650619224932e-11
,
/* 0x3DD0B461, 0x1A626331 */
pio2_2
=
6.07710050630396597660e-11
,
/* 0x3DD0B461, 0x1A600000 */
pio2_2t
=
2.02226624879595063154e-21
,
/* 0x3BA3198A, 0x2E037073 */
pio2_3
=
2.02226624871116645580e-21
,
/* 0x3BA3198A, 0x2E000000 */
pio2_3t
=
8.47842766036889956997e-32
;
/* 0x397B839A, 0x252049C1 */
#ifdef __STDC__
int
__ieee754_rem_pio2
(
double
x
,
double
*
y
)
#else
int
__ieee754_rem_pio2
(
x
,
y
)
double
x
,
y
[];
#endif
{
double
z
,
w
,
t
,
r
,
fn
;
double
tx
[
3
];
int
e0
,
i
,
j
,
nx
,
n
,
ix
,
hx
;
hx
=
__HI
(
x
);
/* high word of x */
ix
=
hx
&
0x7fffffff
;
if
(
ix
<=
0x3fe921fb
)
/* |x| ~<= pi/4 , no need for reduction */
{
y
[
0
]
=
x
;
y
[
1
]
=
0
;
return
0
;}
if
(
ix
<
0x4002d97c
)
{
/* |x| < 3pi/4, special case with n=+-1 */
if
(
hx
>
0
)
{
z
=
x
-
pio2_1
;
if
(
ix
!=
0x3ff921fb
)
{
/* 33+53 bit pi is good enough */
y
[
0
]
=
z
-
pio2_1t
;
y
[
1
]
=
(
z
-
y
[
0
])
-
pio2_1t
;
}
else
{
/* near pi/2, use 33+33+53 bit pi */
z
-=
pio2_2
;
y
[
0
]
=
z
-
pio2_2t
;
y
[
1
]
=
(
z
-
y
[
0
])
-
pio2_2t
;
}
return
1
;
}
else
{
/* negative x */
z
=
x
+
pio2_1
;
if
(
ix
!=
0x3ff921fb
)
{
/* 33+53 bit pi is good enough */
y
[
0
]
=
z
+
pio2_1t
;
y
[
1
]
=
(
z
-
y
[
0
])
+
pio2_1t
;
}
else
{
/* near pi/2, use 33+33+53 bit pi */
z
+=
pio2_2
;
y
[
0
]
=
z
+
pio2_2t
;
y
[
1
]
=
(
z
-
y
[
0
])
+
pio2_2t
;
}
return
-
1
;
}
}
if
(
ix
<=
0x413921fb
)
{
/* |x| ~<= 2^19*(pi/2), medium size */
t
=
fabs
(
x
);
n
=
(
int
)
(
t
*
invpio2
+
half
);
fn
=
(
double
)
n
;
r
=
t
-
fn
*
pio2_1
;
w
=
fn
*
pio2_1t
;
/* 1st round good to 85 bit */
if
(
n
<
32
&&
ix
!=
npio2_hw
[
n
-
1
])
{
y
[
0
]
=
r
-
w
;
/* quick check no cancellation */
}
else
{
j
=
ix
>>
20
;
y
[
0
]
=
r
-
w
;
i
=
j
-
(((
__HI
(
y
[
0
]))
>>
20
)
&
0x7ff
);
if
(
i
>
16
)
{
/* 2nd iteration needed, good to 118 */
t
=
r
;
w
=
fn
*
pio2_2
;
r
=
t
-
w
;
w
=
fn
*
pio2_2t
-
((
t
-
r
)
-
w
);
y
[
0
]
=
r
-
w
;
i
=
j
-
(((
__HI
(
y
[
0
]))
>>
20
)
&
0x7ff
);
if
(
i
>
49
)
{
/* 3rd iteration need, 151 bits acc */
t
=
r
;
/* will cover all possible cases */
w
=
fn
*
pio2_3
;
r
=
t
-
w
;
w
=
fn
*
pio2_3t
-
((
t
-
r
)
-
w
);
y
[
0
]
=
r
-
w
;
}
}
}
y
[
1
]
=
(
r
-
y
[
0
])
-
w
;
if
(
hx
<
0
)
{
y
[
0
]
=
-
y
[
0
];
y
[
1
]
=
-
y
[
1
];
return
-
n
;}
else
return
n
;
}
/*
* all other (large) arguments
*/
if
(
ix
>=
0x7ff00000
)
{
/* x is inf or NaN */
y
[
0
]
=
y
[
1
]
=
x
-
x
;
return
0
;
}
/* set z = scalbn(|x|,ilogb(x)-23) */
__LO
(
z
)
=
__LO
(
x
);
e0
=
(
ix
>>
20
)
-
1046
;
/* e0 = ilogb(z)-23; */
__HI
(
z
)
=
ix
-
(
e0
<<
20
);
for
(
i
=
0
;
i
<
2
;
i
++
)
{
tx
[
i
]
=
(
double
)((
int
)(
z
));
z
=
(
z
-
tx
[
i
])
*
two24
;
}
tx
[
2
]
=
z
;
nx
=
3
;
while
(
tx
[
nx
-
1
]
==
zero
)
nx
--
;
/* skip zero term */
n
=
__kernel_rem_pio2
(
tx
,
y
,
e0
,
nx
,
2
,
two_over_pi
);
if
(
hx
<
0
)
{
y
[
0
]
=
-
y
[
0
];
y
[
1
]
=
-
y
[
1
];
return
-
n
;}
return
n
;
}
This diff is collapsed.
Click to expand it.
lisp/fdlibm.h
0 → 100644
+
216
−
0
View file @
58589c23
/* @(#)fdlibm.h 1.5 04/04/22 */
/*
* ====================================================
* Copyright (C) 2004 by Sun Microsystems, Inc. All rights reserved.
*
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* Sometimes it's necessary to define __LITTLE_ENDIAN explicitly
but these catch some common cases. */
#if defined(i386) || defined(i486) || \
defined(intel) || defined(x86) || defined(i86pc) || \
defined(__alpha) || defined(__osf__)
#define __LITTLE_ENDIAN
#endif
#ifdef __LITTLE_ENDIAN
#define __HI(x) *(1+(int*)&x)
#define __LO(x) *(int*)&x
#define __HIp(x) *(1+(int*)x)
#define __LOp(x) *(int*)x
#else
#define __HI(x) *(int*)&x
#define __LO(x) *(1+(int*)&x)
#define __HIp(x) *(int*)x
#define __LOp(x) *(1+(int*)x)
#endif
#ifdef __STDC__
#define __P(p) p
#else
#define __P(p) ()
#endif
/*
* ANSI/POSIX
*/
extern
int
signgam
;
#define MAXFLOAT ((float)3.40282346638528860e+38)
enum
fdversion
{
fdlibm_ieee
=
-
1
,
fdlibm_svid
,
fdlibm_xopen
,
fdlibm_posix
};
#define _LIB_VERSION_TYPE enum fdversion
#define _LIB_VERSION _fdlib_version
/* if global variable _LIB_VERSION is not desirable, one may
* change the following to be a constant by:
* #define _LIB_VERSION_TYPE const enum version
* In that case, after one initializes the value _LIB_VERSION (see
* s_lib_version.c) during compile time, it cannot be modified
* in the middle of a program
*/
extern
_LIB_VERSION_TYPE
_LIB_VERSION
;
#define _IEEE_ fdlibm_ieee
#define _SVID_ fdlibm_svid
#define _XOPEN_ fdlibm_xopen
#define _POSIX_ fdlibm_posix
struct
exception
{
int
type
;
char
*
name
;
double
arg1
;
double
arg2
;
double
retval
;
};
#define HUGE MAXFLOAT
/*
* set X_TLOSS = pi*2**52, which is possibly defined in <values.h>
* (one may replace the following line by "#include <values.h>")
*/
#define X_TLOSS 1.41484755040568800000e+16
#define DOMAIN 1
#define SING 2
#define OVERFLOW 3
#define UNDERFLOW 4
#define TLOSS 5
#define PLOSS 6
/*
* ANSI/POSIX
*/
extern
double
acos
__P
((
double
));
extern
double
asin
__P
((
double
));
extern
double
atan
__P
((
double
));
extern
double
atan2
__P
((
double
,
double
));
extern
double
cos
__P
((
double
));
extern
double
sin
__P
((
double
));
extern
double
tan
__P
((
double
));
extern
double
cosh
__P
((
double
));
extern
double
sinh
__P
((
double
));
extern
double
tanh
__P
((
double
));
extern
double
exp
__P
((
double
));
extern
double
frexp
__P
((
double
,
int
*
));
extern
double
ldexp
__P
((
double
,
int
));
extern
double
log
__P
((
double
));
extern
double
log10
__P
((
double
));
extern
double
modf
__P
((
double
,
double
*
));
extern
double
pow
__P
((
double
,
double
));
extern
double
sqrt
__P
((
double
));
extern
double
ceil
__P
((
double
));
extern
double
fabs
__P
((
double
));
extern
double
floor
__P
((
double
));
extern
double
fmod
__P
((
double
,
double
));
extern
double
erf
__P
((
double
));
extern
double
erfc
__P
((
double
));
extern
double
gamma
__P
((
double
));
extern
double
hypot
__P
((
double
,
double
));
extern
int
isnan
__P
((
double
));
extern
int
finite
__P
((
double
));
extern
double
j0
__P
((
double
));
extern
double
j1
__P
((
double
));
extern
double
jn
__P
((
int
,
double
));
extern
double
lgamma
__P
((
double
));
extern
double
y0
__P
((
double
));
extern
double
y1
__P
((
double
));
extern
double
yn
__P
((
int
,
double
));
extern
double
acosh
__P
((
double
));
extern
double
asinh
__P
((
double
));
extern
double
atanh
__P
((
double
));
extern
double
cbrt
__P
((
double
));
extern
double
logb
__P
((
double
));
extern
double
nextafter
__P
((
double
,
double
));
extern
double
remainder
__P
((
double
,
double
));
#ifdef _SCALB_INT
extern
double
scalb
__P
((
double
,
int
));
#else
extern
double
scalb
__P
((
double
,
double
));
#endif
extern
int
matherr
__P
((
struct
exception
*
));
/*
* IEEE Test Vector
*/
extern
double
significand
__P
((
double
));
/*
* Functions callable from C, intended to support IEEE arithmetic.
*/
extern
double
copysign
__P
((
double
,
double
));
extern
int
ilogb
__P
((
double
));
extern
double
rint
__P
((
double
));
extern
double
scalbn
__P
((
double
,
int
));
/*
* BSD math library entry points
*/
extern
double
expm1
__P
((
double
));
extern
double
log1p
__P
((
double
));
/*
* Reentrant version of gamma & lgamma; passes signgam back by reference
* as the second argument; user must allocate space for signgam.
*/
#ifdef _REENTRANT
extern
double
gamma_r
__P
((
double
,
int
*
));
extern
double
lgamma_r
__P
((
double
,
int
*
));
#endif
/* _REENTRANT */
/* ieee style elementary functions */
extern
double
__ieee754_sqrt
__P
((
double
));
extern
double
__ieee754_acos
__P
((
double
));
extern
double
__ieee754_acosh
__P
((
double
));
extern
double
__ieee754_log
__P
((
double
));
extern
double
__ieee754_atanh
__P
((
double
));
extern
double
__ieee754_asin
__P
((
double
));
extern
double
__ieee754_atan2
__P
((
double
,
double
));
extern
double
__ieee754_exp
__P
((
double
));
extern
double
__ieee754_cosh
__P
((
double
));
extern
double
__ieee754_fmod
__P
((
double
,
double
));
extern
double
__ieee754_pow
__P
((
double
,
double
));
extern
double
__ieee754_lgamma_r
__P
((
double
,
int
*
));
extern
double
__ieee754_gamma_r
__P
((
double
,
int
*
));
extern
double
__ieee754_lgamma
__P
((
double
));
extern
double
__ieee754_gamma
__P
((
double
));
extern
double
__ieee754_log10
__P
((
double
));
extern
double
__ieee754_sinh
__P
((
double
));
extern
double
__ieee754_hypot
__P
((
double
,
double
));
extern
double
__ieee754_j0
__P
((
double
));
extern
double
__ieee754_j1
__P
((
double
));
extern
double
__ieee754_y0
__P
((
double
));
extern
double
__ieee754_y1
__P
((
double
));
extern
double
__ieee754_jn
__P
((
int
,
double
));
extern
double
__ieee754_yn
__P
((
int
,
double
));
extern
double
__ieee754_remainder
__P
((
double
,
double
));
extern
int
__ieee754_rem_pio2
__P
((
double
,
double
*
));
#ifdef _SCALB_INT
extern
double
__ieee754_scalb
__P
((
double
,
int
));
#else
extern
double
__ieee754_scalb
__P
((
double
,
double
));
#endif
/* fdlibm kernel function */
extern
double
__kernel_standard
__P
((
double
,
double
,
int
));
extern
double
__kernel_sin
__P
((
double
,
double
,
int
));
extern
double
__kernel_cos
__P
((
double
,
double
));
extern
double
__kernel_tan
__P
((
double
,
double
,
int
));
extern
int
__kernel_rem_pio2
__P
((
double
*
,
double
*
,
int
,
int
,
int
,
const
int
*
));
This diff is collapsed.
Click to expand it.
lisp/k_rem_pio2.c
0 → 100644
+
316
−
0
View file @
58589c23
/* @(#)k_rem_pio2.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* __kernel_rem_pio2(x,y,e0,nx,prec,ipio2)
* double x[],y[]; int e0,nx,prec; int ipio2[];
*
* __kernel_rem_pio2 return the last three digits of N with
* y = x - N*pi/2
* so that |y| < pi/2.
*
* The method is to compute the integer (mod 8) and fraction parts of
* (2/pi)*x without doing the full multiplication. In general we
* skip the part of the product that are known to be a huge integer (
* more accurately, = 0 mod 8 ). Thus the number of operations are
* independent of the exponent of the input.
*
* (2/pi) is represented by an array of 24-bit integers in ipio2[].
*
* Input parameters:
* x[] The input value (must be positive) is broken into nx
* pieces of 24-bit integers in double precision format.
* x[i] will be the i-th 24 bit of x. The scaled exponent
* of x[0] is given in input parameter e0 (i.e., x[0]*2^e0
* match x's up to 24 bits.
*
* Example of breaking a double positive z into x[0]+x[1]+x[2]:
* e0 = ilogb(z)-23
* z = scalbn(z,-e0)
* for i = 0,1,2
* x[i] = floor(z)
* z = (z-x[i])*2**24
*
*
* y[] ouput result in an array of double precision numbers.
* The dimension of y[] is:
* 24-bit precision 1
* 53-bit precision 2
* 64-bit precision 2
* 113-bit precision 3
* The actual value is the sum of them. Thus for 113-bit
* precison, one may have to do something like:
*
* long double t,w,r_head, r_tail;
* t = (long double)y[2] + (long double)y[1];
* w = (long double)y[0];
* r_head = t+w;
* r_tail = w - (r_head - t);
*
* e0 The exponent of x[0]
*
* nx dimension of x[]
*
* prec an integer indicating the precision:
* 0 24 bits (single)
* 1 53 bits (double)
* 2 64 bits (extended)
* 3 113 bits (quad)
*
* ipio2[]
* integer array, contains the (24*i)-th to (24*i+23)-th
* bit of 2/pi after binary point. The corresponding
* floating value is
*
* ipio2[i] * 2^(-24(i+1)).
*
* External function:
* double scalbn(), floor();
*
*
* Here is the description of some local variables:
*
* jk jk+1 is the initial number of terms of ipio2[] needed
* in the computation. The recommended value is 2,3,4,
* 6 for single, double, extended,and quad.
*
* jz local integer variable indicating the number of
* terms of ipio2[] used.
*
* jx nx - 1
*
* jv index for pointing to the suitable ipio2[] for the
* computation. In general, we want
* ( 2^e0*x[0] * ipio2[jv-1]*2^(-24jv) )/8
* is an integer. Thus
* e0-3-24*jv >= 0 or (e0-3)/24 >= jv
* Hence jv = max(0,(e0-3)/24).
*
* jp jp+1 is the number of terms in PIo2[] needed, jp = jk.
*
* q[] double array with integral value, representing the
* 24-bits chunk of the product of x and 2/pi.
*
* q0 the corresponding exponent of q[0]. Note that the
* exponent for q[i] would be q0-24*i.
*
* PIo2[] double precision array, obtained by cutting pi/2
* into 24 bits chunks.
*
* f[] ipio2[] in floating point
*
* iq[] integer array by breaking up q[] in 24-bits chunk.
*
* fq[] final product of x*(2/pi) in fq[0],..,fq[jk]
*
* ih integer. If >0 it indicates q[] is >= 0.5, hence
* it also indicates the *sign* of the result.
*
*/
/*
* Constants:
* The hexadecimal values are the intended ones for the following
* constants. The decimal values may be used, provided that the
* compiler will convert from decimal to binary accurately enough
* to produce the hexadecimal values shown.
*/
#include
"fdlibm.h"
#ifdef __STDC__
static
const
int
init_jk
[]
=
{
2
,
3
,
4
,
6
};
/* initial value for jk */
#else
static
int
init_jk
[]
=
{
2
,
3
,
4
,
6
};
#endif
#ifdef __STDC__
static
const
double
PIo2
[]
=
{
#else
static
double
PIo2
[]
=
{
#endif
1.57079625129699707031e+00
,
/* 0x3FF921FB, 0x40000000 */
7.54978941586159635335e-08
,
/* 0x3E74442D, 0x00000000 */
5.39030252995776476554e-15
,
/* 0x3CF84698, 0x80000000 */
3.28200341580791294123e-22
,
/* 0x3B78CC51, 0x60000000 */
1.27065575308067607349e-29
,
/* 0x39F01B83, 0x80000000 */
1.22933308981111328932e-36
,
/* 0x387A2520, 0x40000000 */
2.73370053816464559624e-44
,
/* 0x36E38222, 0x80000000 */
2.16741683877804819444e-51
,
/* 0x3569F31D, 0x00000000 */
};
#ifdef __STDC__
static
const
double
#else
static
double
#endif
zero
=
0
.
0
,
one
=
1
.
0
,
two24
=
1.67772160000000000000e+07
,
/* 0x41700000, 0x00000000 */
twon24
=
5.96046447753906250000e-08
;
/* 0x3E700000, 0x00000000 */
#ifdef __STDC__
int
__kernel_rem_pio2
(
double
*
x
,
double
*
y
,
int
e0
,
int
nx
,
int
prec
,
const
int
*
ipio2
)
#else
int
__kernel_rem_pio2
(
x
,
y
,
e0
,
nx
,
prec
,
ipio2
)
double
x
[],
y
[];
int
e0
,
nx
,
prec
;
int
ipio2
[];
#endif
{
int
jz
,
jx
,
jv
,
jp
,
jk
,
carry
,
n
,
iq
[
20
],
i
,
j
,
k
,
m
,
q0
,
ih
;
double
z
,
fw
,
f
[
20
],
fq
[
20
],
q
[
20
];
/* initialize jk*/
jk
=
init_jk
[
prec
];
jp
=
jk
;
/* determine jx,jv,q0, note that 3>q0 */
jx
=
nx
-
1
;
jv
=
(
e0
-
3
)
/
24
;
if
(
jv
<
0
)
jv
=
0
;
q0
=
e0
-
24
*
(
jv
+
1
);
/* set up f[0] to f[jx+jk] where f[jx+jk] = ipio2[jv+jk] */
j
=
jv
-
jx
;
m
=
jx
+
jk
;
for
(
i
=
0
;
i
<=
m
;
i
++
,
j
++
)
f
[
i
]
=
(
j
<
0
)
?
zero
:
(
double
)
ipio2
[
j
];
/* compute q[0],q[1],...q[jk] */
for
(
i
=
0
;
i
<=
jk
;
i
++
)
{
for
(
j
=
0
,
fw
=
0
.
0
;
j
<=
jx
;
j
++
)
fw
+=
x
[
j
]
*
f
[
jx
+
i
-
j
];
q
[
i
]
=
fw
;
}
jz
=
jk
;
recompute:
/* distill q[] into iq[] reversingly */
for
(
i
=
0
,
j
=
jz
,
z
=
q
[
jz
];
j
>
0
;
i
++
,
j
--
)
{
fw
=
(
double
)((
int
)(
twon24
*
z
));
iq
[
i
]
=
(
int
)(
z
-
two24
*
fw
);
z
=
q
[
j
-
1
]
+
fw
;
}
/* compute n */
z
=
scalbn
(
z
,
q0
);
/* actual value of z */
z
-=
8
.
0
*
floor
(
z
*
0
.
125
);
/* trim off integer >= 8 */
n
=
(
int
)
z
;
z
-=
(
double
)
n
;
ih
=
0
;
if
(
q0
>
0
)
{
/* need iq[jz-1] to determine n */
i
=
(
iq
[
jz
-
1
]
>>
(
24
-
q0
));
n
+=
i
;
iq
[
jz
-
1
]
-=
i
<<
(
24
-
q0
);
ih
=
iq
[
jz
-
1
]
>>
(
23
-
q0
);
}
else
if
(
q0
==
0
)
ih
=
iq
[
jz
-
1
]
>>
23
;
else
if
(
z
>=
0
.
5
)
ih
=
2
;
if
(
ih
>
0
)
{
/* q > 0.5 */
n
+=
1
;
carry
=
0
;
for
(
i
=
0
;
i
<
jz
;
i
++
)
{
/* compute 1-q */
j
=
iq
[
i
];
if
(
carry
==
0
)
{
if
(
j
!=
0
)
{
carry
=
1
;
iq
[
i
]
=
0x1000000
-
j
;
}
}
else
iq
[
i
]
=
0xffffff
-
j
;
}
if
(
q0
>
0
)
{
/* rare case: chance is 1 in 12 */
switch
(
q0
)
{
case
1
:
iq
[
jz
-
1
]
&=
0x7fffff
;
break
;
case
2
:
iq
[
jz
-
1
]
&=
0x3fffff
;
break
;
}
}
if
(
ih
==
2
)
{
z
=
one
-
z
;
if
(
carry
!=
0
)
z
-=
scalbn
(
one
,
q0
);
}
}
/* check if recomputation is needed */
if
(
z
==
zero
)
{
j
=
0
;
for
(
i
=
jz
-
1
;
i
>=
jk
;
i
--
)
j
|=
iq
[
i
];
if
(
j
==
0
)
{
/* need recomputation */
for
(
k
=
1
;
iq
[
jk
-
k
]
==
0
;
k
++
);
/* k = no. of terms needed */
for
(
i
=
jz
+
1
;
i
<=
jz
+
k
;
i
++
)
{
/* add q[jz+1] to q[jz+k] */
f
[
jx
+
i
]
=
(
double
)
ipio2
[
jv
+
i
];
for
(
j
=
0
,
fw
=
0
.
0
;
j
<=
jx
;
j
++
)
fw
+=
x
[
j
]
*
f
[
jx
+
i
-
j
];
q
[
i
]
=
fw
;
}
jz
+=
k
;
goto
recompute
;
}
}
/* chop off zero terms */
if
(
z
==
0
.
0
)
{
jz
-=
1
;
q0
-=
24
;
while
(
iq
[
jz
]
==
0
)
{
jz
--
;
q0
-=
24
;}
}
else
{
/* break z into 24-bit if necessary */
z
=
scalbn
(
z
,
-
q0
);
if
(
z
>=
two24
)
{
fw
=
(
double
)((
int
)(
twon24
*
z
));
iq
[
jz
]
=
(
int
)(
z
-
two24
*
fw
);
jz
+=
1
;
q0
+=
24
;
iq
[
jz
]
=
(
int
)
fw
;
}
else
iq
[
jz
]
=
(
int
)
z
;
}
/* convert integer "bit" chunk to floating-point value */
fw
=
scalbn
(
one
,
q0
);
for
(
i
=
jz
;
i
>=
0
;
i
--
)
{
q
[
i
]
=
fw
*
(
double
)
iq
[
i
];
fw
*=
twon24
;
}
/* compute PIo2[0,...,jp]*q[jz,...,0] */
for
(
i
=
jz
;
i
>=
0
;
i
--
)
{
for
(
fw
=
0
.
0
,
k
=
0
;
k
<=
jp
&&
k
<=
jz
-
i
;
k
++
)
fw
+=
PIo2
[
k
]
*
q
[
i
+
k
];
fq
[
jz
-
i
]
=
fw
;
}
/* compress fq[] into y[] */
switch
(
prec
)
{
case
0
:
fw
=
0
.
0
;
for
(
i
=
jz
;
i
>=
0
;
i
--
)
fw
+=
fq
[
i
];
y
[
0
]
=
(
ih
==
0
)
?
fw
:
-
fw
;
break
;
case
1
:
case
2
:
fw
=
0
.
0
;
for
(
i
=
jz
;
i
>=
0
;
i
--
)
fw
+=
fq
[
i
];
y
[
0
]
=
(
ih
==
0
)
?
fw
:
-
fw
;
fw
=
fq
[
0
]
-
fw
;
for
(
i
=
1
;
i
<=
jz
;
i
++
)
fw
+=
fq
[
i
];
y
[
1
]
=
(
ih
==
0
)
?
fw
:
-
fw
;
break
;
case
3
:
/* painful */
for
(
i
=
jz
;
i
>
0
;
i
--
)
{
fw
=
fq
[
i
-
1
]
+
fq
[
i
];
fq
[
i
]
+=
fq
[
i
-
1
]
-
fw
;
fq
[
i
-
1
]
=
fw
;
}
for
(
i
=
jz
;
i
>
1
;
i
--
)
{
fw
=
fq
[
i
-
1
]
+
fq
[
i
];
fq
[
i
]
+=
fq
[
i
-
1
]
-
fw
;
fq
[
i
-
1
]
=
fw
;
}
for
(
fw
=
0
.
0
,
i
=
jz
;
i
>=
2
;
i
--
)
fw
+=
fq
[
i
];
if
(
ih
==
0
)
{
y
[
0
]
=
fq
[
0
];
y
[
1
]
=
fq
[
1
];
y
[
2
]
=
fw
;
}
else
{
y
[
0
]
=
-
fq
[
0
];
y
[
1
]
=
-
fq
[
1
];
y
[
2
]
=
-
fw
;
}
}
return
n
&
7
;
}
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment