From: Dmitry Kalyanov <Kalyanov.Dmitry@gmail.com>
Date: Thu, 26 Nov 2009 20:46:57 +0000 (+0300)
Subject: Destroy opaque GBoxed object thread-safely (not tested)
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=cee936c7fc2623c44ab7f37602821089b0b27cd1;p=cl-gtk2.git

Destroy opaque GBoxed object thread-safely (not tested)
---

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))