#! perl -slw
use strict;
use Inline C => Config => BUILD_NOISY => 1;
use Inline C => <<'END_C',  NAME => '_867652', CLEAN_AFTER_BUILD => 0;
#include <windows.h>

PerlInterpreter *saved;
SV *callbacks[ 4 ];
SRWLOCK locks[ 4 ];

VOID CALLBACK cbProc( int cbn, DWORD time ) {
    printf( "CCB[%d]: %u\n", cbn, time );

    PERL_SET_CONTEXT( saved );
    {
        dSP;
        ENTER;
        SAVETMPS;
        PUSHMARK( SP );
        XPUSHs( sv_2mortal( newSVuv( (UV)time ) ) );
        PUTBACK;
        call_sv( callbacks[ cbn ], G_DISCARD );

        FREETMPS;
        LEAVE;
    }
    return;
}

void __cdecl thread( VOID *arg ) {
    while( Sleep( rand() & 7 ), 1 ) {
        int choice = rand() & 3;
        AcquireSRWLockExclusive( &locks[ choice ] );
        cbProc( choice, GetTickCount() );
        ReleaseSRWLockExclusive( &locks[ choice ] );
     }
}

void setCallback( SV *cb1, SV* cb2, SV *cb3, SV *cb4 ) {
    int i;
    saved = Perl_get_context();
    callbacks[0] = cb1; SvREFCNT_inc( cb1 );
    callbacks[1] = cb2; SvREFCNT_inc( cb2 );
    callbacks[2] = cb3; SvREFCNT_inc( cb3 );
    callbacks[3] = cb4; SvREFCNT_inc( cb4 );
    for( i=1; i < 4; ++i ) InitializeSRWLock( &locks[ i ] );
    _beginthread( &thread, 0, (void*)0 );
    _beginthread( &thread, 0, (void*)1 );
    _beginthread( &thread, 0, (void*)2 );
    _beginthread( &thread, 0, (void*)3 );
    return;
}

END_C
$|++;

{
    package fred;
    my @c = (0) x 4;

    sub callback1 { ++$c[0]; print "PCB1: $_[0] (@c)"; return; }
    sub callback2 { ++$c[1]; print "PCB2: $_[0] (@c)"; return; }
    sub callback3 { ++$c[2]; print "PCB3: $_[0] (@c)"; return; }
    sub callback4 { ++$c[3]; print "PCB4: $_[0] (@c)"; return; }
}

setCallback( 
    \&fred::callback1, 
    \&fred::callback2, 
    \&fred::callback3, 
    \&fred::callback4, 
);

sleep 100;