[Openmcl-devel] Voodoo: Callbacks and Closures

[Gary Byers]

On Wed, 4 May 2005, David Steuber wrote:

> On May 3, 2005, at 1:43 AM, Gary Byers wrote:
>
>> If you want to associate a CLOS object with a particular (foreign) function
>> pointer, that seems fairly straightforward:
>> 
>> (defun make-callback-with-object (thing)
>>   (let ((fn))
>>     (declare (special fn))
>>     (defcallback fn (:int arg :int) ; for instance
>>       (some-random-method thing arg)
>>       (slot-value thing 'whatever))
>>     fn))
>
> This is exactly what I wanted and what I wrote is below with its usage.  I am 
> still rather baffled about how it works with the garbage collector though.  I 
> don't know if I've programmed in a slow memory leak or not.
>
> My function that returns a C callback as a closure:
>
> (defun make-event-target-callback (et)
>  (let (fn)
>    (declare (special fn))
>    (ccl:defcallback fn
>        (:<e>vent<h>andler<c>all<r>ef next-handler :<e>vent<r>ef event (:* t) 
> user-data :<oss>tatus)
>      (let ((class (#_GetEventClass event))
>            (kind  (#_GetEventKind  event)))
>        (declare (dynamic-extent class kind))
>        (debug-log "Callback CARBON-EVENT-HANDLER: event-handler-ref = ~S; 
> Class: '~A' Kind: ~A~%"
>                   (slot-value et 'event-handler-ref) (int32-to-string class) 
> kind)
>        (multiple-value-bind (r c)
>            (ignore-errors
>              (handle-event et class kind next-handler event user-data))
>          (declare (dynamic-extent r c))
>          (when c
>            (debug-log "Condition signaled from CARBON-EVENT-HANDLER: < ~A 
>> ~%" c))
>          (if r #$noErr #$eventNotHandledErr))))
>    fn))
>
> The method that uses it:
>
> (defmethod install-event-handler ((et event-target) target event-type-specs 
> userdata)
>  (let* ((num-specs (length event-type-specs))
>         (offset 0)
>         (event-specs (ccl::malloc (* num-specs (ccl::record-length 
> :<e>vent<t>ype<s>pec)))))
>    (dolist (ets event-type-specs)
>      (setf (ccl::%get-unsigned-long event-specs offset) (ets-event-class 
> ets))
>      (incf offset (ccl::record-length :unsigned))
>      (setf (ccl::%get-unsigned-long event-specs offset) (ets-event-kind 
> ets))
>      (incf offset (ccl::record-length :unsigned)))
>    (rlet ((ehr :<e>vent<h>andler<r>ef))
>      (let ((retval (#_InstallEventHandler target
>                                           (#_NewEventHandlerUPP 
> (make-event-target-callback et))
>                                           num-specs
>                                           event-specs
>                                           userdata
>                                           ehr)))
>        (ccl::free event-specs)
>        (with-slots (user-data event-handler-ref) et
>          (setf user-data userdata)
>          (setf event-handler-ref (ccl::%get-ptr ehr))
>          (debug-log "Installed event handler: ~S~%" event-handler-ref))
>        retval))))
>
> The value returned from make-event-target-callback is handed off to the 
> Carbon function NewEventHandlerUPP and then not ever used or saved again. 
> What I think is happening is that the value is simply held in a MACPTR that 
> is free to be garbage collected.  Somehow the closure itself survives this 
> (this is the voodoo bit).  I started thinking perhaps I was creating an 
> immortal object leading to a slow memory leak if I did this many times.  I 
> tried testing in the slime repl to see with the following forms:
>
> (defvar foo (make-instance 'cl-carbon::event-target))
> (cl-carbon::make-event-target-callback foo)
> (time (dotimes (i 1000) (cl-carbon::make-event-target-callback foo)))
> (room t)
> (ccl:gc)
>
> I noted that each time make-event-target-callback is called, a different 
> macptr is returned.  The dotimes loop showed me that this is an expensive 
> function call (not that it matters).  What i was trying to do here was see if 
> room would show me with less and less memory after running the gc.  What I'm 
> not clear on is if that is at all a reliable way to see if I am leaking 
> memory.  Room does seem to show less available memory when I run it.  After I 
> do a gc call, I don't seem to have as much as before the dotimes loop.
>

If you create N unique callback functions and each requires M bytes of
memory, you'll need (according to my calculations) MxN bytes of memory.

> Should I be worried about a memory leak?

I don't remember how often or in what contexts NewEventHandlerUPP is 
called.  If (for example) you install a new event handler callback
every time your applicaton creates a window, you'd probably need to
create quite a few of them before the memory requirements of the unique
per-window callbacks became significant.

> What magic keeps the closure alive?

The symbol CCL::%PASCAL-FUNCTIONS% (so called because - 20 years or so ago -
the MacOS Toobox was mostly written in Pascal, or at least followd 68K
Pascal calling conventions) is allocated at a fixed memory address (known
to the kernel.)  Its value is a vector; each non-NIL element of that
vector is itself a little vector (could be a structure) that contains
a pointer, the actual callback function, the name of the symbol whose
global value is presumed to contain the pointer, and a few (rarely-used)
other values.

(DEFCALLBACK name ...) looks in this vector to see if there's an entry
with the NAME "name", and, if so, if the value of "name" matches the
pointer.  If both of these conditions hold, the callback function in
that entry is replaced; otherwise, a new entry is created.  If the
%PASCAL-FUNCTIONS% vector is full, a larger copy is created, existing
entries get copied to the new vector, and the new entry is added to
the vector.

Each globally named entry has a unique index within the (current) vector,
and this index doesn't change.  (It's preserved across SAVE-APPLICATION.)

Each pointer contains a little block of machine code that does something
like:

   (load-constant scratch-register index-for-entry)
   (jump callback-code-in-lisp-kernel)

The callback code in the lisp kernel handles the transition between
foreign code and lisp code and calls the function in the INDEXth entry
in the %PASCAL-FUNCTIONS% vector.  (It actually calls the functional
value of the symbol %PASCAL-FUNCTIONS% to do the latter; static symbol
names were once in short supply ...)

The fact that the functions are referenced from a global variable
keeps them from getting GCed.  The GC can't in general run around
freeing these things, since it has no idea whether an individual
entry can be referenced from foreign code.  (If the application
"knows" when a callback pointer can no longer be referenced, it'd
be fairly simple to delete the entry associated with that pointer.)