When your C/XS code receives the callback address from Perl, take a copy of the *current* context and save it away in a suitable place.

At this point, my script is just a single line of execution (no ithreads or anything else), except for the subs that are the callacks. So, can there still be more than one context when I get the callback address in XS?

With the "force context" solution, I encountered a crash (actually a "Not a CODE ref" assert) in a scenario when a 2nd callback was called from a 2nd thread. I was puzzled at that..but, perhaps perl.exe has more than one 'context' by default? Or perhaps its because I didnt "save" & "restore" contexts after the 1st callback that the context for the 2nd is messed up?

Maybe this will explain the save&restore and context caching mechanism better than I've achieved using words:

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


PerlInterpreter *saved;
SV *callback;

VOID CALLBACK cbProc( DWORD time ) {
    PerlInterpreter *temp = Perl_get_context();

    printf( "C-Callback: %u\n", time );

    PERL_SET_CONTEXT( saved );
    {
        dSP;
        ENTER;
        SAVETMPS;
        PUSHMARK( SP );
        XPUSHs( sv_2mortal( newSVuv( (UV)time ) ) );
        PUTBACK;

        call_sv( callback, G_DISCARD );

        FREETMPS;
        LEAVE;
    }
    PERL_SET_CONTEXT( temp );
    return;
}

void __cdecl thread( VOID *arg ) {
    while( Sleep( 5000 ), 1 ) {
         printf( "Here\n" );
         cbProc( GetTickCount() );
     }
}

void setCallback( SV* cv ) {
    dTHX;
    saved = Perl_get_context();
    callback = cv;

    // Start callback timer thread
    _beginthread( &thread, 0, NULL );
    return;
}

END_C

$|++;

sub callback {
    print "Timer value is: $_[0]";
    return;
}


setCallback( 'callback' );

sleep 100;

__END__
C:\test>867652
Here
C-Callback: 1355573480
Timer value is: 1355573480
Here
C-Callback: 1355578472
Timer value is: 1355578472
Here
C-Callback: 1355583479
Timer value is: 1355583479
Terminating on signal SIGINT(2)
[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

Thx for the code example. It matches what I understood about your caching mechanism.

However, my confusion was why there would be 'multiple' contexts: without any perl_clone, I expected only one perl context now.

Anyhow, I modified my code to match the caching scheme and the results are same as when I 'forced' the context : the first callback is invoked fine, but the 2nd callback fails with "Undefined subroutine &main::0 called at" error. It points to a line that contains a "sleep()" statement in the main body of my perl-script. This however happens, just as the 2nd callback executes call_sv().

I also confirmed from prints that 'saved' context is set properly before invoking the call_sv. Unrelated, but the prints also show the same values for the 'saved' context in the two (actually 3) callbacks in my project.

I am unable to run your code as my machine didnt have Inline installed & I'm now getting compile errors executing your code (_867652.xs:13: error: expected â=â, â,â, â;â, âasmâ or â__attribute__â before âCALLBACKâ etc). However, I'm posting the modified version to give a better picture of how my real project looks & hope it reproduces the error I'm seeing.

I cant thank you enough for your efforts here!!

ps: Ofcourse, in my real project is more involved (multiple callbacks executed in each thread & multiple such threads. callbacks and 'main' do lot more than sleep())

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


PerlInterpreter *saved1;
SV *callback1;

PerlInterpreter *saved2;
SV *callback2;

VOID CALLBACK cbProc1( DWORD time ) {
//this always returns "0"
    PerlInterpreter *temp = Perl_get_context();

    printf( "C-Callback1: %u\n", time );

//my code has a dTHX; here.  Without it, I get errors that my_perl is 
+undefined
    PERL_SET_CONTEXT( saved1 );
    {
        dSP;
        ENTER;
        SAVETMPS;
        PUSHMARK( SP );
        XPUSHs( sv_2mortal( newSVuv( (UV)time ) ) );
        PUTBACK;

        call_sv( callback, G_DISCARD );

        FREETMPS;
        LEAVE;
    }
    PERL_SET_CONTEXT( temp );
    return;
}

VOID CALLBACK cbProc2( DWORD time ) {
//this always returns "0"
    PerlInterpreter *temp = Perl_get_context();

    printf( "C-Callback2: %u\n", time );

//my code has a dTHX; here.  Without it, I get errors that my_perl is 
+undefined

    PERL_SET_CONTEXT( saved2 );
    {
        dSP;
        ENTER;
        SAVETMPS;
        PUSHMARK( SP );
        XPUSHs( sv_2mortal( newSVuv( (UV)time ) ) );
        PUTBACK;

//the error msg shows up after calling this
        call_sv( callback, G_DISCARD );

        FREETMPS;
        LEAVE;
    }
    PERL_SET_CONTEXT( temp );
    return;
}

void __cdecl thread1( VOID *arg ) {
    while( Sleep( 5000 ), 1 ) {
         printf( "Here in thread1\n" );
         cbProc1( GetTickCount() );
     }
}

void __cdecl thread2( VOID *arg ) {
    while( Sleep( 5000 ), 1 ) {
         printf( "Here in thread2\n" );
         cbProc2( GetTickCount() );
     }
}

void setCallback1( SV* cv ) {
//my code did not have the dTHX here, but adding it made no difference
+ (i.e saved1 the same).
    dTHX;
//saved1 and saved2 are always the same too.
    saved1 = Perl_get_context();
    callback1 = cv;

    // Start callback timer thread
    _beginthread( &thread1, 0, NULL );
    return;
}

void setCallback2( SV* cv ) {
//my code did not have the dTHX here, but adding it made no difference
+ (i.e saved2 is the same).
    dTHX;
    saved2 = Perl_get_context();
    callback2 = cv;

    // Start callback timer thread
    _beginthread( &thread2, 0, NULL );
    return;
}

END_C

$|++;

my cb1_cnt = 0;
sub callback1 {
    print "Timer value in callback1 is: $_[0]";
    cb1_cnt++;
    return;
}

my cb2_cnt = 0;
sub callback2 {
    print "Timer value in callback2 is: $_[0]";
    cb2_cnt++;
    return;
}

setCallback1( 'callback1' );

while (cb1_cnt != 4)
{
  sleep(1);
}

setCallback2('callback2');

while (cb2_cnt != 4)
{
#the error msg will point to this line.  Not sure if its just a
#coincidence that it points here..
  sleep(1);
}

sleep (15);

__END__
[download]