diff options
| -rw-r--r-- | Lisp/memory-management.lisp | 42 | ||||
| -rw-r--r-- | Lisp/method-invocation.lisp | 4 |
2 files changed, 28 insertions, 18 deletions
diff --git a/Lisp/memory-management.lisp b/Lisp/memory-management.lisp index 5463e0b..1d652ae 100644 --- a/Lisp/memory-management.lisp +++ b/Lisp/memory-management.lisp @@ -65,7 +65,24 @@ ;; By the way, is using the return value of SETF considered ;; bad style? (let* ((*in-make-pointer-wrapper-p* t) - (new-wrapper (apply constructor class initargs))) + (new-wrapper (apply constructor + ;; We do not create direct + ;; instances of ID anymore. + ;; Instead, we look for the correct + ;; Objective-C wrapper class and + ;; use that. + ;; + ;; Note that we do not have to + ;; handle the case of POINTER + ;; pointing to a class, because it + ;; is handled right at the + ;; beginning of the function. + (if (eq class 'id) + (primitive-invoke pointer + "class" + 'id) + class) + initargs))) (setf (weak-gethash address hash-table) new-wrapper) ;; As classes always have a retain count of -1, we don't ;; have to do memory management for them. Meanwhile, @@ -83,21 +100,12 @@ (unless *skip-retaining* (primitive-invoke new-wrapper "retain" 'id)) (flet ((finalizer () - ;; In order to send the `release' message to the - ;; newly GC'd object, we have to create a - ;; temporary container object for the final - ;; message delivery. Note that this can cause an - ;; infinite recursion or even memory corruption - ;; if we don't take measure to skip both - ;; finalization and retaining of the temporary - ;; object. Therefore, we call MAKE-INSTANCE - ;; directly. - ;; - ;; (In principle, PRIMITIVE-INVOKE should also - ;; happily take a pointer as its first argument, - ;; but why push our luck?) - (let* ((temporary-wrapper - (funcall constructor class :pointer pointer))) - (primitive-invoke temporary-wrapper "release" :void)))) + ;; Nowadays, PRIMITIVE-INVOKE happily accepts a + ;; pointer as its first argument, which is + ;; important here because the previously created + ;; object wrapper cannot be used anymore. We're + ;; right within its finalisation phase, after + ;; all. + (primitive-invoke pointer "release" :void))) (trivial-garbage:finalize new-wrapper #'finalizer))) new-wrapper))))) diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp index a0a426b..08e0dac 100644 --- a/Lisp/method-invocation.lisp +++ b/Lisp/method-invocation.lisp @@ -285,7 +285,9 @@ easier to use with __apply__. (* ,num +pessimistic-allocation-size+)))) (flet ((ad-hoc-arglist->objc-arglist! (args) (setf (argref '(:pointer :void) 0) - (pointer-to receiver) + (if (pointerp receiver) + receiver + (pointer-to receiver)) (argref '(:pointer :void) 1) (pointer-to selector)) (loop for arg in args |