From a459a234428120fa6c46b5f9593fcb142b5482e3 Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Mon, 28 Jan 2008 18:21:04 +0000
Subject: [PATCH] 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.
---
 code/irrat.lisp          | 60 +++++++++++++++++++++++++---------------
 lisp/Config.linux_gencgc |  4 +--
 lisp/ppc-arch.c          | 16 ++++++++++-
 lisp/x86-arch.c          | 18 +++++++++++-
 4 files changed, 71 insertions(+), 27 deletions(-)

diff --git a/code/irrat.lisp b/code/irrat.lisp
index dc96e73ad..63a80ec86 100644
--- a/code/irrat.lisp
+++ b/code/irrat.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (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 @@
 
 #+(or ppc x86)
 (progn
-(declaim (inline %ieee754-rem-pi/2))
+(declaim (inline %%ieee754-rem-pi/2))
 ;; 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
 ;; 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.
 
-(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)
   (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
@@ -207,7 +218,7 @@
 #+(or ppc x86)
 (macrolet
     ((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
 	  ;;
 	  ;; In all of the routines below, we just compute the sum of
@@ -222,35 +233,38 @@
 	    (if (< (abs x) (/ pi 4))
 		(,sin x)
 		;; Argument reduction needed
-		(let* ((n (%ieee754-rem-pi/2 x (vector-sap y)))
-		       (reduced (+ (aref y 0) (aref y 1))))
-		  (case (logand n 3)
-		    (0 (,sin reduced))
-		    (1 (,cos reduced))
-		    (2 (- (,sin reduced)))
-		    (3 (- (,cos reduced)))))))
+		(multiple-value-bind (n y0 y1)
+		    (%ieee754-rem-pi/2 x)
+		  (let ((reduced (+ y0 y1)))
+		    (case (logand n 3)
+		      (0 (,sin reduced))
+		      (1 (,cos reduced))
+		      (2 (- (,sin reduced)))
+		      (3 (- (,cos reduced))))))))
 	  (defun %cos (x)
 	    (declare (double-float x))
 	    (if (< (abs x) (/ pi 4))
 		(,cos x)
 		;; Argument reduction needed
-		(let* ((n (%ieee754-rem-pi/2 x (vector-sap y)))
-		       (reduced (+ (aref y 0) (aref y 1))))
-		  (case (logand n 3)
-		    (0 (,cos reduced))
-		    (1 (- (,sin reduced)))
-		    (2 (- (,cos reduced)))
-		    (3 (,sin reduced))))))
+		(multiple-value-bind (n y0 y1)
+		    (%ieee754-rem-pi/2 x)
+		  (let ((reduced (+ y0 y1)))
+		    (case (logand n 3)
+		      (0 (,cos reduced))
+		      (1 (- (,sin reduced)))
+		      (2 (- (,cos reduced)))
+		      (3 (,sin reduced)))))))
 	  (defun %tan (x)
 	    (declare (double-float x))
 	    (if (< (abs x) (/ pi 4))
 		(,tan x)
 		;; Argument reduction needed
-		(let* ((n (%ieee754-rem-pi/2 x (vector-sap y)))
-		       (reduced (+ (aref y 0) (aref y 1))))
-		  (if (evenp n)
-		      (,tan reduced)
-		      (- (/ (,tan reduced))))))))))
+		(multiple-value-bind (n y0 y1)
+		    (%ieee754-rem-pi/2 x)
+		  (let ((reduced (+ y0 y1)))
+		    (if (evenp n)
+			(,tan reduced)
+			(- (/ (,tan reduced)))))))))))
   #+x86
   (frob %sin-quick %cos-quick %tan-quick)
   #+ppc
diff --git a/lisp/Config.linux_gencgc b/lisp/Config.linux_gencgc
index 108a2f454..94c91e5e1 100644
--- a/lisp/Config.linux_gencgc
+++ b/lisp/Config.linux_gencgc
@@ -41,7 +41,7 @@ OS_LIBS = -ldl
 # since we can't tell what compiler version we're using.
 
 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
-	$(CC) -c $(CFLAGS) -O1 $<
+	$(CC) -c $(CFLAGS) -O1 -ffloat-store $<
diff --git a/lisp/ppc-arch.c b/lisp/ppc-arch.c
index 90b3b7e3a..c18e1f228 100644
--- a/lisp/ppc-arch.c
+++ b/lisp/ppc-arch.c
@@ -1,6 +1,6 @@
 /*
 
- $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
  Carnegie Mellon University, and has been placed in the public domain.
@@ -723,3 +723,17 @@ arch_linkage_entry(unsigned long retaddr)
 	/ LinkageEntrySize;
 }
 #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;
+}
diff --git a/lisp/x86-arch.c b/lisp/x86-arch.c
index 0ec7ea66c..88f5fb910 100644
--- a/lisp/x86-arch.c
+++ b/lisp/x86-arch.c
@@ -1,6 +1,6 @@
 /* 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)
     return ((retaddr - 5) - FOREIGN_LINKAGE_SPACE_START) / LinkageEntrySize;
 }
 #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;
+}
+
+  
-- 
GitLab