--- a/src/bit-streams.lisp Sat Jul 18 22:46:32 2020 -0400
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,72 +0,0 @@
-(in-package :tdcb)
-
-;;;; Struct -------------------------------------------------------------------
-(defstruct (bits (:constructor make-bits% (underlying-stream))
- (:conc-name nil))
- (underlying-stream nil :type stream :read-only t)
- (rack 0 :type (unsigned-byte 8))
- (mask #b10000000 :type (unsigned-byte 8)))
-
-(declaim (inline write-bit% read-bit%))
-
-
-;;;; Write --------------------------------------------------------------------
-(defun write-bit% (b bit)
- (declare (type bits b))
- (when (plusp bit)
- (logiorf (rack b) (mask b)))
- (when (zerop (ashf (mask b) -1))
- (write-byte (rack b) (underlying-stream b))
- (setf (rack b) 0
- (mask b) #b10000000)))
-
-(defun write-bit (b bit)
- (write-bit% b bit)
- bit)
-
-(defun write-bits (b byte count)
- (loop :with mask = (ash 1 (1- count))
- :until (zerop mask)
- :do (progn (write-bit% b (logand mask byte))
- (ashf mask -1)))
- byte)
-
-(defun flush (b)
- (unless (= (mask b) #x80)
- (write-byte (rack b) (underlying-stream b))))
-
-
-;;;; Read ---------------------------------------------------------------------
-(defun read-bit% (b)
- (declare (type bits b))
- (when (= (mask b) #b10000000)
- (setf (rack b) (read-byte (underlying-stream b))))
- (prog1 (if (zerop (logand (mask b) (rack b)))
- 0
- 1)
- (when (zerop (ashf (mask b) -1))
- (setf (mask b) #b10000000))))
-
-(defun read-bit (b)
- (read-bit% b))
-
-(defun read-bits (b count)
- (loop :with result = 0
- :with mask = (ash 1 (1- count))
- :until (zerop mask)
- :do (progn (when (plusp (read-bit b))
- (logiorf result mask))
- (ashf mask -1))
- :finally (return result)))
-
-
-;;;; Create -------------------------------------------------------------------
-(defmacro with-bits-output ((var stream) &body body)
- `(let ((,var (make-bits% ,stream)))
- (unwind-protect (progn ,@body)
- (flush ,var))))
-
-(defmacro with-bits-input ((var stream) &body body)
- `(let ((,var (make-bits% ,stream)))
- ,@body))
-
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/bits.lisp Sat Jul 18 22:49:13 2020 -0400
@@ -0,0 +1,72 @@
+(in-package :tdcb)
+
+;;;; Struct -------------------------------------------------------------------
+(defstruct (bits (:constructor make-bits% (underlying-stream))
+ (:conc-name nil))
+ (underlying-stream nil :type stream :read-only t)
+ (rack 0 :type (unsigned-byte 8))
+ (mask #b10000000 :type (unsigned-byte 8)))
+
+(declaim (inline write-bit% read-bit%))
+
+
+;;;; Write --------------------------------------------------------------------
+(defun write-bit% (b bit)
+ (declare (type bits b))
+ (when (plusp bit)
+ (logiorf (rack b) (mask b)))
+ (when (zerop (ashf (mask b) -1))
+ (write-byte (rack b) (underlying-stream b))
+ (setf (rack b) 0
+ (mask b) #b10000000)))
+
+(defun write-bit (b bit)
+ (write-bit% b bit)
+ bit)
+
+(defun write-bits (b byte count)
+ (loop :with mask = (ash 1 (1- count))
+ :until (zerop mask)
+ :do (progn (write-bit% b (logand mask byte))
+ (ashf mask -1)))
+ byte)
+
+(defun flush (b)
+ (unless (= (mask b) #x80)
+ (write-byte (rack b) (underlying-stream b))))
+
+
+;;;; Read ---------------------------------------------------------------------
+(defun read-bit% (b)
+ (declare (type bits b))
+ (when (= (mask b) #b10000000)
+ (setf (rack b) (read-byte (underlying-stream b))))
+ (prog1 (if (zerop (logand (mask b) (rack b)))
+ 0
+ 1)
+ (when (zerop (ashf (mask b) -1))
+ (setf (mask b) #b10000000))))
+
+(defun read-bit (b)
+ (read-bit% b))
+
+(defun read-bits (b count)
+ (loop :with result = 0
+ :with mask = (ash 1 (1- count))
+ :until (zerop mask)
+ :do (progn (when (plusp (read-bit b))
+ (logiorf result mask))
+ (ashf mask -1))
+ :finally (return result)))
+
+
+;;;; Create -------------------------------------------------------------------
+(defmacro with-bits-output ((var stream) &body body)
+ `(let ((,var (make-bits% ,stream)))
+ (unwind-protect (progn ,@body)
+ (flush ,var))))
+
+(defmacro with-bits-input ((var stream) &body body)
+ `(let ((,var (make-bits% ,stream)))
+ ,@body))
+
--- a/tdcb.asd Sat Jul 18 22:46:32 2020 -0400
+++ b/tdcb.asd Sat Jul 18 22:49:13 2020 -0400
@@ -10,6 +10,6 @@
:components ((:module "src" :serial t
:components ((:file "package")
(:file "utilities")
- (:file "bit-streams")))))
+ (:file "bits")))))