From ca01de1b4128e7b32b56e14b091762f2bce0d33d Mon Sep 17 00:00:00 2001 Message-Id: From: Mark Wooding Date: Tue, 7 Feb 2006 13:20:39 +0000 Subject: [PATCH] Added caching of invalidated proxy instances Organization: Straylight/Edgeware From: espen --- glib/proxy.lisp | 35 +++++++++++++++++++++++++++++++---- 1 file changed, 31 insertions(+), 4 deletions(-) diff --git a/glib/proxy.lisp b/glib/proxy.lisp index 52e329d..aad2918 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.28 2006-02-06 18:12:19 espen Exp $ +;; $Id: proxy.lisp,v 1.29 2006-02-07 13:20:39 espen Exp $ (in-package "GLIB") @@ -234,7 +234,6 @@ (defmethod validate-superclass ;;;; Proxy cache -(internal *instance-cache*) (defvar *instance-cache* (make-hash-table :test #'eql)) (defun cache-instance (instance &optional (weak-ref t)) @@ -266,6 +265,27 @@ (defun list-cached-instances () *instance-cache*) instances)) +;; Instances that gets invalidated tend to be short lived, but created +;; in large numbers. So we're keeping them in a hash table to be able +;; to reuse them (and thus reduce consing) +(defvar *invalidated-instance-cache* (make-hash-table :test #'eql)) + +(defun cache-invalidated-instance (instance) + (push instance + (gethash (class-of instance) *invalidated-instance-cache*))) + +(defun find-invalidated-instance (class) + (when (gethash class *invalidated-instance-cache*) + (pop (gethash class *invalidated-instance-cache*)))) + +(defun list-invalidated-instances () + (let ((instances ())) + (maphash #'(lambda (location ref) + (declare (ignore location)) + (push ref instances)) + *invalidated-instance-cache*) + instances)) + ;;;; Proxy for alien instances @@ -312,9 +332,13 @@ (defmethod instance-finalizer ((instance proxy)) (remove-cached-instance location) (unreference-foreign class location)))) +;; Any reference to the foreign object the instance may have held +;; should be released before this method is invoked (defmethod invalidate-instance ((instance proxy)) (remove-cached-instance (foreign-location instance)) - (slot-makunbound instance 'location)) + (slot-makunbound instance 'location) + (cancel-finalization instance) + (cache-invalidated-instance instance)) ;;;; Metaclass used for subclasses of proxy @@ -535,7 +559,10 @@ (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) - (let ((instance (allocate-instance class))) + (let ((instance + (or + (find-invalidated-instance class) + (allocate-instance class)))) (setf (slot-value instance 'location) location) (unless weak (finalize instance (instance-finalizer instance))) -- [mdw]