[cl-store-devel] Patch to optimize (simple-array (unsigned-byte 8) (*))

[Chris Dean]

Below is a patch to optimize the storage of vectors of type
(unsigned-byte 8).

For large vectors of this type we get a 75% savings in storage space
(that is, if it used to take 4000 bytes to store an array now it will
only take about 1000 bytes).

Comments welcome.

Cheers,
Chris Dean


Index: default-backend.lisp
===================================================================
RCS file: /project/cl-store/cvsroot/cl-store/default-backend.lisp,v
retrieving revision 1.39
diff -u -w -r1.39 default-backend.lisp
--- default-backend.lisp	26 Jan 2007 15:02:24 -0000	1.39
+++ default-backend.lisp	31 May 2007 00:39:50 -0000
@@ -43,6 +43,7 @@
 (defparameter +array-code+ (register-code 19 'array))
 (defparameter +simple-vector-code+ (register-code 20 'simple-vector))
 (defparameter +package-code+ (register-code 21 'package))
+(defparameter +simple-byte-vector-code+ (register-code 22 'simple-byte-vector))
 
 ;; fast storing for 32 bit ints
 (defparameter +32-bit-integer-code+ (register-code 24 '32-bit-integer))
@@ -513,9 +514,9 @@
     (simple-base-string (store-simple-base-string obj stream))
     (simple-string (store-simple-string obj stream))
     (simple-vector (store-simple-vector obj stream))
+    ((simple-array (unsigned-byte 8) (*)) (store-simple-byte-vector obj stream))
     (t (store-array obj stream))))
 
-
 (defun store-array (obj stream)
   (declare (optimize speed (safety 0) (debug 0))
            (type array obj))
@@ -563,6 +564,14 @@
   (loop for x across obj do
     (store-object x stream)))
 
+(defun store-simple-byte-vector (obj stream)
+  (declare (optimize speed (safety 0) (debug 0))
+           (type (simple-array (unsigned-byte 8) (*)) obj))
+  (output-type-code +simple-byte-vector-code+ stream)
+  (store-object (length obj) stream)
+  (loop for x across obj do
+       (write-byte x stream)))
+
 (defrestore-cl-store (simple-vector stream)
   (declare (optimize speed (safety 1) (debug 0)))
   (let* ((size (restore-object stream))
@@ -576,6 +585,19 @@
           (setting (aref obj x) (restore-object stream)))))
     res))
 
+(defrestore-cl-store (simple-byte-vector stream)
+  (declare (optimize speed (safety 1) (debug 0)))
+  (let* ((size (restore-object stream))
+         (res (make-array size :element-type '(unsigned-byte 8))))
+    (declare (type array-size size))
+    (resolving-object (obj res)
+      (dotimes (i size)
+        ;; we need to copy the index so that
+        ;; it's value at this time is preserved.
+        (let ((x i)) 
+          (setting (aref obj x) (read-byte stream)))))
+    res))
+
 ;; Dumping (unsigned-byte 32) for each character seems
 ;; like a bit much when most of them will be 
 ;; base-chars. So we try to cater for them.