[elephant-cvs] CVS update: elephant/src/sleepycat.lisp

[Robert L. Read]

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)