Changeset 7467 for branches/working-0710


Ignore:
Timestamp:
Oct 18, 2007, 12:54:08 AM (14 years ago)
Author:
palter
Message:

Add :AUTO-CLOSE to MAKE-FD-STREAM, MAKE-SOCKET, MAKE-TCP-STREAM, and
MAKE-FILE-SOCKET-STREAM. The default for MAKE-FD-STREAM is NIL; the default
for the other functions is T. (In other words, all socket streams will close
the file descriptor automatically when the stream is forgotten.)

Change RUN-PROGRAM to create the streams to the external process with :AUTO-CLOSE T.

Location:
branches/working-0710/ccl/level-1
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0710/ccl/level-1/l1-sockets.lisp

    r6914 r7467  
    603603                    local-port local-host backlog class out-of-band-inline
    604604                    local-filename remote-filename sharing basic
    605                     external-format)
     605                    external-format (auto-close t))
    606606  "Create and return a new socket."
    607607  (declare (dynamic-extent keys))
     
    609609                   keepalive reuse-address nodelay broadcast linger
    610610                   local-port local-host backlog class out-of-band-inline
    611                    local-filename remote-filename sharing basic external-format))
     611                   local-filename remote-filename sharing basic external-format
     612                   auto-close))
    612613  (ecase address-family
    613614    ((:file) (apply #'make-file-socket keys))
     
    696697
    697698
    698 (defun make-tcp-stream (fd &key (format :bivalent) external-format (class 'tcp-stream) sharing (basic t) &allow-other-keys)
     699(defun make-tcp-stream (fd &key (format :bivalent) external-format (class 'tcp-stream) sharing (basic t) (auto-close t) &allow-other-keys)
    699700  (let* ((external-format (normalize-external-format :socket external-format)))
    700701    (let ((element-type (ecase format
     
    711712                      :encoding (external-format-character-encoding external-format)
    712713                      :line-termination (external-format-line-termination external-format)
    713                       :basic basic))))
    714 
    715 (defun make-file-socket-stream (fd &key (format :bivalent) external-format (class 'file-socket-stream)  sharing basic &allow-other-keys)
     714                      :basic basic
     715                      :auto-close auto-close))))
     716
     717(defun make-file-socket-stream (fd &key (format :bivalent) external-format (class 'file-socket-stream)  sharing basic (auto-close t) &allow-other-keys)
    716718  (let* ((external-format (normalize-external-format :socket external-format)))
    717719 
     
    729731                      :sharing sharing
    730732                      :character-p (not (eq format :binary))
    731                       :basic basic))))
     733                      :basic basic
     734                      :auto-close auto-close))))
    732735
    733736(defun make-tcp-listener-socket (fd &rest keys &key backlog &allow-other-keys)
  • branches/working-0710/ccl/level-1/l1-streams.lisp

    r7422 r7467  
    32733273                          (basic nil)
    32743274                          encoding
    3275                           line-termination)
     3275                          line-termination
     3276                          auto-close)
    32763277  (when line-termination
    32773278    (setq line-termination
     
    32833284         (out-p (member direction '(:io :output)))
    32843285         (class-name (select-stream-class class in-p out-p character-p))
    3285          (class (find-class class-name)))
    3286     (make-ioblock-stream class
    3287                          :insize (if in-p elements-per-buffer)
    3288                          :outsize (if out-p elements-per-buffer)
    3289                          :device fd
    3290                          :interactive interactive
    3291                          :element-type element-type
    3292                          :advance-function (if in-p
    3293                                              (select-stream-advance-function class direction))
    3294                          :listen-function (if in-p 'fd-stream-listen)
    3295                          :eofp-function (if in-p 'fd-stream-eofp)
    3296                          :force-output-function (if out-p
    3297                                                   (select-stream-force-output-function class direction))
    3298                          :close-function 'fd-stream-close
    3299                          :sharing sharing
    3300                          :character-p character-p
    3301                          :encoding encoding
    3302                          :line-termination line-termination)))
     3286         (class (find-class class-name))
     3287         (stream
     3288          (make-ioblock-stream class
     3289                               :insize (if in-p elements-per-buffer)
     3290                               :outsize (if out-p elements-per-buffer)
     3291                               :device fd
     3292                               :interactive interactive
     3293                               :element-type element-type
     3294                               :advance-function (if in-p
     3295                                                    (select-stream-advance-function class direction))
     3296                               :listen-function (if in-p 'fd-stream-listen)
     3297                               :eofp-function (if in-p 'fd-stream-eofp)
     3298                               :force-output-function (if out-p
     3299                                                         (select-stream-force-output-function class direction))
     3300                               :close-function 'fd-stream-close
     3301                               :sharing sharing
     3302                               :character-p character-p
     3303                               :encoding encoding
     3304                               :line-termination line-termination)))
     3305    (if auto-close
     3306       (terminate-when-unreachable stream
     3307                                   (lambda (stream)
     3308                                     (let ((fd (shiftf (ioblock-device stream) nil)))
     3309                                       (when fd
     3310                                         (fd-close fd))))))
     3311    stream))
     3312
    33033313 
    33043314;;;  Fundamental streams.
     
    53675377    (when fd
    53685378      (setf (ioblock-device ioblock) nil)
    5369       (fd-close fd))))
     5379      (fd-close fd)
     5380      (cancel-terminate-when-unreachable s))))
    53705381
    53715382(defun fd-stream-force-output (s ioblock count finish-p)
  • branches/working-0710/ccl/level-1/linux-files.lisp

    r7408 r7467  
    714714                                  :element-type element-type
    715715                                  :interactive nil
    716                                   :basic t)
     716                                  :basic t
     717                                  :auto-close t)
    717718                  (cons read-pipe close-in-parent)
    718719                  (cons write-pipe close-on-error)))
     
    723724                                  :element-type element-type
    724725                                  :interactive nil
    725                                   :basic t)
     726                                  :basic t
     727                                  :auto-close t)
    726728                  (cons write-pipe close-in-parent)
    727729                  (cons read-pipe close-on-error)))
Note: See TracChangeset for help on using the changeset viewer.