[slime-cvs] CVS update: slime/swank-cmucl.lisp

[Helmut Eller]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv15110

Modified Files:
	swank-cmucl.lisp 
Log Message:
(thread-id, find-thread): New backend function.
Date: Sun Jun 27 08:00:37 2004
Author: heller

Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.108 slime/swank-cmucl.lisp:1.109
--- slime/swank-cmucl.lisp:1.108	Fri Jun 25 01:05:34 2004
+++ slime/swank-cmucl.lisp	Sun Jun 27 08:00:37 2004
@@ -1735,6 +1735,17 @@
   (defimplementation spawn (fn &key (name "Anonymous"))
     (mp:make-process fn :name name))
 
+  (defvar *thread-id-counter* 0)
+
+  (defimplementation thread-id (thread)
+    (or (getf (mp:process-property-list thread) 'id)
+        (setf (getf (mp:process-property-list thread) 'id)
+              (incf *thread-id-counter*))))
+
+  (defimplementation find-thread (id)
+    (find id (all-threads)
+          :key (lambda (p) (getf (mp:process-property-list p) 'id))))
+
   (defimplementation thread-name (thread)
     (mp:process-name thread))