diff -r 2225a8f2d322 -r 3c562ce589df swank-abcl.lisp
--- a/swank-abcl.lisp	Wed Jul 01 05:38:54 2009 +0200
+++ b/swank-abcl.lisp	Wed Jul 01 11:06:42 2009 +0200
@@ -17,6 +17,7 @@
 (defun sys::break (&optional (format-control "BREAK called") 
                    &rest format-arguments)
   (let ((*saved-backtrace* (backtrace-as-list-ignoring-swank-calls)))
+    (declare (ignore *saved-backtrace*))
     (with-simple-restart (continue "Return from BREAK.")
       (invoke-debugger
        (sys::%make-condition 'simple-condition
@@ -42,10 +43,16 @@
 
 ;(defun class-finalized-p (class) t)
 
-(defun slot-definition-documentation (slot) #+nil (documentation slot 't))
-(defun slot-definition-type (slot) t)
-(defun class-prototype (class))
-(defun generic-function-declarations (gf))
+(defun slot-definition-documentation (slot) 
+  (declare (ignore slot))
+  #+nil (documentation slot 't))
+(defun slot-definition-type (slot) 
+  (declare (ignore slot)) 
+  t)
+(defun class-prototype (class) 
+  (declare (ignore class)))  
+(defun generic-function-declarations (gf)
+  (declare (ignore gf)))
 (defun specializer-direct-methods (spec) (mop::class-direct-methods spec))
 
 (defun slot-definition-name (slot)
@@ -61,9 +68,11 @@
   (mop::%method-function method))
 
 (defun slot-boundp-using-class (class object slotdef)
+  (declare (ignore class)) ; FIXME
   (system::slot-boundp object (slot-definition-name slotdef)))
 
 (defun slot-value-using-class (class object slotdef)
+  (declare (ignore class)) ; FIXME
   (system::slot-value object (slot-definition-name slotdef)))
 
 (import-to-swank-mop
@@ -119,7 +128,7 @@
 
 
 (defimplementation preferred-communication-style ()
-  nil)
+  :spawn)
 
 (defimplementation create-socket (host port)
   (ext:make-server-socket port))
@@ -483,8 +492,8 @@
 
 ;;;; Multithreading
 
-(defimplementation startup-multiprocessing ()
-  #+nil(mp:start-scheduler))
+#+nil  ; Already started
+(defimplementation startup-multiprocessing (continuation))
 
 (defimplementation spawn (fn &key name)
   (ext:make-thread (lambda () (funcall fn)) :name name))
@@ -513,7 +522,23 @@
 (defimplementation thread-status (thread)
   (format nil "Thread is ~:[dead~;alive~]" (ext:thread-alive-p thread)))
 
+;; XXX should be a weak hash table
+(defparameter *thread-description-map* (make-hash-table)) 
+
+(defvar *thread-description-map-lock*
+  (ext:make-mutex))
+
+(defimplementation thread-description (thread) 
+  (ext:with-mutex (*thread-description-map-lock*)
+    (or (gethash thread *thread-description-map*)
+        "No description available.")))
+
+(defimplementation set-thread-description (thread description) 
+  (ext:with-mutex (*thread-description-map-lock*)
+    (setf (gethash thread *thread-description-map*) description)))
+
 (defimplementation make-lock (&key name)
+  (declare (ignore name))
   (ext:make-thread-lock))
 
 (defimplementation call-with-lock-held (lock function)
@@ -525,8 +550,11 @@
 (defimplementation all-threads ()
   (copy-list (ext:mapcar-threads #'identity)))
 
+(defimplementation thread-alive-p (thread)
+  (member thread (all-threads)))
+
 (defimplementation interrupt-thread (thread fn)
-  (ext:interrupt-thread thread fn))
+  (ext:interrupt-thread thread fn)) 
 
 (defimplementation kill-thread (thread)
   (ext:destroy-thread thread))
@@ -542,14 +570,13 @@
         (setf (getf (gethash thread *thread-props*) 'mailbox)
               (make-mailbox)))))
 
-(defimplementation send (thread object)
+(defimplementation send (thread message)
   (let ((mbox (mailbox thread)))
     (ext:with-mutex ((mailbox-mutex mbox))
       (setf (mailbox-queue mbox) 
             (nconc (mailbox-queue mbox) (list message))))))
 
-#+(or)
-(defimplementation receive-if (thread &optional timeout)
+(defimplementation receive-if (test &optional timeout)
   (let* ((mbox (mailbox (current-thread))))
     (assert (or (not timeout) (eq timeout t)))
     (loop
@@ -561,9 +588,7 @@
            (setf (mailbox-queue mbox) (nconc (ldiff q tail) (cdr tail)))
            (return (car tail))))
        (when (eq timeout t) (return (values nil t)))
-       ;;(java:jcall (java:jmethod "java.lang.Object" "wait") 
-       ;;            (mailbox-mutex mbox) 1000)
-       ))))
+       (sleep .05)))))
 
 (defimplementation quit-lisp ()
   (ext:exit))
