From sross at common-lisp.net  Mon Sep 17 18:32:16 2007
From: sross at common-lisp.net (sross)
Date: Mon, 17 Sep 2007 14:32:16 -0400 (EDT)
Subject: [cl-store-cvs] CVS cl-store/allegrocl
Message-ID: <20070917183216.0866D450C9@common-lisp.net>

Update of /project/cl-store/cvsroot/cl-store/allegrocl
In directory clnet:/tmp/cvs-serv1114/allegrocl

Log Message:
Directory /project/cl-store/cvsroot/cl-store/allegrocl added to the repository





From sross at common-lisp.net  Mon Sep 17 18:40:04 2007
From: sross at common-lisp.net (sross)
Date: Mon, 17 Sep 2007 14:40:04 -0400 (EDT)
Subject: [cl-store-cvs] CVS cl-store
Message-ID: <20070917184004.0FB07450CB@common-lisp.net>

Update of /project/cl-store/cvsroot/cl-store
In directory clnet:/tmp/cvs-serv1189

Modified Files:
	ChangeLog cl-store.asd default-backend.lisp package.lisp 
	plumbing.lisp tests.lisp 
Log Message:
faster (simple-array (unsigned-byte 8) (*)) storing. Thanks to Chris Dean
more lenient parsing of sbcl version. Thanks to Gustavo


--- /project/cl-store/cvsroot/cl-store/ChangeLog	2007/01/26 15:02:24	1.48
+++ /project/cl-store/cvsroot/cl-store/ChangeLog	2007/09/17 18:40:02	1.49
@@ -1,3 +1,8 @@
+2007-09-17 Sean Ross <sross at common-lisp.net>
+	* sbcl/custom.lisp: be lenient when parsing parts of sbcls version string. Thanks to Gustavo.
+	* default-backend.lisp: faster serializing of (simple-array
+	unsigned-byte 8). Thanks to Chris Dean
+
 2007-01-26 Sean Ross <sross at common-lisp.net>
 	* default-backend.lisp : Checked in a fix for non sb32 integers, certain 
 	large number numbers where incorrectly serialize. 
