Thread Perl Funktion von XS aufrufen (16 answers)
Opened by Max_Perlbeginner at 2019-01-02 16:28

Max_Perlbeginner
 2020-04-25 00:29
#191776 #191776
User since
2016-04-04
101 articles
BenutzerIn
[default_avatar]
Liebe Perl-Gemeinde,

Es gibt wieder einmal Neuigkeit von meinem libmpv Modul. Ich habe es endlich geschafft, die via mpv_set_wakeup_callback definierte und von einem zufälligen, fremden Thread aufgerufene Callback Funktion unter Linux nutzbar zu machen. Die Vorteile gegenüber meinem oben beschriebenem Workaround gehen zwar gegen Null, weil im Perl Thread Konzept (ithread) grundsätzlich keine Variablen geteilt werden (es werden nur Kopien sämtlicher Variablen im neuen Thread angelegt). Zwar kann man mittels thread::shared einzelne Variablen teilen, allerdings geht dies auch nicht bei allen Typen und macht bei mir insbesondere bei Objekten Probleme (in meinem Fall reicht jedoch ein einzelner Skalar, der angibt, ob neue Ereignisse aufgetreten sind).

Da es bislang kaum Anleitungen dafür gibt, wie man in Perl eine aus fremden Thread aufgerufene Callback Funktion implementieren kann, wollte ich trotz der Beschränkungen hier meinen Weg beschreiben.

Die Lösung lieferte mir im Ergebnis die SDL Anbindung und deren time_add_timer Funktion in der Datei Time.xs (naja, eigtl. verstehe ich nicht, warum es dort funktioniert, weil die wesentlichen Schritte dort nur ausgeführt werden, wenn USE_THREADS (= alte Threads Implementierung!) definiert ist).

Der Trick ist m.E., dass man im Constructor (new) bzw. in der Funktion, in der man die Callback Funktion festlegt, eine externe (warum extern weiß ich auch nicht ;-) ) Variable (extern PerlInterpreter *parent_perl) mit dem Eltern Perl Interpreter speichert und zugleich in die statische Variable current_perl klont.
Code: (dl )
1
2
3
4
5
if(!current_perl) { 
parent_perl = PERL_GET_CONTEXT;
current_perl = perl_clone(parent_perl, CLONEf_KEEP_PTR_TABLE);
PERL_SET_CONTEXT(parent_perl);
}


Sobald nun ein neuer Thread erstellt wird, wird m.E. auch der geklonte Perl Interpreter / Perl Kontext kopiert. Dadurch ist es möglich, in der Callback Funktion den Perl Context folgendermaßen zu setzen (PS.: Wichtig ist übrigens, dass man nicht - wie bei h2xs standardmäßig - das #PERL_NO_GET_CONTEXT definiert!!!):
Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Uint32 add_timer_cb (Uint32 interval, void* param )
{
Uint32 ret_interval;
{
if(!PERL_GET_CONTEXT) {
PERL_SET_CONTEXT(current_perl);
}

[...]

}

return ret_interval;
}


Nicht ganz klar ist mir, ob man im XS "BOOT:" Abschnitt die Variable PL_perl_destruct_level auf einen positiven Wert setzen muss, weil ja mehrere Perl Interpreter erstellt werden und später auch aufgeräumt werden müssen. Es schadet jedenfalls nicht.

Wie ich es in meinem MPV::Simple Modul gemacht habe, könnt ihr unter hier nachsehen. In MPV::Simple::Pipe wird der mpv Player in einen gesonderten Prozess ausgeführt. Das Teilen der Variable $MPV::Simple::Pipe::wakeup mit der im fremden Thread ausgeführten Callback Funktion MPV::Simple::Pipe::wakeup() klappt dabei wunderbar mit threads::shared (ich mixe also ein ganz kleines bisschen forks auf der Perl Ebene und threads/threads::shared, um mit den auf der C Ebene erzeugten Threads zu kommunizieren. Ein Versuch, auch auf Perl Ebene threads zu verwenden ist hier zu finden. Allerdings klappt dabei nicht das Zusammenspiel mit dem Modul Tcl::Tk (das ganz bestimmt schuld daran ist ;-))

Hier zuletzt die Implementierung der SDL-Funktion time_add_timer:
Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

#include "const-c.inc"

#include <SDL/SDL.h>
#include <SDL/SDL_thread.h>
#define stdout PerlIO_stdout()


#ifndef SDL_PERL_DEFINES_H
#define SDL_PERL_DEFINES_H
#endif

PerlInterpreter *parent_perl = NULL;
extern PerlInterpreter *parent_perl;
PerlInterpreter *current_perl = NULL;


void
sdl_perl_atexit (void)
{
SDL_Quit();
}


Uint32 add_timer_cb (Uint32 interval, void* param )
{
Uint32 ret_interval;

{
if(!PERL_GET_CONTEXT) {
PERL_SET_CONTEXT(current_perl);
}

dSP;

int count;

ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(sv_2mortal(newSViv(interval)));
PUTBACK;

count = call_pv(param,G_SCALAR);

SPAGAIN;

if (count != 1 ) croak("callback returned more than 1 value\n");
ret_interval = POPi;

PUTBACK;
FREETMPS;
LEAVE;

}


return ret_interval;
}


MODULE = SDLTimer PACKAGE = SDLTimer

INCLUDE: const-xs.inc

BOOT:
PL_perl_destruct_level = 2;

int
init ( flags )
Uint32 flags
CODE:
RETVAL = SDL_Init(SDL_INIT_TIMER);
atexit(sdl_perl_atexit);

OUTPUT:
RETVAL


MODULE = SDLTimer PACKAGE = SDLTimer::Time

SDL_TimerID
time_add_timer ( interval, cmd )
Uint32 interval
char *cmd
CODE:
if(!current_perl) {
parent_perl = PERL_GET_CONTEXT;
current_perl = perl_clone(parent_perl, CLONEf_KEEP_PTR_TABLE);
PERL_SET_CONTEXT(parent_perl);
}
RETVAL = SDL_AddTimer(interval, add_timer_cb, (void *)cmd);
OUTPUT:
RETVAL

Last edited: 2020-04-25 08:14:16 +0200 (CEST)

View full thread Perl Funktion von XS aufrufen