Patrick Dupre wrote:
> I am trying to explain,
> 
> Here are the 2 perl subroutines:
> sub sub1 {
>    my %a ;
>    $a {a} = 1 ;
>    $a {b} = 2 ;
>    foreach (keys %a) {
>      print $_, " => ", $a {$_}, "\n" ;
>      }
>    return \%a ;
>    }
> 
> sub sub2 {
>    my ($h) = @_ ;
>    foreach (keys %$h) {
>      print $_, " => ", $$h {$_}, "\n" ;
>      }
>    }
> +++++++++++++++++++++++++++++++++
> In XS:
>    PREINIT:
>      int count ;
>      SV *retval ;
>      HV *hv ;
>      SV **elem ;
>    CODE:
>      dSP ;
>      ENTER ;
>      SAVETMPS ;
>      PUSHMARK (SP) ;
>      PUTBACK ;
>      count = call_pv ("sub_::sub1", G_ARRAY | G_NOARGS | G_EVAL) ;
>      SPAGAIN ;
>      if (SvTRUE (ERRSV)) {
>        printf ("An error occured in the Perl preprocessor: %s\n", 
> SvPV_nolen (ERRSV)) ;
>        }
>      else {
>        printf ("Nb values returned: %d\n", count) ;
>        retval = POPs ;
>        if (! SvROK (retval) || SvTYPE (SvRV (retval)) != SVt_PVHV) {
>          croak ("Return value is not a hash reference\n") ;
>          }
>        else {
>          hv = (HV*) SvRV (retval) ;
>       }
>        }
> newRV ((SV*) retval) ; //OK
>      FREETMPS ;
>      LEAVE ;
>      elem = hv_fetch (hv, "a", 1, FALSE) ;
>      ENTER ;
>      SAVETMPS ;
>      PUSHMARK (SP) ;
>      XPUSHs (sv_2mortal (newRV ((SV*) hv))) ;
>      PUTBACK ;
>      count = call_pv ("sub_::sub2", G_DISCARD | G_EVAL) ;
>      SPAGAIN ;
>      FREETMPS ;
>      LEAVE ;
> 
> Like it is here, it should partially work, at least it gives me the 
> correct display due to sub2.
> Notice the newRV before the FREETMPS !!!
> If I remove it, it does not work at all, 1) the hv_fetch generate a
> segmentation fault, 2) the sub2 gives an error:
> Attempt to free unreferenced scalar: SV 0x8941998, Perl interpreter: 
> 0x87b9008 at ./test.pl line 13
> 
> Somethnig does not make sense to me !!!
> I do not get the refernce properly for sure, but why ?

Why is the FREETMPS there at all? I can't think of a reason to call FREETMPS and
LEAVE in the middle of an XSUB unless you need to fancy stuff with nested
scoping, but that's not applicable here. You can get away without calling it
altogether, but unless you're certain you know what you're doing all your XSUBs
should always start with

  dSP;
  ENTER;
  SAVETMPS;

and end with

  FREETMPS;
  LEAVE;

as the very last statements.

Apart from that it should all work I think, but I wouldn't bother with using
G_EVAL unless there's a chance that your Perl subroutines will call die and you
want to handle it within the XSUB.

I also think it would be nicer to pass your Perl subroutines in to your XSUB,
rather than just relying on knowing the name of them. That way the program will
fail before the XSUB is even called. So the Perl and XSUB code looks like below.

HTH,

Rob



  use Module;

  Module::xsub(\&sub1, \&sub2);

  sub sub1 {
    :
  }

  sub sub2 {
    :
  }

======================================

  MODULE = Query    PACKAGE = Query

  void
  test(sub1, sub2)
      SV *sub1
      SV *sub2

    CODE:
      dSP;

      I32 count;
      SV *retval;
      HV *hash;

      ENTER;
      SAVETMPS;

      if (! SvROK(sub1) || SvTYPE(SvRV(sub1)) != SVt_PVCV) {
        croak("sub1 is not a code reference");
      }

      if (! SvROK(sub2) || SvTYPE(SvRV(sub2)) != SVt_PVCV) {
        croak("sub2 is not a code reference");
      }

      PUSHMARK(SP);
      count = call_sv (sub1, G_SCALAR | G_NOARGS);
      SPAGAIN;

      if (count != 1) {
        croak("Wrong number of return items");
      }

      retval = POPs;

      if (! SvROK(retval) || SvTYPE(SvRV(retval)) != SVt_PVHV) {
        croak("Return value is not a hash reference");
      }

      hash = (HV*)SvRV(retval);

      PUSHMARK(SP);
      XPUSHs(sv_2mortal(newRV_inc((SV*)hash)));
      PUTBACK;
      call_sv(sub2, G_VOID | G_DISCARD);
      SPAGAIN;

      FREETMPS;
      LEAVE;

-- 
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/


Reply via email to