/[slime]/slime/swank-sbcl.lisp
ViewVC logotype

Diff of /slime/swank-sbcl.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.300 by sboukarev, Wed Dec 21 16:19:52 2011 UTC revision 1.301 by heller, Fri Jan 6 09:02:43 2012 UTC
# Line 1578  stack." Line 1578  stack."
1578               (return (car tail))))               (return (car tail))))
1579           (when (eq timeout t) (return (values nil t)))           (when (eq timeout t) (return (values nil t)))
1580           (condition-timed-wait waitq mutex 0.2)))))           (condition-timed-wait waitq mutex 0.2)))))
1581    
1582      (let ((alist '())
1583            (mutex (sb-thread:make-mutex :name "register-thread")))
1584    
1585        (defimplementation register-thread (name thread)
1586          (declare (type symbol name))
1587          (sb-thread:with-mutex (mutex)
1588            (etypecase thread
1589              (null
1590               (setf alist (delete name alist :key #'car)))
1591              (sb-thread:thread
1592               (let ((probe (assoc name alist)))
1593                 (cond (probe (setf (cdr probe) thread))
1594                       (t (setf alist (acons name thread alist))))))))
1595          nil)
1596    
1597        (defimplementation find-registered (name)
1598          (sb-thread:with-mutex (mutex)
1599            (cdr (assoc name alist)))))
1600    
1601    )    )
1602    
1603  (defimplementation quit-lisp ()  (defimplementation quit-lisp ()

Legend:
Removed from v.1.300  
changed lines
  Added in v.1.301

  ViewVC Help
Powered by ViewVC 1.1.5