Changeset 5208

Timestamp:

Sep 16, 2006, 11:45:10 PM (18 years ago)

Author:

Gary Byers

Message:

more changes

File:

• trunk/ccl/level-1/l1-streams.lisp (modified) (5 diffs)

trunk/ccl/level-1/l1-streams.lisp

@@ -481 +481 @@
 
 (declaim (inline %ioblock-read-u8-byte))
-
 (defun %ioblock-read-u8-byte (ioblock)
   (declare (optimize (speed 3) (safety 0)))
@@ -497 +496 @@
             (io-buffer-buffer buf)) idx)))
 
+(declaim (inline %ioblock-read-s8-byte))
+(defun %ioblock-read-s8-byte (ioblock)
+  (declare (optimize (speed 3) (safety 0)))
+  (let* ((buf (ioblock-inbuf ioblock))
+         (idx (io-buffer-idx buf))
+         (limit (io-buffer-count buf)))
+    (declare (fixnum idx limit))
+    (when (= idx limit)
+      (unless (%ioblock-advance ioblock t)
+        (return-from %ioblock-read-s8-byte :eof))
+      (setq idx (io-buffer-idx buf)
+            limit (io-buffer-count buf)))
+    (setf (io-buffer-idx buf) (the fixnum (1+ idx)))
+    (aref (the (simple-array (signed-byte 8) (*))
+            (io-buffer-buffer buf)) idx)))
+
 (declaim (inline %ioblock-read-u16-byte))
-
 (defun %ioblock-read-u16-byte (ioblock)
   (declare (optimize (speed 3) (safety 0)))
@@ -513 +527 @@
     (aref (the (simple-array (unsigned-byte 16) (*))
             (io-buffer-buffer buf)) idx)))
+
+(declaim (inline %ioblock-read-s16-byte))
+(defun %ioblock-read-s16-byte (ioblock)
+  (declare (optimize (speed 3) (safety 0)))
+  (let* ((buf (ioblock-inbuf ioblock))
+         (idx (io-buffer-idx buf))
+         (limit (io-buffer-count buf)))
+    (declare (fixnum idx limit))
+    (when (= idx limit)
+      (unless (%ioblock-advance ioblock t)
+        (return-from %ioblock-read-s16-byte :eof))
+      (setq idx (io-buffer-idx buf)
+            limit (io-buffer-count buf)))
+    (setf (io-buffer-idx buf) (the fixnum (1+ idx)))
+    (aref (the (simple-array (signed-byte 16) (*))
+            (io-buffer-buffer buf)) idx)))
+
+(declaim (inline %ioblock-read-u32-byte))
+(defun %ioblock-read-u32-byte (ioblock)
+  (declare (optimize (speed 3) (safety 0)))
+  (let* ((buf (ioblock-inbuf ioblock))
+         (idx (io-buffer-idx buf))
+         (limit (io-buffer-count buf)))
+    (declare (fixnum idx limit))
+    (when (= idx limit)
+      (unless (%ioblock-advance ioblock t)
+        (return-from %ioblock-read-u32-byte :eof))
+      (setq idx (io-buffer-idx buf)
+            limit (io-buffer-count buf)))
+    (setf (io-buffer-idx buf) (the fixnum (1+ idx)))
+    (aref (the (simple-array (unsigned-byte 32) (*))
+            (io-buffer-buffer buf)) idx)))
+
+(defun %private-ioblock-read-u16-byte (ioblock)
+  (check-ioblock-owner ioblock)
+  (%ioblock-read-u16-byte ioblock))
+
+(defun %locked-ioblock-read-u16-byte (ioblock)
+  (check-ioblock-owner ioblock)
+  (%ioblock-read-u16-byte ioblock))
+
 
 (declaim (inline %ioblock-read-swapped-u16-byte))
@@ -902 +957 @@
 (defun %ioblock-write-u8-element (ioblock element)
   (declare (optimize (speed 3) (safety 0)))
-  (unless (eql element (logand #xff element))
-    (report-bad-arg element '(unsigned-byte 8)))
+  (let* ((buf (ioblock-outbuf ioblock))
+         (idx (io-buffer-idx buf))
+         (count (io-buffer-count buf))
+         (limit (io-buffer-limit buf)))
+    (declare (fixnum idx limit count))
+    (when (= idx limit)
+      (%ioblock-force-output ioblock nil)
+      (setq idx 0 count 0))
+    (setf (aref (the (simple-array (unsigned-byte 8) (*)) (io-buffer-buffer buf)) idx) element)
+    (incf idx)
+    (setf (io-buffer-idx buf) idx)
+    (when (> idx count)
+      (setf (io-buffer-count buf) idx))
+    (setf (ioblock-dirty ioblock) t)
+    element))
+
+(declaim (inline %ioblock-write-u16-element))
+(defun %ioblock-write-u16-element (ioblock element)
+  (declare (optimize (speed 3) (safety 0)))
   (let* ((buf (ioblock-outbuf ioblock))
          (idx (io-buffer-idx buf))
@@ -990 +1062 @@
         (funcall encode-function char #'%ioblock-write-u8-element ioblock)))))
 
-(defun %ioblock-write-byte (ioblock byte)
+(defun %ioblock-write-u8-byte (ioblock byte)
   (declare (optimize (speed 3) (safety 0)))
-  (%ioblock-write-element ioblock byte))
+  (if (= byte (logand #xff byte))
+    (%ioblock-write-u8-element ioblock byte)
+    (error "Can't write ~s to stream ~s". (byte (ioblock-stream ioblock)))))