From e72051a4ccdf6b71a0edbddca9745cc97090073d Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Wed, 6 Apr 2005 17:37:55 +0000 Subject: [PATCH] r10389: sbcl working now --- byte-stream.lisp | 43 +++++++++++++++++++++++++++---------------- 1 file changed, 27 insertions(+), 16 deletions(-) diff --git a/byte-stream.lisp b/byte-stream.lisp index 712904d..a712803 100644 --- a/byte-stream.lisp +++ b/byte-stream.lisp @@ -23,11 +23,19 @@ ;; Intial CMUCL version by OnShored. Ported to SBCL by Kevin Rosenberg +#+sbcl +(eval-when (:compile-toplevel :load-toplevel :execute) + (when (sb-ext:without-package-locks + (sb-pcl::structure-class-p + (find-class (intern "FILE-STREAM" "SB-IMPL")))) + (push :old-sb-file-stream cl:*features*))) + #+(or cmu sbcl) (progn (defstruct (byte-array-output-stream (:include #+cmu system:lisp-stream - #+sbcl sb-sys:fd-stream + #+(and sbcl old-sb-file-stream) sb-impl::fd-stream + #+(and sbcl (not old-sb-file-stream)) sb-sys:fd-stream (bout #'byte-array-bout) (misc #'byte-array-out-misc)) (:print-function %print-byte-array-output-stream) @@ -86,23 +94,22 @@ Make-Byte-Array-Output-Stream since the last call to this function." #+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))) - +(eval-when (:compile-toplevel :load-toplevel :execute) + (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-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-sys:fd-stream + #+(and sbcl old-sb-file-stream) sb-impl::file-stream + #+(and sbcl (not old-sb-file-stream)) sb-sys:fd-stream (in #'byte-array-inch) (bin #'byte-array-binch) (n-bin #'byte-array-stream-read-n-bytes) @@ -167,12 +174,12 @@ Make-Byte-Array-Output-Stream since the last call to this function." #+sbcl (sb-sys:without-gcing (funcall *system-copy-fn* (sb-sys:vector-sap byte-array) - (* index *system-copy-multiplier*) + (* index +system-copy-multiplier+) (if (typep buffer 'sb-sys::system-area-pointer) buffer (sb-sys:vector-sap buffer)) - (* start *system-copy-multiplier*) - (* copy *system-copy-multiplier*)))) + (* start +system-copy-multiplier+) + (* copy +system-copy-multiplier+)))) (if (and (> requested copy) eof-errorp) (error 'end-of-file :stream stream) copy))) @@ -198,6 +205,8 @@ Make-Byte-Array-Output-Stream since the last call to this function." ) ;; progn +(eval-when (:compile-toplevel :load-toplevel :execute) + (setq cl:*features* (delete :old-sb-file-stream cl:*features*))) ;;; Simple streams implementation by Kevin Rosenberg @@ -256,3 +265,5 @@ Make-Byte-Array-Output-Stream since the last call to this function." (end (length buffer))) (excl:make-buffer-input-stream buffer start end :octets)) ) ;; progn + + -- 2.34.1