X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-stream.lisp;h=4da3db17dba17520472da020c8f5e9889abc886d;hb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;hp=4b254f68ff67f588bd250b7ee4b54bae8916375e;hpb=c47519c9e63fd32a635943a84ec13d8a60d95f08;p=sbcl.git

diff --git a/src/code/target-stream.lisp b/src/code/target-stream.lisp
index 4b254f6..4da3db1 100644
--- a/src/code/target-stream.lisp
+++ b/src/code/target-stream.lisp
@@ -18,102 +18,109 @@
 ;;;
 ;;; All arguments are forms which will be used for a specific purpose
 ;;; PEEK-TYPE - the current peek-type as defined by ANSI CL
-;;; EOF-VALUE - the eof-value argument to peek-char
+;;; EOF-RESULT - the eof-value argument to peek-char
 ;;; CHAR-VAR - the variable which will be used to store the current character
 ;;; READ-FORM - the form which will be used to read a character
+;;; EOF-VALUE - the result returned from READ-FORM when hitting eof
 ;;; UNREAD-FORM - ditto for unread-char
 ;;; SKIPPED-CHAR-FORM - the form to execute when skipping a character
 ;;; EOF-DETECTED-FORM - the form to execute when EOF has been detected
-;;;                     (this will default to CHAR-VAR)
-(eval-when (:compile-toplevel :execute)
-  (sb!xc:defmacro generalized-peeking-mechanism
-      (peek-type eof-value char-var read-form unread-form
-       &optional (skipped-char-form nil) (eof-detected-form nil))
-    `(let ((,char-var ,read-form))
-      (cond ((eql ,char-var ,eof-value) 
-             ,(if eof-detected-form
-                  eof-detected-form
-                  char-var))
-            ((characterp ,peek-type)
-             (do ((,char-var ,char-var ,read-form))
-                 ((or (eql ,char-var ,eof-value) 
-                      (char= ,char-var ,peek-type))
-                  (cond ((eql ,char-var ,eof-value)
-                         ,(if eof-detected-form
-                              eof-detected-form
-                              char-var))
-                        (t ,unread-form
-                           ,char-var)))
-               ,skipped-char-form))
-            ((eql ,peek-type t)
-             (do ((,char-var ,char-var ,read-form))
-                 ((or (eql ,char-var ,eof-value)
-                      (not (whitespacep ,char-var)))
-                  (cond ((eql ,char-var ,eof-value)
-                         ,(if eof-detected-form
-                              eof-detected-form
-                              char-var))
-                        (t ,unread-form
-                           ,char-var)))
-               ,skipped-char-form))
-            ((null ,peek-type)
-             ,unread-form
-             ,char-var)
-            (t
-             (bug "Impossible case reached in PEEK-CHAR"))))))
+;;;                     (this will default to EOF-RESULT)
+(sb!xc:defmacro generalized-peeking-mechanism
+    (peek-type eof-value char-var read-form read-eof unread-form
+     &optional (skipped-char-form nil) (eof-detected-form nil))
+  `(let ((,char-var ,read-form))
+    (cond ((eql ,char-var ,read-eof)
+           ,(if eof-detected-form
+                eof-detected-form
+                eof-value))
+          ((characterp ,peek-type)
+           (do ((,char-var ,char-var ,read-form))
+               ((or (eql ,char-var ,read-eof)
+                    (char= ,char-var ,peek-type))
+                (cond ((eql ,char-var ,read-eof)
+                       ,(if eof-detected-form
+                            eof-detected-form
+                            eof-value))
+                      (t ,unread-form
+                         ,char-var)))
+             ,skipped-char-form))
+          ((eql ,peek-type t)
+           (do ((,char-var ,char-var ,read-form))
+               ((or (eql ,char-var ,read-eof)
+                    (not (whitespacep ,char-var)))
+                (cond ((eql ,char-var ,read-eof)
+                       ,(if eof-detected-form
+                            eof-detected-form
+                            eof-value))
+                      (t ,unread-form
+                         ,char-var)))
+             ,skipped-char-form))
+          ((null ,peek-type)
+           ,unread-form
+           ,char-var)
+          (t
+           (bug "Impossible case reached in PEEK-CHAR")))))
 
-;;; We proclaim them INLINE here, then proclaim them MAYBE-INLINE at EOF,
-;;; so, except in this file, they are not inline by default, but they can be.
-#!-sb-fluid (declaim (inline read-char unread-char read-byte listen))
+;;; rudi (2004-08-09): There was an inline declaration for read-char,
+;;; unread-char, read-byte, listen here that was removed because these
+;;; functions are redefined when simple-streams are loaded.
+
+#!-sb-fluid (declaim (inline ansi-stream-peek-char))
+(defun ansi-stream-peek-char (peek-type stream eof-error-p eof-value
+                              recursive-p)
+  (cond ((typep stream 'echo-stream)
+         (echo-misc stream
+                    :peek-char
+                    peek-type
+                    (list eof-error-p eof-value)))
+        (t
+         (generalized-peeking-mechanism
+          peek-type eof-value char
+          (ansi-stream-read-char stream eof-error-p :eof recursive-p)
+          :eof
+          (ansi-stream-unread-char char stream)))))
 
 (defun peek-char (&optional (peek-type nil)
-			    (stream *standard-input*)
-			    (eof-error-p t)
-			    eof-value
-			    recursive-p)
-  (declare (ignore recursive-p))
+                            (stream *standard-input*)
+                            (eof-error-p t)
+                            eof-value
+                            recursive-p)
   (the (or character boolean) peek-type)
   (let ((stream (in-synonym-of stream)))
-    (cond ((typep stream 'echo-stream)
-	   (echo-misc stream
-		      :peek-char
-		      peek-type
-		      (list eof-error-p eof-value)))
-	  ((ansi-stream-p stream)
-	   (generalized-peeking-mechanism
-	    peek-type eof-value char
-	    (read-char stream eof-error-p eof-value)
-	    (unread-char char stream)))
-	  (t
-	   ;; by elimination, must be Gray streams FUNDAMENTAL-STREAM
-	   (generalized-peeking-mechanism
-	    peek-type :eof char
-	    (if (null peek-type)
-		(stream-peek-char stream)
-		(stream-read-char stream))
-	    (if (null peek-type)
-		()
-		(stream-unread-char stream char))
-	    ()
-	    (eof-or-lose stream eof-error-p eof-value))))))
+    (if (ansi-stream-p stream)
+        (ansi-stream-peek-char peek-type stream eof-error-p eof-value
+                               recursive-p)
+        ;; by elimination, must be Gray streams FUNDAMENTAL-STREAM
+        (generalized-peeking-mechanism
+         peek-type :eof char
+         (if (null peek-type)
+             (stream-peek-char stream)
+             (stream-read-char stream))
+         :eof
+         (if (null peek-type)
+             ()
+             (stream-unread-char stream char))
+         ()
+         (eof-or-lose stream eof-error-p eof-value)))))
 
 (defun echo-misc (stream operation &optional arg1 arg2)
   (let* ((in (two-way-stream-input-stream stream))
-	 (out (two-way-stream-output-stream stream)))
+         (out (two-way-stream-output-stream stream)))
     (case operation
       (:listen
        (or (not (null (echo-stream-unread-stuff stream)))
-	   (if (ansi-stream-p in)
-	       (or (/= (the fixnum (ansi-stream-in-index in))
-		       +ansi-stream-in-buffer-length+)
-		   (funcall (ansi-stream-misc in) in :listen))
-	       (stream-misc-dispatch in :listen))))
+           (if (ansi-stream-p in)
+               (or (/= (the fixnum (ansi-stream-in-index in))
+                       +ansi-stream-in-buffer-length+)
+                   (funcall (ansi-stream-misc in) in :listen))
+               (stream-misc-dispatch in :listen))))
       (:unread (push arg1 (echo-stream-unread-stuff stream)))
       (:element-type
        (let ((in-type (stream-element-type in))
-	     (out-type (stream-element-type out)))
-	 (if (equal in-type out-type)
-	     in-type `(and ,in-type ,out-type))))
+             (out-type (stream-element-type out)))
+         (if (equal in-type out-type)
+             in-type `(and ,in-type ,out-type))))
       (:close
        (set-closed-flame stream))
       (:peek-char
@@ -131,32 +138,32 @@
        ;; the semantics for UNREAD-CHAR are held; the character should
        ;; not be echoed again.
        (let ((unread-char-p nil))
-	 (flet ((outfn (c)
-		  (unless unread-char-p
-		    (if (ansi-stream-p out)
-			(funcall (ansi-stream-out out) out c)
-			;; gray-stream
-			(stream-write-char out c))))
-		(infn ()
-		  ;; Obtain input from unread buffer or input stream,
-		  ;; and set the flag appropriately.
-		  (cond ((not (null (echo-stream-unread-stuff stream)))
-			 (setf unread-char-p t)
-			 (pop (echo-stream-unread-stuff stream)))
-			(t
-			 (setf unread-char-p nil)
-			 (read-char in (first arg2) (second arg2))))))
-	   (generalized-peeking-mechanism
-	    arg1 (second arg2) char
-	    (infn)
-	    (unread-char char in)
-	    (outfn char)))))
+         (flet ((outfn (c)
+                  (unless unread-char-p
+                    (if (ansi-stream-p out)
+                        (funcall (ansi-stream-out out) out c)
+                        ;; gray-stream
+                        (stream-write-char out c))))
+                (infn ()
+                  ;; Obtain input from unread buffer or input stream,
+                  ;; and set the flag appropriately.
+                  (cond ((not (null (echo-stream-unread-stuff stream)))
+                         (setf unread-char-p t)
+                         (pop (echo-stream-unread-stuff stream)))
+                        (t
+                         (setf unread-char-p nil)
+                         (read-char in (first arg2) :eof)))))
+           (generalized-peeking-mechanism
+            arg1 (second arg2) char
+            (infn)
+            :eof
+            (unread-char char in)
+            (outfn char)))))
       (t
        (or (if (ansi-stream-p in)
-	       (funcall (ansi-stream-misc in) in operation arg1 arg2)
-	       (stream-misc-dispatch in operation arg1 arg2))
-	   (if (ansi-stream-p out)
-	       (funcall (ansi-stream-misc out) out operation arg1 arg2)
-	       (stream-misc-dispatch out operation arg1 arg2)))))))
+               (funcall (ansi-stream-misc in) in operation arg1 arg2)
+               (stream-misc-dispatch in operation arg1 arg2))
+           (if (ansi-stream-p out)
+               (funcall (ansi-stream-misc out) out operation arg1 arg2)
+               (stream-misc-dispatch out operation arg1 arg2)))))))
 
-(declaim (maybe-inline read-char unread-char read-byte listen))
\ No newline at end of file