[Openmcl-devel] Voodoo: Callbacks and Closures

[Gary Byers]

On Fri, 6 May 2005, David Steuber wrote:

> On May 5, 2005, at 5:01 PM, Gary Byers wrote:
>
>>> Does this mean that a CLOS object referenced by the callback is also 
>>> protected from getting GCed?
>> 
>> yes; it's transitively reachable from a global variable 
>> (%PASCAL-FUNCTIONS%).
>> 
>>> I also have a function for uninstalling an event handler.  Once this is 
>>> done, the callback will no longer by referenced.  What do I need to do to 
>>> delete the entry?
>> 
>> This is untested, assumes that it's defined in the CCL package, and 
>> continues
>> the confusing tradition of calling callbacks "Pascal functions".
>> 
>> (defun %delete-pascal-function (pointer)
>>   (with-lock-grabbed (*callback-lock*)
>>     (let* ((index (dotimes (i (length %pascal-function))
>>                     (when (eql (pfe.routine-descriptor (svref 
>> %pascal-functions%^ i)) pointer)
>>                       (return i)))))
>>       (when index
>>         (let* ((entry (svref %pascal-functions%^ index)))
>>           (setf (svref %pascal-functions%^ index) nil)
>>           (when (eql (symbol-value (pfe.sym entry))
>>                      (pfe.routine-descriptor entry))
>>             (set (symbol-value (pfe.sym entry)) nil))
>>           (free (pfe.routine-descriptor entry))
>>           t)))))
>
> Thanks, Gary.
>
> Based on the above, I made some minor modifications to your function and did 
> some testing:
>
> ;; this function is based on code that Gary Byers posted to openmcl-devel
> (defun delete-event-target-callback (pointer)
>  (with-lock-grabbed (ccl::*callback-lock*)
>    (let ((index (dotimes (i (length ccl::%pascal-functions%))
>                   (when (eql (ccl::pfe.routine-descriptor (svref 
> ccl::%pascal-functions% i))
>                              pointer)
>                     (return i)))))
>      (when index
>        (let ((entry (svref ccl::%pascal-functions% index)))
>          (setf (svref ccl::%pascal-functions% index) nil)
>          (ccl::free (ccl::pfe.routine-descriptor entry))
>          t)))))
>
> I had some trouble with the symbol-value stuff so I removed it.  It looks 
> like what's left does all I need.  I'm not sure why the call to free is 
> necessary though but I left it in.  It's just the reference to the closure I 
> need removed.  The program is expected to create a new closure for each 
> window or whatever other object may need to receive carbon events that is 
> created.  I haven't tested this with window objects yet, but here is a 
> partial transcript from my slime repl session where I tested the code.  Note 
> also that I have not yet tested to see if this gets rid of the "memory leak" 
> that I think I had/have.

It's probably worth fixing the SYMBOL-VALUE stuff to check to do a BOUNDP
check.

It might also be worth modifying DEFCALLBACK to allow NIL as a name
(or, since that's starting to get a bit kludgy, to have something like
DEFINE-ANONYMOUS-CALLBACK, which sets everything up and returns the
pointer.)

>
> CL-USER> (loop for i across ccl::%pascal-functions% do (print i))
>
> #(#<A Mac Pointer #x102490> NIL #<Compiled-function 
> CCL::%FOREIGN-THREAD-CONTROL (Non-Global)  #x60F58BE> 
> CCL::%FOREIGN-THREAD-CONTROL T NIL)
> #(#<A Mac Pointer #x1024B0> NIL #<Compiled-function CCL::XCMAIN (Non-Global) 
> #x6134406> CCL::XCMAIN T NIL)
> #(#<A Mac Pointer #x1024D0> NIL #<Compiled-function CCL::%XERR-DISP 
> (Non-Global)  #x6168F4E> CCL::%XERR-DISP NIL NIL)
> #(#<A Mac Pointer #x105D80> NIL #<COMPILED-LEXICAL-CLOSURE CL-CARBON::FN 
> #x640AA06> CL-CARBON::FN NIL NIL)
> NIL
> NIL
> NIL
> NIL
> NIL
>
> NIL
> CL-USER> (setf bar (cl-carbon::make-event-target-callback foo))
> #<A Mac Pointer #x15E6D0>
> CL-USER> (loop for i across ccl::%pascal-functions% do (print i))
>
> #(#<A Mac Pointer #x102490> NIL #<Compiled-function 
> CCL::%FOREIGN-THREAD-CONTROL (Non-Global)  #x60F58BE> 
> CCL::%FOREIGN-THREAD-CONTROL T NIL)
> #(#<A Mac Pointer #x1024B0> NIL #<Compiled-function CCL::XCMAIN (Non-Global) 
> #x6134406> CCL::XCMAIN T NIL)
> #(#<A Mac Pointer #x1024D0> NIL #<Compiled-function CCL::%XERR-DISP 
> (Non-Global)  #x6168F4E> CCL::%XERR-DISP NIL NIL)
> #(#<A Mac Pointer #x105D80> NIL #<COMPILED-LEXICAL-CLOSURE CL-CARBON::FN 
> #x640AA06> CL-CARBON::FN NIL NIL)
> #(#<A Mac Pointer #x15E6D0> NIL #<COMPILED-LEXICAL-CLOSURE CL-CARBON::FN 
> #x6C01B0E> CL-CARBON::FN NIL NIL)
> NIL
> NIL
> NIL
> NIL
>
> NIL
> CL-USER> (cl-carbon::delete-event-target-callback bar)
> T
> CL-USER> (loop for i across ccl::%pascal-functions% do (print i))
>
> #(#<A Mac Pointer #x102490> NIL #<Compiled-function 
> CCL::%FOREIGN-THREAD-CONTROL (Non-Global)  #x60F58BE> 
> CCL::%FOREIGN-THREAD-CONTROL T NIL)
> #(#<A Mac Pointer #x1024B0> NIL #<Compiled-function CCL::XCMAIN (Non-Global) 
> #x6134406> CCL::XCMAIN T NIL)
> #(#<A Mac Pointer #x1024D0> NIL #<Compiled-function CCL::%XERR-DISP 
> (Non-Global)  #x6168F4E> CCL::%XERR-DISP NIL NIL)
> #(#<A Mac Pointer #x105D80> NIL #<COMPILED-LEXICAL-CLOSURE CL-CARBON::FN 
> #x640AA06> CL-CARBON::FN NIL NIL)
> NIL
> NIL
> NIL
> NIL
> NIL
> NIL
> CL-USER>
>
> Does this look kosher to you?

Yes; the entry with the pointer at #x15E6D0 is gone.

>
>
>