Fix i386 and amd64 lapgen rules to load negative zero correctly.

diff --git a/src/compiler/machines/i386/rulflo.scm b/src/compiler/machines/i386/rulflo.scm
index a407f7497d9db45ac2db9ccc3c6f87797f7e95c7..e6258b6d076ea30b12154efa2a940c9ef9ed7586 100644 (file)
--- a/src/compiler/machines/i386/rulflo.scm
+++ b/src/compiler/machines/i386/rulflo.scm
@@ -809,12 +809,14 @@ USA.
   (flonum->label fp-value 'SINGLE-FLOATS 4 0
                 (LAP ,@(lap:comment `(SINGLE-FLOAT ,fp-value))
                      (LONG U ,(flo:32-bit-representation-exact? fp-value)))))
-\f                                   
+\f
 (define-rule statement
   (ASSIGN (REGISTER (? target)) (OBJECT->FLOAT (CONSTANT (? fp-value))))
   (cond ((not (flo:flonum? fp-value))
         (error "OBJECT->FLOAT: Not a floating-point value" fp-value))
-       ((flo:= fp-value 0.0)
+       ((and (flo:= fp-value 0.0)
+              ;; XXX Kludgey but expedient test for zero sign.
+              (not (flo:negative? (flo:atan2 x -1.))))
         (let ((target (flonum-target! target)))
           (LAP (FLDZ)
                (FSTP (ST ,(1+ target))))))

diff --git a/src/compiler/machines/x86-64/rulflo.scm b/src/compiler/machines/x86-64/rulflo.scm
index 7cd2178631ac0f98e6d4f4df3a28702828f47930..0a3fd79d11da1901b6e511dd00ba5241b658f0e9 100644 (file)
--- a/src/compiler/machines/x86-64/rulflo.scm
+++ b/src/compiler/machines/x86-64/rulflo.scm
@@ -353,12 +353,14 @@ USA.
     (else
      (error "flonum-branch!: Unknown predicate" predicate)))
   (LAP (UCOMIF S D ,source1 ,source2)))
-\f                                   
+\f
 (define-rule statement
   (ASSIGN (REGISTER (? target)) (OBJECT->FLOAT (CONSTANT (? fp-value))))
   (cond ((not (flo:flonum? fp-value))
          (error "OBJECT->FLOAT: Not a floating-point value" fp-value))
-        ((flo:= fp-value 0.0)
+        ((and (flo:= fp-value 0.0)
+              ;; XXX Kludgey but expedient test for zero sign.
+              (not (flo:negative? (flo:atan2 x -1.))))
          (let ((target (flonum-target-reference! target)))
            (LAP (XORF P D ,target ,target))))
         (else