X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=byte-stream.lisp;h=6e785fa2fa90d883ce1aca8ba3f784151f4fdf44;hp=a375cdcd6f5ca6ab3860d95dcdecd20f089d8470;hb=03712fbb06acbb103602bae10f41aeae7fa05127;hpb=739b14ee8844dc777b174105646df3abcb865282

diff --git a/byte-stream.lisp b/byte-stream.lisp
index a375cdc..6e785fa 100644
--- a/byte-stream.lisp
+++ b/byte-stream.lisp
@@ -26,16 +26,16 @@
 #+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"))))
+            (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
-		       #+(and sbcl old-sb-file-stream) sb-impl::file-stream
-		       #+(and sbcl (not old-sb-file-stream)) 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
                        (bout #'byte-array-bout)
                        (misc #'byte-array-out-misc))
              (:print-function %print-byte-array-output-stream)
@@ -55,13 +55,13 @@
 
 (defun byte-array-bout (stream byte)
   (let ((current (byte-array-output-stream-index stream))
-	(workspace (byte-array-output-stream-buffer stream)))
+        (workspace (byte-array-output-stream-buffer stream)))
     (if (= current (length workspace))
-	(let ((new-workspace (make-array (* current 2) :element-type '(unsigned-byte 8))))
-	  (replace new-workspace workspace)
-	  (setf (aref new-workspace current) byte)
-	  (setf (byte-array-output-stream-buffer stream) new-workspace))
-	(setf (aref workspace current) byte))
+        (let ((new-workspace (make-array (* current 2) :element-type '(unsigned-byte 8))))
+          (replace new-workspace workspace)
+          (setf (aref new-workspace current) byte)
+          (setf (byte-array-output-stream-buffer stream) new-workspace))
+        (setf (aref workspace current) byte))
     (setf (byte-array-output-stream-index stream) (1+ current))))
 
 (defun byte-array-out-misc (stream operation &optional arg1 arg2)
@@ -69,7 +69,7 @@
   (case operation
     (:file-position
      (if (null arg1)
-	 (byte-array-output-stream-index stream)))
+         (byte-array-output-stream-index stream)))
     (:element-type '(unsigned-byte 8))))
 
 (defun get-output-stream-data (stream)
@@ -77,8 +77,8 @@
 Make-Byte-Array-Output-Stream since the last call to this function and
 clears buffer."
   (declare (type byte-array-output-stream stream))
-    (prog1 
-	(dump-output-stream-data stream)
+    (prog1
+        (dump-output-stream-data stream)
       (setf (byte-array-output-stream-index stream) 0)))
 
 (defun dump-output-stream-data (stream)
@@ -86,7 +86,7 @@ clears buffer."
 Make-Byte-Array-Output-Stream since the last call to this function."
   (declare (type byte-array-output-stream stream))
   (let* ((length (byte-array-output-stream-index stream))
-	 (result (make-array length :element-type '(unsigned-byte 8))))
+         (result (make-array length :element-type '(unsigned-byte 8))))
     (replace result (byte-array-output-stream-buffer stream))
     result))
 
@@ -97,107 +97,107 @@ Make-Byte-Array-Output-Stream since the last call to this function."
 (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")))
+                                   (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))))
-  
+                                              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
-		       #+(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)
-		       (misc #'byte-array-in-misc))
-	     (:print-function %print-byte-array-input-stream)
-					;(:constructor nil)
-	     (:constructor internal-make-byte-array-input-stream
-			   (byte-array current end)))
+             (: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
+                       (in #'byte-array-inch)
+                       (bin #'byte-array-binch)
+                       (n-bin #'byte-array-stream-read-n-bytes)
+                       (misc #'byte-array-in-misc))
+             (:print-function %print-byte-array-input-stream)
+                                        ;(:constructor nil)
+             (:constructor internal-make-byte-array-input-stream
+                           (byte-array current end)))
   (byte-array nil :type vector)
   (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)))
+        (index (byte-array-input-stream-current stream)))
     (cond ((= index (byte-array-input-stream-end stream))
-	   #+cmu
-	   (eof-or-lose stream eof-errorp eof-value)
-	   #+sbcl
-	   (sb-impl::eof-or-lose stream eof-errorp eof-value)
-	   )
-	  (t
-	   (setf (byte-array-input-stream-current stream) (1+ index))
-	   (aref byte-array index)))))
+           #+cmu
+           (eof-or-lose stream eof-errorp eof-value)
+           #+sbcl
+           (sb-impl::eof-or-lose stream eof-errorp eof-value)
+           )
+          (t
+           (setf (byte-array-input-stream-current stream) (1+ index))
+           (aref byte-array index)))))
 
 (defun byte-array-binch (stream eof-errorp eof-value)
   (let ((byte-array (byte-array-input-stream-byte-array stream))
-	(index (byte-array-input-stream-current stream)))
+        (index (byte-array-input-stream-current stream)))
     (cond ((= index (byte-array-input-stream-end stream))
-	   #+cmu
-	   (eof-or-lose stream eof-errorp eof-value)
-	   #+sbcl
-	   (sb-impl::eof-or-lose stream eof-errorp eof-value)
-	   )
-	  (t
-	   (setf (byte-array-input-stream-current stream) (1+ index))
-	   (aref byte-array index)))))
+           #+cmu
+           (eof-or-lose stream eof-errorp eof-value)
+           #+sbcl
+           (sb-impl::eof-or-lose stream eof-errorp eof-value)
+           )
+          (t
+           (setf (byte-array-input-stream-current stream) (1+ index))
+           (aref byte-array index)))))
 
 (defun byte-array-stream-read-n-bytes (stream buffer start requested eof-errorp)
   (declare (type byte-array-input-stream stream))
   (let* ((byte-array (byte-array-input-stream-byte-array stream))
-	 (index (byte-array-input-stream-current stream))
-	 (available (- (byte-array-input-stream-end stream) index))
-	 (copy (min available requested)))
+         (index (byte-array-input-stream-current stream))
+         (available (- (byte-array-input-stream-end stream) index))
+         (copy (min available requested)))
     (when (plusp copy)
       (setf (byte-array-input-stream-current stream)
-	(+ index copy))
+        (+ index copy))
       #+cmu
       (system:without-gcing
        (system::system-area-copy (system:vector-sap byte-array)
-			 (* index vm:byte-bits)
-			 (if (typep buffer 'system::system-area-pointer)
-			     buffer
-			     (system:vector-sap buffer))
-			 (* start vm:byte-bits)
-			 (* copy vm:byte-bits)))
+                         (* index vm:byte-bits)
+                         (if (typep buffer 'system::system-area-pointer)
+                             buffer
+                             (system:vector-sap buffer))
+                         (* start vm:byte-bits)
+                         (* copy vm:byte-bits)))
       #+sbcl
       (sb-sys:without-gcing
        (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 +system-copy-multiplier+)
-			 (* copy +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+))))
     (if (and (> requested copy) eof-errorp)
-	(error 'end-of-file :stream stream)
-	copy)))
+        (error 'end-of-file :stream stream)
+        copy)))
 
 (defun byte-array-in-misc (stream operation &optional arg1 arg2)
   (declare (ignore arg2))
   (case operation
     (:file-position
      (if arg1
-	 (setf (byte-array-input-stream-current stream) arg1)
-	 (byte-array-input-stream-current stream)))
+         (setf (byte-array-input-stream-current stream) arg1)
+         (byte-array-input-stream-current stream)))
     (:file-length (length (byte-array-input-stream-byte-array stream)))
     (:unread (decf (byte-array-input-stream-current stream)))
     (:listen (or (/= (the fixnum (byte-array-input-stream-current stream))
-		     (the fixnum (byte-array-input-stream-end stream)))
-		 :eof))
+                     (the fixnum (byte-array-input-stream-end stream)))
+                 :eof))
     (:element-type 'base-char)))
-  
+
 (defun make-byte-array-input-stream (buffer &optional (start 0) (end (length buffer)))
   "Returns an input stream which will supply the bytes of BUFFER between
   Start and End in order."
@@ -228,41 +228,41 @@ Make-Byte-Array-Output-Stream since the last call to this function."
     "Returns an array of all data sent to a stream made by
 Make-Byte-Array-Output-Stream since the last call to this function
 and clears buffer."
-    (prog1 
-	(dump-output-stream-data stream)
+    (prog1
+        (dump-output-stream-data stream)
       (file-position stream 0)))
-  
+
   (defun dump-output-stream-data (stream)
     "Returns an array of all data sent to a stream made by
 Make-Byte-Array-Output-Stream since the last call to this function."
     (force-output stream)
     (let* ((length (file-position stream))
-	   (result (make-array length :element-type '(unsigned-byte 8))))
+           (result (make-array length :element-type '(unsigned-byte 8))))
       (replace result (slot-value stream 'excl::buffer))
       result))
-  
+
   (defmethod excl:device-extend ((stream extendable-buffer-output-stream)
-				 need action)
+                                 need action)
     (declare (ignore action))
     (let* ((len (file-position stream))
-	   (new-len (max (+ len need) (* 2 len)))
-	   (old-buf (slot-value stream 'excl::buffer))
-	   (new-buf (make-array new-len :element-type '(unsigned-byte 8))))
+           (new-len (max (+ len need) (* 2 len)))
+           (old-buf (slot-value stream 'excl::buffer))
+           (new-buf (make-array new-len :element-type '(unsigned-byte 8))))
       (declare (fixnum len)
-	       (optimize (speed 3) (safety 0)))
+               (optimize (speed 3) (safety 0)))
       (dotimes (i len)
-	(setf (aref new-buf i) (aref old-buf i)))
+        (setf (aref new-buf i) (aref old-buf i)))
       (setf (slot-value stream 'excl::buffer) new-buf)
       (setf (slot-value stream 'excl::buffer-ptr) new-len)
       )
     t)
-  
+
 )
 
 #+allegro
 (progn
   (defun make-byte-array-input-stream (buffer &optional (start 0)
-							(end (length buffer)))
+                                                        (end (length buffer)))
     (excl:make-buffer-input-stream buffer start end :octets))
   ) ;; progn