[usocket-cvs] r443 - in usocket/trunk: . backend

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


Author: ctian
Date: Tue Oct 21 13:34:39 2008
New Revision: 443

Log:
Merge c441,442 from branch 0.4.x to trunk

Modified:
   usocket/trunk/backend/lispworks.lisp
   usocket/trunk/condition.lisp

Modified: usocket/trunk/backend/lispworks.lisp
==============================================================================
--- usocket/trunk/backend/lispworks.lisp	(original)
+++ usocket/trunk/backend/lispworks.lisp	Tue Oct 21 13:34:39 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")
 

Modified: usocket/trunk/condition.lisp
==============================================================================
--- usocket/trunk/condition.lisp	(original)
+++ usocket/trunk/condition.lisp	Tue Oct 21 13:34:39 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))




More information about the usocket-cvs mailing list