Creación de devoluciones de llamada en XS

Question

EDITAR: He creado un ticket para esto que tiene datos sobre una alternativa a esta forma de hacer las cosas.

Tengo updated the code en un intento de utilizar la devolución de llamada de MY_CXT ya que gcxt no se almacenaba entre subprocesos. Sin embargo, esto segfaults en ENTER.

#include "EXTERN.h" 
#include "perl.h" 
#include "XSUB.h" 

#ifndef aTHX_ 
#define aTHX_ 
#endif 

#ifdef USE_THREADS 
#define HAVE_TLS_CONTEXT 
#endif 

/* For windows */ 
#ifndef SDL_PERL_DEFINES_H 
#define SDL_PERL_DEFINES_H 

#ifdef HAVE_TLS_CONTEXT 
PerlInterpreter *parent_perl = NULL; 
extern PerlInterpreter *parent_perl; 
#define GET_TLS_CONTEXT parent_perl = PERL_GET_CONTEXT; 
#define ENTER_TLS_CONTEXT \ 
     PerlInterpreter *current_perl = PERL_GET_CONTEXT; \ 
      PERL_SET_CONTEXT(parent_perl); { \ 
           PerlInterpreter *my_perl = parent_perl; 
#define LEAVE_TLS_CONTEXT \ 
             } PERL_SET_CONTEXT(current_perl); 
#else 
#define GET_TLS_CONTEXT   /* TLS context not enabled */ 
#define ENTER_TLS_CONTEXT  /* TLS context not enabled */ 
#define LEAVE_TLS_CONTEXT  /* TLS context not enabled */ 
#endif 

#endif 


#include <SDL.h> 

#define MY_CXT_KEY "SDL::Time::_guts" XS_VERSION 


typedef struct { 
void* data; 
SV* callback; 
Uint32 retval; 
} my_cxt_t; 

static my_cxt_t gcxt; 

START_MY_CXT 


static Uint32 add_timer_cb (Uint32 interval, void* param) 
{ 

     ENTER_TLS_CONTEXT 
     dMY_CXT; 
     dSP; 
     int back; 
     ENTER; //SEGFAULTS RIGHT HERE! 
     SAVETMPS; 
     PUSHMARK(SP); 
     XPUSHs(sv_2mortal(newSViv(interval))); 
     PUTBACK; 

     if (0 != (back = call_sv(MY_CXT.callback,G_SCALAR))) { 
     SPAGAIN; 
     if (back != 1) Perl_croak (aTHX_ "Timer Callback failed!"); 
     MY_CXT.retval = POPi;  
     } else { 
     Perl_croak(aTHX_ "Timer Callback failed!"); 
     } 

     FREETMPS; 
     LEAVE; 

     LEAVE_TLS_CONTEXT 
     dMY_CXT; 
     return MY_CXT.retval; 

} 

MODULE = SDL::Time PACKAGE = SDL::Time PREFIX = time_ 

BOOT: 
{ 
    MY_CXT_INIT; 
} 


SDL_TimerID 
time_add_timer (interval, cmd) 
    Uint32 interval 
    void *cmd 
    PREINIT: 
     dMY_CXT; 
    CODE: 
     MY_CXT.callback=cmd;  
     gcxt = MY_CXT; 
     RETVAL = SDL_AddTimer(interval,add_timer_cb,(void *)cmd);  
    OUTPUT: 
     RETVAL 

void 
CLONE(...) 
    CODE: 
    MY_CXT_CLONE; 

Esto falla tan pronto como ingreso en ENTER para la devolución de llamada.

use SDL; 
use SDL::Time; 

SDL::init(SDL_INIT_TIMER); 
my $time = 0; 
SDL::Timer::add_timer(100, sub { $time++; return $_[0]}); 
sleep(10); 
print "Never Prints"; 

salida es

$ 

Cabe

$ Never Prints 

Answer 1

Hemos encontrado una solución a esto utilizando los hilos del intérprete Perl y los hilos :: compartidos. Consulte estos

Time.xs

También en este caso es un ejemplo de una secuencia de comandos que utiliza este código.

TestTimer.pl

Answer 2

$ tiempo tiene que ser una variable compartida - de lo contrario las obras Perl con copias separadas de la variable.

Answer 3

comentarios rápidos:

• no uso de Perl estructuras (SV, AV, HV, ...) fuera del contexto de un objeto intérprete de Perl. Es decir. no lo use como datos estáticos de nivel C. Estallará en un contexto de enhebrado. Confía en mí, he estado allí.
• Consulte la sección "Almacenamiento seguro de datos estáticos en XS" en la página de manual perlxs.
• Algunas de esas cosas que estás haciendo no son públicas desde el punto de vista del perlapi. Aunque no estoy seguro.

Answer 4

Mi forma preferida de manejar esto es almacenar los datos en el hash PL_modglobal. Está automáticamente vinculado al intérprete actual.