in reply to Re^15: Perl crash during perl_clone
in thread Perl crash during perl_clone

This version takes it one stage further and runs two concurrent C-threads sharing the same 4 callbacks. As the threads are calling back into the same Perl code, if they both randomly pick the same callback on different cores at the same time, then two threads are trying to access Perl's internals concurrently and things go pear-shaped.

To prevent this I've added a (very simplistic) user space mutex to ensure that only one thread enters a callback at any given time. This uses the global integer sem, increments and decrements and free-running while loops. Its processor intensive, probably full of race conditions and too broad a granularity--I should use 1 per callback not one for all callbacks--but it is surprisingly effective and serves to demonstrate the solution. You should probably use proper pthreads condition vars.

Update: putback the scoping brackets and switched to using proper mutexes. 

#! 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__

[download]
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
RIP an inspiration; A true Folk's Guy

Replies are listed 'Best First'.
Re^17: Perl crash during perl_clone
by perlmonk1729 (Acolyte) on Nov 08, 2010 at 15:08 UTC
    Hi BrowserUk,

    Thanks again for the response. I will try tomorrow, but I'm also fairly positive, these versions will work for me too..Fundamentally, there seems no issue with callbacks perse, as long as I comply with your comment that.

    If I try to pass the callback addresses by code-reference instead of name, I too get traps. I don't know why, so don't do that.

    Although, it is strange why the code-ref way works, reliably, for one of my callbacks registered this way.

    I had tried, but the SWIG typemaps I have currently did not allow the 'modulename:subname' format to register the callbacks. I'll have to dig into that more. Will hopefully have good news to share tomorrow!

[reply]
      I had tried, but the SWIG typemaps I have currently did not allow the 'modulename:subname' format to register the callbacks.

      I don't understand this. The SWIG stuff wraps the registering of the CCB, not the PCB.

      So you "register" the PCB--by storing the SV* you pass into your code. You then call that stored SV* (using call_sv()) when the SWIG stuff calls back you CCB.

      I agree that call_sv() should handle coderefs (according to the documentation; I even think I've done it in the past on 5.8x era perls), but every time I've tried it recently, it falls in a heap with coderefs (with or without threads involved), and works as advertised with a function name. So I stick with the latter. It does mean you have to name the callbacks rather than use anonymous subs or blocks, but that is an acceptable limitation (for me).

      I having trouble understanding why you cannot do the same?

      Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
      "Science is about questioning the status quo. Questioning authority".
      In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]
[d/l]

        I may have made some other mistake when I tried the SWIG wrapper experiment.

        Its quite late in the night here and I hope I'm not celebrating too early: I think I figured out the cause for the seg-faults in the sample code (myModule version) and my real project.

        The problem seems to be that the \&module:sub syntax is somehow a temporary reference and was out of scope by the time my callback was invoked. The reason it worked in one of my callbacks was sheer coincidence: a scalar that was holding a reference to the sub was still in scope when the callback is called.

        In the RegisterCB function, by doing a newSVsv() and then using that new SV as the PCB always seem to keep the reference in scope/valid when the PCB is called. This newSVsv() was in the first version of my code that did the perl_clone, but I had removed it along with a bunch of other code, thinking it was not necessary.

        I'll try to reconfirm tomorrow when I'm more awake :-) Let me know if it works for you and if it makes sense.

[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom