[slime-cvs] CVS slime

[heller]

Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv18721

Modified Files:
	swank-ecl.lisp 
Log Message:
* swank-ecl.lisp (thread-id): Assign an non-nil id to unknown
threads.

--- /project/slime/cvsroot/slime/swank-ecl.lisp	2008/08/08 13:43:33	1.25
+++ /project/slime/cvsroot/slime/swank-ecl.lisp	2008/08/11 07:39:23	1.26
@@ -441,6 +441,7 @@
       (incf *thread-id-counter*)))
 
   (defparameter *thread-id-map* (make-hash-table))
+  (defparameter *id-thread-map* (make-hash-table))
 
   (defvar *thread-id-map-lock*
     (mp:make-lock :name "thread id map lock"))
@@ -454,19 +455,22 @@
 	#'(lambda ()
 	    (unwind-protect
 	      (mp:with-lock (*thread-id-map-lock*)
-	        (setf (gethash id *thread-id-map*) thread))
+	        (setf (gethash id *thread-id-map*) thread)
+                (setf (gethash thread *id-thread-map*) id))
 	      (funcall fn)
 	      (mp:with-lock (*thread-id-map-lock*)
+                (remhash thread *id-thread-map*)
                 (remhash id *thread-id-map*)))))
       (mp:process-enable thread)))
 
   (defimplementation thread-id (thread)
     (block thread-id
       (mp:with-lock (*thread-id-map-lock*)
-        (loop for id being the hash-key in *thread-id-map*
-              using (hash-value thread-pointer)
-              do (if (eq thread thread-pointer)
-		   (return-from thread-id id))))))
+        (or (gethash thread *id-thread-map*)
+            (let ((id (next-thread-id)))
+              (setf (gethash id *thread-id-map*) thread)
+              (setf (gethash thread *id-thread-map*) id)
+              id)))))
 
   (defimplementation find-thread (id)
     (mp:with-lock (*thread-id-map-lock*)