October 2008 - usocket-cvs@common-lisp.net

[usocket-cvs] r442 - usocket/branches/0.4.x
by Chun Tian 21 Oct '08

21 Oct '08

Author: ctian Date: Tue Oct 21 13:31:36 2008 New Revision: 442 Log: Report more details of a UNKNOWN-ERROR or NS-UNKNOWN-ERROR Modified: usocket/branches/0.4.x/condition.lisp Modified: usocket/branches/0.4.x/condition.lisp ============================================================================== --- usocket/branches/0.4.x/condition.lisp (original) +++ usocket/branches/0.4.x/condition.lisp Tue Oct 21 13:31:36 2008 @@ -109,6 +109,10 @@ (define-condition unknown-error (socket-error) ((real-error :initarg :real-error :accessor usocket-real-error)) + (:report (lambda (c stream) + (format stream + (simple-condition-format-control (usocket-real-error c)) + (simple-condition-format-arguments (usocket-real-error c))))) (:documentation "Error raised when there's no other - more applicable - error available.")) @@ -135,6 +139,10 @@ (define-condition ns-unknown-error (ns-error) ((real-error :initarg :real-error :accessor ns-real-error)) + (:report (lambda (c stream) + (format stream + (simple-condition-format-control (ns-real-error c)) + (simple-condition-format-arguments (ns-real-error c))))) (:documentation "Error raised when there's no other - more applicable - error available.")) @@ -197,4 +205,4 @@ :context ,context :minimum ,minimum)) (defmacro unimplemented (feature context) - `(signal 'unimplemented :feature ,feature :context ,context)) \ No newline at end of file + `(signal 'unimplemented :feature ,feature :context ,context))

1 0

[usocket-cvs] r441 - usocket/branches/0.4.x/backend
by Chun Tian 21 Oct '08

21 Oct '08

Author: ctian Date: Tue Oct 21 13:30:16 2008 New Revision: 441 Log: [lispworks] on non-win32 platform, add a warn when MP is not enabled when load. Modified: usocket/branches/0.4.x/backend/lispworks.lisp Modified: usocket/branches/0.4.x/backend/lispworks.lisp ============================================================================== --- usocket/branches/0.4.x/backend/lispworks.lisp (original) +++ usocket/branches/0.4.x/backend/lispworks.lisp Tue Oct 21 13:30:16 2008 @@ -8,6 +8,22 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (require "comm")) +;;; --------------------------------------------------------------------------- +;;; Warn if multiprocessing is not running on Lispworks + +#-win32 +(defun check-for-multiprocessing-started (&optional errorp) + (unless mp:*current-process* + (funcall (if errorp 'error 'warn) + "You must start multiprocessing on Lispworks by calling~ + ~%~3t(~s)~ + ~%for ~s function properly." + 'mp:initialize-multiprocessing + 'wait-for-input))) + +#-win32 +(check-for-multiprocessing-started) + #+win32 (fli:register-module "ws2_32")

1 0

[usocket-cvs] r440 - usocket/branches/0.4.x/backend
by Erik Huelsmann 21 Oct '08

21 Oct '08

Author: ehuelsmann Date: Tue Oct 21 12:27:45 2008 New Revision: 440 Log: Merge c439: report deadline errors as DEADLINE-ERROR. Modified: usocket/branches/0.4.x/backend/openmcl.lisp Modified: usocket/branches/0.4.x/backend/openmcl.lisp ============================================================================== --- usocket/branches/0.4.x/backend/openmcl.lisp (original) +++ usocket/branches/0.4.x/backend/openmcl.lisp Tue Oct 21 12:27:45 2008 @@ -64,7 +64,7 @@ (ccl:input-timeout (error 'timeout-error :socket socket :real-error condition)) (ccl:communication-deadline-expired - (error 'timeout-error :socket socket :real-error condition)) + (error 'deadline-error :socket socket :real-error condition)) (ccl::socket-creation-error #| ugh! |# (raise-error-from-id (ccl::socket-creation-error-identifier condition) socket condition))))

1 0

[usocket-cvs] r439 - usocket/trunk/backend
by Erik Huelsmann 21 Oct '08

21 Oct '08

Author: ehuelsmann Date: Tue Oct 21 12:25:53 2008 New Revision: 439 Log: Report deadline errors as DEADLINE-ERROR instead of TIMEOUT-ERROR Modified: usocket/trunk/backend/openmcl.lisp Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp (original) +++ usocket/trunk/backend/openmcl.lisp Tue Oct 21 12:25:53 2008 @@ -64,7 +64,7 @@ (ccl:input-timeout (error 'timeout-error :socket socket :real-error condition)) (ccl:communication-deadline-expired - (error 'timeout-error :socket socket :real-error condition)) + (error 'deadline-error :socket socket :real-error condition)) (ccl::socket-creation-error #| ugh! |# (raise-error-from-id (ccl::socket-creation-error-identifier condition) socket condition))))

1 0

[usocket-cvs] r438 - usocket/branches/0.4.x
by Erik Huelsmann 21 Oct '08

21 Oct '08

Author: ehuelsmann Date: Tue Oct 21 10:02:22 2008 New Revision: 438 Log: Backport c437: Make UNSUPPORTED evaluate to a CERROR, for REPL users. Modified: usocket/branches/0.4.x/condition.lisp Modified: usocket/branches/0.4.x/condition.lisp ============================================================================== --- usocket/branches/0.4.x/condition.lisp (original) +++ usocket/branches/0.4.x/condition.lisp Tue Oct 21 10:02:22 2008 @@ -193,7 +193,7 @@ (defmacro unsupported (feature context &key minimum) - `(signal 'unsupported :feature ,feature + `(cerror 'unsupported :feature ,feature :context ,context :minimum ,minimum)) (defmacro unimplemented (feature context)

1 0

[usocket-cvs] r437 - usocket/trunk
by Erik Huelsmann 21 Oct '08

21 Oct '08

Author: ehuelsmann Date: Tue Oct 21 09:59:52 2008 New Revision: 437 Log: Change the UNSUPPORTED macro to use CERROR instead of SIGNAL, for REPL users. Modified: usocket/trunk/condition.lisp Modified: usocket/trunk/condition.lisp ============================================================================== --- usocket/trunk/condition.lisp (original) +++ usocket/trunk/condition.lisp Tue Oct 21 09:59:52 2008 @@ -193,7 +193,7 @@ (defmacro unsupported (feature context &key minimum) - `(signal 'unsupported :feature ,feature + `(cerror 'unsupported :feature ,feature :context ,context :minimum ,minimum)) (defmacro unimplemented (feature context)

1 0

[usocket-cvs] r436 - usocket/branches/0.4.x/backend
by Erik Huelsmann 20 Oct '08

20 Oct '08

Author: ehuelsmann Date: Mon Oct 20 22:21:08 2008 New Revision: 436 Log: Merge c424 from trunk: Stop leaking socket handles. Modified: usocket/branches/0.4.x/backend/sbcl.lisp Modified: usocket/branches/0.4.x/backend/sbcl.lisp ============================================================================== --- usocket/branches/0.4.x/backend/sbcl.lisp (original) +++ usocket/branches/0.4.x/backend/sbcl.lisp Mon Oct 20 22:21:08 2008 @@ -209,27 +209,33 @@ (not (fboundp 'sb-bsd-sockets::sockopt-tcp-nodelay))) (unsupported 'nodelay 'socket-connect)) - (let* ((socket (make-instance 'sb-bsd-sockets:inet-socket - :type :stream :protocol :tcp)) - (stream (sb-bsd-sockets:socket-make-stream socket - :input t - :output t - :buffering :full - :element-type element-type)) - ;;###FIXME: The above line probably needs an :external-format - (usocket (make-stream-socket :stream stream :socket socket)) - (ip (host-to-vector-quad host))) - (when (and nodelay-specified - (fboundp 'sb-bsd-sockets::sockopt-tcp-nodelay)) - (setf (sb-bsd-sockets:sockopt-tcp-nodelay socket) nodelay)) - (when (or local-host local-port) - (sb-bsd-sockets:socket-bind socket - (host-to-vector-quad - (or local-host *wildcard-host*)) - (or local-port *auto-port*))) - (with-mapped-conditions (usocket) - (sb-bsd-sockets:socket-connect socket ip port)) - usocket)) + (let ((socket (make-instance 'sb-bsd-sockets:inet-socket + :type :stream :protocol :tcp))) + (handler-case + (let* ((stream + (sb-bsd-sockets:socket-make-stream socket + :input t + :output t + :buffering :full + :element-type element-type)) + ;;###FIXME: The above line probably needs an :external-format + (usocket (make-stream-socket :stream stream :socket socket)) + (ip (host-to-vector-quad host))) + (when (and nodelay-specified + (fboundp 'sb-bsd-sockets::sockopt-tcp-nodelay)) + (setf (sb-bsd-sockets:sockopt-tcp-nodelay socket) nodelay)) + (when (or local-host local-port) + (sb-bsd-sockets:socket-bind socket + (host-to-vector-quad + (or local-host *wildcard-host*)) + (or local-port *auto-port*))) + (with-mapped-conditions (usocket) + (sb-bsd-sockets:socket-connect socket ip port)) + usocket) + (t (c) + ;; Make sure we don't leak filedescriptors + (sb-bsd-sockets:socket-close socket) + (error c))))) (defun socket-listen (host port &key reuseaddress @@ -240,11 +246,16 @@ (ip (host-to-vector-quad host)) (sock (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp))) - (with-mapped-conditions () - (setf (sb-bsd-sockets:sockopt-reuse-address sock) reuseaddress) - (sb-bsd-sockets:socket-bind sock ip port) - (sb-bsd-sockets:socket-listen sock backlog) - (make-stream-server-socket sock :element-type element-type)))) + (handler-case + (with-mapped-conditions () + (setf (sb-bsd-sockets:sockopt-reuse-address sock) reuseaddress) + (sb-bsd-sockets:socket-bind sock ip port) + (sb-bsd-sockets:socket-listen sock backlog) + (make-stream-server-socket sock :element-type element-type)) + (t (c) + ;; Make sure we don't leak filedescriptors + (sb-bsd-sockets:socket-close sock) + (error c))))) (defmethod socket-accept ((socket stream-server-usocket) &key element-type) (with-mapped-conditions (socket)

1 0

[usocket-cvs] r435 - usocket/branches/0.4.x/backend
by Erik Huelsmann 20 Oct '08

20 Oct '08

Author: ehuelsmann Date: Mon Oct 20 22:17:59 2008 New Revision: 435 Log: Merge r418-423: Fix SBCL waiting backend. Modified: usocket/branches/0.4.x/backend/sbcl.lisp Modified: usocket/branches/0.4.x/backend/sbcl.lisp ============================================================================== --- usocket/branches/0.4.x/backend/sbcl.lisp (original) +++ usocket/branches/0.4.x/backend/sbcl.lisp Mon Oct 20 22:17:59 2008 @@ -330,7 +330,7 @@ (multiple-value-bind (count err) (sb-unix:unix-fast-select - (1+ (reduce #'max (mapcar #'socket (wait-list-waiters sockets)) + (1+ (reduce #'max (wait-list-%wait sockets) :key #'sb-bsd-sockets:socket-file-descriptor)) (sb-alien:addr rfds) nil nil (when timeout secs) musecs) @@ -340,9 +340,10 @@ (when (< 0 count) ;; process the result... (dolist (x (wait-list-waiters sockets)) - (when (not (sb-unix:fd-isset - (sb-bsd-sockets:socket-file-descriptor (socket x)) - rfds)) + (when (sb-unix:fd-isset + (sb-bsd-sockets:socket-file-descriptor + (socket x)) + rfds) (setf (state x) :READ)))))))))) #+win32

1 0

[usocket-cvs] r434 - usocket/branches/0.4.x/backend
by Erik Huelsmann 20 Oct '08

20 Oct '08

Author: ehuelsmann Date: Mon Oct 20 22:14:12 2008 New Revision: 434 Log: Merge c428 from trunk: WAIT-FOR-INPUT without timeout (non-Win32). Modified: usocket/branches/0.4.x/backend/lispworks.lisp Modified: usocket/branches/0.4.x/backend/lispworks.lisp ============================================================================== --- usocket/branches/0.4.x/backend/lispworks.lisp (original) +++ usocket/branches/0.4.x/backend/lispworks.lisp Mon Oct 20 22:14:12 2008 @@ -216,15 +216,20 @@ ;; Can we have a sane -pref. complete [UDP!?]- API next time, please? (dolist (x (wait-list-waiters wait-list)) (mp:notice-fd (os-socket-handle x))) - (mp:process-wait-with-timeout "Waiting for a socket to become active" - (truncate timeout) - #'(lambda (socks) - (let (rv) - (dolist (x socks rv) - (when (usocket-listen x) - (setf (state x) :READ - rv t))))) - (wait-list-waiters wait-list)) + (labels ((wait-function (socks) + (let (rv) + (dolist (x socks rv) + (when (usocket-listen x) + (setf (state x) :READ + rv t)))))) + (if timeout + (mp:process-wait-with-timeout "Waiting for a socket to become active" + (truncate timeout) + #'wait-function + (wait-list-waiters wait-list)) + (mp:process-wait "Waiting for a socket to become active" + #'wait-function + (wait-list-waiters wait-list)))) (dolist (x (wait-list-waiters wait-list)) (mp:unnotice-fd (os-socket-handle x))) wait-list)))

1 0

[usocket-cvs] r433 - usocket/branches/experimental-udp/backend
by Chun Tian 20 Oct '08

20 Oct '08

Author: ctian Date: Mon Oct 20 07:40:43 2008 New Revision: 433 Log: [udp] minor fixes for CMUCL Modified: usocket/branches/experimental-udp/backend/cmucl.lisp Modified: usocket/branches/experimental-udp/backend/cmucl.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/cmucl.lisp (original) +++ usocket/branches/experimental-udp/backend/cmucl.lisp Mon Oct 20 07:40:43 2008 @@ -89,7 +89,7 @@ (if (or local-host local-port) (with-mapped-conditions (socket) (ext:create-inet-listener (or local-port 0) :datagram :host local-host)) - (with-mapped-conditoins (socket) + (with-mapped-conditions (socket) (ext:create-inet-socket :datagram))))) (if socket (let ((usocket (make-datagram-socket socket))) @@ -248,5 +248,6 @@ (when (unix:fd-isset (socket x) rfds) (setf (state x) :READ))) (progn - ;;###FIXME generate an error, except for EINTR + ;;###FIXME generate an error, except for EINTR + (cmucl-map-socket-error err) )))))))

1 0