Changeset 15145


Ignore:
Timestamp:
Dec 18, 2011, 5:24:51 AM (8 years ago)
Author:
gb
Message:

Try to address ticket:896 (at least the parts that aren't "this isn't
Smalltalk.") For the time being, do so by holding strong references
to termination functions while they're on the finalization alist; it
might be preferable to do this in the GC, but this approach is better
than forcing the user to do it themselves.

It's now the case that if a termination function (transitively) refers
to the associated object the object won't be terminated (or even GCed.)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-lisp-threads.lisp

    r14748 r15145  
    10211021(defvar *enable-automatic-termination* t)
    10221022
     1023(defstatic  *termination-functions-lock* (make-lock))
     1024(defstatic *termination-functions* (make-hash-table :test #'eq :lock-free nil))
     1025
     1026(defun register-termination-function (f)
     1027  (with-lock-grabbed (*termination-functions-lock*)
     1028    (without-interrupts
     1029     (incf (gethash f *termination-functions* 0)))))
     1030
     1031(defun deregister-termination-function (f)
     1032  (with-lock-grabbed (*termination-functions-lock*)
     1033    (without-interrupts
     1034     (let* ((count (gethash f *termination-functions*)))
     1035       (when count
     1036         (if (eql 0 (decf count))
     1037           (remhash f *termination-functions*)
     1038           (setf (gethash f *termination-functions*) count)))))))
     1039
    10231040(defun terminate-when-unreachable (object &optional (function 'terminate))
    10241041  "The termination mechanism is a way to have the garbage collector run a
     
    10321049        (population *termination-population*))
    10331050    (without-interrupts
     1051     (register-termination-function function)
    10341052     (with-lock-grabbed (*termination-population-lock*)
    10351053       (atomic-push-uvector-cell population population.data new-cell)))
     
    10471065          (if (not existed)
    10481066            (return)
    1049           (funcall (cdr cell) (car cell))))))))
     1067            (let* ((f (cdr cell)))
     1068              (deregister-termination-function f)
     1069              (funcall f (car cell)))))))))
    10501070
    10511071(defun cancel-terminate-when-unreachable (object &optional (function nil function-p))
     
    10661086                         (or (null function-p)
    10671087                             (eq function f)))
     1088                (deregister-termination-function f)
    10681089                (if prev
    10691090                  (setf (cdr prev) (cdr spine))
Note: See TracChangeset for help on using the changeset viewer.