[usocket-devel] Multiprocess MCL usocket

Chun Tian (binghe) binghe.lisp at gmail.com
Thu Jan 7 07:30:46 UTC 2010


Committed as r514. Thanks very much.

Your idea on using a lock is also useful for some other CLs, I think.

--binghe

在 2010-1-7,01:13, Terje Norderhaug 写道:

> Binghe,
> 
> Below is an upgrade to the usocket MCL backend that allows a socket server to be shared between multiple processes. It adds a lock so only one process at a time polls for an established connection for the socket.
> 
> (defclass passive-socket (socket)
>  ((streams :accessor socket-streams :type list :initform NIL
>            :documentation "Circular list of streams with first element the next to open")
>   (reuse-address :reader reuse-address :initarg :reuse-address)
>   (lock :reader socket-lock :initform (ccl:make-lock "Socket"))))
> 
> (defmethod socket-accept ((socket passive-socket) &key element-type &aux (lock (socket-lock socket)))
>  (flet ((connection-established-p (stream)
>           (ccl::with-io-buffer-locked ((ccl::stream-io-buffer stream nil))
>             (let ((state (ccl::opentransport-stream-connection-state stream)))
>               (not (eq :unbnd state))))))
>    (with-mapped-conditions ()
>      (ccl:with-lock-grabbed (lock nil "Socket Lock")
>        (let ((connection (shiftf (car (socket-streams socket))
>                                  (socket-open-listener socket element-type))))
>          (pop (socket-streams socket))
>          (ccl:process-wait "Accepting" #'connection-established-p connection)
>          connection)))))
> 
> 
> -- Terje Norderhaug
>  terje at in-progress.com
> 
> 
> 
> 

-------------- next part --------------
A non-text attachment was scrubbed...
Name: smime.p7s
Type: application/pkcs7-signature
Size: 2603 bytes
Desc: not available
URL: <https://mailman.common-lisp.net/pipermail/usocket-devel/attachments/20100107/f66ed7de/attachment.bin>


More information about the usocket-devel mailing list