MaxPerl has asked for the wisdom of the Perl Monks concerning the following question:

Dear Perl experts, I am a beginner in XS. To learn XS, I hardly try to create a binding to libmpv and especially the function mpv_set_wakeup_callback. The event handler works one time, then I get a segfault. I think the problem is that the callback will be called from foreign threads. I thought using the MY_CXT macros would be the solution. But still there is a segfault. My current state can be seen on github. The relevant parts are the followings:
1) Simple.pm 
sub set_wakeup_callback {
    my ($self, $callback, $userdata) = @_;
    $self->set_my_callback($callback);
    #$self->set_callback_data($userdata);
    #use Devel::Peek;
    #Dump $callback;
    $self->_xs_set_wakeup_callback();
    #use Devel::Peek;
    #Dump $callback;
}

[download]
2) Simple.xs 
void
set_my_callback(ctx, fn)
        MPV::Simple ctx
        SV *    fn
        PREINIT:
            dMY_CXT;
        CODE:
        /* Remember the Perl sub */
        if (MY_CXT.callback == (SV*)NULL)
            MY_CXT.callback = newSVsv(fn);
        else
            SvSetSV(MY_CXT.callback, fn);
    
void
_xs_set_wakeup_callback(MPV::Simple ctx)
    PREINIT:
            dMY_CXT;
    CODE:
    {
    SV* data;
    void (*rechne)(void*);
    callp_ptr = callp;
    mpv_set_wakeup_callback(ctx,callp_ptr,MY_CXT.callback);
    }

[download]
and the perl call in the C-section: 
void callp( SV* string)
{
    dTHX;
    dMY_CXT;
    dSP;
    
    ENTER; SAVETMPS; 
    PUSHMARK(SP);
    
    PUTBACK;
    
    perl_call_sv(MY_CXT.callback,G_DISCARD|G_NOARGS);
    SPAGAIN;
    
    PUTBACK;FREETMPS;LEAVE;
    
}

[download]
I tested everything with the following nonsense code (einladung2.mp4 is a video file): 
use MPV::Simple;

my $ctx = MPV::Simple->new();
$ctx->set_wakeup_callback(\&func);
$ctx->initialize();
$ctx->command();


exit 0;

sub func {print "callback called \n"}

[download]
Thanks in advance for any help. I hope this is not far away beyond my capabilities.. Max

Replies are listed 'Best First'.
Re: XS callback to mpv_set_wakeup_callback
by dave_the_m (Monsignor) on Jan 04, 2019 at 16:59 UTC
    I suspect your problem lies in some random foreign thread calling the callback. The dTHX macro in your callback function expands (depending on platform and configuration) to something like 
    PerlInterpreter* my_perl = pthread_getspecific(PL_thr_key);

    [download]
    This means that it attempts to set the current interpreter (my_perl) to whatever value is stored in thread-local storage for that thread. For a perl thread, that value will point to the interpreter associated with that thread. For a foreign thread, it's likely to be NULL.

    The question is, if a foreign thread calls the callback, what interpreter structure should it use? Once you have decided that, then you'll need to do 

    PERL_SET_CONTEXT(some_perl);

    [download]
    at some point. See perlguts and perlembed.

    The question of what interpreter to use depends on your setup - how threads are created and managed - but in any case, you need to avoid two separate threads sharing the same interpreter.

    Dave.

[reply]
[d/l]
[select]
Re: XS callback to mpv_set_wakeup_callback
by bliako (Abbot) on Jan 04, 2019 at 13:53 UTC

    It does not compile: replace rechne with callp_ptr or skip callp_ptr entirely by using mpv_set_wakeup_callback(ctx,(void (*)(void *) )callp,MY_CXT.callback);

    When you get it compilable add OPTIMIZE => '-g' to your Makefile.PL and compile. Then run gdb -q --args perl <test-program.pl> For more info on debugging, see https://stackoverflow.com/questions/50643536/how-do-i-trace-through-an-xs-so-file

    I have no idea about threads and XS but I would eliminate all the assignment from incompatible pointer type warnings before investigationg in that direction.

    bw, bliako

