From 0b3f5cc5fa9e6b121d232960ccd964d2eb15f695 Mon Sep 17 00:00:00 2001 From: Paul Khuong Date: Fri, 24 May 2013 16:45:57 -0400 Subject: [PATCH] Revert "Fix (aref vector (+ i constant)) with i negative on x86oids" This reverts commit 5d3a728a1d9a91e7218fe53f12f96ab63b846810. The current code is still wrong, but better the bugs we've always had than the ones that break currently-working code. Kept the test case, and added the one we failed on. --- NEWS | 2 -- src/compiler/fndb.lisp | 4 ++-- src/compiler/generic/vm-fndb.lisp | 4 ++-- src/compiler/generic/vm-tran.lisp | 16 ++++++---------- tests/compiler.pure.lisp | 12 +++++++++++- 5 files changed, 21 insertions(+), 17 deletions(-) diff --git a/NEWS b/NEWS index 6a36c16..a2e9a56 100644 --- a/NEWS +++ b/NEWS @@ -73,8 +73,6 @@ changes relative to sbcl-1.1.7: about a constant NIL (similar for non-EQ-comparable catch tags). * bug fix: Referring to INLINE global functions as values should not result in a compilation failure. (lp#1035721) - * bug fix: Known-safe vector access on x86oids should not fail spuriously - when the index is of the form (+ x constant-positive-integer). * optimization: faster ISQRT on fixnums and small bignums * optimization: faster and smaller INTEGER-LENGTH on fixnums on x86-64. * optimization: On x86-64, the number of multi-byte NOP instructions used diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index 5a4e4eb..1aef68d 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -1477,11 +1477,11 @@ (movable foldable flushable dx-safe)) (defknown data-vector-ref (simple-array index) t (foldable explicit-check always-translatable)) -(defknown data-vector-ref-with-offset (simple-array fixnum fixnum) t +(defknown data-vector-ref-with-offset (simple-array index fixnum) t (foldable explicit-check always-translatable)) (defknown data-vector-set (array index t) t (explicit-check always-translatable)) -(defknown data-vector-set-with-offset (array fixnum fixnum t) t +(defknown data-vector-set-with-offset (array index fixnum t) t (explicit-check always-translatable)) (defknown hairy-data-vector-ref (array index) t (foldable explicit-check)) diff --git a/src/compiler/generic/vm-fndb.lisp b/src/compiler/generic/vm-fndb.lisp index 003dc37..37273c1 100644 --- a/src/compiler/generic/vm-fndb.lisp +++ b/src/compiler/generic/vm-fndb.lisp @@ -287,7 +287,7 @@ (defknown %bignum-ref (bignum-type bignum-index) bignum-element-type (flushable)) #!+(or x86 x86-64) -(defknown %bignum-ref-with-offset (bignum-type fixnum (signed-byte 24)) +(defknown %bignum-ref-with-offset (bignum-type bignum-index (signed-byte 24)) bignum-element-type (flushable always-translatable)) (defknown %bignum-set (bignum-type bignum-index bignum-element-type) @@ -295,7 +295,7 @@ ()) #!+(or x86 x86-64) (defknown %bignum-set-with-offset - (bignum-type fixnum (signed-byte 24) bignum-element-type) + (bignum-type bignum-index (signed-byte 24) bignum-element-type) bignum-element-type (always-translatable)) (defknown %digit-0-or-plusp (bignum-element-type) boolean diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp index 7984b71..c4044a3 100644 --- a/src/compiler/generic/vm-tran.lisp +++ b/src/compiler/generic/vm-tran.lisp @@ -50,24 +50,20 @@ index offset &optional setter-p) (multiple-value-bind (func index-args) (extract-fun-args index '(+ -) 2) (destructuring-bind (x constant) index-args - (unless (and (constant-lvar-p constant) - ;; the remaining argument must be a fixnum, otherwise we lose - (csubtypep (lvar-type x) (specifier-type 'fixnum))) - (delay-ir1-transform :constraint) + (declare (ignorable x)) + (unless (constant-lvar-p constant) (give-up-ir1-transform)) - (let ((value (lvar-value constant)) - new-offset) + (let ((value (lvar-value constant))) (unless (and (integerp value) (sb!vm::foldable-constant-offset-p element-size lowtag data-offset - (setf new-offset (funcall func (lvar-value offset) value)))) + (funcall func value (lvar-value offset)))) (give-up-ir1-transform "constant is too large for inlining")) (splice-fun-args index func 2) `(lambda (thing index off1 off2 ,@(when setter-p '(value))) - (declare (ignore off1 off2)) - (,fun-name thing index ',new-offset ,@(when setter-p - '(value)))))))) + (,fun-name thing index (,func off2 off1) ,@(when setter-p + '(value)))))))) #!+(or x86 x86-64) (deftransform sb!bignum:%bignum-ref-with-offset diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index 6ffdf0a..bccf8ef 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -4568,9 +4568,19 @@ (test (- most-positive-fixnum x) y) (test (+ most-negative-fixnum x) y)))))) -(test-util:with-test (:name :fold-index-addressing-positive-offset) +;; expected failure +(test-util:with-test (:name :fold-index-addressing-positive-offset + :fails-on '(and)) (let ((f (compile nil `(lambda (i) (if (typep i '(integer -31 31)) (aref #. (make-array 63) (+ i 31)) (error "foo")))))) (funcall f -31))) + +;; 5d3a728 broke something like this in CL-PPCRE +(test-util:with-test (:name :fold-index-addressing-potentially-negative-index) + (compile nil `(lambda (index vector) + (declare (optimize speed (safety 0)) + ((simple-array character (*)) vector) + ((unsigned-byte 24) index)) + (aref vector (1+ (mod index (1- (length vector)))))))) -- 1.7.10.4