From 690430250882c7ccaa77033bec06b5d5c5aa1db5 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Wed, 6 Apr 2005 16:59:43 +0000 Subject: [PATCH] r10387: support new sbcl --- byte-stream.lisp | 26 ++++++++++++++++++++------ 1 file changed, 20 insertions(+), 6 deletions(-) diff --git a/byte-stream.lisp b/byte-stream.lisp index 6bea1f1..79ce9df 100644 --- a/byte-stream.lisp +++ b/byte-stream.lisp @@ -85,11 +85,24 @@ Make-Byte-Array-Output-Stream since the last call to this function." ) ; progn +#+sbcl +(sb-ext:without-package-locks + (defvar *system-copy-fn* (if (fboundp (intern "COPY-SYSTEM-AREA" "SB-KERNEL")) + (intern "COPY-SYSTEM-AREA" "SB-KERNEL") + (intern "COPY-SYSTEM-UB8-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))) + #+(or cmu sbcl) (progn (defstruct (byte-array-input-stream (:include #+cmu system:lisp-stream - #+sbcl sb-impl::file-stream + ;;#+sbcl sb-impl::file-stream + #+sbcl sb-sys:fd-stream (in #'byte-array-inch) (bin #'byte-array-binch) (n-bin #'byte-array-stream-read-n-bytes) @@ -102,10 +115,11 @@ Make-Byte-Array-Output-Stream since the last call to this function." (current nil) (end nil)) + (defun %print-byte-array-input-stream (s stream d) (declare (ignore s d)) (write-string "#" stream)) - + (defun byte-array-inch (stream eof-errorp eof-value) (let ((byte-array (byte-array-input-stream-byte-array stream)) (index (byte-array-input-stream-current stream))) @@ -152,13 +166,13 @@ Make-Byte-Array-Output-Stream since the last call to this function." (* copy vm:byte-bits))) #+sbcl (sb-sys:without-gcing - (sb-kernel:system-area-copy (sb-sys:vector-sap byte-array) - (* index sb-vm:n-byte-bits) + (funcall *system-copy-fn* (sb-sys:vector-sap byte-array) + (* index *system-copy-multiplier*) (if (typep buffer 'sb-sys::system-area-pointer) buffer (sb-sys:vector-sap buffer)) - (* start sb-vm:n-byte-bits) - (* copy sb-vm:n-byte-bits)))) + (* start *system-copy-multiplier*) + (* copy *system-copy-multiplier*)))) (if (and (> requested copy) eof-errorp) (error 'end-of-file :stream stream) copy))) -- 2.34.1