//gcc -o libmylib.so -shared -fpic mylib.c -lpthread
#include "mylib.h"
#include <pthread.h>

static lib_work_done_callback_t GCB;
static void *GData;

static void *run( void *Arg )
{
    sleep( 3 );
    printf( "Calling callback() from thread.\n" );
    GCB( GData ); /* crashes here */
    printf( "Calling callback() from thread done.\n" );
    return( NULL );
}

int lib_RegisterWorkDoneCallback( void *a, 
    lib_work_done_callback_t CB, void *Data )
{
    pthread_t thread;
    pthread_attr_t attr;
    int res = 0;
    
    GCB = CB;
    GData = Data;
    
    pthread_attr_init( &attr );
    pthread_attr_setdetachstate( &attr, PTHREAD_CREATE_DETACHED );
    if( pthread_create( &thread, &attr, run, NULL ) ) {
        printf( "Error: Could not create thread.\n" );
        res = 1;
    }
    pthread_attr_destroy( &attr );
    return( res );
}
[download]

#ifndef mylib_h
#define mylib_h
typedef void (*lib_work_done_callback_t)( void * );
int lib_RegisterWorkDoneCallback( void *a, 
    lib_work_done_callback_t CB, void *Data );
#endif
[download]

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

#include "../mylib.h"

#define MY_CXT_KEY "MyLib::_guts" XS_VERSION

typedef struct {
    HV * Mapping;
} my_cxt_t;

START_MY_CXT

static void
lib_RegisterWorkDoneCallback_if( void *Data )
{
  dSP;
  dMY_CXT;
  printf( "Performing perl callback.\n" ); fflush( stdout );
  ENTER;
  SAVETMPS;
  SV ** sv;
  sv = hv_fetch( MY_CXT.Mapping, (void*)&Data, sizeof(Data), FALSE );
  if( sv == (SV**)NULL)
    croak("Internal error. No callback registered.\n");
  PUSHMARK( sp );
  XPUSHs( sv_2mortal( newSViv( (int) Data ) ) );
  PUTBACK;
  perl_call_sv( *sv, G_DISCARD );
  FREETMPS;
  LEAVE;
}

#include "const-c.inc"

MODULE = MyLib        PACKAGE = MyLib                PREFIX = lib_

INCLUDE: const-xs.inc

BOOT:
{
    MY_CXT_INIT;
    MY_CXT.Mapping = (HV*)NULL;
}

int
lib_RegisterWorkDoneCallback(A, Callback, Data)
  void *A
  SV *Callback
  void *Data
  CODE:
  {
    dMY_CXT;
    printf( "Registering Perl callback.\n" ); fflush( stdout );
    if( MY_CXT.Mapping == (HV*)NULL )
      MY_CXT.Mapping = newHV();
    hv_store( MY_CXT.Mapping, (void*)&Data, sizeof( Data ),
                          newSVsv( Callback ), 0 );

    RETVAL = lib_RegisterWorkDoneCallback( A, 
            &lib_RegisterWorkDoneCallback_if, Data );
  }
  OUTPUT:
    RETVAL
[download]

package MyLib;
use 5.008;
use strict;
use warnings;
use Carp;
require Exporter;
use AutoLoader;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = ( 'all' => [ qw(
) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw(
);
our $VERSION = '0.01';
sub AUTOLOAD {
    my $constname;
    our $AUTOLOAD;
    ($constname = $AUTOLOAD) =~ s/.*:://;
    croak "&MyLib::constant not defined" if $constname eq 'constant';
    my ($error, $val) = constant($constname);
    if ($error) { croak $error; }
    {
    no strict 'refs';
        *$AUTOLOAD = sub { $val };
    }
    goto &$AUTOLOAD;
}
require XSLoader;
XSLoader::load('MyLib', $VERSION);
1;
__END__
[download]