[usocket-cvs] r445 - in usocket/branches/experimental-udp: . backend

Chun Tian (binghe) ctian at common-lisp.net
Tue Oct 21 13:48:28 UTC 2008


Author: ctian
Date: Tue Oct 21 13:48:27 2008
New Revision: 445

Log:
[udp] merge last changes from trunk

Modified:
   usocket/branches/experimental-udp/backend/lispworks.lisp
   usocket/branches/experimental-udp/backend/openmcl.lisp
   usocket/branches/experimental-udp/condition.lisp

Modified: usocket/branches/experimental-udp/backend/lispworks.lisp
==============================================================================
--- usocket/branches/experimental-udp/backend/lispworks.lisp	(original)
+++ usocket/branches/experimental-udp/backend/lispworks.lisp	Tue Oct 21 13:48:27 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")
 
@@ -245,7 +261,7 @@
      (unsupported 'local-port 'socket-connect :minimum "LispWorks 5.0+ (verified)"))
 
   (ecase protocol
-    ((:stream :tcp)
+    (:stream
      (let ((hostname (host-to-hostname host))
 	   (stream))
        (setf stream
@@ -263,7 +279,7 @@
 	   (make-stream-socket :socket (comm:socket-stream-socket stream)
 			       :stream stream)
 	   (error 'unknown-error))))
-    ((:datagram :udp)
+    (:datagram
      (let ((usocket (make-datagram-socket
 		     (if (and host port)
 			 (connect-to-udp-server host port

Modified: usocket/branches/experimental-udp/backend/openmcl.lisp
==============================================================================
--- usocket/branches/experimental-udp/backend/openmcl.lisp	(original)
+++ usocket/branches/experimental-udp/backend/openmcl.lisp	Tue Oct 21 13:48:27 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))))

Modified: usocket/branches/experimental-udp/condition.lisp
==============================================================================
--- usocket/branches/experimental-udp/condition.lisp	(original)
+++ usocket/branches/experimental-udp/condition.lisp	Tue Oct 21 13:48:27 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."))
 
@@ -193,7 +201,7 @@
 
 
 (defmacro unsupported (feature context &key minimum)
-  `(signal 'unsupported :feature ,feature
+  `(cerror 'unsupported :feature ,feature
     :context ,context :minimum ,minimum))
 
 (defmacro unimplemented (feature context)




More information about the usocket-cvs mailing list