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)