Hi! I've got a question which is halfway between perlxs and perlembed. I'm hoping you guys can help me. :)
I wrote an XS wrapper for FUSE (http://fuse.sf.net) a couple years ago. You "use Fuse;" in your perlscript, and call Fuse::main(). It then maps filesystem calls from a C library (libfuse) into calls to Perl sub refs, with call_sv(). For a long time, the whole thing has been single-threaded, because it was unclear how to call perl from multiple threads concurrently. (Back in the days of perl 5.6.1, I couldn't find anything in the docs about this.) Recently, I noticed a blurb in perlguts which said all I had to do was do PERL_SET_CONTEXT() and everything would be happy. (This perlguts entry seems unclear as to whether this will work for concurrent calls, or just for the occasional call on its own.) So I tried it. And everything does work, if I put a lock around the whole thing. It crashes horribly if I call into it multiple times concurrently. So, I did a little more research. It looks like I have to call perl_clone(), but that crashes when I call into it concurrently, too. And this time I have an additional problem: none of the arguments get passed down to the callback sub! I'm obviously doing something wrong, and I have no idea how to debug this. I've tried boiling things down, I've got a test project which just manages a single callback, with a single argument. Here's what happens when I run it under valgrind (it shows a lost arg, followed by a crash): calling test_threads interpreter cached (master) Got to callback! Argument = 4658 perl_clone -> 0452c530 Got to callback! Argument = perl_clone -> 04df9708 ==4658== Thread 3: ==4658== Invalid read of size 4 ==4658== at 0x80A02B5: Perl_pad_push (in /usr/bin/perl5.8.7) ==4658== by 0x80CD041: Perl_pp_entersub (in /usr/bin/perl5.8.7) ==4658== by 0x806152E: (within /usr/bin/perl5.8.7) ==4658== by 0x80648F2: Perl_call_sv (in /usr/bin/perl5.8.7) ==4658== by 0x404261C: test_callback (in /home/paranoid/workspace/ithreads-test/Threadtest/blib/arch/auto/Threadtest/Threadtest.so) ==4658== by 0x404228C: do_something (in /home/paranoid/workspace/ithreads-test/Threadtest/blib/arch/auto/Threadtest/Threadtest.so) ==4658== by 0x404A37F: start_thread (in /lib/tls/libpthread-2.3.5.so) ==4658== by 0x417ED1D: clone (in /lib/tls/libc-2.3.5.so) ==4658== Address 0x0 is not stack'd, malloc'd or (recently) free'd ==4658== ==4658== Process terminating with default action of signal 11 (SIGSEGV) Unfortunately, this tree is still in several files. I'm pasting the XS file and the test.pl script into this email; you can find the rest of the tree at http://glines.org/bin/ithreads-test.tar.gz if needed. Thanks! Mark ------ begin Threadtest.xs ------ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "ppport.h" #include "const-c.inc" /* blatant linuxism for test purposes */ #include <linux/unistd.h> #include <errno.h> _syscall0(pid_t,gettid); /* emulate FUSE; a simple C pthread thing to test concurrency */ #define NUM_THREADS 20 void *do_something(void *arg) { int tid = gettid(); int rv = tid; int (*func)(int) = arg; rv = func(tid); return NULL; } int test_threads(int (*funcptr)(int)) { pthread_t threads[NUM_THREADS]; int i; do_something(funcptr); for(i = 0; i < NUM_THREADS; i++) pthread_create(&threads[i], NULL, &do_something, funcptr); do_something(funcptr); for(i = 0; i < NUM_THREADS; i++) pthread_join(threads[i], NULL); } /* this is /usr/bin/perl's PerlInterpreter, we clone this for new threads */ PerlInterpreter *master_interp = NULL; /* thread-local storage key to clone PerlInterpreters as necessary*/ pthread_key_t test_interp_key; /* set up our PerlInterpreter state */ static inline void setup_perl_context() { if(master_interp) { PerlInterpreter *me = pthread_getspecific(test_interp_key); if(!me) { PERL_SET_CONTEXT(master_interp); me = perl_clone(master_interp, CLONEf_KEEP_PTR_TABLE); pthread_setspecific(test_interp_key,me); //PERL_SET_CONTEXT(me); fprintf(stderr,"perl_clone -> %08lx\n",(long)me); } else { fprintf(stderr,"interpreter cached (%s)\n", me == master_interp ? "master" : "slave"); } } } /* free our PerlInterpreter when the thread exits */ static void destroy_perl_context(void *ptr) { PerlInterpreter *ctx = ptr; if(ctx && (ctx != master_interp)) { perl_destruct(ctx); perl_free(ctx); fprintf(stderr,"perl_free\n"); } } /* storage for the callback sub-reference */ static SV *test_callback_SV; int test_callback(int tid) { int rv; setup_perl_context(); { dSP; ENTER; SAVETMPS; PUSHMARK(SP); XPUSHs(sv_2mortal(newSViv(tid))); PUTBACK; rv = call_sv(test_callback_SV,G_SCALAR); SPAGAIN; if(rv) rv = POPi; else rv = 0; FREETMPS; LEAVE; PUTBACK; } return rv; } MODULE = Threadtest PACKAGE = Threadtest PROTOTYPES: DISABLE INCLUDE: const-xs.inc void test_threads(...) CODE: test_callback_SV = ST(0); /* save off the interpreter which we'll clone later on */ master_interp = PERL_GET_INTERP; /* setup the TLS key, so new threads can figure themselves out */ pthread_key_create(&test_interp_key, destroy_perl_context); /* the primary thread uses the primary perl interpreter */ pthread_setspecific(test_interp_key, master_interp); /* this is where FUSE used to get called; we usually segfault here. */ test_threads(&test_callback); /* cleanup */ pthread_key_delete(test_interp_key); ------ end Threadtest.xs ------ ------ begin test.pl ------ #!/usr/bin/perl push(@INC,'blib/arch'); push(@INC,'blib/lib'); require Threadtest; sub cb { my $arg = shift; print(STDERR "Got to callback! Argument = $arg\n"); # this sleep makes the crash happen almost every time select(undef,undef,undef,0.1); return $arg; } print("calling test_threads\n"); Threadtest::test_threads(\&cb); print("done\n"); ------ end test.pl ------
