[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