Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv19163/src
Modified Files: serializer.lisp sleepycat.lisp Log Message: Bug fix for unicode SBCL
Date: Mon Dec 5 16:08:36 2005 Author: rread
Index: elephant/src/serializer.lisp diff -u elephant/src/serializer.lisp:1.11 elephant/src/serializer.lisp:1.12 --- elephant/src/serializer.lisp:1.11 Wed Nov 23 18:51:37 2005 +++ elephant/src/serializer.lisp Mon Dec 5 16:08:35 2005 @@ -120,6 +120,7 @@ (%serialize (package-name package)) (%serialize nil))))) (string + (progn (buffer-write-byte #+(and allegro ics) +ucs2-string+ #+(or (and sbcl sb-unicode) lispworks) @@ -130,7 +131,7 @@ +ucs1-string+ bs) (buffer-write-int (byte-length frob) bs) - (buffer-write-string frob bs)) + (buffer-write-string frob bs))) (persistent (buffer-write-byte +persistent+ bs) (buffer-write-int (oid frob) bs) @@ -293,6 +294,7 @@ ((= tag +ucs4-symbol+) (let ((name (buffer-read-ucs4-string bs (buffer-read-fixnum bs))) (maybe-package-name (%deserialize bs))) +;; (format t "ouput name = ~A~%" name) (if maybe-package-name (intern name (find-package maybe-package-name)) (make-symbol name))))
Index: elephant/src/sleepycat.lisp diff -u elephant/src/sleepycat.lisp:1.14 elephant/src/sleepycat.lisp:1.15 --- elephant/src/sleepycat.lisp:1.14 Wed Nov 23 18:51:37 2005 +++ elephant/src/sleepycat.lisp Mon Dec 5 16:08:35 2005 @@ -149,19 +149,19 @@ )
(declaim (inline read-int read-uint read-float read-double - write-int write-uint write-float write-double - offset-char-pointer copy-str-to-buf %copy-str-to-buf copy-bufs - ;;resize-buffer-stream - ;;buffer-stream-buffer buffer-stream-size buffer-stream-position - ;;buffer-stream-length - reset-buffer-stream - buffer-write-byte buffer-write-int buffer-write-uint - buffer-write-float buffer-write-double buffer-write-string - buffer-read-byte buffer-read-fixnum buffer-read-int - buffer-read-uint buffer-read-float buffer-read-double - #-(and allegreo ics) buffer-read-ucs1-string - #+(or lispworks (and allegro ics)) buffer-read-ucs2-string - #+(and sbcl sb-unicode) buffer-read-ucs4-string)) + write-int write-uint write-float write-double + offset-char-pointer copy-str-to-buf %copy-str-to-buf copy-bufs + ;;resize-buffer-stream + ;;buffer-stream-buffer buffer-stream-size buffer-stream-position + ;;buffer-stream-length + reset-buffer-stream + buffer-write-byte buffer-write-int buffer-write-uint + buffer-write-float buffer-write-double buffer-write-string + buffer-read-byte buffer-read-fixnum buffer-read-int + buffer-read-uint buffer-read-float buffer-read-double + #-(and allegreo ics) buffer-read-ucs1-string + #+(or lispworks (and allegro ics)) buffer-read-ucs2-string + #+(and sbcl sb-unicode) buffer-read-ucs4-string))
;; Constants and Flags ;; eventually write a macro which generates a custom flag function. @@ -541,10 +541,11 @@
#+(or cmu sbcl scl) (defun copy-str-to-buf (d do s so l) - (declare (optimize (speed 3) (safety 0)) - (type array-or-pointer-char d) - (type fixnum do so l) - (type string s)) + (declare (optimize (speed 3) (safety 0)) + (type array-or-pointer-char d) + (type fixnum do so l) + (type string s)) +;; (format t "copy-str-to-buf s = ~A do =~a so=~A len=~A~%" s do so l) (%copy-str-to-buf d do #+sbcl (sb-sys:vector-sap s) @@ -660,6 +661,7 @@ (declare (optimize (speed 3) (safety 0)) (type buffer-stream bs) (type (unsigned-byte 8) b)) +;; (format t "BW-byte ~A~%" b) (with-struct-slots ((buf buffer-stream-buffer) (size buffer-stream-size) (len buffer-stream-length)) @@ -737,9 +739,9 @@ (defun buffer-write-string (s bs) "Write the underlying bytes of a string. On Unicode Lisps, this is a 16-bit operation." - (declare (optimize (speed 3) (safety 0)) - (type buffer-stream bs) - (type string s)) +;; (declare (optimize (speed 3) (safety 0)) +;; (type buffer-stream bs) +;; (type string s)) (with-struct-slots ((buf buffer-stream-buffer) (size buffer-stream-size) (len buffer-stream-length)) @@ -750,6 +752,8 @@ (dynamic-extent str-bytes needed)) (when (> needed len) (resize-buffer-stream bs needed)) +;; I wonder if the basic problem here is that we are using this +;; routine instead of something like "copy-ub8-from-system-area"? (copy-str-to-buf buf size s 0 str-bytes) (setf size needed) nil))) @@ -853,11 +857,11 @@ (let ((res (make-string byte-length :element-type 'base-char))) #+#.(sleepycat::new-style-copy-p) (sb-kernel:copy-ub8-from-system-area - (sb-alien:alien-sap (buffer-stream-buffer bs)) - (* position sb-vm:n-byte-bits) - res - (* sb-vm:vector-data-offset sb-vm:n-word-bits) - (* byte-length sb-vm:n-byte-bits)) + (sb-alien:alien-sap (buffer-stream-buffer bs)) + position + res + 0 + byte-length) #-#.(sleepycat::new-style-copy-p) (sb-kernel:copy-from-system-area (sb-alien:alien-sap (buffer-stream-buffer bs)) @@ -896,12 +900,12 @@ (setf (buffer-stream-position bs) (+ position byte-length)) (let ((res (make-string (/ byte-length 4) :element-type 'character))) #+#.(sleepycat::new-style-copy-p) - (sb-kernel:copy-ub8-from-system-area - (sb-alien:alien-sap (buffer-stream-buffer bs)) - (* position sb-vm:n-byte-bits) - res - (* sb-vm:vector-data-offset sb-vm:n-word-bits) - (* byte-length sb-vm:n-byte-bits)) + (sb-kernel:copy-ub8-from-system-area + (sb-alien:alien-sap (buffer-stream-buffer bs)) + position + res + 0 + byte-length) #-#.(sleepycat::new-style-copy-p) (sb-kernel:copy-from-system-area (sb-alien:alien-sap (buffer-stream-buffer bs))