From: Taylor R Campbell Date: Tue, 4 Jun 2013 17:17:28 +0000 (+0000) Subject: Fix i386 and amd64 lapgen rules to load negative zero correctly. X-Git-Tag: release-9.2.0~163 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=4b1d1e5b1980f154a5f3e72aa31d1bce346a0204;p=mit-scheme.git 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 a407f7497..e6258b6d0 100644 --- 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))))) - + (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 7cd217863..0a3fd79d1 100644 --- 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))) - + (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