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)
