) ; 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)
(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)))