bit-ldb

bit-ldb.lisp

(defun bit-ldb (vector byte-spec)
           (loop
             for idx downfrom (- (length vector) (byte-position byte-spec) 1) 
             for pos from 0 below (byte-size byte-spec)
             unless (zerop (bit vector idx)) sum (ash 1 pos)))

(define-setf-expander bit-ldb (vector bytespec &environment env)
           "Set some bits in a bit-vector to a value based on a bytespec"
           (multiple-value-bind (dummies vals newval setter getter)
               (get-setf-expansion vector env)
             (let ((store (gensym))
                   (pos (gensym "POS"))
                   (idx (gensym "IDX"))
                   (byte-temp (gensym)))
               (values
                `(,byte-temp ,@dummies)
                `(,bytespec ,@vals)
                `(,store)
                `(loop
                   for ,idx downfrom (- (length ,getter) (byte-position ,byte-temp) 1) 
                   for ,pos from 0
                   repeat (byte-size ,byte-temp)
                   do (setf (bit ,getter ,idx) (ldb (byte 1 ,pos) ,store))
                   finally (return ,store))
                `(bit-ldb ,byte-temp ,getter)))))