From 4e6aae19275dad2053adbc2ad34ab1330daf1b0f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Juan=20Manuel=20Tom=C3=A1s?= Date: Tue, 4 Nov 2025 17:53:41 -0300 Subject: Working decoder on byte level --- decode.lisp | 55 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 55 insertions(+) create mode 100644 decode.lisp (limited to 'decode.lisp') diff --git a/decode.lisp b/decode.lisp new file mode 100644 index 0000000..df578a7 --- /dev/null +++ b/decode.lisp @@ -0,0 +1,55 @@ +(in-package #:lempel) + +(declaim (ftype (function ((array (unsigned-byte 8)) (unsigned-byte 8)) (array (unsigned-byte 8))) prefix-decode)) +(defun prefix-decode (data prefix) + (let ((result (queue:new))) + (dotimes (i (length data)) + (cond ((= (elt data i) prefix) + (let ((point (byte-pair->point data i))) + (if (= (point-size point) 0) + (progn + (queue:push prefix result) + (incf i)) + (progn + (queue:push point result) + (incf i 2))))) + (t (queue:push (elt data i) result)))) + (decompress (queue:to-list result)))) + +(declaim (ftype (function (list) (array (unsigned-byte 8))) decompress)) +(defun decompress (data) + (declare (optimize (debug 3))) + (let ((result (make-array (get-uncompressed-size data) :element-type '(unsigned-byte 8))) + (fill-count 0)) + (dolist (point data) + (cond ((point-p point) + (let ((start (- fill-count (point-offset point)))) + (dotimes (j (point-size point)) + (setf (elt result (+ fill-count j)) (elt result (+ start j)))) + (incf fill-count (point-size point)))) + ((typep point '(unsigned-byte 8)) + (setf (elt result fill-count) point) + (incf fill-count)) + (t (error (format nil "cannot handle type ~a" (type-of point)))))) + (assert (= fill-count (length result))) + result)) + +(declaim (ftype (function ((array (unsigned-byte 8)) fixnum) point) byte-pair->point)) +(defun byte-pair->point (bytes index) + (let ((offset (elt bytes (+ (if reversed-byte-order 2 1) index))) + (size (elt bytes (+ (if reversed-byte-order 1 2) index))) + (max-word-length (1- (ash 1 (- 16 window-bits))))) + (make-point :offset (logior offset + (ash (logand size (logxor #xff max-word-length)) + (- window-bits 8))) + :size (logand size max-word-length)))) + +(declaim (ftype (function (list) fixnum) get-uncompressed-size)) +(defun get-uncompressed-size (data) + (let ((size 0)) + (dolist (point data) + (cond ((point-p point) + (incf size (point-size point))) + (t + (incf size)))) + size)) -- cgit v1.2.3