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.

diff --git a/src/code/bit-bash.lisp b/src/code/bit-bash.lisp
index 909db1f..30c3c5b 100644 (file)
--- 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 (file)
--- 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)