--- /project/cl-store/cvsroot/cl-store/cl-store.asd	2007/01/23 15:37:17	1.43
+++ /project/cl-store/cvsroot/cl-store/cl-store.asd	2007/09/17 18:40:02	1.44
@@ -20,7 +20,7 @@
 
 (defun lisp-system-shortname ()
   #+mcl :mcl #+lispworks :lispworks #+cmu :cmucl #+clisp :clisp #+sbcl :sbcl
-  #+allegro :acl #+ecl :ecl #+openmcl :openmcl #+abcl :abcl)
+  #+allegro :allegrocl #+ecl :ecl #+openmcl :openmcl #+abcl :abcl)
 
 (defmethod component-pathname ((component non-required-file))
   (let ((pathname (call-next-method))
@@ -45,7 +45,7 @@
   :name "CL-STORE"
   :author "Sean Ross <sross at common-lisp.net>"
   :maintainer "Sean Ross <sross at common-lisp.net>"
-  :version "0.7.9"
+  :version "0.7.12"
   :description "Serialization package"
   :long-description "Portable CL Package to serialize data"
   :licence "MIT"
--- /project/cl-store/cvsroot/cl-store/default-backend.lisp	2007/01/26 15:02:24	1.39
+++ /project/cl-store/cvsroot/cl-store/default-backend.lisp	2007/09/17 18:40:02	1.40
@@ -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))
@@ -220,7 +221,7 @@
   (declare (optimize speed))
   (block body
     (let (significand exponent sign)
-      (handler-bind (((or simple-error arithmetic-error)
+      (handler-bind (((or simple-error arithmetic-error type-error)
                       #'(lambda (err)
                           (declare (ignore err))
                           (when-let (type (cdr (assoc obj *special-floats*)))
@@ -513,6 +514,7 @@
     (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))))
 
 
@@ -533,6 +535,9 @@
   (loop for x from 0 below (array-total-size obj) do
         (store-object (row-major-aref obj x) stream)))
 
+ 
+
+
 (defrestore-cl-store (array stream)
   (declare (optimize speed (safety 1) (debug 0)))
   (let* ((fill-pointer (restore-object stream))
@@ -576,6 +581,27 @@
           (setting (aref obj x) (restore-object stream)))))
     res))
 
+(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-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.
--- /project/cl-store/cvsroot/cl-store/package.lisp	2007/01/26 15:02:24	1.27
+++ /project/cl-store/cvsroot/cl-store/package.lisp	2007/09/17 18:40:02	1.28
@@ -1,7 +1,7 @@
 ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;; See the file LICENCE for licence information.
 
-(in-package :cl-store.system)
+;(in-package :cl-store.system)
 
 (defpackage #:cl-store
   (:use #:cl) 
--- /project/cl-store/cvsroot/cl-store/plumbing.lisp	2007/01/22 17:59:20	1.20
+++ /project/cl-store/cvsroot/cl-store/plumbing.lisp	2007/09/17 18:40:02	1.21
@@ -105,7 +105,6 @@
   (:documentation 
    "Store magic-number of BACKEND, when present, into STREAM."))
 
-(declaim (inline store-object))
 (defun store-object (obj stream &optional (backend *current-backend*))
   "Store OBJ into STREAM. Not meant to be overridden, 
    use backend-store-object instead"
@@ -204,10 +203,11 @@
 
 ;; Wrapper for backend-restore-object so we don't have to pass
 ;; a backend object around all the time
-(declaim (inline restore-object))
-(defun restore-object (place &optional (backend *current-backend*))
-  "Restore the object in PLACE using BACKEND"
-  (backend-restore-object backend place))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun restore-object (place &optional (backend *current-backend*))
+    "Restore the object in PLACE using BACKEND"
+    (backend-restore-object backend place)))
 
 (defgeneric backend-restore-object (backend place)
   (:documentation
--- /project/cl-store/cvsroot/cl-store/tests.lisp	2007/01/26 15:02:25	1.32
+++ /project/cl-store/cvsroot/cl-store/tests.lisp	2007/09/17 18:40:03	1.33
@@ -126,6 +126,11 @@
 (deftestit vector.6 #())
 
 
+;; (array octect (*))
+
+(deftestit vector.octet.1 (make-array 10 :element-type '(unsigned-byte 8)))
+           
+
 ;; arrays
 (deftestit array.1
   (make-array '(2 2) :initial-contents '((1 2) (3 4))))
@@ -507,6 +512,7 @@
                           (eql (aref ret 1) (aref ret 2)))))
   t)
 
+
 (defclass foo.1 ()
   ((a :accessor foo1-a)))
 
@@ -644,8 +650,6 @@
                 (f-x new-obj) (f-y new-obj) (f-z new-obj)))))
   (t t t 3 2 "Z"))
 
-
-
 (deftest serialization-unit.1
          (with-serialization-unit ()
            (with-open-file (outs *test-file* :element-type '(unsigned-byte 8)
@@ -663,5 +667,7 @@
   (when (probe-file *test-file*)
     (ignore-errors (delete-file *test-file*))))
 
+(run-tests 'cl-store:cl-store)
+
 ;; EOF
 



From sross at common-lisp.net  Mon Sep 17 18:40:04 2007
From: sross at common-lisp.net (sross)
Date: Mon, 17 Sep 2007 14:40:04 -0400 (EDT)
Subject: [cl-store-cvs] CVS cl-store/acl
Message-ID: <20070917184004.917BF490A0@common-lisp.net>

Update of /project/cl-store/cvsroot/cl-store/acl
In directory clnet:/tmp/cvs-serv1189/acl

Removed Files:
	custom.lisp 
Log Message:
faster (simple-array (unsigned-byte 8) (*)) storing. Thanks to Chris Dean
more lenient parsing of sbcl version. Thanks to Gustavo





From sross at common-lisp.net  Mon Sep 17 18:40:05 2007
From: sross at common-lisp.net (sross)
Date: Mon, 17 Sep 2007 14:40:05 -0400 (EDT)
Subject: [cl-store-cvs] CVS cl-store/allegrocl
Message-ID: <20070917184005.566C05832F@common-lisp.net>

Update of /project/cl-store/cvsroot/cl-store/allegrocl
In directory clnet:/tmp/cvs-serv1189/allegrocl

Added Files:
	custom.lisp 
Log Message:
faster (simple-array (unsigned-byte 8) (*)) storing. Thanks to Chris Dean
more lenient parsing of sbcl version. Thanks to Gustavo



--- /project/cl-store/cvsroot/cl-store/allegrocl/custom.lisp	2007/09/17 18:40:04	NONE
+++ /project/cl-store/cvsroot/cl-store/allegrocl/custom.lisp	2007/09/17 18:40:04	1.1
;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;; See the file LICENCE for licence information.

(in-package :cl-store)

(defun setup-special-floats ()
  (flet ((short-float-values ()
           (list (cons #.excl::*infinity-single* +short-float-inf+)
                 (cons #.excl::*negative-infinity-single* +short-float-neg-inf+)
                 (cons #.excl::*nan-single* +short-float-nan+)))
         (single-float-values ()
           (list (cons #.excl::*infinity-single* +single-float-inf+)
                 (cons #.excl::*negative-infinity-single* +single-float-neg-inf+)
                 (cons #.excl::*nan-single* +single-float-nan+)))
         (double-float-values ()
           (list (cons #.excl::*infinity-double* +double-float-inf+)
                 (cons #.excl::*negative-infinity-double* +double-float-neg-inf+)
                 (cons #.excl::*nan-double* +double-float-nan+)))
         (long-float-values ()
           (list (cons #.excl::*infinity-double* +long-float-inf+)
                 (cons #.excl::*negative-infinity-double* +long-float-neg-inf+)
                 (cons #.excl::*nan-double* +long-float-nan+))))
    (setf *special-floats*
          (append (short-float-values)
                  (single-float-values)
                  (double-float-values)
                  (long-float-values)))))

;; EOF


From sross at common-lisp.net  Mon Sep 17 18:40:09 2007
From: sross at common-lisp.net (sross)
Date: Mon, 17 Sep 2007 14:40:09 -0400 (EDT)
Subject: [cl-store-cvs] CVS cl-store/sbcl
Message-ID: <20070917184009.975266B565@common-lisp.net>

Update of /project/cl-store/cvsroot/cl-store/sbcl
In directory clnet:/tmp/cvs-serv1189/sbcl

Modified Files:
	custom.lisp 
Log Message:
faster (simple-array (unsigned-byte 8) (*)) storing. Thanks to Chris Dean
more lenient parsing of sbcl version. Thanks to Gustavo


--- /project/cl-store/cvsroot/cl-store/sbcl/custom.lisp	2006/12/14 18:15:43	1.13
+++ /project/cl-store/cvsroot/cl-store/sbcl/custom.lisp	2007/09/17 18:40:05	1.14
@@ -85,13 +85,30 @@
   (funcall (compile nil `(lambda () ,@(sbcl-struct-defs dd))))
   (find-class (dd-name dd)))
 
+;;; with apologies to christophe rhodes ...
+;; takes a source location as a third argument.
+(eval-when (:compile-toplevel)
+  (defun split (string &optional max (ws '(#\Space #\Tab)))
+    (flet ((is-ws (char) (find char ws)))
+      (nreverse
+       (let ((list nil) (start 0) (words 0) end)
+         (loop
+          (when (and max (>= words (1- max)))
+            (return (cons (subseq string start) list)))
+          (setf end (position-if #'is-ws string :start start))
+          (push (subseq string start end) list)
+          (incf words)
+          (unless end (return list))
+          (setf start (1+ end))))))))
+
 ;; From 0.9.6.25 sb-kernel::%defstruct
 ;; takes a source location as a third argument.
 (eval-when (:compile-toplevel)
   (labels ((make-version (string)
              (map-into (make-list 4 :initial-element 0)
-                       #'parse-integer
-                       (asdf::split string nil '(#\.))))
+                       #'(lambda (part)
+                           (parse-integer part :junk-allowed t))
+                       (split string nil '(#\.))))
            (version>= (v1 v2)
              (loop for x in (make-version v1)
                    for y in (make-version v2)