From ba319c3d8531b10c30f794942c817443c9a7a078 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Fri, 30 Dec 2011 15:07:14 +0200 Subject: [PATCH] use %VECTOR-RAW-BITS in %BIT-POSITION/[0|1] No need to pin, and it even performs a tiny bit better than using explicit word -> byte address computations. --- src/code/bit-bash.lisp | 77 +++++++++++++++++++++++------------------------- src/pcl/defclass.lisp | 11 ++++--- 2 files changed, 42 insertions(+), 46 deletions(-) diff --git a/src/code/bit-bash.lisp b/src/code/bit-bash.lisp index 909db1f..30c3c5b 100644 --- a/src/code/bit-bash.lisp +++ b/src/code/bit-bash.lisp @@ -600,8 +600,8 @@ ;;;; ;;;; Similar search would work well for base-strings as well. ;;;; (Technically for all unboxed sequences of sub-word size elements, -;;;; but somehow I doubt other eg. octet vectors get POSIION or FIND -;;;; used as much on them.) +;;;; but somehow I doubt eg. octet vectors get POSITION or FIND used +;;;; as much on them.) (defconstant +bit-position-base-mask+ (1- n-word-bits)) (defconstant +bit-position-base-shift+ (integer-length +bit-position-base-mask+)) (macrolet ((def (name frob) @@ -638,55 +638,52 @@ (logior i (truly-the fixnum (ash word-offset +bit-position-base-shift+))))) - (get-word (sap offset) - (,@frob (sap-ref-word sap (* n-word-bytes offset))))) + (get-word (offset) + (,@frob (%vector-raw-bits vector offset)))) (declare (inline start-bit end-bit get-word)) - (with-pinned-objects (vector) - (if from-end - ;; Back to front - (let* ((sap (vector-sap vector)) - (word-offset last-word) - (word (logand end-mask (get-word sap word-offset)))) - (declare (word word) - (index word-offset)) + (if from-end + ;; Back to front + (let* ((word-offset last-word) + (word (logand end-mask (get-word word-offset)))) + (declare (word word) + (index word-offset)) + (unless (zerop word) + (when (= word-offset first-word) + (setf word (logand word start-mask))) + (unless (zerop word) + (found (end-bit word) word-offset))) + (decf word-offset) + (loop + (when (< word-offset first-word) + (return-from ,name nil)) + (setf word (get-word word-offset)) (unless (zerop word) (when (= word-offset first-word) (setf word (logand word start-mask))) (unless (zerop word) (found (end-bit word) word-offset))) - (decf word-offset) - (loop - (when (< word-offset first-word) - (return-from ,name nil)) - (setf word (get-word sap word-offset)) - (unless (zerop word) - (when (= word-offset first-word) - (setf word (logand word start-mask))) - (unless (zerop word) - (found (end-bit word) word-offset))) - (decf word-offset))) - ;; Front to back - (let* ((sap (vector-sap vector)) - (word-offset first-word) - (word (logand start-mask (get-word sap word-offset)))) - (declare (word word) - (index word-offset)) + (decf word-offset))) + ;; Front to back + (let* ((word-offset first-word) + (word (logand start-mask (get-word word-offset)))) + (declare (word word) + (index word-offset)) + (unless (zerop word) + (when (= word-offset last-word) + (setf word (logand word end-mask))) + (unless (zerop word) + (found (start-bit word) word-offset))) + (incf word-offset) + (loop + (when (> word-offset last-word) + (return-from ,name nil)) + (setf word (get-word word-offset)) (unless (zerop word) (when (= word-offset last-word) (setf word (logand word end-mask))) (unless (zerop word) (found (start-bit word) word-offset))) - (incf word-offset) - (loop - (when (> word-offset last-word) - (return-from ,name nil)) - (setf word (get-word sap word-offset)) - (unless (zerop word) - (when (= word-offset last-word) - (setf word (logand word end-mask))) - (unless (zerop word) - (found (start-bit word) word-offset))) - (incf word-offset))))))))))) + (incf word-offset)))))))))) (def %bit-position/0 (logandc2 #.(1- (expt 2 n-word-bits)))) (def %bit-position/1 (identity))) (defun %bit-position (bit vector from-end start end) diff --git a/src/pcl/defclass.lisp b/src/pcl/defclass.lisp index e342b6e..33bfd0b 100644 --- a/src/pcl/defclass.lisp +++ b/src/pcl/defclass.lisp @@ -312,12 +312,11 @@ ;; that :WHERE-FROM is :DEFINED, not :DECLARED, and should ;; probably be factored into a common function -- eg. ;; (%proclaim-ftype name declared-or-defined). - (with-single-package-locked-error (:symbol name "proclaiming ~S as a function") - (when (eq (info :function :where-from name) :assumed) - (proclaim-as-fun-name name) - (note-name-defined name :function) - (setf (info :function :where-from name) :defined - (info :function :type name) type))))) + (when (eq (info :function :where-from name) :assumed) + (proclaim-as-fun-name name) + (note-name-defined name :function) + (setf (info :function :where-from name) :defined + (info :function :type name) type)))) (let ((rtype (specifier-type '(function (t) t))) (wtype (specifier-type '(function (t t) t)))) (dolist (reader readers) -- 1.7.10.4