[bknr-cvs] r2096 - in branches/grin-neu/thirdparty: cl-gd portableaserve/acl-compat uffi/src

[bknr at bknr.net]

Author: hhubner
Date: 2006-12-03 03:33:51 -0500 (Sun, 03 Dec 2006)
New Revision: 2096

Modified:
   branches/grin-neu/thirdparty/cl-gd/packages.lisp
   branches/grin-neu/thirdparty/portableaserve/acl-compat/acl-excl-common.lisp
   branches/grin-neu/thirdparty/uffi/src/aggregates.lisp
   branches/grin-neu/thirdparty/uffi/src/strings.lisp
Log:
Further SBCL tweaks


Modified: branches/grin-neu/thirdparty/cl-gd/packages.lisp
===================================================================
--- branches/grin-neu/thirdparty/cl-gd/packages.lisp	2006-12-03 08:14:14 UTC (rev 2095)
+++ branches/grin-neu/thirdparty/cl-gd/packages.lisp	2006-12-03 08:33:51 UTC (rev 2096)
@@ -1,7 +1,9 @@
 (in-package #:cl-user)
 
 (defpackage #:cl-gd
-  (:use #:cl #:uffi)
+  (:use #:cl
+        #-(or :clisp :openmcl) #:uffi
+	#+(or :clisp :openmcl) #:cffi-uffi-compat)
   (:export #:*default-image*
            #:*default-color*
            #:*default-font*

Modified: branches/grin-neu/thirdparty/portableaserve/acl-compat/acl-excl-common.lisp
===================================================================
--- branches/grin-neu/thirdparty/portableaserve/acl-compat/acl-excl-common.lisp	2006-12-03 08:14:14 UTC (rev 2095)
+++ branches/grin-neu/thirdparty/portableaserve/acl-compat/acl-excl-common.lisp	2006-12-03 08:33:51 UTC (rev 2096)
@@ -189,6 +189,7 @@
                            (array (signed-byte 8) 1)))
   (write-sequence sequence stream :start start :end end))
 
+#-sbcl
 (defun string-to-octets (string &key (null-terminate t) (start 0)
                          end mb-vector make-mb-vector?
                          (external-format :default))

Modified: branches/grin-neu/thirdparty/uffi/src/aggregates.lisp
===================================================================
--- branches/grin-neu/thirdparty/uffi/src/aggregates.lisp	2006-12-03 08:14:14 UTC (rev 2095)
+++ branches/grin-neu/thirdparty/uffi/src/aggregates.lisp	2006-12-03 08:33:51 UTC (rev 2096)
@@ -224,28 +224,13 @@
       (setf (aref a i) (uffi:deref-array s '(:array :unsigned-byte) i)))))
 
 #+sbcl
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (sb-ext:without-package-locks
-      (defvar *system-copy-fn* (if (fboundp (intern "COPY-FROM-SYSTEM-AREA" "SB-KERNEL"))
-				   (intern "COPY-FROM-SYSTEM-AREA" "SB-KERNEL")
-				   (intern "COPY-UB8-FROM-SYSTEM-AREA" "SB-KERNEL")))
-    (defconstant +system-copy-offset+ (if (fboundp (intern "COPY-FROM-SYSTEM-AREA" "SB-KERNEL"))
-					  (* sb-vm:vector-data-offset sb-vm:n-word-bits)
-					  0))
-    (defconstant +system-copy-multiplier+ (if (fboundp (intern "COPY-FROM-SYSTEM-AREA" "SB-KERNEL"))
-					      sb-vm:n-byte-bits
-					      1))))
-  
-
-#+sbcl
 (defun convert-from-foreign-usb8 (s len)
   (let ((sap (sb-alien:alien-sap s)))
     (declare (type sb-sys:system-area-pointer sap))
     (locally
      (declare (optimize (speed 3) (safety 0)))
      (let ((result (make-array len :element-type '(unsigned-byte 8))))
-       (funcall *system-copy-fn* sap 0 result +system-copy-offset+
-		(* len +system-copy-multiplier+))
+       (sb-kernel:copy-ub8-from-system-area sap 0 result 0 len)
        result))))
 
 #+cmu

Modified: branches/grin-neu/thirdparty/uffi/src/strings.lisp
===================================================================
--- branches/grin-neu/thirdparty/uffi/src/strings.lisp	2006-12-03 08:14:14 UTC (rev 2095)
+++ branches/grin-neu/thirdparty/uffi/src/strings.lisp	2006-12-03 08:33:51 UTC (rev 2096)
@@ -207,6 +207,8 @@
 				     :null-terminated-p ,null-terminated-p))))
 
   #+sbcl
+  (declare (ignore locale))
+  #+sbcl
   (let ((stored-obj (gensym)))
     `(let ((,stored-obj ,obj))
        (if (null-pointer-p ,stored-obj)