From 9f1e96bf7a99aea67ff9bb8aded52cc422d3fb90 Mon Sep 17 00:00:00 2001
From: dtc <dtc>
Date: Sun, 30 Nov 1997 22:53:51 +0000
Subject: [PATCH] Fix for the fsin, fcos, and ftan VOPs which were writing to
 the EAX register but had not declared this register as a temporary.

---
 compiler/x86/float.lisp | 185 +++++++++++++++++++++++++++++-----------
 1 file changed, 135 insertions(+), 50 deletions(-)

diff --git a/compiler/x86/float.lisp b/compiler/x86/float.lisp
index 83f77e6ad..c3b2b952c 100644
--- a/compiler/x86/float.lisp
+++ b/compiler/x86/float.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float.lisp,v 1.16 1997/11/19 03:00:36 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float.lisp,v 1.17 1997/11/30 22:53:51 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1665,20 +1665,65 @@
 		      (t
 		       (inst fst y)))))))
 
-  (frob fsin-quick  %sin-quick fsin)		; arg range is 2^63
-  (frob fcos-quick  %cos-quick fcos)		; so may need frem1
+  ;; Quick versions of fsin and fcos that require the argument to be
+  ;; within range 2^63.
+  (frob fsin-quick %sin-quick fsin)
+  (frob fcos-quick %cos-quick fcos)
+  ;;
   (frob fsqrt %sqrt fsqrt))
 
