problem with perl + thread + extension

[Andreas Otto]

Hi,

the following scenario:

I use perl (see below) and write an extension (perlmsgque) as wrapper for
an existing shared library (libmsgque).
everything works fine without threads:

now I add threads.

1) I want to use a new interpreter per thread
2) the new thread is created in the libmsgque shared library
3) after create the perl is initialized with
static enum MqErrorE FactoryCreate (
struct MqS * const tmpl,
enum MqFactoryE create,
MQ_PTR data,
struct MqS ** contextP
) {
if (create == MQ_FACTORY_NEW_THREAD) {
PERL_SET_CONTEXT (perl_clone ((PerlInterpreter*)tmpl->threadData, 0));
}
....
<<<<<<<<<<<<<<<<<<<<<<<<<

4) I use "perl_clone" the create the new interpreter as clone
from the existing one
6) create and setup was fine
7) but the first callback:
static enum MqErrorE
ProcCall (
struct MqS * const context,
MQ_PTR const data
)
{
dSP;
SV * method = (SV*) data;
enum MqErrorE ret = MQ_OK;

ENTER;
SAVETMPS;

PUSHMARK(SP);
XPUSHs((SV*)context->self);
PUTBACK;

call_sv (method, G_SCALAR|G_DISCARD|G_EVAL);

ret = ProcError (aTHX_ context, ERRSV);

FREETMPS;
LEAVE;

return ret;
}
<<<<<<<<<<<<<<<<<<<<<<<<<<<

