/[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.40 by dtc, Tue Mar 25 17:07:31 1997 UTC revision 1.40.2.2 by dtc, Sun Jul 19 01:06:03 1998 UTC
# Line 61  Line 61 
61  (defstruct (fd-stream  (defstruct (fd-stream
62              (:print-function %print-fd-stream)              (:print-function %print-fd-stream)
63              (:constructor %make-fd-stream)              (:constructor %make-fd-stream)
64              (:include stream              (:include lisp-stream
65                        (misc #'fd-stream-misc-routine)))                        (misc #'fd-stream-misc-routine)))
66    
67    (name nil)                  ; The name of this stream    (name nil)                  ; The name of this stream
# Line 476  Line 476 
476               (setf (fd-stream-ibuf-tail stream) tail))))               (setf (fd-stream-ibuf-tail stream) tail))))
477      (setf (fd-stream-listen stream) nil)      (setf (fd-stream-listen stream) nil)
478      (multiple-value-bind      (multiple-value-bind
479          (count errno)            (count errno)
480          (unix:unix-select (1+ fd) (the (unsigned-byte 32) (ash 1 fd)) 0 0 0)          (alien:with-alien ((read-fds (alien:struct unix:fd-set)))
481              (unix:fd-zero read-fds)
482              (unix:fd-set fd read-fds)
483              (unix:unix-fast-select (1+ fd) (alien:addr read-fds) nil nil 0 0))
484        (case count        (case count
485          (1)          (1)
486          (0          (0
487           (unless (system:wait-until-fd-usable           (unless #-mp (system:wait-until-fd-usable
488                    fd :input (fd-stream-timeout stream))                         fd :input (fd-stream-timeout stream))
489                     #+mp (mp:process-wait-until-fd-usable
490                           fd :input (fd-stream-timeout stream))
491             (error 'io-timeout :stream stream :direction :read)))             (error 'io-timeout :stream stream :direction :read)))
492          (t          (t
493           (error "Problem checking to see if ~S is readable: ~A"           (error "Problem checking to see if ~S is readable: ~A"
494                  stream                  stream
495                  (unix:get-unix-error-msg errno)))))                  (unix:get-unix-error-msg errno)))))
496      (multiple-value-bind      (multiple-value-bind
497          (count errno)            (count errno)
498          (unix:unix-read fd          (unix:unix-read fd
499                          (system:int-sap (+ (system:sap-int ibuf-sap) tail))                          (system:int-sap (+ (system:sap-int ibuf-sap) tail))
500                          (- buflen tail))                          (- buflen tail))
501        (cond ((null count)        (cond ((null count)
502               (if (eql errno unix:ewouldblock)               (if (eql errno unix:ewouldblock)
503                   (progn                   (progn
504                     (unless (system:wait-until-fd-usable                     (unless #-mp (system:wait-until-fd-usable
505                              fd :input (fd-stream-timeout stream))                                   fd :input (fd-stream-timeout stream))
506                               #+mp (mp:process-wait-until-fd-usable
507                                     fd :input (fd-stream-timeout stream))
508                       (error 'io-timeout :stream stream :direction :read))                       (error 'io-timeout :stream stream :direction :read))
509                     (do-input stream))                     (do-input stream))
510                   (error "Error reading ~S: ~A"                   (error "Error reading ~S: ~A"
# Line 851  non-server method is also significantly Line 858  non-server method is also significantly
858          (when (eql size 1)          (when (eql size 1)
859            (setf (fd-stream-n-bin stream) #'fd-stream-read-n-bytes)            (setf (fd-stream-n-bin stream) #'fd-stream-read-n-bytes)
860            (when buffer-p            (when buffer-p
861              (setf (stream-in-buffer stream)              (setf (lisp-stream-in-buffer stream)
862                    (make-array in-buffer-length                    (make-array in-buffer-length
863                                :element-type '(unsigned-byte 8)))))                                :element-type '(unsigned-byte 8)))))
864          (setf input-size size)          (setf input-size size)
# Line 919  non-server method is also significantly Line 926  non-server method is also significantly
926                     (fd-stream-ibuf-tail stream)))                     (fd-stream-ibuf-tail stream)))
927           (fd-stream-listen stream)           (fd-stream-listen stream)
928           (setf (fd-stream-listen stream)           (setf (fd-stream-listen stream)
929                 (eql (unix:unix-select (1+ (fd-stream-fd stream))                 (eql (alien:with-alien ((read-fds (alien:struct unix:fd-set)))
930                                        (the (unsigned-byte 32)                        (unix:fd-zero read-fds)
931                                             (ash 1 (fd-stream-fd stream)))                        (unix:fd-set (fd-stream-fd stream) read-fds)
932                                        0                        (unix:unix-fast-select (1+ (fd-stream-fd stream))
933                                        0                                               (alien:addr read-fds) nil nil
934                                        0)                                               0 0))
935                      1))))                      1))))
936      (:unread      (:unread
937       (setf (fd-stream-unread stream) arg1)       (setf (fd-stream-unread stream) arg1)
# Line 989  non-server method is also significantly Line 996  non-server method is also significantly
996       (setf (fd-stream-ibuf-tail stream) 0)       (setf (fd-stream-ibuf-tail stream) 0)
997       (catch 'eof-input-catcher       (catch 'eof-input-catcher
998         (loop         (loop
999          (let ((count (unix:unix-select (1+ (fd-stream-fd stream))          (let ((count (alien:with-alien ((read-fds (alien:struct unix:fd-set)))
1000                                         (the (unsigned-byte 32)                         (unix:fd-zero read-fds)
1001                                              (ash 1 (fd-stream-fd stream)))                         (unix:fd-set (fd-stream-fd stream) read-fds)
1002                                         0 0 0)))                         (unix:unix-fast-select (1+ (fd-stream-fd stream))
1003                                                  (alien:addr read-fds) nil nil
1004                                                  0 0))))
1005            (cond ((eql count 1)            (cond ((eql count 1)
1006                   (do-input stream)                   (do-input stream)
1007                   (setf (fd-stream-ibuf-head stream) 0)                   (setf (fd-stream-ibuf-head stream) 0)
# Line 1389  non-server method is also significantly Line 1398  non-server method is also significantly
1398                     (case if-does-not-exist                     (case if-does-not-exist
1399                       (:error                       (:error
1400                        (cerror "Return NIL."                        (cerror "Return NIL."
1401                                "Error opening ~S, ~A."                                'simple-file-error
1402                                pathname                                :pathname pathname
1403                                (unix:get-unix-error-msg errno)))                                :format-control "Error opening ~S, ~A."
1404                                  :format-arguments
1405                                  (list pathname (unix:get-unix-error-msg errno))))
1406                       (:create                       (:create
1407                        (cerror "Return NIL."                        (cerror "Return NIL."
1408                                "Error creating ~S, path does not exist."                                "Error creating ~S, path does not exist."
# Line 1400  non-server method is also significantly Line 1411  non-server method is also significantly
1411                    ((eql errno unix:eexist)                    ((eql errno unix:eexist)
1412                     (unless (eq nil if-exists)                     (unless (eq nil if-exists)
1413                       (cerror "Return NIL."                       (cerror "Return NIL."
1414                               "Error opening ~S, ~A."                               'simple-file-error
1415                               pathname                               :pathname pathname
1416                               (unix:get-unix-error-msg errno)))                               :format-control "Error opening ~S, ~A."
1417                                 :format-arguments
1418                                 (list pathname (unix:get-unix-error-msg errno))))
1419                     (return nil))                     (return nil))
1420                    ((eql errno unix:eacces)                    ((eql errno unix:eacces)
1421                     (cerror "Try again."                     (cerror "Try again."

Legend:
Removed from v.1.40  
changed lines
  Added in v.1.40.2.2

  ViewVC Help
Powered by ViewVC 1.1.5