MORE SALZA
« previous entry | next entry »
Dec. 19th, 2007 | 10:00 pm
I've been working on a replacement for Salza, my DEFLATE/ZLIB library. Salza is ok, but it suffers from some compression performance problems and design flaws. It's also hard to update since everything was optimized, prematurely.
Salza2 is a nearly from-scratch rewrite with a new design that places clarity first and performance second. As it turns out, profiling and relatively minor tuning have paid off extremely well, to the point that Salza2 is faster and produces better compression ratios than Salza1 after only a few nights and weekends of work.
Salza1 has a particularly ugly case where runs of zero-valued bytes are not compressed at all. This makes Vecto produce some embarrassingly large transparent PNG files, and was a major reason I decided to investigate a new implementation.
I figured I could start with CLOS classes and switch to structures when the need for speed arose, but I was able to achieve the speed without switching. As a result, it was much simpler for Salza2 to have the DEFLATE format as a base class and the ZLIB format as a subclass. Since ZLIB is essentially DEFLATE with a bit of extra prologue, data checking, and epilogue, only a few simple :BEFORE and :AFTER methods were needed to implement it.
As another exmample, the gzip file format is also a simple wrapper around DEFLATE. Here's the complete code needed to write a simple gzip file compressor with Salza2:
(defpackage #:zpb-gzip
(:use #:cl #:salza2)
(:export #:gzip))
(in-package #:zpb-gzip)
(defvar *gzip-signature*
(make-array 2
:element-type '(unsigned-byte 8)
:initial-contents '(#x1F #x8B)))
(defconstant +gzip-deflate-compression+ 8)
(defconstant +gzip-fast-compression+ 4)
(defconstant +gzip-flags+ 0)
(defconstant +gzip-unix-os+ 3)
(defconstant +gzip-mtime+ 0)
(defun write-u32 (value bitstream)
;; LSB
(write-octet (ldb (byte 8 0) value) bitstream)
(write-octet (ldb (byte 8 8) value) bitstream)
(write-octet (ldb (byte 8 16) value) bitstream)
(write-octet (ldb (byte 8 24) value) bitstream))
(defclass gzip-compressor (deflate-compressor)
((checksum
:initarg :checksum
:accessor checksum)
(data-length
:initarg :data-length
:accessor data-length))
(:default-initargs
:checksum (make-instance 'crc32-checksum)
:data-length 0))
(defmethod start-compression :before ((compressor gzip-compressor))
(let ((bitstream (bitstream compressor)))
(write-octet-vector *gzip-signature* bitstream)
(write-octet +gzip-deflate-compression+ bitstream)
(write-octet +gzip-flags+ bitstream)
(write-u32 +gzip-mtime+ bitstream)
(write-octet +gzip-fast-compression+ bitstream)
(write-octet +gzip-unix-os+ bitstream)))
(defmethod process-input :after ((compressor gzip-compressor)
input start count)
(incf (data-length compressor) count)
(update (checksum compressor) input start count))
(defmethod finish-compression :after ((compressor gzip-compressor))
(let ((bitstream (bitstream compressor)))
(write-u32 (result (checksum compressor)) bitstream)
(write-u32 (data-length compressor) bitstream)
(flush bitstream)))
(defmethod gzip (input output)
(with-open-file (istream input :element-type '(unsigned-byte 8))
(with-open-file (ostream output
:element-type '(unsigned-byte 8)
:direction :output
:if-exists :supersede)
(let* ((callback (lambda (data end)
(write-sequence data
ostream
:end end)))
(compressor (make-instance 'gzip-compressor
:callback callback))
(buffer (make-array 8192 :element-type '(unsigned-byte 8))))
(start-compression compressor)
(loop
(let ((end (read-sequence buffer istream)))
(when (zerop end)
(finish-compression compressor)
(return))
(compress-octet-vector buffer compressor :end end)))))))
It's much simpler than the corresponding Salza1 implementation, and took about five minutes to write.
I hope to have a complete and fully documented Salza2 available within a few weeks.
Small syntax error
from: anonymous
date: Dec. 21st, 2007 12:41 am (UTC)
Link
At the end of your definition for WRITE-U32 is an extraneous right parenthesis.
Reply | Thread
Re: Small syntax error
from:
xach
date: Dec. 21st, 2007 12:47 am (UTC)
Link
Reply | Parent | Thread