107 lines
3.3 KiB
Common Lisp
107 lines
3.3 KiB
Common Lisp
;;;; binary.lisp
|
|
|
|
(in-package #:binary)
|
|
|
|
;;; "binary" goes here. Hacks and glory await!
|
|
|
|
(defun octets (stream length)
|
|
"Read length bytes from the stream."
|
|
(let ((bin (make-array length :element-type '(unsigned-byte 8))))
|
|
(read-sequence bin stream)
|
|
bin))
|
|
|
|
(defun uint-from-bytes (bin &key (endian :little))
|
|
"Produce an unsigned integer from the binary array input."
|
|
(let ((bin (cond
|
|
((eql endian :little) bin)
|
|
((eql endian :big) (reverse bin))
|
|
(t (error "Invalid endian specification."))))
|
|
(n 0))
|
|
(dotimes (i (length bin))
|
|
(setf n (+ n (ash (aref bin i) (* i 8)))))
|
|
n))
|
|
|
|
(defun uint-to-bytes (n size &key (endian :little))
|
|
"Produce a binary array of size bytes from the unsigned integer
|
|
provided."
|
|
(let ((bin (make-array size :element-type '(unsigned-byte 8))))
|
|
(dotimes (i size)
|
|
(setf (aref bin i)
|
|
(logand 255 (ash n (- 0 (* i 8))))))
|
|
(cond
|
|
((eql endian :little) bin)
|
|
((eql endian :big) (nreverse bin))
|
|
(t (error "Invalid endian specification.")))))
|
|
|
|
(defun read-uint (stream size &key (endian :little))
|
|
(uint-from-bytes (octets stream size) :endian endian))
|
|
|
|
(defun write-uint (stream n size &key (endian :little))
|
|
(write-sequence (uint-to-bytes n size :endian endian) stream))
|
|
|
|
(defun twos-complement (n size)
|
|
(if (zerop (logand (ash 1 (* (- size 1) 8)) n))
|
|
n
|
|
(- n (ash 1 (* size 8)))))
|
|
|
|
(defun int-from-bytes (bin &key (endian :little))
|
|
"Produce a signed integer from the binary array input."
|
|
(twos-complement (uint-from-bytes bin :endian endian)
|
|
(length bin)))
|
|
|
|
(defun int-to-bytes (n size &key (endian :little))
|
|
"Produce a binary array of size bytes from the provided signed
|
|
integer."
|
|
(uint-to-bytes (twos-complement n size) size :endian endian))
|
|
|
|
(defun read-int (stream size &key (endian :little))
|
|
(int-from-bytes (octets stream size)
|
|
:endian endian))
|
|
|
|
(defun write-int (stream n size &key (endian :little))
|
|
(write-sequence (int-to-bytes n size :endian endian)
|
|
stream))
|
|
|
|
(defmacro define-reader (const-name)
|
|
(let* ((signed (equal #\I (elt (symbol-name const-name) 0)))
|
|
(docstring
|
|
(format nil
|
|
"Read a~Asigned ~A-bit integer from a stream."
|
|
(if signed " " "n un")
|
|
(subseq (symbol-name const-name) 1))))
|
|
`(export
|
|
(defun ,(intern (format nil "READ-~A" const-name))
|
|
(stream &key (endian :little))
|
|
,docstring
|
|
(,(if signed 'read-int 'read-uint) stream ,const-name :endian endian)))))
|
|
|
|
(defmacro define-writer (const-name)
|
|
(let* ((signed (equal #\I (elt (symbol-name const-name) 0)))
|
|
(docstring
|
|
(format nil
|
|
"Write a~Asigned ~A-bit integer to a stream."
|
|
(if signed " " "n un")
|
|
(subseq (symbol-name const-name) 1))))
|
|
`(export
|
|
(defun ,(intern (format nil "WRITE-~A" const-name))
|
|
(stream n &key (endian :little))
|
|
,docstring
|
|
(,(if signed 'write-int 'write-uint) stream n ,const-name :endian endian)))))
|
|
|
|
(defmacro define-type (const-name)
|
|
(let ((size (/ (parse-integer (subseq (symbol-name const-name) 1)) 8)))
|
|
`(progn
|
|
(defconstant ,const-name ,size)
|
|
(export ',const-name :binary)
|
|
(define-reader ,const-name)
|
|
(define-writer ,const-name))))
|
|
|
|
(define-type U64)
|
|
(define-type I64)
|
|
(define-type U32)
|
|
(define-type I32)
|
|
(define-type U16)
|
|
(define-type I16)
|
|
(define-type U8)
|
|
(define-type I8)
|