Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
cmucl
cmucl
Commits
881903dd
Commit
881903dd
authored
Dec 07, 2013
by
Raymond Toy
Browse files
Use C sincos for CIS on linux/x86.
parent
5d7af879
Changes
2
Hide whitespace changes
Inline
Side-by-side
src/code/irrat.lisp
View file @
881903dd
...
...
@@ -309,7 +309,49 @@
#+
(
or
ppc
sse2
)
(
frob
%%sin
%%cos
%%tan
))
;; Linux has a sincos function in the C library. Use it. But we need
;; to do pi reduction ourselves because the C library doesn't do
;; accurate reduction.
#+
(
or
(
and
linux
x86
))
(
progn
(
declaim
(
inline
%%sincos
))
(
export
'%%sincos
)
(
alien:def-alien-routine
(
"sincos"
%%sincos
)
c-call:void
(
x
double-float
)
(
sin
double-float
:out
)
(
cos
double-float
:out
))
(
defun
%sincos
(
theta
)
(
declare
(
double-float
theta
))
;; Accurately reduce theta.
(
multiple-value-bind
(
n
y0
y1
)
(
%ieee754-rem-pi/2
theta
)
(
multiple-value-bind
(
ignore
s
c
)
(
%%sincos
y0
)
(
declare
(
ignore
ignore
))
;; Figure out which quadrant to use, and finish out the
;; computation using y1. This is done by using a 1st-order
;; Taylor expansion about y0.
(
flet
((
sin2
(
s
c
y
)
;; sin(x+y) = sin(x) + cos(x)*y
(
+
s
(
*
c
y
)))
(
cos2
(
s
c
y
)
;; cos(x+y) = cos(x) - sin(x)*y
(
-
c
(
*
s
y
))))
(
case
(
logand
n
3
)
(
0
(
values
(
cos2
s
c
y1
)
(
sin2
s
c
y1
)))
(
1
(
values
(
-
(
sin2
s
c
y1
))
(
cos2
s
c
y1
)))
(
2
(
values
(
-
(
cos2
s
c
y1
))
(
-
(
sin2
s
c
y1
))))
(
3
(
values
(
sin2
s
c
y1
)
(
-
(
cos2
s
c
y1
)))))))))
)
;;;; Power functions.
...
...
@@ -964,7 +1006,24 @@
"Return cos(Theta) + i sin(Theta), AKA exp(i Theta)."
(
if
(
complexp
theta
)
(
error
(
intl:gettext
"Argument to CIS is complex: ~S"
)
theta
)
(
complex
(
cos
theta
)
(
sin
theta
))))
#-
(
or
(
and
linux
x86
))
(
complex
(
cos
theta
)
(
sin
theta
))
#+
(
or
(
and
linux
x86
))
(
number-dispatch
((
theta
real
))
((
rational
)
(
let
((
arg
(
coerce
theta
'double-float
)))
(
multiple-value-bind
(
s
c
)
(
%sincos
arg
)
(
complex
(
coerce
s
'single-float
)
(
coerce
c
'single-float
)))))
(((
foreach
single-float
double-float
))
(
multiple-value-bind
(
s
c
)
(
%sincos
(
coerce
theta
'double-float
))
(
complex
(
coerce
s
'
(
dispatch-type
theta
))
(
coerce
c
'
(
dispatch-type
theta
)))))
#+
double-double
((
double-double-float
)
(
complex
(
cos
theta
)
(
sin
theta
))))))
(
defun
asin
(
number
)
"Return the arc sine of NUMBER."
...
...
src/compiler/float-tran.lisp
View file @
881903dd
...
...
@@ -731,6 +731,30 @@
(
deftransform
name
((
x
)
'
(
double-float
)
rtype
:eval-name
t
:when
:both
)
`
(
,
prim
x
))))
#+
(
or
(
and
linux
x86
))
(
progn
(
defknown
(
kernel::%sincos
)
(
double-float
)
(
values
double-float
double-float
)
(
movable
foldable
flushable
))
(
deftransform
cis
((
x
)
(
single-float
)
*
:when
:both
)
`
(
multiple-value-bind
(
s
c
)
(
kernel::%sincos
(
coerce
x
'double-float
))
(
complex
(
coerce
s
'single-float
)
(
coerce
c
'single-float
))))
(
deftransform
cis
((
x
)
(
double-float
)
*
:when
:both
)
`
(
multiple-value-bind
(
ignore
s
c
)
(
kernel::%%sincos
x
)
(
declare
(
ignore
ignore
))
(
complex
s
c
)))
#+
double-double
(
deftransform
cis
((
z
)
(
double-double-float
)
*
)
;; Cis.
'
(
complex
(
cos
z
)
(
sin
z
)))
)
;;; The argument range is limited on the x86 FP trig. functions. A
;;; post-test can detect a failure (and load a suitable result), but
;;; this test is avoided if possible.
...
...
@@ -1777,6 +1801,7 @@
(
deftransform
*
((
z
w
)
(
,
real-type
(
complex
,
type
))
*
)
;; Real * complex
'
(
complex
(
*
z
(
realpart
w
))
(
*
z
(
imagpart
w
))))
#-
(
or
(
and
linux
x86
))
(
deftransform
cis
((
z
)
((
,
type
))
*
)
;; Cis.
'
(
complex
(
cos
z
)
(
sin
z
)))
...
...
Write
Preview
Supports
Markdown
0%
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!
Cancel
Please
register
or
sign in
to comment