Proxies may now have "weak" references to the foreign object

diff --git a/glib/gtype.lisp b/glib/gtype.lisp
index 7c368922d81bc9d029e702fd57505dcac21a58eb..2498302a8c839f490607f4528a5cc602f0f8201f 100644 (file)
--- a/glib/gtype.lisp
+++ b/glib/gtype.lisp
@@ -20,7 +20,7 @@
 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 

-;; $Id: gtype.lisp,v 1.39 2006-02-05 15:38:57 espen Exp $
+;; $Id: gtype.lisp,v 1.40 2006-02-06 11:52:24 espen Exp $

 
 (in-package "GLIB")
 
 
 (in-package "GLIB")
 


@@ -302,7 +302,6 @@              (default-alien-type-name class-name)))
       (warn "~A is the super type for ~A in the gobject type system."
        (supertype type-number) class-name))))
 
       (warn "~A is the super type for ~A in the gobject type system."
        (supertype type-number) class-name))))
 

-

 (defmethod validate-superclass ((class ginstance-class) (super standard-class))
   (subtypep (class-name super) 'ginstance))
 
 (defmethod validate-superclass ((class ginstance-class) (super standard-class))
   (subtypep (class-name super) 'ginstance))
 


@@ -344,6 +343,10 @@ (defmethod make-proxy-instance ((class ginstance-class) location &rest initargs)
   ;; and therefor ignore the weak-p argument.
   (call-next-method class location :weak nil))
 
   ;; and therefor ignore the weak-p argument.
   (call-next-method class location :weak nil))
 

+(defmethod invalidate-instance ((instance ginstance))
+  (declare (ignore instance))
+  ;; A ginstance should never be invalidated since it is ref counted
+  nil)

 
 (defmethod copy-from-alien-form (location (class ginstance-class) &rest args)
   (declare (ignore location class args))
 
 (defmethod copy-from-alien-form (location (class ginstance-class) &rest args)
   (declare (ignore location class args))

diff --git a/glib/proxy.lisp b/glib/proxy.lisp
index 5f0e5cfb24308aa22c31484d01cf50ce02c7fbe4..ff08b84900ce8df8736615ee638c49253a0b8e1a 100644 (file)
--- a/glib/proxy.lisp
+++ b/glib/proxy.lisp
@@ -20,7 +20,7 @@
 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 

-;; $Id: proxy.lisp,v 1.25 2006-02-05 15:38:57 espen Exp $
+;; $Id: proxy.lisp,v 1.26 2006-02-06 11:52:24 espen Exp $

 
 (in-package "GLIB")
 
 
 (in-package "GLIB")
 


@@ -270,6 +270,7 @@ (defun list-cached-instances ()
 
 ;;;; Proxy for alien instances
 
 
 ;;;; Proxy for alien instances
 

+;; TODO: add a ref-counted-proxy subclass

 (defclass proxy ()
   ((location :allocation :special :reader foreign-location :type pointer))
   (:metaclass virtual-slots-class))
 (defclass proxy ()
   ((location :allocation :special :reader foreign-location :type pointer))
   (:metaclass virtual-slots-class))


@@ -277,6 +278,7 @@ (defclass proxy ()
 (defgeneric instance-finalizer (object))
 (defgeneric reference-foreign (class location))
 (defgeneric unreference-foreign (class location))
 (defgeneric instance-finalizer (object))
 (defgeneric reference-foreign (class location))
 (defgeneric unreference-foreign (class location))

+(defgeneric invalidate-instance (object))

 
 (defmethod reference-foreign ((name symbol) location)
   (reference-foreign (find-class name) location))
 
 (defmethod reference-foreign ((name symbol) location)
   (reference-foreign (find-class name) location))


@@ -310,6 +312,10 @@ (defmethod instance-finalizer ((instance proxy))
        (remove-cached-instance location)
        (unreference-foreign class location))))
 
        (remove-cached-instance location)
        (unreference-foreign class location))))
 

+(defmethod invalidate-instance ((instance proxy))
+  (remove-cached-instance (foreign-location instance))
+  (slot-makunbound instance 'location))
+

 
 ;;;; Metaclass used for subclasses of proxy
 
 
 ;;;; Metaclass used for subclasses of proxy
 


@@ -509,7 +515,10 @@ (defun ensure-proxy-instance (class location &rest initargs)
 MAKE-PROXY-INSTANCE is called to create one."
   (unless (null-pointer-p location)
     (or 
 MAKE-PROXY-INSTANCE is called to create one."
   (unless (null-pointer-p location)
     (or 

-     (find-cached-instance location)
+     (let ((instance (find-cached-instance location)))
+       (when instance
+        (format t "Object found in cache: ~A~%" instance)
+        instance))

      (let ((instance (apply #'make-proxy-instance class location initargs)))
        (cache-instance instance)
        instance))))
      (let ((instance (apply #'make-proxy-instance class location initargs)))
        (cache-instance instance)
        instance))))


@@ -519,11 +528,10 @@ (defgeneric make-proxy-instance (class location &key weak)
 object at the give location. If WEAK is non NIL the foreign memory
 will not be released when the proxy is garbage collected."))
 
 object at the give location. If WEAK is non NIL the foreign memory
 will not be released when the proxy is garbage collected."))
 

-(defmethod make-proxy-instance ((class symbol) location &key weak)
-  (ensure-proxy-instance (find-class class) location :weak weak))
+(defmethod make-proxy-instance ((class symbol) location &rest initargs)
+  (apply #'make-proxy-instance (find-class class) location initargs))

 
 (defmethod make-proxy-instance ((class proxy-class) location &key weak)
 
 (defmethod make-proxy-instance ((class proxy-class) location &key weak)

-  (declare (ignore weak-p))

   (let ((instance (allocate-instance class)))
     (setf (slot-value instance 'location) location)
     (unless weak
   (let ((instance (allocate-instance class)))
     (setf (slot-value instance 'location) location)
     (unless weak


@@ -573,6 +581,13 @@ (defmethod compute-foreign-size ((class struct-class))
                         (size-of (slot-definition-type slotd))))))
     (+ size (mod size +struct-alignmen+))))
 
                         (size-of (slot-definition-type slotd))))))
     (+ size (mod size +struct-alignmen+))))
 

+(defmethod weak-reader-function ((class struct-class) &rest args)
+  (declare (ignore args))
+  #'(lambda (location &optional (offset 0))
+      (let ((instance (sap-ref-sap location offset)))
+       (unless (null-pointer-p instance)
+         (ensure-proxy-instance class instance :weak t)))))
+

 
 (defclass static-struct-class (struct-class)
   ())
 
 (defclass static-struct-class (struct-class)
   ())


@@ -599,6 +614,12 @@ (defmethod reader-function ((type (eql 'inlined)) &rest args)
        (ensure-proxy-instance class 
         (reference-foreign class (sap+ location offset))))))
 
        (ensure-proxy-instance class 
         (reference-foreign class (sap+ location offset))))))
 

+(defmethod writer-function ((type (eql 'inlined)) &rest args)
+  (declare (ignore type))
+  (destructuring-bind (class) args
+    #'(lambda (instance location &optional (offset 0))
+       (copy-memory (foreign-location instance) (foreign-size class) (sap+ location offset)))))
+

 (defmethod destroy-function ((type (eql 'inlined)) &rest args)
   (declare (ignore args))
   #'(lambda (location &optional (offset 0))
 (defmethod destroy-function ((type (eql 'inlined)) &rest args)
   (declare (ignore args))
   #'(lambda (location &optional (offset 0))