From 4a64c16d900f59a4e6b1ac57fc8658f6faabbcfc Mon Sep 17 00:00:00 2001 Message-Id: <4a64c16d900f59a4e6b1ac57fc8658f6faabbcfc.1714395787.git.mdw@distorted.org.uk> From: Mark Wooding Date: Mon, 6 Feb 2006 11:52:24 +0000 Subject: [PATCH] Proxies may now have "weak" references to the foreign object Organization: Straylight/Edgeware From: espen --- glib/gtype.lisp | 7 +++++-- glib/proxy.lisp | 31 ++++++++++++++++++++++++++----- 2 files changed, 31 insertions(+), 7 deletions(-) diff --git a/glib/gtype.lisp b/glib/gtype.lisp index 7c36892..2498302 100644 --- 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. -;; $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") @@ -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)))) - (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)) +(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)) diff --git a/glib/proxy.lisp b/glib/proxy.lisp index 5f0e5cf..ff08b84 100644 --- 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. -;; $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") @@ -270,6 +270,7 @@ (defun list-cached-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)) @@ -277,6 +278,7 @@ (defclass proxy () (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)) @@ -310,6 +312,10 @@ (defmethod instance-finalizer ((instance proxy)) (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 @@ -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 - (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)))) @@ -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.")) -(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) - (declare (ignore weak-p)) (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+)))) +(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) ()) @@ -599,6 +614,12 @@ (defmethod reader-function ((type (eql 'inlined)) &rest args) (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)) -- [mdw]