-;;; Versions of fsin and fcos which handle a larger arg. range.
+;;; Quick version of ftan that requires the argument to be within
+;;; range 2^63.
+(define-vop (ftan-quick)
+  (:translate %tan-quick)
+  (:args (x :scs (double-reg) :target fr0))
+  (:temporary (:sc double-reg :offset fr0-offset
+		   :from :argument :to :result) fr0)
+  (:temporary (:sc double-reg :offset fr1-offset
+		   :from :argument :to :result) fr1)
+  (:results (y :scs (double-reg)))
+  (:arg-types double-float)
+  (:result-types double-float)
+  (:policy :fast-safe)
+  (:note "inline tan function")
+  (:vop-var vop)
+  (:save-p :compute-only)
+  (:generator 5
+    (note-this-location vop :internal-error)
+    (case (tn-offset x)
+       (0 
+	(inst fstp fr1))
+       (1
+	(inst fstp fr0))
+       (t
+	(inst fstp fr0)
+	(inst fstp fr0)
+	(inst fldd (make-random-tn :kind :normal
+				   :sc (sc-or-lose 'double-reg)
+				   :offset (- (tn-offset x) 2)))))
+    (inst fptan)
+    ;; Result is in fr1
+    (case (tn-offset y)
+       (0
+	(inst fxch fr1))
+       (1)
+       (t
+	(inst fxch fr1)
+	(inst fstd y)))))
+	     
+;;; These versions of fsin, fcos, and ftan try to use argument
+;;; reduction but to do this accurately requires greater precision and
+;;; it is hopelessly inaccurate.
+#+nil
 (macrolet ((frob (func trans op)
 	     `(define-vop (,func)
 		(:translate ,trans)
 		(:args (x :scs (double-reg) :target fr0))
-		#+nil(:temporary (:sc word-reg :offset eax-offset
-				 :from :eval :to :result) temp)
+		(:temporary (:sc dword-reg :offset eax-offset
+				 :from :eval :to :result) eax)
 		(:temporary (:sc double-reg :offset fr0-offset
 				 :from :argument :to :result) fr0)
-		#+nil(:temporary (:sc double-reg :offset fr1-offset
+		(:temporary (:sc double-reg :offset fr1-offset
 				 :from :argument :to :result) fr1)
 		(:results (y :scs (double-reg)))
 		(:arg-types double-float)
@@ -1687,7 +1732,7 @@
 		(:note "inline sin/cos function")
 		(:vop-var vop)
 		(:save-p :compute-only)
-		#+nil(:ignore temp)
+		(:ignore eax)
 		(:generator 5
 		  (note-this-location vop :internal-error)
 		  (unless (zerop (tn-offset x))
@@ -1699,32 +1744,28 @@
 		  (inst and ah-tn #x04)		 ; C2
 		  (inst jmp :z DONE)
 		  ;; Else x was out of range so reduce it; ST0 is unchanged.
-		  #+nil				; @@@
-		  (progn			; Arg reduction is errorful
-		    (inst fstp fr1) 		; Load 2*PI
-		    (inst fldpi)
-		    (inst fadd fr0)
-		    (inst fxch fr1)
-		    LOOP
-		    (inst fprem1)
-		    (inst fnstsw)		; status word to %ea
-		    (inst and ah-tn #x04)	; C2
-		    (inst jmp :nz LOOP)
-		    (inst ,op))
-		  (progn			; @@@
-		    (inst fstp fr0)		; Else Load 0.0
-		    (inst fldz))		; on too big args
+		  (inst fstp fr1) 		; Load 2*PI
+		  (inst fldpi)
+		  (inst fadd fr0)
+		  (inst fxch fr1)
+		  LOOP
+		  (inst fprem1)
+		  (inst fnstsw)		; status word to %ea
+		  (inst and ah-tn #x04)	; C2
+		  (inst jmp :nz LOOP)
+		  (inst ,op)
 		  DONE
 		  (unless (zerop (tn-offset y))
 			  (inst fstd y))))))
 	  (frob fsin  %sin fsin)
 	  (frob fcos  %cos fcos))
 	     
+#+nil
 (define-vop (ftan)
   (:translate %tan)
   (:args (x :scs (double-reg) :target fr0))
-  #+nil(:temporary (:sc word-reg :offset eax-offset
-		   :from :eval :to :result) temp)
+  (:temporary (:sc dword-reg :offset eax-offset
+		   :from :argument :to :result) eax)
   (:temporary (:sc double-reg :offset fr0-offset
 		   :from :argument :to :result) fr0)
   (:temporary (:sc double-reg :offset fr1-offset
@@ -1736,7 +1777,7 @@
   (:note "inline tan function")
   (:vop-var vop)
   (:save-p :compute-only)
-  #+nil(:ignore temp)
+  (:ignore eax)
   (:generator 5
     (note-this-location vop :internal-error)
     (case (tn-offset x)
@@ -1755,21 +1796,16 @@
     (inst and ah-tn #x04)		 ; C2
     (inst jmp :z DONE)
     ;; Else x was out of range so reduce it; ST0 is unchanged.
-    #+nil
-    (progn				; @@@ Reduction doesn't work well.
-      (inst fldpi)                         ; Load 2*PI
-      (inst fadd fr0)
-      (inst fxch fr1)
-      LOOP
-      (inst fprem1)
-      (inst fnstsw)			 ; status word to %ea
-      (inst and ah-tn #x04)		 ; C2
-      (inst jmp :nz LOOP)
-      (inst fstp fr1)
-      (inst fptan))
-    (progn				; @@@ just load 0.0 
-      (inst fldz)
-      (inst fxch fr1))
+    (inst fldpi)                         ; Load 2*PI
+    (inst fadd fr0)
+    (inst fxch fr1)
+    LOOP
+    (inst fprem1)
+    (inst fnstsw)			 ; status word to %ea
+    (inst and ah-tn #x04)		 ; C2
+    (inst jmp :nz LOOP)
+    (inst fstp fr1)
+    (inst fptan)
     DONE
     ;; Result is in fr1
     (case (tn-offset y)
@@ -1780,20 +1816,62 @@
 	(inst fxch fr1)
 	(inst fstd y)))))
 
-(define-vop (ftan-quick)
-  (:translate %tan-quick)
+;;; These versions of fsin, fcos, and ftan simply load a 0.0 result if
+;;; the argument is out of range 2^63 and would thus be hopelessly
+;;; inaccurate.
+(macrolet ((frob (func trans op)
+	     `(define-vop (,func)
+		(:translate ,trans)
+		(:args (x :scs (double-reg) :target fr0))
+		(:temporary (:sc double-reg :offset fr0-offset
+				 :from :argument :to :result) fr0)
+		(:temporary (:sc dword-reg :offset eax-offset
+			     :from :argument :to :result) eax)
+		(:results (y :scs (double-reg)))
+	        (:arg-types double-float)
+	        (:result-types double-float)
+		(:policy :fast-safe)
+		(:note "inline sin/cos function")
+		(:vop-var vop)
+		(:save-p :compute-only)
+	        (:ignore eax)
+		(:generator 5
+		  (note-this-location vop :internal-error)
+		  (unless (zerop (tn-offset x))
+			  (inst fxch x)		 ; x to top of stack
+			  (unless (location= x y)
+				  (inst fst x))) ; maybe save it
+		  (inst ,op)
+		  (inst fnstsw)			 ; status word to %ea
+		  (inst and ah-tn #x04)		 ; C2
+		  (inst jmp :z DONE)
+		  ;; Else x was out of range so reduce it; ST0 is unchanged.
+		  (inst fstp fr0)                ; Load 0.0
+		  (inst fldz)
+		  DONE
+		  (unless (zerop (tn-offset y))
+			  (inst fstd y))))))
+	  (frob fsin  %sin fsin)
+	  (frob fcos  %cos fcos))
+	     
+(define-vop (ftan)
+  (:translate %tan)
   (:args (x :scs (double-reg) :target fr0))
   (:temporary (:sc double-reg :offset fr0-offset
 		   :from :argument :to :result) fr0)
   (:temporary (:sc double-reg :offset fr1-offset
 		   :from :argument :to :result) fr1)
+  (:temporary (:sc dword-reg :offset eax-offset
+		   :from :argument :to :result) eax)
   (:results (y :scs (double-reg)))
   (:arg-types double-float)
   (:result-types double-float)
+  (:ignore eax)
   (:policy :fast-safe)
   (:note "inline tan function")
   (:vop-var vop)
   (:save-p :compute-only)
+  (:ignore eax)
   (:generator 5
     (note-this-location vop :internal-error)
     (case (tn-offset x)
@@ -1808,15 +1886,22 @@
 				   :sc (sc-or-lose 'double-reg)
 				   :offset (- (tn-offset x) 2)))))
     (inst fptan)
+    (inst fnstsw)			 ; status word to %ea
+    (inst and ah-tn #x04)		 ; C2
+    (inst jmp :z DONE)
+    ;; Else x was out of range so reduce it; ST0 is unchanged.
+    (inst fldz)                         ; Load 0.0
+    (inst fxch fr1)
+    DONE
     ;; Result is in fr1
     (case (tn-offset y)
-      (0
-       (inst fxch fr1))
-      (1)
-      (t
-       (inst fxch fr1)
-       (inst fstd y)))))
-	     
+       (0
+	(inst fxch fr1))
+       (1)
+       (t
+	(inst fxch fr1)
+	(inst fstd y)))))
+
 #+nil
 (define-vop (fexp)
   (:translate %exp)
-- 
GitLab