[cl-store-cvs] CVS update: cl-store/ChangeLog cl-store/default-backend.lisp cl-store/utils.lisp

[Sean Ross]

Update of /project/cl-store/cvsroot/cl-store
In directory common-lisp.net:/tmp/cvs-serv11376

Modified Files:
	ChangeLog default-backend.lisp utils.lisp 
Log Message:
Changelog 2005-02-03
Date: Thu Feb  3 12:55:13 2005
Author: sross

Index: cl-store/ChangeLog
diff -u cl-store/ChangeLog:1.18 cl-store/ChangeLog:1.19
--- cl-store/ChangeLog:1.18	Tue Feb  1 09:27:26 2005
+++ cl-store/ChangeLog	Thu Feb  3 12:55:13 2005
@@ -1,3 +1,10 @@
+2005-02-03 Sean Ross <sross at common-lisp.net>
+	* default-backend.lisp: Fixed hash-table restoration,
+	it no longer assumes that the result of hash-table-test
+	is a symbol but treats it as a function designator.
+	* default-backend.lisp: Added various declarations
+	to help improve speed.
+	
 2005-02-01 Sean Ross <sross at common-lisp.net>
 	* various: Large patch which has removed pointless 
 	argument-precedence-order from various gf's, added the 


Index: cl-store/default-backend.lisp
diff -u cl-store/default-backend.lisp:1.16 cl-store/default-backend.lisp:1.17
--- cl-store/default-backend.lisp:1.16	Tue Feb  1 09:27:26 2005
+++ cl-store/default-backend.lisp	Thu Feb  3 12:55:13 2005
@@ -103,7 +103,7 @@
 ;; We need this for circularity stuff.
 (defmethod int-sym-or-char-p ((backend cl-store-backend) (fn symbol))
   (declare (ignore backend))
-  (member fn '(integer character 32-bit-integer symbol)))
+  (find fn '(integer character 32-bit-integer symbol)))
 
 (defstore-cl-store (obj integer stream)
   (if (typep obj 'sb32)
@@ -111,26 +111,31 @@
       (store-arbitrary-integer obj stream)))
 
 (defun dump-int (obj stream)
+  (declare (optimize speed))
   (typecase obj 
     ((unsigned-byte 8) (write-byte 1 stream) (write-byte obj stream))
     (t (write-byte 2 stream) (store-32-bit obj stream))))
 
 (defun undump-int (stream)
+  (declare (optimize speed))
   (ecase (read-byte stream)
     (1 (read-byte stream))
     (2 (read-32-bit stream nil))))
 
 (defun store-32-bit-integer (obj stream)
+  (declare (optimize speed) (type sb32 obj))
   (output-type-code +32-bit-integer-code+ stream)
   (write-byte (if (minusp obj) 1 0) stream)
   (dump-int (abs obj) stream))
 
 (defrestore-cl-store (32-bit-integer stream)
+  (declare (optimize speed))
   (funcall (if (zerop (the fixnum (read-byte stream))) #'+ #'-)
            (undump-int stream)))
 
 (defun store-arbitrary-integer (obj stream)
-  (declare (type integer obj) (stream stream))
+  (declare (type integer obj) (stream stream)
+           (optimize speed))
   (output-type-code +integer-code+ stream)
   (loop for n = (abs obj) then (ash n -32)
         for counter from 0
@@ -146,6 +151,7 @@
                     (dump-int num stream)))))
 
 (defrestore-cl-store (integer buff)
+  (declare (optimize speed))
   (let ((count (restore-object buff))
         (result 0))
     (declare (type integer result count))
@@ -277,7 +283,7 @@
         (test (restore-object stream))
         (count (restore-object stream)))
     (declare (type integer count size))
-    (let ((hash (make-hash-table :test (symbol-function test)
+    (let ((hash (make-hash-table :test test
                                  :rehash-size rehash-size
                                  :rehash-threshold rehash-threshold
                                  :size size)))
@@ -455,7 +461,8 @@
   "Largest character that can be represented in 8 bits")
 
 (defun store-simple-string (obj stream)
-  (declare (type simple-string obj))
+  (declare (type simple-string obj)
+           (optimize speed))
   ;; must be a better test than this.
   (cond ((some #'(lambda (x) (char> x *char-marker*)) obj)
          ;; contains wide characters
@@ -465,19 +472,23 @@
            (dump-string #'write-byte obj stream))))
 
 (defun dump-string (dumper obj stream)
-  (declare (simple-string obj) (function dumper) (stream stream))
+  (declare (simple-string obj) (function dumper) (stream stream)
+           (optimize speed))
   (dump-int (the array-size (length obj)) stream)
   (loop for x across obj do (funcall dumper (char-code x) stream)))
 
 
 (defrestore-cl-store (simple-string stream)
+  (declare (optimize speed))
   (undump-string #'read-byte stream))
 
 (defrestore-cl-store (unicode-string stream)
+  (declare (optimize speed))
   (undump-string #'undump-int stream))
 
 (defun undump-string (reader stream)
-  (declare (type function reader) (type stream stream))
+  (declare (type function reader) (type stream stream)
+           (optimize speed))
   (let* ((length (the array-size (undump-int stream)) )
          (res (make-string length 
                            #+lispworks :element-type #+lispworks 'character)))


Index: cl-store/utils.lisp
diff -u cl-store/utils.lisp:1.9 cl-store/utils.lisp:1.10
--- cl-store/utils.lisp:1.9	Tue Feb  1 09:27:26 2005
+++ cl-store/utils.lisp	Thu Feb  3 12:55:13 2005
@@ -3,8 +3,6 @@
 
 ;; Miscellaneous utilities used throughout the package.
 (in-package :cl-store)
-;(declaim (optimize (speed 3) (safety 1) (debug 1)))
-
 
 (defmacro aif (test then &optional else)
   `(let ((it ,test))
@@ -60,18 +58,19 @@
 
 (defun store-32-bit (obj stream)
   "Write OBJ down STREAM as a 32 bit integer."
+  (declare (optimize speed))
   (let ((obj (logand #XFFFFFFFF obj)))
     (write-byte (ldb (byte 8 0) obj) stream)
     (write-byte (ldb (byte 8 8) obj) stream)
     (write-byte (ldb (byte 8 16) obj) stream)
     (write-byte (+ 0 (ldb (byte 8 24) obj)) stream)))
 
-
 (defmacro make-ub32 (a b c d)
   `(the ub32 (logior (ash ,a 24) (ash ,b 16) (ash ,c 8) ,d)))
 
 (defun read-32-bit (buf &optional (signed t))
   "Read a signed or unsigned byte off STREAM."
+  (declare (optimize speed))
   (let ((byte1 (read-byte buf))
         (byte2 (read-byte buf))
         (byte3 (read-byte buf))
@@ -96,4 +95,4 @@
   (values (intern (string-upcase name) :keyword)))
 
 
-;; EOF
\ No newline at end of file
+;; EOF