Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv21934/src
Modified Files: Tag: SQL-BACK-END sleepycat.lisp Log Message: Version test to allow compilation under both SBCL 8 and SBCL 9
Date: Wed Nov 2 20:56:39 2005 Author: rread
Index: elephant/src/sleepycat.lisp diff -u elephant/src/sleepycat.lisp:1.13.2.1 elephant/src/sleepycat.lisp:1.13.2.2 --- elephant/src/sleepycat.lisp:1.13.2.1 Tue Oct 18 22:41:27 2005 +++ elephant/src/sleepycat.lisp Wed Nov 2 20:56:39 2005 @@ -827,6 +827,15 @@ (setf (buffer-stream-position bs) (+ position 8)) (read-double (buffer-stream-buffer bs) position)))
+;; A non-back-compatible change was made in SBCL 8 moving to SBCL 9, +;; in that the function copy-from-system-area disappeared. +;; This code is an attempt to allow compilation under bothe SBCL 8 and SBCL 9. +;; Thanks to Juho Snellman for this idiom. +(defun new-style-copy-p () + (if (find-symbol "COPY-UB8-FROM-SYSTEM-AREA" "SB-KERNEL") + '(:and) + '(:or))) + (defun buffer-read-ucs1-string (bs byte-length) "Read a UCS1 string." (declare (optimize (speed 3) (safety 0)) @@ -840,6 +849,14 @@ :length byte-length :null-terminated-p nil) #+(and sbcl sb-unicode) (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)) +#-#.(sleepycat::new-style-copy-p) (sb-kernel:copy-from-system-area (sb-alien:alien-sap (buffer-stream-buffer bs)) (* position sb-vm:n-byte-bits) @@ -876,6 +893,14 @@ (let ((position (buffer-stream-position bs))) (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)) +#-#.(sleepycat::new-style-copy-p) (sb-kernel:copy-from-system-area (sb-alien:alien-sap (buffer-stream-buffer bs)) (* position sb-vm:n-byte-bits)