[reply]
[d/l]
[select]
Re: XS callback to mpv_set_wakeup_callback
by MaxPerl (Acolyte) on Jan 04, 2019 at 20:20 UTC
    Dear bliako, dear Dave, Thank you very much for your hints. I traced to my test script and - to be honest - I don't understand very much :-) But, I think Dave is right. The callp function is hited two times, the first time by perl, and the second time by a mpv/mpv core thread. The passed args are the same, so that I think, that the assignment from incompatible pointer type warnings are at the moment less important.. I will read the perlembed manual, but it is really a steep learning curve, hopefully not too steep... PS.: Here the output of gdb: 
    (gdb) run
Starting program: /usr/bin/perl ./play2.t
[Thread debugging using libthread_db enabled]
Using host libthread_db library "/lib/x86_64-linux-gnu/libthread_db.so
+.1".
[New Thread 0x7fffc9dca700 (LWP 7239)]
callback called 

Thread 2 "mpv/mpv core" received signal SIGSEGV, Segmentation fault.
[Switching to Thread 0x7fffc9dca700 (LWP 7239)]
0x00007ffff6ab126d in callp (string=0x5555559756b0) at Simple.xs:30
30          dMY_CXT;
(gdb) break Simple.xs:27
Haltepunkt 1 at 0x7ffff6ab1255: file Simple.xs, line 27.
(gdb) run
The program being debugged has been started already.
Start it from the beginning? (y or n) x
Please answer y or n.
The program being debugged has been started already.
Start it from the beginning? (y or n) y
Starting program: /usr/bin/perl ./play2.t
[Thread debugging using libthread_db enabled]
Using host libthread_db library "/lib/x86_64-linux-gnu/libthread_db.so
+.1".
[New Thread 0x7fffc9dca700 (LWP 7241)]

Thread 1 "perl" hit Breakpoint 1, callp (string=0x5555559756b0) at Sim
+ple.xs:29
29          dTHX;
(gdb) s
__GI___pthread_getspecific (key=0) at pthread_getspecific.c:30
30      pthread_getspecific.c: Datei oder Verzeichnis nicht gefunden.
(gdb) s
31      in pthread_getspecific.c
(gdb) s
55      in pthread_getspecific.c
(gdb) s
56      in pthread_getspecific.c
(gdb) s
60      in pthread_getspecific.c
(gdb) s
65      in pthread_getspecific.c
(gdb) s
callp (string=0x5555559756b0) at Simple.xs:30
30          dMY_CXT;
(gdb) s
31          dSP;
(gdb) s
33          ENTER; SAVETMPS; 
(gdb) s
34          PUSHMARK(SP);
(gdb) s
36          PUTBACK;
(gdb) s
38          perl_call_sv(MY_CXT.callback,G_DISCARD|G_NOARGS);
(gdb) s
callback called 
39          SPAGAIN;
(gdb) s
41          PUTBACK;FREETMPS;LEAVE;
(gdb) s
43      }
(gdb) s
0x00007ffff67708aa in mpv_set_wakeup_callback () from /usr/lib/x86_64-
+linux-gnu/libmpv.so.1
(gdb) s
Single stepping until exit from function mpv_set_wakeup_callback,
which has no line number information.
__GI___pthread_mutex_unlock (mutex=0x7fffc4018a08) at pthread_mutex_un
+lock.c:345
345     pthread_mutex_unlock.c: Datei oder Verzeichnis nicht gefunden.
(gdb) s
__pthread_mutex_unlock_usercnt (decr=1, mutex=0x7fffc4018a08) at pthre
+ad_mutex_unlock.c:344
344     in pthread_mutex_unlock.c
(gdb) s
345     in pthread_mutex_unlock.c
(gdb) s
__pthread_mutex_unlock_usercnt (decr=1, mutex=0x7fffc4018a08) at pthre
+ad_mutex_unlock.c:38
38      in pthread_mutex_unlock.c
(gdb) s
39      in pthread_mutex_unlock.c
(gdb) s
38      in pthread_mutex_unlock.c
(gdb) s
39      in pthread_mutex_unlock.c
(gdb) s
43      in pthread_mutex_unlock.c
(gdb) s
48      in pthread_mutex_unlock.c
(gdb) s
51      in pthread_mutex_unlock.c
(gdb) s
54      in pthread_mutex_unlock.c
(gdb) s
56      in pthread_mutex_unlock.c
(gdb) s
__GI___pthread_mutex_unlock (mutex=0x7fffc4018a08) at pthread_mutex_un
+lock.c:346
346     in pthread_mutex_unlock.c
(gdb) s
XS_MPV__Simple__xs_set_wakeup_callback (my_perl=0x555555953260, cv=0x5
+55555aae830) at Simple.c:524
524         XSRETURN_EMPTY;
(gdb) s
525     }
(gdb) s
0x0000555555630201 in Perl_pp_entersub ()
(gdb) s
Single stepping until exit from function Perl_pp_entersub,
which has no line number information.
0x0000555555628026 in Perl_runops_standard ()
(gdb) s
Single stepping until exit from function Perl_runops_standard,
which has no line number information.
[Switching to Thread 0x7fffc9dca700 (LWP 7241)]

