From d446dd586b59edea428d612ad76267b9c1cacd9b Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Wed, 12 Sep 2007 16:14:16 +0000 Subject: [PATCH] 1.0.9.59: Fix ash/smod61 on x86-64 for constant large shifts. Thanks to Paul Khuong for the translation. --- NEWS | 3 ++- src/compiler/x86-64/arith.lisp | 27 ++++++++++++++------------- version.lisp-expr | 2 +- 3 files changed, 17 insertions(+), 15 deletions(-) diff --git a/NEWS b/NEWS index 33cdc48..447969d 100644 --- a/NEWS +++ b/NEWS @@ -30,7 +30,8 @@ changes in sbcl-1.0.10 relative to sbcl-1.0.9: * bug fix: copy propagation interfered with parallel assignment semantics in local calls. (reported by Paul Khuong) * bug fix: the signed modular fixnum shift compiled to wrong code on - x86. (spotted by a slight modification to some of PFD's tests) + x86 and x86-64. (spotted by a slight modification to some of + PFD's random tests) changes in sbcl-1.0.9 relative to sbcl-1.0.8: * minor incompatible change: SB-SYS:OUTPUT-RAW-BYTES is deprecated. diff --git a/src/compiler/x86-64/arith.lisp b/src/compiler/x86-64/arith.lisp index 3e55ac2..1f63042 100644 --- a/src/compiler/x86-64/arith.lisp +++ b/src/compiler/x86-64/arith.lisp @@ -600,19 +600,20 @@ (inst lea result (make-ea :qword :index number :scale 8))) (t (move result number) - (cond ((plusp amount) - ;; We don't have to worry about overflow because of the - ;; result type restriction. - (inst shl result amount)) - (t - ;; Since the shift instructions take the shift amount - ;; modulo 64 we must special case amounts of 64 and more. - ;; Because fixnums have only 61 bits, the result is 0 or - ;; -1 for all amounts of 60 or more, so use this as the - ;; limit instead. - (inst sar result (min (- n-word-bits n-fixnum-tag-bits 1) - (- amount))) - (inst and result (lognot fixnum-tag-mask)))))))) + (cond ((< -64 amount 64) + ;; this code is used both in ASH and ASH-SMOD61, so + ;; be careful + (if (plusp amount) + (inst shl result amount) + (progn + (inst sar result (- amount)) + (inst and result (lognot fixnum-tag-mask))))) + ((plusp amount) + (if (sc-is result any-reg) + (inst xor result result) + (inst mov result 0))) + (t (inst sar result 63) + (inst and result (lognot fixnum-tag-mask)))))))) (define-vop (fast-ash-left/fixnum=>fixnum) (:translate ash) diff --git a/version.lisp-expr b/version.lisp-expr index 1564240..2774615 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.9.58" +"1.0.9.59" -- 1.7.10.4