Index: /trunk/ccl/level-1/l1-lisp-threads.lisp
===================================================================
--- /trunk/ccl/level-1/l1-lisp-threads.lisp	(revision 421)
+++ /trunk/ccl/level-1/l1-lisp-threads.lisp	(revision 422)
@@ -1189,4 +1189,6 @@
   (%cons-terminatable-alist))
 
+(defvar *termination-population-lock* (make-lock))
+
 
 (defvar *enable-automatic-termination* t)
@@ -1195,5 +1197,5 @@
   (let ((new-cell (list (cons object function)))
         (population *termination-population*))
-    (without-interrupts
+    (with-lock-grabbed (*termination-population-lock*)
      (setf (cdr new-cell) (population-data population)
            (population-data population) new-cell))
@@ -1207,5 +1209,5 @@
         (population *termination-population*))
     (loop
-      (without-interrupts
+      (with-lock-grabbed (*termination-population-lock*)
        (let ((list (population-termination-list population)))
          (unless list (return))
@@ -1222,5 +1224,5 @@
                   (setq found-it? t))))
       (declare (dynamic-extent #'test))
-      (without-interrupts
+      (with-lock-grabbed (*termination-population-lock*)
        (setf (population-data *termination-population*)
              (delete object (population-data *termination-population*)
@@ -1230,5 +1232,6 @@
 
 (defun termination-function (object)
-  (cdr (assq object (population-data *termination-population*))))
+  (with-lock-grabbed (*termination-population-lock*)
+    (cdr (assq object (population-data *termination-population*)))))
 
 (defun do-automatic-termination ()