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@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@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