[cl-store-cvs] CVS cl-store/sbcl

[sross]

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)