Registering multiple Perl sub references for a C library in XS

Question

Both perlcall (in the "Strategies for storing Callback Context Information" section) and Extending and Embedding Perl (in the "Callback" section) lists 3 different ways to handle calling Perl sub routines from XS/C:

1. Immediately: XS calls
2. Deferred: saving the sub ref as an SV* for later
3. Multiple: save n sub refs for later

The example and details listed for #3 above use a hash in XS to associate the sub ref with a particular C function, but they predefine a fixed number of C functions which is not adequate.

I'm working on an XS interface to a C library that uses callbacks/function pointers with optional arguments e.g.:

  blah(custom_type *o, void (*func) (void *data, int more_data), const void * data);

The C blah in this library will end up calling the function passed to it along with the data passed in.

If possible, I'd like to do a 1-to-1 mapping of the C API to the Perl one. e.g.

  blah($o, \&func, $data);

Currently, I have #2 above, but another call to blah() would overwrite the saved SV *.

How would I implement #3 above?

Answer 1

This is the solution I came up with:

Most of the callbacks in this C library will take a user supplied void * and pass that as the first argument. So I save the SV * and user supplied data in a struct:

typedef struct __saved_callback {
    SV   *func;
    void *data;
} _saved_callback;

My XS function will allocate a _saved_callback struct and pass that as the first argument to call_perl_sub() with the Perl sub reference and that user supposed data.

void
blah(obj, func, data)
    whatever *obj
    void *func
    void *data
    CODE:
        _saved_callback *sc = NULL;
        Newx(sc, 1, _saved_callback);
        sc->func = (SV *)func;
        sc->data = data;
        blah(obj, call_perl_sub, sc);

Then call the Perl sub reference (I've omitted the stack manipulation for the user supplied data argument):

void call_perl_sub(void *data) {
    dSP;
    int count;
    _saved_callback *perl_saved_cb = data;

    count = call_sv(perl_saved_cb->func, G_DISCARD);
    if ( count != 0 )
        croak("Expected 0 value got %d\n", count);
}