in reply to Re^6: Extending & Embedding Perl simultaneously: How to share a scalar between perl callback sub and main body?
in thread Extending & Embedding Perl simultaneously: How to share a scalar between perl callback sub and main body?
Thanks in advance!
PS: I think there some leaks etc in that code, but didnt care about those at this point.
myModule.xs
#include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "ppport.h" #include <pthread.h> static PerlInterpreter *orig_perl=NULL; static PerlInterpreter *cb_perl=NULL; SV* cb_ptr = NULL; void InvokeCB () { static int val = 0; val++; dTHX; dSP; ENTER; SAVETMPS; PUSHMARK(SP); SV * sv = cb_ptr; if (my_perl != orig_perl) { CLONE_PARAMS clone_param; clone_param.stashes = NULL; clone_param.flags = CLONEf_COPY_STACKS | CLONEf_KEEP_PTR_TABLE; clone_param.proto_perl = cb_perl; sv = sv_dup(sv, &clone_param); } XPUSHs(sv_2mortal(newSViv(val))); PUTBACK; call_sv(sv, G_DISCARD); FREETMPS; LEAVE; } void * BGThread(void * dontcare) { PERL_SET_CONTEXT(orig_perl); cb_perl = perl_clone(orig_perl, CLONEf_COPY_STACKS | CLONEf_KEEP_PT +R_TABLE); PERL_SET_CONTEXT(cb_perl); while (1) { sleep(5); InvokeCB(); } } MODULE = myModule PACKAGE = myModule int RegisterCB (SV *SubRef) CODE: pthread_t tid; pthread_create(&tid, NULL, BGThread, NULL); orig_perl = PERL_GET_CONTEXT; cb_ptr = newSVsv(SubRef); SvSHARE(cb_ptr); RETVAL = 1; OUTPUT: RETVAL
test.pl
#! /usr/local/bin/perl use myModule; use warnings; #shared scalar $cb_done = 0; @results = (); #This cb would be invoked by the cloned interpreter in the #C library. This works fine. sub cb_one { ($value) = @_; print "CB called. val received : ", $value, "\n"; $results[scalar(@results)] = $value; if ($value == 5) { print "cb_done changed to one.\n"; $cb_done = 1; } } print "Registered CB...\n"; $status = myModule::RegisterCB(\&main::cb_one); do { print "Waiting for CB to be done...\n"; sleep (5); } until ($cb_done == 1); #These line should be printed when $cb_done becomes 1 #in the main of the perl script print "CB was invoked : $cb_done\n"; print "results are : @results \n";
script output
Name "main::status" used only once: possible typo at ./test.pl line 27 +. Registered CB... Waiting for CB to be done... Waiting for CB to be done... CB called. val received : 1 Waiting for CB to be done... CB called. val received : 2 Waiting for CB to be done... CB called. val received : 3 Waiting for CB to be done... CB called. val received : 4 Waiting for CB to be done... CB called. val received : 5 cb_done changed to one. Waiting for CB to be done... CB called. val received : 6 Waiting for CB to be done... CB called. val received : 7
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re^8: Extending & Embedding Perl simultaneously: How to share a scalar between perl callback sub and main body?
by perlmonk1729 (Acolyte) on Dec 07, 2009 at 07:36 UTC | |
by perlmonk1729 (Acolyte) on Nov 12, 2010 at 10:02 UTC |