Thread 2 "mpv/mpv core" hit Breakpoint 1, callp (string=0x5555559756b0
+) at Simple.xs:29
29          dTHX;
(gdb) s
__GI___pthread_getspecific (key=0) at pthread_getspecific.c:30
30      pthread_getspecific.c: Datei oder Verzeichnis nicht gefunden.
(gdb) s
31      in pthread_getspecific.c
(gdb) s
55      in pthread_getspecific.c
(gdb) s
56      in pthread_getspecific.c
(gdb) s
65      in pthread_getspecific.c
(gdb) s
callp (string=0x5555559756b0) at Simple.xs:30
30          dMY_CXT;
(gdb) s

Thread 2 "mpv/mpv core" received signal SIGSEGV, Segmentation fault.
0x00007ffff6ab126d in callp (string=0x5555559756b0) at Simple.xs:30
30          dMY_CXT;

    [download]
[reply]
[d/l]
      I'd suggest setting a breakpoint in callp() on the dMY_CXT line - so it stops just after dTHX has been executed. Then print out the value of my_perl at that point. I suspect on the first call it will be same as that passed to other functions, e.g. the 
      XS_MPV__Simple__xs_set_wakeup_callback (my_perl=0x555555953260, ...)

      [download]
      from your example above. I also suspect that on the second call it will be NULL (or at least not the same as the first call). If so it will confirm my diagnosis.

      You'll need to explain to me how these extra threads are created and what they do, and what happens to the main perl thread while the callback is taking place - is it suspended, or is it off busily doing its own thing?

      Dave.

[reply]
[d/l]
        Dear Dave, Yes, the perl interpreters are not the same: 
        # perl thread
(gdb) p my_perl
$1 = (PerlInterpreter *) 0xb
(...)
 dSP;
(gdb) p my_perl
$7 = (PerlInterpreter *) 0x555555953260
(...)
# mpv thread:
(gdb) p my_perl
$2 = (PerlInterpreter *) 0x1
(...)
dSP;
(gdb) p my_perl
$3 = (PerlInterpreter *) 0x0

        [download]
        Regarding the creation of the extra threads: To be honest, I don't know how they are created and what with the main perl thread happens. This is managed by libmpv and I don't know and understand the code very well.. The error seems to occur in mpv_initialize from mpv-player/client.c, which calls mp_wakeup_core from mpv-player/playloop.c that triggers an event from the saved dispatch queue. mpv/misc/dispatch.c describes it as follows: "A dispatch queue lets other threads run callbacks in a target thread. The target thread is the thread which calls mp_dispatch_queue_process()." This is here mp_dispatch_interrupt which was called in mp_wakeup_core. So I think the target thread is created in mpv_create with the following lines: 
        pthread_t thread;
    if (pthread_create(&thread, NULL, core_thread, mpctx) != 0) {
        ctx->clients->have_terminator = true; // avoid blocking
        mpv_terminate_destroy(ctx);
        mp_destroy(mpctx);
        return NULL;
}

        [download]
        core_thread() consists of the following lines: 
        static void *core_thread(void *p)
{
    struct MPContext *mpctx = p;

    mpthread_set_name("mpv core");

    while (!mpctx->initialized && mpctx->stop_play != PT_QUIT)
        mp_idle(mpctx);

    if (mpctx->initialized)
        mp_play_files(mpctx);

    // This actually waits until all clients are gone before actually
    // destroying mpctx. Actual destruction is done by whatever destro
+ys
    // the last mpv_handle.
    mp_shutdown_clients(mpctx);

    return NULL;
}

        [download]
        I don't know whether this is helpful. Perhaps the task is a number too big for me because I have no clue regarding threads? Nevertheless thank you very much for all your help and patience..

        Max

        PS.: I also don't understand why one time the callback is called in the perl thread? Perhaps because of the following line in mpv_set_wakeup_callback? 
        if (ctx->wakeup_cb)
