summaryrefslogtreecommitdiff
path: root/Lisp
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2008-03-07 01:56:31 +0100
committerMatthias Benkard <code@mail.matthias.benkard.de>2008-03-07 01:56:31 +0100
commitd388e4fb3ccd643aa9df6f5fe2b191589bad9157 (patch)
tree9cd350763686ad1a4ed31a3883a972814eb1c98c /Lisp
parent214faeb5d7a5f7fbb2cac0b1edd44f841e73aa7e (diff)
Implement memory management for Lisp-managed instances.
darcs-hash:88a7136f0fa0768b525a44de92100c15a6f8792a
Diffstat (limited to 'Lisp')
-rw-r--r--Lisp/class-definition.lisp32
1 files changed, 29 insertions, 3 deletions
diff --git a/Lisp/class-definition.lisp b/Lisp/class-definition.lisp
index 24db8b1..6637212 100644
--- a/Lisp/class-definition.lisp
+++ b/Lisp/class-definition.lisp
@@ -172,15 +172,22 @@ __define-objective-c-method__"
name)))
superclasses))
(objc-superclass (or (car objc-superclasses) 'ns::ns-object)))
- (assert (null (cdr objc-superclasses)))
- `(progn
+ (assert (endp (cdr objc-superclasses)))
+ `(prog2
(find-objc-class ',objc-superclass)
(defclass ,name ,(or superclasses '(ns::ns-object)) ,slots
,@(unless (member :metaclass options :key #'car)
(if (find-class name nil)
`((:metaclass ,(class-name (class-of (find-class name)))))
`((:metaclass ns::+ns-object))))
- ,@options))))
+ ,@options)
+ (define-objective-c-method #:|retain| :id ((instance ,name))
+ (super)
+ (retain instance)
+ instance)
+ (define-objective-c-method #:|release| :void ((instance ,name))
+ (release instance)
+ (super)))))
(defclass foreign-slot-definition-mixin ()
@@ -544,3 +551,22 @@ intern any missing superclass objects.
__collect-methods__"
(%objcl-for-each-class-do (callback collect-class)))
+
+
+;;;; (@* "Memory management")
+(defvar *retained-lisp-objects* (make-hash-table :test #'eql))
+
+(defun retain (instance)
+ ;; Ensure that INSTANCE is not garbage-collected on the Lisp side.
+ (setf (gethash (pointer-address (pointer instance))
+ *retained-lisp-objects*)
+ instance))
+
+(defun release (instance)
+ ;; If the reference count drops to 1, only the Lisp side has a
+ ;; reference to the instance left. (The Lisp side has certainly got
+ ;; one because this very function does.) In this case, we make the
+ ;; Lisp wrapper object eligible for garbage collection by removing it
+ ;; from the hash table.
+ (when (<= (invoke-by-name instance "retainCount") 2)
+ (remhash (pointer-address (pointer instance)) *retained-lisp-objects*)))