Calling into perl from multiple pthreads, simultaneously

[Mark Glines]

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 ------

[Eric Garland]

Why don't you create a single message receiving thread in perl that handles the incoming XS calls and
have it relay the requests to other worker threads in perl.

That's what I did to multi-thread perlfs. (http://perlfs.sf.net/) The responses to the kernel are issued by the worker threads
directly but all incoming messages are handled through one thread. I'm not sure how the structure of the kernel side of Fuse
differs from perlfs but I suspect it's similar.

-Eric

Post by Mark Glines
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
calling test_threads
interpreter cached (master)
Got to callback! Argument = 4658
perl_clone -> 0452c530
Got to callback! Argument =
perl_clone -> 04df9708
==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(...)
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
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 ------

[Jeremy White]

Post by Mark Glines
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!

Ok - this works for me (both Win32 and Linux).

As early as you can perform a clone on the main thread, then save this
cloned Perl for later use. When you start spawning your worker threads, you
need to clone from the saved clone. You will also need a mutex around your
cloning logic. Some rough code:


PerlInterpreter* ClonePerl() {
//lock the mutex before we do anything
PerlInterpreter *NewPerl;
PerlInterpreter *my_perl;
pthread_mutex_lock(&CloneMutex);
PERL_SET_CONTEXT(savedPerlClone);
NewPerl = perl_clone(savedPerlClone,XXX); //XXX your flags
//you would check if NewPerl is valid...
//unlock the mutex
pthread_mutex_unlock(&CloneMutex);
//return the new perl
return NewPerl;
}


void worker() {
//worker thread init
PerlInterpreter* my_perl;
my_perl = ClonePerl();
//each worker now has it's own perl, and you can do what you want to it:)
}

Cheers,

jez.

[Mark Glines]

Jeremy, Eric,

Thanks for your replies. Actually, I was able to get an answer a month
ago, on perl5-porters. A discussion ensued, and I had a few other
issues to resolve (such as perl 5.8.7 not allowing me to SvSHARE() a
code reference).

For reference, that thread can be found here:
http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2005-12/msg00497.html

...and the resulting (working) multithreaded code is at:
http://search.cpan.org/~dpavlin/Fuse-0.07_3/

My only current gripe is that I have to use symbolic references (strings
like "main::read_callback") to the callback functions. If anyone can
figure out a way to SvSHARE() an actual code reference or closure or
something like that, I'd be very grateful. :)

Mark

Post by Jeremy White

Post by Mark Glines
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!

Ok - this works for me (both Win32 and Linux).
As early as you can perform a clone on the main thread, then save this
cloned Perl for later use. When you start spawning your worker threads,
you need to clone from the saved clone. You will also need a mutex
PerlInterpreter* ClonePerl() {
//lock the mutex before we do anything
PerlInterpreter *NewPerl;
PerlInterpreter *my_perl;
pthread_mutex_lock(&CloneMutex);
PERL_SET_CONTEXT(savedPerlClone);
NewPerl = perl_clone(savedPerlClone,XXX); //XXX your flags
//you would check if NewPerl is valid...
//unlock the mutex
pthread_mutex_unlock(&CloneMutex);
//return the new perl
return NewPerl;
}
void worker() {
//worker thread init
PerlInterpreter* my_perl;
my_perl = ClonePerl();
//each worker now has it's own perl, and you can do what you want to it:)
}
Cheers,
jez.

[Jeremy White]

Post by Mark Glines
Jeremy, Eric,
Thanks for your replies. Actually, I was able to get an answer a month
ago, on perl5-porters. A discussion ensued, and I had a few other
issues to resolve (such as perl 5.8.7 not allowing me to SvSHARE() a
code reference).

No worries:) I must have missed your original post.

While we're on the subject of SvSHARE, have you any pointers to
documentation to show how it's used?

The API docs simply say "Arranges for sv to be shared between threads if a
suitable module has been loaded.", which leads to a lot of questions. For
example: What can and can not be shared? If a hash is shared, are sv's added
to the hash shared too? Does Perl maintain the mutex locks on a shared SV,
or do we have to do it explicitly with SvLock? I can think of a few more
questions as well:)

Cheers,

jez.

[Mark Glines]

[sorry, I forgot to Cc: the list. resending.]

Post by Jeremy White

Post by Mark Glines
Jeremy, Eric,
Thanks for your replies. Actually, I was able to get an answer a month
ago, on perl5-porters. A discussion ensued, and I had a few other
issues to resolve (such as perl 5.8.7 not allowing me to SvSHARE() a
code reference).

No worries:) I must have missed your original post.
While we're on the subject of SvSHARE, have you any pointers to
documentation to show how it's used?

threads::shared(3pm).

Post by Jeremy White
The API docs simply say "Arranges for sv to be shared between threads
if a suitable module has been loaded.", which leads to a lot of
questions. For example: What can and can not be shared? If a hash is
shared, are sv's added to the hash shared too? Does Perl maintain the
mutex locks on a shared SV, or do we have to do it explicitly with
SvLock? I can think of a few more questions as well:)

The "suitable module" they were talking about is threads::shared. It
seems SvSHARE and SvLOCK are the XS entry points to threads::shared's
share() and lock() functions. The perl script needs to have done a "use
threads; use threads::shared" before these functions are usable.

At the moment, it looks from the manpage like most normal data
structures are share()able, though I wouldn't assume share() works more
than one level of references deep.

However, this error message seems to indicate that they plan to add the
ability to share() more things:

$ perl -Mthreads -Mthreads::shared -e 'sub s {}; my $s=\&s; share($s);'
Cannot share subs yet at -e line 1.

I'm hoping they do; sharing sub refs (esp. closures!) would be really
*really* useful for Fuse.

Mark