repair for eqv? on an immediate flonum

original commit: fd544591c6d8ba59456d5cbe6e9fc7fc010410f2
This commit is contained in:
Matthew Flatt 2019-02-02 13:35:30 -07:00
parent 627c809de4
commit 3db5d5ab2d

View File

@ -6053,6 +6053,7 @@
(lambda (e1 e2) (lambda (e1 e2)
(nanopass-case (L7 Expr) e1 (nanopass-case (L7 Expr) e1
[(quote ,d) (and (flonum? d) [(quote ,d) (and (flonum? d)
(bind #t (e2)
(build-and (build-and
(%type-check mask-flonum type-flonum ,e2) (%type-check mask-flonum type-flonum ,e2)
(if ($nan? d) (if ($nan? d)
@ -6062,7 +6063,6 @@
;; Non-NaN: compare bits ;; Non-NaN: compare bits
(constant-case ptr-bits (constant-case ptr-bits
[(32) [(32)
(bind #t (e2)
(let ([d0 (if (eq? (constant-case native-endianness) (native-endianness)) 0 4)]) (let ([d0 (if (eq? (constant-case native-endianness) (native-endianness)) 0 4)])
(let ([word1 ($object-ref 'iptr d (fx+ (constant flonum-data-disp) d0))] (let ([word1 ($object-ref 'iptr d (fx+ (constant flonum-data-disp) d0))]
[word2 ($object-ref 'iptr d (fx+ (constant flonum-data-disp) (fx- 4 d0)))]) [word2 ($object-ref 'iptr d (fx+ (constant flonum-data-disp) (fx- 4 d0)))])
@ -6072,7 +6072,7 @@
(immediate ,word1)) (immediate ,word1))
(%inline eq? (%inline eq?
,(%mref ,e2 ,(fx+ (constant flonum-data-disp) 4)) ,(%mref ,e2 ,(fx+ (constant flonum-data-disp) 4))
(immediate ,word2))))))] (immediate ,word2)))))]
[(64) [(64)
(let ([word ($object-ref 'iptr d (constant flonum-data-disp))]) (let ([word ($object-ref 'iptr d (constant flonum-data-disp))])
(%inline eq? (%inline eq?
@ -6080,7 +6080,7 @@
(immediate ,word)))] (immediate ,word)))]
[else ($oops 'compiler-internal [else ($oops 'compiler-internal
"eqv doesn't handle ptr-bits = ~s" "eqv doesn't handle ptr-bits = ~s"
(constant ptr-bits))]))))] (constant ptr-bits))])))))]
[else #f]))) [else #f])))
(define eqok-help? (define eqok-help?
(lambda (obj) (lambda (obj)