summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Lisp/memory-management.lisp42
-rw-r--r--Lisp/method-invocation.lisp4
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