create an error: the argument stack is empty and:
sub ServerSetup {
my $ctx = shift;
print "ctx<$ctx>\n";
....
<<<<<<<<<<<<<<<<<<<<<<<<<<<
says that "$ctx" is empty
so I come to the conclusion that "call_sv" and "stack" does not match
anymore. "context->self is not empty


Question

What can I do ?




PERL:

perl -V

Summary of my perl5 (revision 5 version 10 subversion 1) configuration:

Platform:
osname=linux, osvers=2.6.27.29-0.1-default, archname=x86_64-linux-
thread-multi
uname='linux linux-522u 2.6.27.29-0.1-default #1 smp 2009-08-15 17:53:59
+0200 x86_64 x86_64 x86_64 gnulinux '
config_args='-des -Dprefix=/home/dev1usr/ext/x86_64-suse-linux/thread -
Dusethreads'
hint=recommended, useposix=true, d_sigaction=define
useithreads=define, usemultiplicity=define
useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
use64bitint=define, use64bitall=define, uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing -pipe
-fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -
D_FILE_OFFSET_BITS=64',
optimize='-O2',
cppflags='-D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing -pipe -fstack-
protector -I/usr/local/include'
ccversion='', gccversion='4.3.2 [gcc-4_3-branch revision 141291]',
gccosandvers=''
intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t',
lseeksize=8
alignbytes=8, prototype=define
Linker and Libraries:
ld='cc', ldflags =' -fstack-protector -L/usr/local/lib'
libpth=/usr/local/lib /lib /usr/lib /lib64 /usr/lib64 /usr/local/lib64
libs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
perllibs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
libc=/lib/libc-2.9.so, so=so, useshrplib=false, libperl=libperl.a
gnulibc_version='2.9'
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
cccdlflags='-fPIC', lddlflags='-shared -O2 -L/usr/local/lib -fstack-
protector'


Characteristics of this binary (from libperl):
Compile-time options: MULTIPLICITY PERL_DONT_CREATE_GVSV
PERL_IMPLICIT_CONTEXT PERL_MALLOC_WRAP
USE_64_BIT_ALL
USE_64_BIT_INT USE_ITHREADS USE_LARGE_FILES
USE_PERLIO USE_REENTRANT_API
Built under linux
Compiled at Oct 2 2009 09:10:52

 

[Andreas Otto]

I'm surprised that even compiled.

The code is only a subset of existing code

Where is that function getting its THX
from?

I do not change anything the THX is from behind perl macro call

I don't really understand how these functions interact,

1. original process
2. libmsgque create a new thread
3. SysServerThreadCreate calling FactoryCreate on the new thread using
the tmpl argument from original process
3. perl_clone is called as first step in FactoryCreatestatic enum MqErrorE FactoryCreate (
struct MqS * const tmpl,
enum MqFactoryE create,
MQ_PTR data,
struct MqS ** contextP
) {

if (create == MQ_FACTORY_NEW_THREAD) {
perl_clone ((PerlInterpreter*)tmpl->threadData, CLONEf_KEEP_PTR_TABLE |
CLONEf_CLONE_HOST);
}

{
dSP;
enum MqErrorE ret = MQ_OK;
int count;

ENTER;
SAVETMPS;

PUSHMARK(SP);

count = call_sv ((SV*)data, G_SCALAR|G_NOARGS|G_EVAL);

SPAGAIN;
if ((ret = ProcError (aTHX_ tmpl, ERRSV)) == MQ_OK) {
if (count != 1) {
ret = MqErrorC(tmpl, __func__, -1, "factory return more than one
value!");
} else {
SV * sv = POPs;
if (sv_derived_from(sv, "MqS")) {
IV tmp = SvIV((SV*)SvRV(sv));
MqS * context = *contextP = INT2PTR(MqS*,tmp);
MqConfigDup (context, tmpl);
if ((ret = MqSetupDup (context, tmpl)) != MQ_OK) {
MqErrorCopy (tmpl, context);
}
} else {
ret = MqErrorC(tmpl, __func__, -1, "factory return is not of type
'MqS'");
}
}
}
PUTBACK;
FREETMPS;
LEAVE;

return ret;
}
}
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
4. now context is setup for current thread
5. call the perl "Factory" from FactoryCreate to return
the new Object referencevoid
new(SV* MqS_class)
PPCODE:
if (!SvROK(MqS_class)) {
// called by a "class"
MqS * context = (MqS*) MqContextCreate(sizeof(struct PerlContextS),
NULL);
ST(0) = sv_newmortal();
sv_setref_pv(ST(0), SvPV_nolen(MqS_class), (void*)context);
context->self = SvREFCNT_inc(ST(0));
context->setup.Child.fCreate = MqDefaultLinkCreate;
context->setup.Parent.fCreate = MqDefaultLinkCreate;
context->setup.fProcessExit = ProcessExit;
//context->setup.fThreadInit = ThreadInit;
context->setup.fThreadExit = ThreadExit;
context->setup.Factory.Delete.fCall = FactoryDelete;
context->threadData = PERL_GET_CONTEXT;
} else {
MqConfigReset (INT2PTR(MqS*,SvIV((SV*)SvRV(ST(0)))));
}
XSRETURN(1);
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
7. after the object is available the SysServerThreadCreate continue
to setup the connectionstatic mqthread_ret_t mqthread_stdcall sSysServerThreadCreate (
void * data
)
{
struct SysServerThreadCreateS * argP = (struct SysServerThreadCreateS *)
data;
// save data local
struct MqS * tmpl = argP->tmpl;
struct MqFactoryS factory = argP->factory;
struct MqBufferLS * argv = argP->argv;
struct MqBufferLS * alfa = argP->alfa;
struct MqS * newctx;
// cleanup
free(argP);
// create the new context
MqErrorCheck(pCallFactory (tmpl, MQ_FACTORY_NEW_THREAD, factory,
&newctx));

^^^^^^^^^^^^^^^^^ call factory ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

// add my configuration
newctx->statusIs = (enum MqStatusIsE) (newctx->statusIs |
MQ_STATUS_IS_THREAD);
// the new CONTEXT is always a SERVER
newctx->setup.isServer = MQ_YES;
// join argvP alfaP
if (alfa != NULL) {
MqBufferLAppendC(argv, MQ_ALFA_STR);
MqBufferLMove(argv, &alfa);
}
// create link
MqErrorCheck(MqLinkCreate(newctx, &argv));

^^^^^^^^^^^^^^ setup connection ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

//MqDLogC(msgque,0,"THREAD exit");
// the MqProcessEvent is necessary because "ParentCreate" have to come
back
// ifNot: java create object will fail
if (newctx->setup.isServer == MQ_YES) {
MqProcessEvent(newctx, MQ_TIMEOUT, MQ_WAIT_FOREVER);
}
error:
MqBufferLDelete (&argv);
<<<<<<<<<<<<<<<<<<<<<<<<<<<<
8. the connection setup code call a perl setup function ProcCall
with the setup callback sub-ref as argument
sub ServerSetup {
my $ctx = shift;
print "ctx<$ctx>\n";
if ($ctx->ConfigGetIsSlave()) {
# add "slave" services here
} else {
....
<<<<<<<<<<<<<<<<<<<<<<<

9. ServerSetup fails .. because the argument from the stack is not visible

ERROR: $ctx is empty !!!!

or (for example)
which thread ProcCall is being called from.

ProcCall is a callback called from the libraray libmsgque

If you can cut out libmsgque
for now, and produce a minimal complete program using just
pthread_create or some such that shows the same failure, maybe someone
can help you.

it is not a problem from libmsgque because the same thread code is used
for C, C++, C#, JAVA, TCL, PYTHON .....
without problems ....
the problem is only the PERL stack arguments missing

 

[Andreas Otto]

Hi,

The problem is solved ...

the method reference from:
static enum MqErrorE
ProcCall (
struct MqS * const context,
MQ_PTR const data
)
{
dSP;
SV * method = (SV*) data;
enum MqErrorE ret = MQ_OK;

ENTER;
SAVETMPS;

PUSHMARK(SP);
XPUSHs((SV*)context->self);
PUTBACK;

call_sv (method, G_SCALAR|G_DISCARD|G_EVAL);

^^^^^^^^^^^^^^^^^^^ the "method" ^^^^^^^^^^^^^^^^^^^^^^^

ret = ProcError (aTHX_ context, ERRSV);

FREETMPS;
LEAVE;

return ret;
}
<<<<<<<<<<<<<<<<<<<<<

point to the "old" interpreter ... In Fact I call this a
libmsgque bug because the "copyConstructor" for
this sub-ref is not available in the public perl-api.

all other languages have a "copyConstructor" and so
the libmsgque code was to throw away the "right" values
from the "objectConstructor" and use the "copyConstructor"
to set this value to the new value.

now libmsgque check if this value was already set in the
"objectConstructor" and do !!not!! use the "copyConstructor"
(this one not exit in the public perl API) to set it again.


mfg

Andreas Otto

 

[Andreas Otto]

You do realise this isn't actually a method call, don't you? You need
G_METHOD for that.

G_METHOD is not in the public perl api -> this was the reason
I don't use it for me I only use sub-ref and it works

public is "call_method" but this does not accept references

You can use sv_dup to copy SVs from one interpreter to another (is this

yes I check for sv_dup but this is again not part of the public perl API
and it is not documented

what you mean by 'copyConstructor'?). You call it in the context of the
new interpreter.

copyConstructor:
1. I have a sub-ref in interpreter one
2. I use perl_clone to get a new interpreter
3. I want to use the sub-ref from 1. in the new interpreter

my solution right now you have to define all "callbacks"
in the object constructor

this is OK and as close as possible to the "interface" programming template
of C++, JAVA and C#
package Server;
use base qw(MqS);
....
sub ServerSetup {
my $ctx = shift;
...
}
....
sub new {
my $class = shift;
my $ctx = $class->SUPER::new(@_);
$ctx->ConfigSetName("server");
$ctx->ConfigSetServerSetup(\&ServerSetup);
$ctx->ConfigSetServerCleanup(\&ServerCleanup);
$ctx->ConfigSetFactory(
sub {
new Server()
}
);
return $ctx;
}
....
package main;

our $srv = new Server();

eval {
$srv->LinkCreate(@ARGV);
$srv->ProcessEvent({wait => "FOREVER"});
};
if ($@) {
$srv->ErrorSet($@);
}
$srv->Exit();
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

 

[Andreas Otto]

OK. G_METHOD has been there since 2000, so I doubt it's going anywhere,
but sticking carefully to the public API is still a good idea. As long
as you realise that this call is

$subref->($object);

rather than

$object->method;

In your place I would probably allow the user to pass in a string as
well, and choose call_sv or call_method based on what type of SV I got.

well "man perl_call" -> "Using call_sv ..." says something about this:
Because we are using an SV to call fred the following can all be used

CallSubSV("fred");
CallSubSV(\&fred);
$ref = \&fred;
CallSubSV($ref);
CallSubSV( sub { print "Hello there\n" } );
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

you see "call_sv" already covers all kind of possibilities

I agree it's not documented, but if you check
http://perl5.git.perl.org/perl.git/blob/HEAD:/embed.fnc you will find

ApR |SV* |sv_dup |NULLOK const SV *const sstr|NN
CLONE_PARAMS *const param

but I still not know what to do with the last parameter...CLONE_PARAMS
-> what to fill in

where the initial 'A' means this is a public API function. I suspect the
lack of documentation is simply an oversight.

If you have questions about what is and isn't a supported part of the
API, you can take them to (e-mail address removed): actually, if you have
questions about using the more advanced parts of the perl API, you will
probably find more people there who know about them than you will here.

this is not all of my code the "toplevel" package called "perlmsgque"

from the startuse strict;
use Switch;
use perlmsgque;
....
package Server;
use base qw(MqS);
....
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

"MqS" (this is from me) and is just a "subpackage" of "perlmsgque"
(this is also from me)

the package "Server" is a synonym for a "end-user" package
I use this name for testing only

the full name is "perlmsgque::MqS"

 

[Andreas Otto]

right now I have a more serious problem:

as opposite to "FactoryCreate" I have a "FactoryDelete" too
static void FactoryDelete (
struct MqS * context,
MQ_BOL doFactoryCleanup,
MQ_PTR data
) {
enum MqStatusIsE statusIs = context->statusIs;
PerlInterpreter *itp = context->threadData;
if (statusIs & MQ_STATUS_IS_THREAD) {
PERL_SET_CONTEXT(itp);
perl_destruct (itp);
PERL_SET_CONTEXT(itp);
perl_free (itp);
} else {
SvREFCNT_dec((SV*)context->self);
}
}
<<<<<<<<<<<<<<<<<<<<<<<<<

now the problem :

"perl_destruct" delete all objects even the
ones from the "original" interpreter copied
into the new interpreter using "perl_clone"

for me every object is linked to a pointer
of type "struct MqS" from "libmsgque"

now shutdown of interpreter "1" delete the
"libmsgque" objects belonging to the original interpreter "0"
too => not good :-(


mfg

Andreas Otto

 

[Andreas Otto]

Are you sure it destroys the Perl objects in the original interpreter?
Do you perhaps have a DESTROY method on your objects that frees the
libmsgque object,

yes I have (code below) and this DESTROY is called during "perl_destruct"
on the objects already available before the "perl_clone" was done.

and this is getting called because the cloned object
has been destroyed? If that's the case then you need to refcount your
pointers to libmsgque object; if it's not, then can you provide a
*complete*, *minimal* (in particular: not using either libmsgque or
threads) C program that demonstrates your problem.

yes I'm sure ... I see it from my application logfile.
I get an application CORE just after the "C" pointer is gone ....

but I already found an work-around:
void
DESTROY(SV *obj)
PPCODE:
if (!SvROK(obj) || !SvOK(SvRV(obj))) XSRETURN(0);
MqS* context = INT2PTR(MqS*,SvIV((SV*)SvRV(ST(0))));
SV* self = context->self;
HV* hash = PERL_DATA;
// well "perl_clone" clone everything including the "perl" objects
// from the other interpreter. These objects get an "DESTROY" if
// "perl_clone" interpreter is destroyed with "perl_destruct"
// -> this is not good
if (PERL_GET_CONTEXT != (PerlInterpreter*)context->threadData)
XSRETURN(0);

^^^^^^^^^^^^^^^^^^^^^^^ this is the work-around ^^^^^^^^^^^^^^^^^^^^^^^^^^^^

// the "Factory" is useless -> delete
context->setup.Factory.Delete.fCall = NULL;
// delete the context
MqContextDelete(&context);
// free the data
if (self && SvREFCNT(self)) SvREFCNT_dec(self);
if (hash) hv_undef (hash);
// free the handle
SvSetSV_nosteal (SvRV(ST(0)), &PL_sv_undef);
XSRETURN(0);
<<<<<<<<<<<<<<<<<<

I save the context , where the object was created on, in a data entry of the
"struct MqS" pointer "context->threadData".

If the DESTROY is called from the wrong context it is blocked.

-> now it works

the problem is that "perl" does not increase the refCount on objects created
withvoid
new(SV* MqS_class)
PPCODE:
if (!SvROK(MqS_class)) {
// called by a "class"
MqS * context = (MqS*) MqContextCreate(sizeof(struct PerlContextS),
NULL);
ST(0) = sv_newmortal();
sv_setref_pv(ST(0), SvPV_nolen(MqS_class), (void*)context);
....
<<<<<<<<<<<<<<<<<<<<<
during "perl_clone"

it is in close to the same problem of \&calllback which were not updated
during "perl_clone"

=> but for now I'm fine