Skip to content

Instantly share code, notes, and snippets.

@tail-call
Created June 2, 2023 18:43
Show Gist options
  • Save tail-call/a3ab0bb5750f218a4bdf2a40416f3e93 to your computer and use it in GitHub Desktop.
Save tail-call/a3ab0bb5750f218a4bdf2a40416f3e93 to your computer and use it in GitHub Desktop.
(defconstant ~bad-number~ (integer->bit-vector #xEDB88320)
"Used in CRC computation.")
;; From https://lispforum.com/viewtopic.php?p=6269#p6269
(defun integer->bit-vector (integer)
"Create a bit-vector from a positive integer."
(labels ((integer->bit-list (int &optional accum)
(cond ((> int 0)
(multiple-value-bind (i r) (truncate int 2)
(integer->bit-list i (push r accum))))
((null accum) (push 0 accum))
(t accum))))
(coerce (integer->bit-list integer) 'bit-vector)))
(defun bit-vector->integer (bit-vector)
"Creates a positive integer from a bit-vector."
(let ((result 0)
(multiplier 1))
(loop for i
from (1- (length bit-vector))
downto 0
do (let ((element (aref bit-vector i)))
(setf result (+ result (* multiplier element)))
(setf multiplier (* 2 multiplier))))
result))
(defun drop-last (sequence count)
(remove-if (lambda (-) t)
sequence
:count count
:from-end t))
(defun make-byte ()
#*00000000)
(defun bit-pad-left (sequence item count)
(let ((padding (make-array count :initial-element item)))
(concatenate '(vector bit) padding sequence)))
(defun force-n-bits (n bit-vector)
(bit-pad-left bit-vector 0 (- n (length bit-vector))))
(defun integer->bit32 (integer)
(force-n-bits 32 (integer->bit-vector integer)))
(defun make-crc-table ()
"Make the table for a fast CRC."
(let ((c (force-n-bits 32 #*0))
(crc-table (make-array 256)))
(loop for n from 0 to 255
do (progn
(setf c (integer->bit32 n))
(loop for k from 0 to 7
do (if (equal (bit-and c (integer->bit32 1)) (integer->bit32 1))
(setf c (bit-xor ~bad-number~
(force-n-bits 32 (drop-last c 1))))
(setf c (force-n-bits 32 (drop-last c 1)))))
(setf (aref crc-table n) c)
(setf *crc-table-computed* t)))
crc-table))
(defun fill-32 (bit)
(make-array 32 :element-type 'bit :initial-element bit))
(defun update-crc (crc sequence crc-table)
"Update a running crc with the bytes buf[0..len-1] and return
the updated crc. The crc should be initialized to zero.
post-conditioning (one's complement) is performed within this
function so it shouldn't be done by the caller."
(let ((c (bit-xor crc (fill-32 1))))
(loop for n from 0 to (1- (length sequence))
do (setf c
(bit-xor (aref crc-table (bit-vector->integer
(bit-and (force-n-bits 32 #*11111111)
(bit-xor c (force-n-bits 32 (integer->bit-vector (aref sequence n)))))))
(force-n-bits 32 (drop-last c 8)))))
(bit-xor c (fill-32 1))))
(defun crc-32 (data)
(bit-vector->integer (update-crc (fill-32 0) data (make-crc-table))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment