;;; Newsgroups: comp.lang.lisp
;;; From: Daniel Janus <przesunma...@nathell.korpus.pl>
;;; Date: Sun, 11 Feb 2007 01:58:19 +0000 (UTC)
;;; Local: Sun, Feb 11 2007 2:58 am
;;; Subject: WITH-BITFIELDS: handling of C99-like structures of packed bitfields

;; Hello Lispniks,
;; 
;; I just stumbled upon the following problem: how to quickly read and parse
;; a binary file containing fixed-size structures of bit fields, written by
;; a C program on a little-endian architecture?  
;; 
;; I started with writing a function that parses several consecutive bytes
;; from a given array, then twiddled it around for some time until
;; it worked reasonably fast and with as little consing as possible.
;; Then I realized it could be reasonably generalized to a macro.  
;; Here it is; feel free to use it for anything (I place the code into
;; public domain):

(defmacro with-bitfields (sequence ofs bit-descriptions &body body)
  "Bind variables as integer values of bit fields in a given SEQUENCE.
SEQUENCE should be an array of integers (most likely 8-bit bytes).
OFS is the starting offset of a bit-field structure.  Each field
description in BIT-DESCRIPTIONS is a two-element list: first element
specifies the name of a variable, while second elements marks the
number of bits in a corresponding bit field.  BODY is executed with
variables bound to values of their respective bit fields."
  (let ((%offset (gensym)))
    `(let ((,%offset ,ofs))
      ,(iter outer
             (for (name length) in bit-descriptions)    
             (with offset = 0)
             (with byte = 0)
             (let ((summed-bytes
                    (iter
                      (for i from offset below length by 8)
                      (collect
                          (let* ((x (- length i))
                                 (aref-expr `(aref ,sequence ,(if (= byte 0) %offset `(+ ,%offset ,byte))))
                                 (shifted-expr
                                  (if (< x 8)
                                      `(ldb (byte ,x 0) ,aref-expr)
                                      aref-expr)))
                            (if (= i 0)
                                shifted-expr
                                `(ash ,shifted-expr ,i))))
                      (incf byte)
                      (finally (setf offset (- i 8))))))
               (collect
                   `(,name ,(if (cdr summed-bytes)
                                `(+ ,@summed-bytes)
                                (car summed-bytes)))
                 into let-clauses))
             (decf offset length)
             (if (= offset -8)
                 (setf offset 0)
                 (decf byte))
             (finally
              (return-from outer
                `(let ,let-clauses ,@body)))))))

;; Using WITH-BITFIELDS, I have been able to parse my structure
;; (four unsigned bitfields: one 1-bit and three 21-bit, 8 bytes
;; total) in the following way:
;; 
;; (with-bitfields array ofs
;;     ((field-1 1)
;;      (field-2 21)
;;      (field-3 21)
;;      (field-4 21))
;;   (do-something field-1 field-2 field-3 field-4))
;; 
;; which does no consing except for what DO-SOMETHING does,
;; and is very fast (around 60 million decoded structures per second
;; on my Celeron 2.4GHz) when compiled with SBCL 1.0 with maximum
;; speed settings and DO-SOMETHING a noop.
;; 
;; I hope somebody will find it useful.  Comments are welcome.
;; 
;; -- 
;; Daniel 'Nathell' Janus, GG #1631668, przesunma...@nathell.korpus.pl
;; "Though a program be but three lines long, someday it will have to be
;; maintained."
;;       -- The Tao of Programming