From cee936c7fc2623c44ab7f37602821089b0b27cd1 Mon Sep 17 00:00:00 2001 From: Dmitry Kalyanov Date: Thu, 26 Nov 2009 23:46:57 +0300 Subject: [PATCH] Destroy opaque GBoxed object thread-safely (not tested) --- glib/gobject.boxed.lisp | 29 +++++++++++++++++++++++++++-- 1 file changed, 27 insertions(+), 2 deletions(-) diff --git a/glib/gobject.boxed.lisp b/glib/gobject.boxed.lisp index 983d0ff..4c000bd 100644 --- a/glib/gobject.boxed.lisp +++ b/glib/gobject.boxed.lisp @@ -241,13 +241,38 @@ (defmethod free-translated-object (native (type boxed-opaque-foreign-type) param) (declare (ignore native type param))) +(defvar *gboxed-gc-hooks-lock* (make-recursive-lock "gboxed-gc-hooks-lock")) +(defvar *gboxed-gc-hooks* nil);;pointers to objects to be freed + +(defun activate-gboxed-gc-hooks () + (with-recursive-lock-held (*gboxed-gc-hooks-lock*) + (when *gboxed-gc-hooks* + (log-for :gc "activating gc hooks for boxeds: ~A~%" *gboxed-gc-hooks*) + (loop + for (pointer type) in *gboxed-gc-hooks* + do (boxed-free-fn type pointer)) + (setf *gboxed-gc-hooks* nil)))) + +(defcallback gboxed-idle-gc-hook :boolean ((data :pointer)) + (declare (ignore data)) + (activate-gboxed-gc-hooks) + nil) + +(defun register-gboxed-for-gc (type pointer) + (with-recursive-lock-held (*gboxed-gc-hooks-lock*) + (let ((locks-were-present (not (null *gboxed-gc-hooks*)))) + (push (list pointer type) *gboxed-gc-hooks*) + (unless locks-were-present + (log-for :gc "adding gboxed idle-gc-hook to main loop~%") + (g-idle-add (callback gboxed-idle-gc-hook) (null-pointer)))))) + (defun make-boxed-free-finalizer (type pointer) - (lambda () (boxed-free-fn type pointer))) + (lambda () (register-gboxed-for-gc type pointer))) (defmethod translate-from-foreign (native (foreign-type boxed-opaque-foreign-type)) (let* ((type (g-boxed-foreign-info foreign-type)) (proxy (make-instance (g-boxed-info-name type) :pointer native))) - (tg:finalize proxy (make-boxed-free-finalizer type native)))) + proxy)) (defmethod cleanup-translated-object-for-callback ((type boxed-opaque-foreign-type) proxy native) (declare (ignore native)) -- 1.7.10.4