Changeset 4885

Timestamp:

Jul 20, 2006, 12:07:58 AM (18 years ago)

Author:

Gary Byers

Message:

Introduce "owner" slot in basic ioblock. A little tricky to bootstrap.

File:

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

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

@@ -352 +352 @@
   (interactive nil)
   (dirty nil)
-  (outbuf-lock nil))
+  (outbuf-lock nil)
+  (owner nil))
 
 
@@ -422 +423 @@
         (setq idx (io-buffer-idx buf)
               limit (io-buffer-count buf)))
-      (let ((byte (uvref (io-buffer-buffer buf) idx)))
-        (setf (io-buffer-idx buf) (the fixnum (1+ idx)))
-        (if (characterp byte) (%char-code byte) byte)))))
-
-(defun %ioblock-tyi (ioblock &optional (hang t))
+      (setf (io-buffer-idx buf) (the fixnum (1+ idx)))
+      (aref (the (simple-array (unsigned-byte 8) (*))
+              (io-buffer-buffer buf)) idx))))
+
+(declaim (inline %ioblock-tyi))
+
+(defun %ioblock-tyi (ioblock)
+  (declare (optimize (speed 3) (safety 0)))
   (if (ioblock-untyi-char ioblock)
     (prog1 (ioblock-untyi-char ioblock)
@@ -435 +439 @@
       (declare (fixnum idx limit))
       (when (= idx limit)
-        (unless (%ioblock-advance ioblock hang)
+        (unless (%ioblock-advance ioblock t)
           (return-from %ioblock-tyi (if (ioblock-eof ioblock) :eof)))
         (setq idx (io-buffer-idx buf)
               limit (io-buffer-count buf)))
-      (let ((byte (uvref (io-buffer-buffer buf) idx)))
-        (setf (io-buffer-idx buf) (the fixnum (1+ idx)))
-        (if (characterp byte) byte (%code-char byte))))))
+      (setf (io-buffer-idx buf) (the fixnum (1+ idx)))
+      (schar (io-buffer-buffer buf) idx))))
+
+(declaim (inline %ioblock-tyy-no-hang))
+
+(defun %ioblock-tyi-no-hang (ioblock)
+  (declare (optimize (speed 3) (safety 0)))
+  (if (ioblock-untyi-char ioblock)
+    (prog1 (ioblock-untyi-char ioblock)
+      (setf (ioblock-untyi-char ioblock) nil))
+    (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 nil)
+          (return-from %ioblock-tyi-no-hang (if (ioblock-eof ioblock) :eof)))
+        (setq idx (io-buffer-idx buf)
+              limit (io-buffer-count buf)))
+      (setf (io-buffer-idx buf) (the fixnum (1+ idx)))
+      (schar (io-buffer-buffer buf) idx))))
+
 
 (defun %ioblock-peek-char (ioblock)
@@ -1761 +1784 @@
 
 (defun stream-ioblock (stream &optional (error-if-nil t))
-  (or (%stream-ioblock stream)
-      (when error-if-nil
-        (error "~s is closed" stream))))
+  (with-slots (ioblock) stream
+    (or ioblock
+        (when error-if-nil
+          (error "~s is closed" stream)))))
 
 (defmethod stream-device ((s buffered-stream-mixin) direction)
@@ -1898 +1922 @@
 (defmethod stream-read-char-no-hang ((stream buffered-character-input-stream-mixin))
   (with-stream-ioblock-input (ioblock stream :speedy t)
-    (%ioblock-tyi ioblock nil)))
+    (%ioblock-tyi-no-hang ioblock)))
 
 (defmethod stream-peek-char ((stream buffered-character-input-stream-mixin))