Raymond Toy pushed to branch master at cmucl / cmucl Commits: 3c373507 by Raymond Toy at 2015-10-16T21:33:50Z Fix data-vector-set-c for unsigned-byte 1, 2, and 4 For simple-arrays of 1, 2, or 4-bit elements, data-vector-set-c was incorrectly merging the new value into the array when the index is a multiple of the number of elements per (32-bit) word. Thus, for 4-bit elements, the new value was not merged in when the index is a multiple of 8. In these cases, there's no need to shift the array value or the new value to move them into the correct place. When the shift is zero, the code accidentally removed the part that merges in the new value. Fix #10. - - - - - b239ce3f by Raymond Toy at 2015-10-16T21:35:16Z Add tests for issue #10. Covers 1, 2, and 4-bit arrays. Manually verified that the cmucl 21a fails these tests, as expected, when the index is a multiple of the number of elements per 32-bit word. - - - - - 2 changed files: - src/compiler/x86/array.lisp - tests/issues.lisp Changes: ===================================== src/compiler/x86/array.lisp ===================================== --- a/src/compiler/x86/array.lisp +++ b/src/compiler/x86/array.lisp @@ -288,9 +288,10 @@ (unsigned-reg (let ((shift (* extra ,bits))) (unless (zerop shift) - (inst ror old shift) - (inst and old (lognot ,(1- (ash 1 bits)))) - (inst or old value) + (inst ror old shift)) + (inst and old (lognot ,(1- (ash 1 bits)))) + (inst or old value) + (unless (zerop shift) (inst rol old shift))))) (inst mov (make-ea :dword :base object :disp (- (* (+ word vector-data-offset) word-bytes) ===================================== tests/issues.lisp ===================================== --- a/tests/issues.lisp +++ b/tests/issues.lisp @@ -119,3 +119,84 @@ (let ((z (list 1 2))) (flet ((frob (x) (cdr x))) (xpop (frob z)))))) + +(define-test issue.10-unsigned-byte-4 + (:tag :issues) + (macrolet + ((compiled-test-function (constant-index) + ;; Compile the test function from the issue. + (compile nil `(lambda (v x) + (declare (type (integer 0 5) v) + (optimize (safety 0))) + (setf (aref (the (simple-array (integer 0 5) (1)) x) + ,constant-index) + (the (integer 0 5) v)) + x))) + (make-tests () + ;; Create a set of tests for a set of fixed constant indices, + ;; one test for each constant index from 0 to 15. + (let (tests) + (dotimes (k 16) + (push + `(assert-equal 1 + (aref (funcall (compiled-test-function ,k) + 1 + (make-array 16 :element-type '(integer 0 5) :initial-element 0)) + ,k)) + tests)) + `(progn ,@(nreverse tests))))) + (make-tests))) + +(define-test issue.10-unsigned-byte-2 + (:tag :issues) + (macrolet + ((compiled-test-function (constant-index) + ;; Compile the test function from the issue. + (compile nil `(lambda (v x) + (declare (type (integer 0 2) v) + (optimize (safety 0))) + (setf (aref (the (simple-array (integer 0 2) (1)) x) + ,constant-index) + (the (integer 0 2) v)) + x))) + (make-tests () + ;; Create a set of tests for a set of fixed constant indices, + ;; one test for each constant index from 0 to 31. + (let (tests) + (dotimes (k 32) + (push + `(assert-equal 1 + (aref (funcall (compiled-test-function ,k) + 1 + (make-array 32 :element-type '(integer 0 2) :initial-element 0)) + ,k)) + tests)) + `(progn ,@(nreverse tests))))) + (make-tests))) + +(define-test issue.10-unsigned-byte-1 + (:tag :issues) + (macrolet + ((compiled-test-function (constant-index) + ;; Compile the test function from the issue. + (compile nil `(lambda (v x) + (declare (type (integer 0 1) v) + (optimize (safety 0))) + (setf (aref (the (simple-array (integer 0 1) (1)) x) + ,constant-index) + (the (integer 0 1) v)) + x))) + (make-tests () + ;; Create a set of tests for a set of fixed constant indices, + ;; one test for each constant index from 0 to 31. + (let (tests) + (dotimes (k 64) + (push + `(assert-equal 1 + (aref (funcall (compiled-test-function ,k) + 1 + (make-array 64 :element-type '(integer 0 1) :initial-element 0)) + ,k)) + tests)) + `(progn ,@(nreverse tests))))) + (make-tests))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/704b1ae0c0a023bf315a96524...