Skip to content
Snippets Groups Projects
Commit a459a234 authored by rtoy's avatar rtoy
Browse files

Add new interface to ieee754_rem_pio2. No longer need to pass in an

array. The new function returns 2 new output values.

code/irrat.lisp:
o Rename the original %ieee754-rem-pi/2 to %%ieee754-rem-pi-2.
o Define the new %ieee754-rem-pi/2 function.  This returns the output
  as two output values instead of an array.
o Use the new function.  We should have wrapped the original with
  without-gcing, but we don't have to anymore.

lisp/ppc-arch.c:
lisp/x86-arch.c:
o Implement the new C interface to __ieee754_rem_pio2

lisp/Config.linux_gencgc:
o Use -ffloat-store when compiling e_rem_pio2.c and k_rem_pio2.c, just
  to be sure.
parent 06ccb8b6
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/irrat.lisp,v 1.53 2007/08/03 14:28:22 rtoy Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/irrat.lisp,v 1.54 2008/01/28 18:21:03 rtoy Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -182,15 +182,26 @@ ...@@ -182,15 +182,26 @@
#+(or ppc x86) #+(or ppc x86)
(progn (progn
(declaim (inline %ieee754-rem-pi/2)) (declaim (inline %%ieee754-rem-pi/2))
;; Basic argument reduction routine. It returns two values: n and y ;; Basic argument reduction routine. It returns two values: n and y
;; such that (n + 8*k)*pi/2+y = x where |y|<pi/4 and n indicates in ;; such that (n + 8*k)*pi/2+y = x where |y|<pi/4 and n indicates in
;; which octant the arg lies. Y is actually computed in two parts, ;; which octant the arg lies. Y is actually computed in two parts,
;; y[0] and y[1] such that the sum is y, for accuracy. ;; y[0] and y[1] such that the sum is y, for accuracy.
(alien:def-alien-routine ("__ieee754_rem_pio2" %ieee754-rem-pi/2) c-call:int (alien:def-alien-routine ("__ieee754_rem_pio2" %%ieee754-rem-pi/2) c-call:int
(x double-float) (x double-float)
(y (* double-float))) (y (* double-float)))
;; Same as above, but instead of needing to pass an array in, the
;; output array is broken up into two output values instead. This is
;; easier for the user, and we don't have to wrap calls with
;; without-gcing.
(declaim (inline %ieee754-rem-pi/2))
(alien:def-alien-routine ("ieee754_rem_pio2" %ieee754-rem-pi/2) c-call:int
(x double-float)
(y0 double-float :out)
(y1 double-float :out))
) )
#+ppc #+ppc
...@@ -207,7 +218,7 @@ ...@@ -207,7 +218,7 @@
#+(or ppc x86) #+(or ppc x86)
(macrolet (macrolet
((frob (sin cos tan) ((frob (sin cos tan)
`(let ((y (make-array 2 :element-type 'double-float))) `(progn
;; The array y holds the result for %ieee754-rem-pi/2 ;; The array y holds the result for %ieee754-rem-pi/2
;; ;;
;; In all of the routines below, we just compute the sum of ;; In all of the routines below, we just compute the sum of
...@@ -222,35 +233,38 @@ ...@@ -222,35 +233,38 @@
(if (< (abs x) (/ pi 4)) (if (< (abs x) (/ pi 4))
(,sin x) (,sin x)
;; Argument reduction needed ;; Argument reduction needed
(let* ((n (%ieee754-rem-pi/2 x (vector-sap y))) (multiple-value-bind (n y0 y1)
(reduced (+ (aref y 0) (aref y 1)))) (%ieee754-rem-pi/2 x)
(case (logand n 3) (let ((reduced (+ y0 y1)))
(0 (,sin reduced)) (case (logand n 3)
(1 (,cos reduced)) (0 (,sin reduced))
(2 (- (,sin reduced))) (1 (,cos reduced))
(3 (- (,cos reduced))))))) (2 (- (,sin reduced)))
(3 (- (,cos reduced))))))))
(defun %cos (x) (defun %cos (x)
(declare (double-float x)) (declare (double-float x))
(if (< (abs x) (/ pi 4)) (if (< (abs x) (/ pi 4))
(,cos x) (,cos x)
;; Argument reduction needed ;; Argument reduction needed
(let* ((n (%ieee754-rem-pi/2 x (vector-sap y))) (multiple-value-bind (n y0 y1)
(reduced (+ (aref y 0) (aref y 1)))) (%ieee754-rem-pi/2 x)
(case (logand n 3) (let ((reduced (+ y0 y1)))
(0 (,cos reduced)) (case (logand n 3)
(1 (- (,sin reduced))) (0 (,cos reduced))
(2 (- (,cos reduced))) (1 (- (,sin reduced)))
(3 (,sin reduced)))))) (2 (- (,cos reduced)))
(3 (,sin reduced)))))))
(defun %tan (x) (defun %tan (x)
(declare (double-float x)) (declare (double-float x))
(if (< (abs x) (/ pi 4)) (if (< (abs x) (/ pi 4))
(,tan x) (,tan x)
;; Argument reduction needed ;; Argument reduction needed
(let* ((n (%ieee754-rem-pi/2 x (vector-sap y))) (multiple-value-bind (n y0 y1)
(reduced (+ (aref y 0) (aref y 1)))) (%ieee754-rem-pi/2 x)
(if (evenp n) (let ((reduced (+ y0 y1)))
(,tan reduced) (if (evenp n)
(- (/ (,tan reduced)))))))))) (,tan reduced)
(- (/ (,tan reduced)))))))))))
#+x86 #+x86
(frob %sin-quick %cos-quick %tan-quick) (frob %sin-quick %cos-quick %tan-quick)
#+ppc #+ppc
......
...@@ -41,7 +41,7 @@ OS_LIBS = -ldl ...@@ -41,7 +41,7 @@ OS_LIBS = -ldl
# since we can't tell what compiler version we're using. # since we can't tell what compiler version we're using.
e_rem_pio2.o : e_rem_pio2.c e_rem_pio2.o : e_rem_pio2.c
$(CC) -c $(CFLAGS) -O1 $< $(CC) -c $(CFLAGS) -O1 -ffloat-store $<
k_rem_pio2.o : k_rem_pio2.c k_rem_pio2.o : k_rem_pio2.c
$(CC) -c $(CFLAGS) -O1 $< $(CC) -c $(CFLAGS) -O1 -ffloat-store $<
/* /*
$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/ppc-arch.c,v 1.11 2007/11/16 05:04:09 cshapiro Exp $ $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/ppc-arch.c,v 1.12 2008/01/28 18:21:04 rtoy Exp $
This code was written as part of the CMU Common Lisp project at This code was written as part of the CMU Common Lisp project at
Carnegie Mellon University, and has been placed in the public domain. Carnegie Mellon University, and has been placed in the public domain.
...@@ -723,3 +723,17 @@ arch_linkage_entry(unsigned long retaddr) ...@@ -723,3 +723,17 @@ arch_linkage_entry(unsigned long retaddr)
/ LinkageEntrySize; / LinkageEntrySize;
} }
#endif #endif
int ieee754_rem_pio2(double x, double *y0, double *y1)
{
extern int __ieee754_rem_pio2(double x, double *y);
double y[2];
int n;
n = __ieee754_rem_pio2(x, y);
*y0 = y[0];
*y1 = y[1];
return n;
}
/* x86-arch.c -*- Mode: C; comment-column: 40 -*- /* x86-arch.c -*- Mode: C; comment-column: 40 -*-
* *
* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/x86-arch.c,v 1.34 2007/12/15 15:26:29 rtoy Exp $ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/x86-arch.c,v 1.35 2008/01/28 18:21:04 rtoy Exp $
* *
*/ */
...@@ -424,3 +424,19 @@ arch_linkage_entry(unsigned long retaddr) ...@@ -424,3 +424,19 @@ arch_linkage_entry(unsigned long retaddr)
return ((retaddr - 5) - FOREIGN_LINKAGE_SPACE_START) / LinkageEntrySize; return ((retaddr - 5) - FOREIGN_LINKAGE_SPACE_START) / LinkageEntrySize;
} }
#endif /* LINKAGE_TABLE */ #endif /* LINKAGE_TABLE */
int ieee754_rem_pio2(double x, double *y0, double *y1)
{
extern int __ieee754_rem_pio2(double x, double *y);
double y[2];
int n;
n = __ieee754_rem_pio2(x, y);
*y0 = y[0];
*y1 = y[1];
return n;
}
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment