;; 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-impl::file-stream
+ #+(and sbcl old-sb-file-stream) sb-impl::file-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)
) ; progn
+#+sbcl
+(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-impl::file-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)
(current nil)
(end nil))
+
(defun %print-byte-array-input-stream (s stream d)
(declare (ignore s d))
(write-string "#<Byte-Array-Input Stream>" 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)))
(* 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)))
) ;; progn
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (setq cl:*features* (delete :old-sb-file-stream cl:*features*)))
;;; Simple streams implementation by Kevin Rosenberg
(end (length buffer)))
(excl:make-buffer-input-stream buffer start end :octets))
) ;; progn
+
+