Changeset 14226

Timestamp:

Aug 30, 2010, 3:26:03 PM (9 years ago)

Author:

rme

Message:

Merge r14224 (ATAN fixes) from trunk.

Location:

release/1.5/source

Files:

• . (modified) (1 prop)
• cocoa-ide (modified) (1 prop)
• level-0/l0-float.lisp (modified) (3 diffs)

release/1.5/source/level-0/l0-float.lisp

@@ -911 +911 @@
 
 (eval-when (:execute :compile-toplevel)
+  (defconstant single-float-pi (coerce pi 'single-float))
   (defconstant double-float-half-pi (asin 1.0d0))
   (defconstant single-float-half-pi (asin 1.0f0))
@@ -964 +965 @@
 
 
-(defun %df-atan2 (y x &optional result)
+(defun %df-atan2 (y x)
   (if (zerop x)
     (if (zerop y)
       (if (plusp (float-sign x))
-        y
+        (if (eql y -0.0d0)
+          -0.0d0
+          0.0d0)
         (float-sign y pi))
       (float-sign y double-float-half-pi))
-    (%double-float-atan2! y x (or result (%make-dfloat)))))
+    (%double-float-atan2! y x (%make-dfloat))))
 
 #+32-bit-target
-(defun %sf-atan2! (y x &optional result)
+(defun %sf-atan2! (y x)
   (if (zerop x)
     (if (zerop y)
       (if (plusp (float-sign x))
-        y
-        (float-sign y pi))
+        ;; Don't return Y (which may be stack-consed) here.
+        ;; We know that (ZEROP Y) is true, so:
+        (if (eql y -0.0s0)
+          -0.0s0
+          0.0s0)
+        (float-sign y single-float-pi))
       (float-sign y single-float-half-pi))
-    (%single-float-atan2! y x (or result (%make-sfloat)))))
+    (%single-float-atan2! y x (%make-sfloat))))
 
 #+64-bit-target
@@ -989 +996 @@
       (if (plusp (float-sign x))
         y
-        (float-sign y pi))
+        (float-sign y single-float-pi))
       (float-sign y single-float-half-pi))
     (%single-float-atan2 y x)))