From: Nathan F. <nf...@us...> - 2007-04-10 13:50:51
|
Update of /cvsroot/sbcl/sbcl/tests In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv27991/tests Modified Files: seq.impure.lisp Log Message: 1.0.4.55: Optimized REPLACE and UB*-BASH-COPY routines * Expand simple cases of UB*-BASH-COPY inline to avoid full call overhead and generate better code generally; * Handle more cases of REPLACE; we now optimize REPLACE on all simple specialized array types (only element types <= n-word-bits are handled generally, though); * Use a single COPY-SEQ and SUBSEQ transform rather than one per specialized array type; generate inline copies for these too when possible; * Tests; * Backend cleanup: introduce a FIND-SAETP to eliminate duplicate code; * Backend cleanup: change %{SET-,}VECTOR-RAW-BITS on x86 to use the *-WITH-OFFSET machinery. Index: seq.impure.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/seq.impure.lisp,v retrieving revision 1.33 retrieving revision 1.34 diff -u -d -r1.33 -r1.34 --- seq.impure.lisp 3 Mar 2007 17:21:59 -0000 1.33 +++ seq.impure.lisp 10 Apr 2007 13:50:46 -0000 1.34 @@ -1011,12 +1011,68 @@ ;; Too slow for the interpreter #+#.(cl:if (cl:eq sb-ext:*evaluator-mode* :compile) '(and) '(or)) (loop for i = 1 then (* i 2) do - ;; the bare '32' here is fairly arbitrary; '8' provides a good - ;; range of lengths over which to fill and copy, which should tease - ;; out most errors in the code (if any exist). (It also makes this - ;; part of the test suite finish reasonably quickly.) - (assert (test-fill-bashing i 32 8)) - (assert (test-copy-bashing i 32 8)) + ;; the bare '13' here is fairly arbitrary, except that it's been + ;; reduced from '32', which made the tests take aeons; '8' provides + ;; a good range of lengths over which to fill and copy, which + ;; should tease out most errors in the code (if any exist). (It + ;; also makes this part of the test suite finish reasonably + ;; quickly.) + (assert (time (test-fill-bashing i 13 8))) + (assert (time (test-copy-bashing i 13 8))) until (= i sb-vm:n-word-bits)) + +(defun test-inlined-bashing (bitsize) + ;; We have to compile things separately for each bitsize so the + ;; compiler will work out the array type and trigger the REPLACE + ;; transform. + (let ((lambda-form + `(lambda () + (let* ((n-elements-per-word ,(truncate sb-vm:n-word-bits bitsize)) + (size (* 3 n-elements-per-word)) + (standard-dst (make-array size :element-type '(unsigned-byte ,bitsize))) + (bashed-dst (make-array size :element-type '(unsigned-byte ,bitsize))) + (source (make-array size :element-type '(unsigned-byte ,bitsize)))) + (declare (type (simple-array (unsigned-byte ,bitsize) (*)) + source standard-dst bashed-dst)) + (do ((i 0 (1+ i)) + (offset n-elements-per-word (1+ offset))) + ((>= offset (* 2 n-elements-per-word)) t) + (dolist (c (fill-bytes-for-testing ,bitsize)) + (fill-with-known-value (mod (lognot c) (ash 1 ,bitsize)) size + source standard-dst bashed-dst) + ;; fill with test-data + (fill source c :start offset :end (+ offset n-elements-per-word)) + ;; copy filled data to test vectors + ;; + ;; a) the slow way (which is actually fast, since this + ;; should be transformed into UB*-BASH-COPY) + (replace standard-dst source + :start1 (- offset n-elements-per-word i) + :start2 (- offset n-elements-per-word i) + :end1 offset :end2 offset) + ;; b) the fast way--we fold the + ;; :START{1,2} arguments above ourselves + ;; to trigger the REPLACE transform + (replace bashed-dst source + :start1 0 :start2 0 :end1 offset :end2 offset) + ;; check for errors + (when (or (mismatch standard-dst bashed-dst) + ;; trigger COPY-SEQ transform + (mismatch (copy-seq standard-dst) bashed-dst) + ;; trigger SUBSEQ transform + (mismatch (subseq standard-dst (- offset n-elements-per-word i)) + bashed-dst)) + (format t "Test with target-offset ~A, source-offset ~A, fill ~A, and length ~A failed.~%" + 0 0 c offset) + (format t "Mismatch:~% correct ~A~% actual ~A~%" + standard-dst + bashed-dst) + (return-from nil nil)))))))) + (funcall (compile nil lambda-form)))) + +#+#.(cl:if (cl:eq sb-ext:*evaluator-mode* :compile) '(and) '(or)) +(loop for i = 1 then (* i 2) do + (assert (test-inlined-bashing i)) + until (= i sb-vm:n-word-bits)) ;;; success |