X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffd-stream.lisp;h=ae79940b85c155036593b619a71d14a2ffcddb2a;hb=98a76d4426660876dec6649b1e228d2e5b47f579;hp=9ba1ec85ee69e80ac8d90172eaa6b62b2e07ea64;hpb=550e5afc7ad95ff1e1bbfe932bf8dd81b0c4dce6;p=sbcl.git diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index 9ba1ec8..ae79940 100644 --- a/src/code/fd-stream.lisp +++ b/src/code/fd-stream.lisp @@ -11,14 +11,6 @@ (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) - ;;;; buffer manipulation routines ;;; FIXME: Is it really good to maintain this pool separate from the @@ -39,10 +31,18 @@ (pop *available-buffers*) (allocate-system-memory bytes-per-buffer))) -;;;; 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)))) @@ -169,7 +169,7 @@ ;;; 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. @@ -369,6 +369,9 @@ (if (stringp thing) (let ((last-newline (and (find #\newline (the simple-string thing) :start start :end end) + ;; FIXME why do we need both calls? + ;; Is find faster forwards than + ;; position is backwards? (position #\newline (the simple-string thing) :from-end t :start start @@ -454,10 +457,8 @@ (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" @@ -470,10 +471,8 @@ (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))) @@ -593,7 +592,7 @@ ;;; 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) @@ -849,7 +848,8 @@ (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 @@ -879,7 +879,7 @@ (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 @@ -1014,8 +1014,8 @@ ;;; 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. @@ -1235,14 +1235,7 @@ (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*) @@ -1282,7 +1275,7 @@ ;;; ;;; 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)