ctx->wakeup_cb(ctx->wakeup_cb_ctx);

        [download]
[reply]
[d/l]
[select]
        Ok, I found https://www.perlmonks.org/?node_id=867652 and without studying the thread in depth, I tried the following and it seems to work so far:
        first ein deleteted #define PERL_NO_GET_CONTEXT in the beginning of my Simple.xs file. then I created a set_ctx function 
        void set_ctx()
{
    dTHX;
    mine = Perl_get_context;
}
(...)
MODULE = MPV::Simple        PACKAGE = MPV::Simple
(...)
void
_set_context(ctx)
    MPV::Simple ctx
    CODE:
    set_ctx();

        [download]
        and called it in the constructor in Simple.pm 
        sub new {
    my ($class) = shift;
    my $obj = $class->xs_create();
    
    bless $obj;
    $obj->_set_context();
    return $obj;
}

        [download]
        Last I set Perl_Context in callp instead of dTHX: 
        void callp( SV* data)
{
    //dTHX;
    PERL_SET_CONTEXT(mine);
    {
    dMY_CXT;
    dSP;
    
    ENTER; SAVETMPS; 
    PUSHMARK(SP);
    
    PUTBACK;
    
    perl_call_sv(MY_CXT.callback,G_DISCARD|G_NOARGS);
    SPAGAIN;
    
    PUTBACK;FREETMPS;LEAVE;
    }
}

        [download]
        Does that make any sense? Or is it ugly and bad? To be honest, I don't really understand the linked thread :-) And I am a little bit worried because of deleting PERL_NO_GET_CONTEXT.. I have to do further tests, whether the binding now works as expected.. Max

        UPDATE: Unfortunately this doesn't work, too. Sometimes it seems to work and the video is shown. But in other cases there is again the segfault or the thread is closed too early.
[reply]
[d/l]
[select]
        Hello everybody, I have given up to create the binding to mpv_set_wakeup_callback. Instead I created an own pure Perl Module, which makes it possible to run the mpv player in another fork process beside an existing event loop (see MPV::Simple::Pipe on github). It is not perfect, but the best that I can. Nevertheless I wanted to explain my status quo. Perhaps it is useful for some other person, who is confronted with the same problem and is more experienced to solve the problem. The explained segfault problem could be solved by cloning perl in the c callback handler as follows (@dave_the_m: I think this is the solution you explained, but I didn't understand first?): 
        void callp( )
{
    int new_perl = 0;
    
    dTHX;
    if ( my_perl != NULL )
         printf ("my_perl == %ul\n", my_perl);
      else
      {
         printf ("my_perl was NULL\n");
         PERL_SET_CONTEXT(mine);
         perl_for_cb = perl_clone(mine, CLONEf_KEEP_PTR_TABLE);
         PERL_SET_CONTEXT(perl_for_cb);
         
         // The following seems not necessary
         //CLONE_PARAMS clone_param; clone_param.stashes = NULL; clone
+_param.flags = 0; clone_param.proto_perl = perl_for_cb;
         
         new_perl = 1;
      } 
    
    dSP;
    SV* callback = get_sv("MPV::Simple::callback",0);
    SV* data = get_sv("MPV::Simple::callback_data",0);
    
    ENTER; SAVETMPS; 
    PUSHMARK(SP);
    
    EXTEND(SP,1);
    PUSHs(sv_2mortal(newSVsv(data)));
    
    PUTBACK;
    
    perl_call_sv(callback,G_DISCARD);
    SPAGAIN;
    
    PUTBACK;FREETMPS;LEAVE;
    
    // I don't know whether this is important
    if ( new_perl ) {
        perl_free(my_perl);
        PERL_SET_CONTEXT(mine);
    }
}

        [download]
        The callback data and the reference to the perl function was saved in a global perl variable in Simple.pm, before the xs function is called (this was similarly effectiv as the complex MY_CTX stuff). The XS function is: 
        void
_xs_set_wakeup_callback(MPV::Simple ctx, SV* callback)
    CODE:
    {
    void (*callp_ptr)(void*);
    callp_ptr = callp;
    mpv_set_wakeup_callback(ctx,callp_ptr,NULL);
    }

        [download]
        Unfortunately in more complex examples there are sometimes new segfaults, sometimes it works smoothly. I think the problem is the complex structure of the thread for event handling in mpv. If someone has a further idea to implement this all in perl, it would be great. I am still interested in learning and understanding XS more... Thanks all, Max
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom