Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

Correct way to return a reference in XS/embedded perl

by nikolaus (Novice)
on Mar 22, 2004 at 22:49 UTC ( [id://338807]=perlquestion: print w/replies, xml ) Need Help??

nikolaus has asked for the wisdom of the Perl Monks concerning the following question:

I've got two perl classes, call them A and B. A contains an array of references to B. From C (the language, not the class), I'm constructing an A, then constructing a bunch of Bs, then calling A::add( ) (written in perl, not C) to add a list of Bs. All works fine if there are fewer than 121 Bs in the list, but with more than that, something goes wrong. Depending on how I structure the code, the "something" that goes wrong can be that I get an "Attempt to free unreferenced scalar" when returning my A, or my reference to A somehow turns into &PL_sv_undef.

Some particulars:

SV *buildA(A& a) { SV *tmpSv, a_sv; I32 count; int i; dSP; ENTER; SAVETMPS; PUSHMARK; tmpSv = sv_2mortal(newSVpv("A", 0)); XPUSHs(tmpSv); PUTBACK; count = call_method("new", G_SCALAR); // A::new { // my $proto = shift; // my $class = ref($proto) || $proto; // my $this = { }; // bless($this, $class); // $this->{B} = [ ]; // return $this; // } SPAGAIN; assert(1 == count); tmpSv = POPs; a_sv = newSVsv(tmpSv); // or use NEWSV/SvSetMagicSV PUTBACK; FREETMPS; LEAVE; std::vector<SV*> b_svs; for (i = 0; i < a.b_count; ++i) { tmpSv = buildB(a.b[i]); b_svs.push_back(tmpSv); } addBs(a_sv, b_svs); return a_sv; }
buildB looks much like buildA. A::addBs looks like this:
void addBs(SV *a_sv, std::vector<SV*> &b_svs) { SV *tmpSv; I32 count; std::vector<SV*>::iterator iter; dSP; ENTER; SAVETMPS; PUSHMARK(SP); tmpSv = sv_mortalcopy(a_sv); XPUSHs(tmpSv); for (iter = b_svs.begin( ); iter != b_svs.end( ); ++iter) { XPUSHs(sv_2mortal(*iter)); } PUTBACK; count = call_method("add", G_VOID|G_DISCARD); // A::add { // my $this = shift; // push(@{$this->{B}}, @_); // } SPAGAIN; assert(0 == count); FREETMPS; LEAVE; }
If I use newSVsv in buildA/buildB, then the SV* returned by buildA( ) seems to be &PL_sv_undef. If I use NEWSV/SvSetMagicSV, then I get the "Attempt to free unreferenced scalar" in the calling XS code:
void get_a( ) PPCODE: A a = getAFromSomewhere( ); SV *a_sv = buildA(a); XPUSHs(sv_2mortal(a_sv));

Replies are listed 'Best First'.
Re: Correct way to return a reference in XS/embedded perl
by hawtin (Prior) on Mar 23, 2004 at 01:01 UTC

    I am not sure this will help but I do something that is similar. I have a C API which uses callbacks to process the results and I decided that the Perl binding would allow the user to specify Perl functions, so in my case I needed a C routine that would call a Perl function. My XS code looked like.

    /* We have to bundle up enough of the XS environment to be able to call perl functions from our C callbacks */ typedef struct { SV *sv; SV **sp; } SavedEnv; static void send_str(void *data,const char *str) { SavedEnv *env_ptr = (SavedEnv *)data; SV **sp = env_ptr->sp; /* NULL str means do a flush */ if(str == NULL) str = ""; ENTER; SAVETMPS; PUSHMARK(SP); XPUSHs(sv_2mortal(newSVpv(str,0))); PUTBACK; call_sv(env_ptr->sv,G_VOID | G_DISCARD | G_EVAL); FREETMPS; LEAVE; } MODULE = Sgl PACKAGE = Sgl PREFIX = Sgl PROTOTYPES: ENABLE int SglRawXmlList(fun,action_name,session_id,request_id,debug_level,pid_st +r,wid_str,sid_str,cid_str) SV *fun char *action_name char *session_id char *request_id int debug_level char *pid_str char *wid_str char *sid_str char *cid_str CODE: SavedEnv env; env.sv = fun; env.sp = sp; if(*action_name == '\0') action_name = NULL; if(*session_id == '\0') session_id = NULL; if(*request_id == '\0') request_id = NULL; if(*pid_str == '\0') pid_str = NULL; if(*wid_str == '\0') wid_str = NULL; if(*sid_str == '\0') sid_str = NULL; if(*cid_str == '\0') cid_str = NULL; RETVAL = SglXmlList(send_str,&env,action_name, session_id,request_id,debug_level, pid_str,wid_str,sid_str,cid_str); OUTPUT: RETVAL

    (Subset extracted for clarity)

    My pm looked like

    sub XmlList { my($callback,$action_name,%options) = @_; my($session_id,$request_id,$debug_level); my($projectID,$wellID,$setID,$curveID); if(!ref($callback)) { my $ncallback = eval("\\&$callback"); $callback = $ncallback if(ref($ncallback) eq "CODE"); } if(ref($callback) ne "CODE") { carp "Must pass subroutine to XmlList\n"; return; } . . . return RawXmlList($callback,$action_name, $session_id,$request_id,$debug_level, $projectID,$wellID,$setID,$curveID); }

    As I said this seems to work for me and the places where it is different from yours seem insignificant

      One place where ours seem to differ is where mine is trying to return a scalar reference to an instance of a class back to Perl; I don't see where yours is returning anything to Perl. Am I missing something?

        Yes, mine returns a status value via the RETVAL, but of course this is just an interger.

        So then since a class is just a fancy hash I guess the obvious candidate for the villain in your tale is the garbage collector. If the reference counts are not set then it could free up the elements before you have finished with them. Are you sure that you have set the reference counts on both the hash and the reference?

        In buildA() I see one call to sv_2mortal() but don't see how the code

        tmpSv = POPs; a_sv = newSVsv(tmpSv); // or use NEWSV/SvSetMagicSV

        is ensuring the ref counts are set (and my Perl documents are 8 time zones away, so this is only a guess).

        Generally I call sv_2mortal() on anything I send back to Perl (and on things that they reffer to and so on). Here is a place where I return a list of strings to Perl (I suspect this is almost exactly strait from the Perl docs)

        void SglCreateProjectNameList() PPCODE: { char **names; int count,i; SglStatus ret; ret = SglCreateProjectNameList(NULL,&names,&count); if(ret != SGL_SUCCESS) XSRETURN_EMPTY; /* Here we take a belt and braces approach, the fact that we precalculate the length of the list (and call EXTEND +) means that we could use PUSHs rather than XPUSHs, but it doesn't cost much to be paranoid */ EXTEND(SP,count+1); for(i = 0; i < count; i++) XPUSHs(sv_2mortal(newSVpvn(names[i], 1+strlen(names[i] +)))); SglFreeNameList(NULL,names); }

        Of course you have to be carefull with ref counts otherwise your script will run out of memory.

        Hope that was more valuable than my last post :-)

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://338807]
Approved by Limbic~Region
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others pondering the Monastery: (4)
As of 2024-04-19 06:23 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found