0.8.0.3:
[sbcl.git] / src / code / fd-stream.lisp
index 8206e41..26ebeb7 100644 (file)
 
 (in-package "SB!IMPL")
 
-;;; FIXME: Wouldn't it be clearer to just have the structure
-;;; definition be DEFSTRUCT FILE-STREAM (instead of DEFSTRUCT
-;;; FD-STREAM)? That way we'd have TYPE-OF and PRINT-OBJECT refer to
-;;; these objects as FILE-STREAMs (the ANSI name) instead of the
-;;; internal implementation name FD-STREAM, and there might be other
-;;; benefits as well.
-(deftype file-stream () 'fd-stream)
-\f
 ;;;; buffer manipulation routines
 
 ;;; FIXME: Is it really good to maintain this pool separate from the
       (pop *available-buffers*)
       (allocate-system-memory bytes-per-buffer)))
 \f
-;;;; the FD-STREAM structure
+;;;; the FILE-STREAM structure
 
-(defstruct (fd-stream
+(defstruct (file-stream
            (:constructor %make-fd-stream)
+           ;; KLUDGE: in an ideal world, maybe we'd rewrite
+           ;; everything to use FILE-STREAM rather than simply
+           ;; providing this hack for compatibility with the old
+           ;; code.  However, CVS doesn't deal terribly well with
+           ;; file renaming, so for now we use this
+           ;; backward-compatibility feature.
+           (:conc-name fd-stream-)
+           (:predicate fd-stream-p)
            (:include ansi-stream
                      (misc #'fd-stream-misc-routine))
            (:copier nil))
@@ -87,7 +87,7 @@
   (timeout nil :type (or index null))
   ;; pathname of the file this stream is opened to (returned by PATHNAME)
   (pathname nil :type (or pathname null)))
-(def!method print-object ((fd-stream fd-stream) stream)
+(def!method print-object ((fd-stream file-stream) stream)
   (declare (type stream stream))
   (print-unreadable-object (fd-stream stream :type t :identity t)
     (format stream "for ~S" (fd-stream-name fd-stream))))
 ;;; writes. If so, just queue this one. Otherwise, try to write it. If
 ;;; this would block, queue it.
 (defun frob-output (stream base start end reuse-sap)
-  (declare (type fd-stream stream)
+  (declare (type file-stream stream)
           (type (or system-area-pointer (simple-array * (*))) base)
           (type index start end))
   (if (not (null (fd-stream-output-later stream))) ; something buffered.
       (case count
        (1)
        (0
-        (unless #!-mp (sb!sys:wait-until-fd-usable
-                      fd :input (fd-stream-timeout stream))
-                #!+mp (sb!mp:process-wait-until-fd-usable
-                      fd :input (fd-stream-timeout stream))
+        (unless (sb!sys:wait-until-fd-usable
+                 fd :input (fd-stream-timeout stream))
           (error 'io-timeout :stream stream :direction :read)))
        (t
         (simple-stream-perror "couldn't check whether ~S is readable"
       (cond ((null count)
             (if (eql errno sb!unix:ewouldblock)
                 (progn
-                  (unless #!-mp (sb!sys:wait-until-fd-usable
-                                fd :input (fd-stream-timeout stream))
-                          #!+mp (sb!mp:process-wait-until-fd-usable
-                                fd :input (fd-stream-timeout stream))
+                  (unless (sb!sys:wait-until-fd-usable
+                           fd :input (fd-stream-timeout stream))
                     (error 'io-timeout :stream stream :direction :read))
                   (frob-input stream))
                 (simple-stream-perror "couldn't read from ~S" stream errno)))
 ;;; there is a definite amount of reading to be done, so blocking
 ;;; isn't too problematical.
 (defun fd-stream-read-n-bytes (stream buffer start requested eof-error-p)
-  (declare (type fd-stream stream))
+  (declare (type file-stream stream))
   (declare (type index start requested))
   (do ((total-copied 0))
       (nil)
      (fd-stream-element-type fd-stream))
     (:interactive-p
       ;; FIXME: sb!unix:unix-isatty is undefined.
-     (sb!unix:unix-isatty (fd-stream-fd fd-stream)))
+     (= 1 (the (member 0 1)
+            (sb!unix:unix-isatty (fd-stream-fd fd-stream)))))
     (:line-length
      80)
     (:charpos
      (fd-stream-file-position fd-stream arg1))))
 
 (defun fd-stream-file-position (stream &optional newpos)
-  (declare (type fd-stream stream)
+  (declare (type file-stream stream)
           (type (or index (member nil :start :end)) newpos))
   (if (null newpos)
       (sb!sys:without-interrupts
 ;;; Pick a name to use for the backup file for the :IF-EXISTS
 ;;; :RENAME-AND-DELETE and :RENAME options.
 (defun pick-backup-name (name)
-  (declare (type simple-string name))
-  (concatenate 'simple-string name ".bak"))
+  (declare (type simple-base-string name))
+  (concatenate 'simple-base-string name ".bak"))
 
 ;;; Ensure that the given arg is one of the given list of valid
 ;;; things. Allow the user to fix any problems.
    :ELEMENT-TYPE - the type of object to read or write, default BASE-CHAR
    :IF-EXISTS - one of :ERROR, :NEW-VERSION, :RENAME, :RENAME-AND-DELETE,
                       :OVERWRITE, :APPEND, :SUPERSEDE or NIL
-   :IF-DOES-NOT-EXIST - one of :ERROR, :CREATE or nil
+   :IF-DOES-NOT-EXIST - one of :ERROR, :CREATE or NIL
   See the manual for details."
 
   (unless (eq external-format :default)
   (stream-reinit)
   (setf *terminal-io* (make-synonym-stream '*tty*))
   (setf *standard-output* (make-synonym-stream '*stdout*))
-  (setf *standard-input*
-       (#!-high-security
-        ;; FIXME: Why is *STANDARD-INPUT* a TWO-WAY-STREAM? ANSI says
-        ;; it's an input stream.
-        make-two-way-stream
-        #!+high-security
-        %make-two-way-stream (make-synonym-stream '*stdin*)
-                            *standard-output*))
+  (setf *standard-input* (make-synonym-stream '*stdin*))
   (setf *error-output* (make-synonym-stream '*stderr*))
   (setf *query-io* (make-synonym-stream '*terminal-io*))
   (setf *debug-io* *query-io*)
 ;;;
 ;;; FIXME: misleading name, screwy interface
 (defun file-name (stream &optional new-name)
-  (when (typep stream 'fd-stream)
+  (when (typep stream 'file-stream)
       (cond (new-name
             (setf (fd-stream-pathname stream) new-name)
             (setf (fd-stream-file stream)