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

//int sem = 0; // crude simulation.
PerlInterpreter *saved;
SV *callbacks[ 4 ];
SRWLOCK locks[ 4 ]; // one per callback

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 thread2( VOID *arg ) {
    while( Sleep( 1 ), 1 ) {
        AcquireSRWLockExclusive( &locks[ choice ] );
        cbProc( rand() & 3, GetTickCount() );
        ReleaseSRWLockExclusive( &locks[ choice ] );
     }
}

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

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

END_C
$|++;

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

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

setCallback( 
    'fred::callback1', 
    'fred::callback2', 
    'fred::callback3', 
    'fred::callback4' 
);

sleep 100;

__END__