/[cmucl]/src/code/fd-stream.lisp
ViewVC logotype

Diff of /src/code/fd-stream.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.97.2.1 by rtoy, Mon Feb 8 17:15:47 2010 UTC revision 1.97.2.2 by rtoy, Tue Feb 9 19:54:14 2010 UTC
# Line 40  Line 40 
40  ;;;; Buffer manipulation routines.  ;;;; Buffer manipulation routines.
41    
42  (defvar *available-buffers* ()  (defvar *available-buffers* ()
43    "List of available buffers.  Each buffer is an sap pointing to    _N"List of available buffers.  Each buffer is an sap pointing to
44    bytes-per-buffer of memory.")    bytes-per-buffer of memory.")
45    
46  (defvar lisp::*enable-stream-buffer-p* nil)  (defvar lisp::*enable-stream-buffer-p* nil)
47    
48  (defconstant bytes-per-buffer (* 4 1024)  (defconstant bytes-per-buffer (* 4 1024)
49    "Number of bytes per buffer.")    _N"Number of bytes per buffer.")
50    
51  ;; This limit is rather arbitrary  ;; This limit is rather arbitrary
52  (defconstant max-stream-element-size 1024  (defconstant max-stream-element-size 1024
53    "The maximum supported byte size for a stream element-type.")    _N"The maximum supported byte size for a stream element-type.")
54    
55  ;;; NEXT-AVAILABLE-BUFFER -- Internal.  ;;; NEXT-AVAILABLE-BUFFER -- Internal.
56  ;;;  ;;;
# Line 296  Line 296 
296  ;;;; Output routines and related noise.  ;;;; Output routines and related noise.
297    
298  (defvar *output-routines* ()  (defvar *output-routines* ()
299    "List of all available output routines. Each element is a list of the    _N"List of all available output routines. Each element is a list of the
300    element-type output, the kind of buffering, the function name, and the number    element-type output, the kind of buffering, the function name, and the number
301    of bytes per element.")    of bytes per element.")
302    
# Line 322  Line 322 
322                           length)                           length)
323        (cond ((not count)        (cond ((not count)
324               (if (= errno unix:ewouldblock)               (if (= errno unix:ewouldblock)
325                   (error "Write would have blocked, but SERVER told us to go.")                   (error _"Write would have blocked, but SERVER told us to go.")
326                   (error "While writing ~S: ~A"                   (error _"While writing ~S: ~A"
327                          stream (unix:get-unix-error-msg errno))))                          stream (unix:get-unix-error-msg errno))))
328              ((eql count length) ; Hot damn, it worked.              ((eql count length) ; Hot damn, it worked.
329               (when reuse-sap               (when reuse-sap
# Line 593  Line 593 
593  ;;; send it directly (after flushing the buffer, of course).  ;;; send it directly (after flushing the buffer, of course).
594  ;;;  ;;;
595  (defun output-raw-bytes (stream thing &optional start end)  (defun output-raw-bytes (stream thing &optional start end)
596    "Output THING to stream.  THING can be any kind of vector or a sap.  If THING    _N"Output THING to stream.  THING can be any kind of vector or a sap.  If THING
597    is a SAP, END must be supplied (as length won't work)."    is a SAP, END must be supplied (as length won't work)."
598    (let ((start (or start 0))    (let ((start (or start 0))
599          (end (or end (length (the (simple-array * (*)) thing)))))          (end (or end (length (the (simple-array * (*)) thing)))))
# Line 825  Line 825 
825  ;;;; Input routines and related noise.  ;;;; Input routines and related noise.
826    
827  (defvar *input-routines* ()  (defvar *input-routines* ()
828    "List of all available input routines. Each element is a list of the    _N"List of all available input routines. Each element is a list of the
829    element-type input, the function name, and the number of bytes per element.")    element-type input, the function name, and the number of bytes per element.")
830    
831  ;;; DO-INPUT -- internal  ;;; DO-INPUT -- internal
# Line 892  Line 892 
892                             :format-arguments (list (unix:get-unix-error-msg errno))                             :format-arguments (list (unix:get-unix-error-msg errno))
893                             :errno errno))                             :errno errno))
894                     (t                     (t
895                      (error "Error reading ~S: ~A"                      (error _"Error reading ~S: ~A"
896                             stream                             stream
897                             (unix:get-unix-error-msg errno)))))                             (unix:get-unix-error-msg errno)))))
898              ((zerop count)              ((zerop count)
# Line 1282  Line 1282 
1282                                    now-needed)                                    now-needed)
1283                  (declare (type (or index null) count))                  (declare (type (or index null) count))
1284                  (unless count                  (unless count
1285                    (error "Error reading ~S: ~A" stream                    (error _"Error reading ~S: ~A" stream
1286                           (unix:get-unix-error-msg err)))                           (unix:get-unix-error-msg err)))
1287                  (decf now-needed count)                  (decf now-needed count)
1288                  (if eof-error-p                  (if eof-error-p
# Line 1302  Line 1302 
1302                  (unix:unix-read (fd-stream-fd stream) sap len)                  (unix:unix-read (fd-stream-fd stream) sap len)
1303                (declare (type (or index null) count))                (declare (type (or index null) count))
1304                (unless count                (unless count
1305                  (error "Error reading ~S: ~A" stream                  (error _"Error reading ~S: ~A" stream
1306                         (unix:get-unix-error-msg err)))                         (unix:get-unix-error-msg err)))
1307                (when (and eof-error-p (zerop count))                (when (and eof-error-p (zerop count))
1308                  (error 'end-of-file :stream stream))                  (error 'end-of-file :stream stream))
# Line 1368  Line 1368 
1368            (routine type size)            (routine type size)
1369            (pick-input-routine target-type)            (pick-input-routine target-type)
1370          (unless routine          (unless routine
1371            (error "Could not find any input routine for ~S" target-type))            (error _"Could not find any input routine for ~S" target-type))
1372          (setf (fd-stream-ibuf-sap stream) (next-available-buffer))          (setf (fd-stream-ibuf-sap stream) (next-available-buffer))
1373          (setf (fd-stream-ibuf-length stream) bytes-per-buffer)          (setf (fd-stream-ibuf-length stream) bytes-per-buffer)
1374          (setf (fd-stream-ibuf-tail stream) 0)          (setf (fd-stream-ibuf-tail stream) 0)
# Line 1426  Line 1426 
1426            (routine type size)            (routine type size)
1427            (pick-output-routine target-type (fd-stream-buffering stream))            (pick-output-routine target-type (fd-stream-buffering stream))
1428          (unless routine          (unless routine
1429            (error "Could not find any output routine for ~S buffered ~S."            (error _"Could not find any output routine for ~S buffered ~S."
1430                   (fd-stream-buffering stream)                   (fd-stream-buffering stream)
1431                   target-type))                   target-type))
1432          (setf (fd-stream-obuf-sap stream) (next-available-buffer))          (setf (fd-stream-obuf-sap stream) (next-available-buffer))
# Line 1449  Line 1449 
1449    
1450      (when (and input-size output-size      (when (and input-size output-size
1451                 (not (eql input-size output-size)))                 (not (eql input-size output-size)))
1452        (error "Element sizes for input (~S:~S) and output (~S:~S) differ?"        (error _"Element sizes for input (~S:~S) and output (~S:~S) differ?"
1453               input-type input-size               input-type input-size
1454               output-type output-size))               output-type output-size))
1455      (setf (fd-stream-element-size stream)      (setf (fd-stream-element-size stream)
# Line 1467  Line 1467 
1467                  ((subtypep output-type input-type)                  ((subtypep output-type input-type)
1468                   output-type)                   output-type)
1469                  (t                  (t
1470                   (error "Input type (~S) and output type (~S) are unrelated?"                   (error _"Input type (~S) and output type (~S) are unrelated?"
1471                          input-type                          input-type
1472                          output-type))))))                          output-type))))))
1473    
# Line 1689  Line 1689 
1689                   nil)                   nil)
1690                  (t                  (t
1691                   (system:with-interrupts                   (system:with-interrupts
1692                     (error "Error lseek'ing ~S: ~A"                     (error _"Error lseek'ing ~S: ~A"
1693                            stream                            stream
1694                            (unix:get-unix-error-msg errno)))))))                            (unix:get-unix-error-msg errno)))))))
1695        (let ((offset 0)        (let ((offset 0)
# Line 1725  Line 1725 
1725                 (setf offset (* newpos (fd-stream-element-size stream))                 (setf offset (* newpos (fd-stream-element-size stream))
1726                       origin unix:l_set))                       origin unix:l_set))
1727                (t                (t
1728                 (error "Invalid position given to file-position: ~S" newpos)))                 (error _"Invalid position given to file-position: ~S" newpos)))
1729          (multiple-value-bind          (multiple-value-bind
1730              (posn errno)              (posn errno)
1731              (unix:unix-lseek (fd-stream-fd stream) offset origin)              (unix:unix-lseek (fd-stream-fd stream) offset origin)
# Line 1734  Line 1734 
1734                  ((eq errno unix:espipe)                  ((eq errno unix:espipe)
1735                   nil)                   nil)
1736                  (t                  (t
1737                   (error "Error lseek'ing ~S: ~A"                   (error _"Error lseek'ing ~S: ~A"
1738                          stream                          stream
1739                          (unix:get-unix-error-msg errno))))))))                          (unix:get-unix-error-msg errno))))))))
1740    
# Line 1766  Line 1766 
1766                         binary-stream-p)                         binary-stream-p)
1767    (declare (type index fd) (type (or index null) timeout)    (declare (type index fd) (type (or index null) timeout)
1768             (type (member :none :line :full) buffering))             (type (member :none :line :full) buffering))
1769    "Create a stream for the given unix file descriptor.    _N"Create a stream for the given unix file descriptor.
1770    If input is non-nil, allow input operations.    If input is non-nil, allow input operations.
1771    If output is non-nil, allow output operations.    If output is non-nil, allow output operations.
1772    If neither input nor output are specified, default to allowing input.    If neither input nor output are specified, default to allowing input.
# Line 1779  Line 1779 
1779    (cond ((not (or input-p output-p))    (cond ((not (or input-p output-p))
1780           (setf input t))           (setf input t))
1781          ((not (or input output))          ((not (or input output))
1782           (error "File descriptor must be opened either for input or output.")))           (error _"File descriptor must be opened either for input or output.")))
1783    (let ((stream (if binary-stream-p    (let ((stream (if binary-stream-p
1784                      (%make-binary-text-stream :fd fd                      (%make-binary-text-stream :fd fd
1785                                                :name name                                                :name name
# Line 1825  Line 1825 
1825  ;;; Pick a name to use for the backup file.  ;;; Pick a name to use for the backup file.
1826  ;;;  ;;;
1827  (defvar *backup-extension* ".BAK"  (defvar *backup-extension* ".BAK"
1828    "This is a string that OPEN tacks on the end of a file namestring to produce    _N"This is a string that OPEN tacks on the end of a file namestring to produce
1829     a name for the :if-exists :rename-and-delete and :rename options.  Also,     a name for the :if-exists :rename-and-delete and :rename options.  Also,
1830     this can be a function that takes a namestring and returns a complete     this can be a function that takes a namestring and returns a complete
1831     namestring.")     namestring.")
# Line 2127  Line 2127 
2127                        (direction direction)                        (direction direction)
2128                        (if-does-not-exist if-does-not-exist)                        (if-does-not-exist if-does-not-exist)
2129                        (if-exists if-exists))                        (if-exists if-exists))
2130    "Return a stream which reads from or writes to Filename.    _N"Return a stream which reads from or writes to Filename.
2131    Defined keywords:    Defined keywords:
2132     :direction - one of :input, :output, :io, or :probe     :direction - one of :input, :output, :io, or :probe
2133     :element-type - Type of object to read or write, default BASE-CHAR     :element-type - Type of object to read or write, default BASE-CHAR
# Line 2202  Line 2202 
2202               (when stream               (when stream
2203                 (make-instance class :lisp-stream stream))))                 (make-instance class :lisp-stream stream))))
2204            (t            (t
2205             (error "Unable to open streams of class ~S." class)))))             (error _"Unable to open streams of class ~S." class)))))
2206    
2207  ;;;; Initialization.  ;;;; Initialization.
2208    
2209  (defvar *tty* nil  (defvar *tty* nil
2210    "The stream connected to the controlling terminal or NIL if there is none.")    _N"The stream connected to the controlling terminal or NIL if there is none.")
2211  (defvar *stdin* nil  (defvar *stdin* nil
2212    "The stream connected to the standard input (file descriptor 0).")    _N"The stream connected to the standard input (file descriptor 0).")
2213  (defvar *stdout* nil  (defvar *stdout* nil
2214    "The stream connected to the standard output (file descriptor 1).")    _N"The stream connected to the standard output (file descriptor 1).")
2215  (defvar *stderr* nil  (defvar *stderr* nil
2216    "The stream connected to the standard error output (file descriptor 2).")    _N"The stream connected to the standard error output (file descriptor 2).")
2217    
2218  ;;; STREAM-INIT -- internal interface  ;;; STREAM-INIT -- internal interface
2219  ;;;  ;;;
# Line 2265  Line 2265 
2265    (finish-output stream))    (finish-output stream))
2266    
2267  (defvar *beep-function* #'default-beep-function  (defvar *beep-function* #'default-beep-function
2268    "This is called in BEEP to feep the user.  It takes a stream.")    _N"This is called in BEEP to feep the user.  It takes a stream.")
2269    
2270  (defun beep (&optional (stream *terminal-io*))  (defun beep (&optional (stream *terminal-io*))
2271    (funcall *beep-function* stream))    (funcall *beep-function* stream))
# Line 2327  Line 2327 
2327  (defun file-string-length (stream object)  (defun file-string-length (stream object)
2328    (declare (type (or string character) object)    (declare (type (or string character) object)
2329             (type (or file-stream broadcast-stream stream:simple-stream) stream))             (type (or file-stream broadcast-stream stream:simple-stream) stream))
2330    "Return the delta in Stream's FILE-POSITION that would be caused by writing    _N"Return the delta in Stream's FILE-POSITION that would be caused by writing
2331     Object to Stream.  Non-trivial only in implementations that support     Object to Stream.  Non-trivial only in implementations that support
2332     international character sets."     international character sets."
2333    (typecase stream    (typecase stream

Legend:
Removed from v.1.97.2.1  
changed lines
  Added in v.1.97.2.2

  ViewVC Help
Powered by ViewVC 1.1.5