[Openmcl-devel] Voodoo: Callbacks and Closures

[David Steuber]

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.

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?