http://qs321.pair.com?node_id=338857


in reply to Correct way to return a reference in XS/embedded perl

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

[download]

(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);
  }

[download]

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

Replies are listed 'Best First'.
Re: Re: Correct way to return a reference in XS/embedded perl
by nikolaus (Novice) on Mar 23, 2004 at 17:03 UTC
    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?
[reply]

      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

      [download]

      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);
        }

      [download]

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

[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom