X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src%2Faggregates.lisp;h=5d0bcf75bfd07b0f7896efdc1d11091d7e0ce261;hb=3f02f80ce6909ada82d9791172821756f967a844;hp=ec1a559b2612ec5386223bed35ac0c7585654f32;hpb=218088774006bd9df58df318a6b3981065dfc71f;p=uffi.git diff --git a/src/aggregates.lisp b/src/aggregates.lisp index ec1a559..5d0bcf7 100644 --- a/src/aggregates.lisp +++ b/src/aggregates.lisp @@ -228,20 +228,27 @@ of the enum-name name, separator-string, and field-name" #+sbcl (sb-ext:without-package-locks - (let ((copy-fn (if (fboundp (intern "COPY-FROM-SYSTEM-AREA" "SB-KERNEL")) - (intern "COPY-FROM-SYSTEM-AREA" "SB-KERNEL") - (intern "COPY-UB8-FROM-SYSTEM" "SB-KERNEL")))) - (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 copy-fn sap 0 - result (* sb-vm:vector-data-offset - sb-vm:n-word-bits) - (* len sb-vm:n-byte-bits)) - result)))))) + (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*)) + result)))) #+cmu (defun convert-from-foreign-usb8 (s len)