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

As a follow up to Efficient walk/iterate along a string, I started playing with an inline C callback iterator. The following works even with the commented out lines and doesn't appear to leak at all.

However, when I tried to run it as part of a benchmark, it crashes.

So, ignoring the absence of error checking, my questions are: 

#! perl -sw
use strict;
use Inline C => Config => BUILD_NOISY => 1;
use Inline C => <<'END_C',  NAME => 'strIter', CLEAN_AFTER_BUILD => 0;

void strIter( SV *code, SV *string )  {
    dSP;
    STRLEN i ;
    char *p = SvPVX( string );
    SV *c;

//    ENTER;
//    SAVETMPS;

    c = newSV( 1 );
    SvCUR( c ) = 1;
    SvLEN( c ) = 2;
    SvPVX( c ) = p;
    SvPOK_only( c );
    GvSV(PL_defgv) = c;

    for( i=0; i < SvCUR( string ); ++i ) {

        PUSHMARK(SP);
        call_sv( code, G_NOARGS |G_VOID );
        PUTBACK;
        SvPVX( c ) = ++p;
        SvPOK_only( c );

    }
//    FREETMPS;
//    LEAVE;
    GvSV(PL_defgv) = string;
}

END_C

use strict;
use Time::HiRes qw[ time ];
use Benchmark qw[ cmpthese ];

our $string = 'abcdefghijklmnopqrstuvwyxABCDEFGHIJKLMNOPQRSTUVWXY' x 1
+00;

for (1 .. 100 ) {
    strIter sub{ print; }, $string;
}

[download]
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
RIP an inspiration; A true Folk's Guy

Replies are listed 'Best First'.
Re: Help me improve my XS.
by Tux (Canon) on Nov 23, 2010 at 16:18 UTC

    /me just answers the prototype question ...

    XS essentially boils down to two parts. The real C code that is littered with macros, which you are now writing, and a part that is preprocessed when converting XS files to C. The latter part might look like this:

    MODULE = TEST        PACKAGE = main

long
mktime (sec, min, hr, day, mon, yr)
        int     sec
        int     min
        int     hr
        int     day
        int     mon
        int     yr
    PROTOTYPE: $$$$$$
    CODE:
        struct tm       ltm;

        ltm.tm_sec      = sec;
        ltm.tm_min      = min;
        ltm.tm_hour     = hr;
        ltm.tm_mday     = day;
        ltm.tm_mon      = mon;
        ltm.tm_year     = yr;
        ltm.tm_wday     = 0;
        ltm.tm_yday     = 0;
        ltm.tm_isdst    = 0;

        RETVAL = mktime (&ltm);
    OUTPUT:
        RETVAL

    [download]

    Which will be translated to something like

    XS(XS_main_mktime); /* prototype to pass -Wmissing-prototypes */
XS(XS_main_mktime)
{
#ifdef dVAR
    dVAR; dXSARGS;
#else
    dXSARGS;
#endif
    if (items != 6)
       croak_xs_usage(cv,  "sec, min, hr, day, mon, yr");
    {
        int     sec = (int)SvIV(ST(0));
        int     min = (int)SvIV(ST(1));
        int     hr = (int)SvIV(ST(2));
        int     day = (int)SvIV(ST(3));
        int     mon = (int)SvIV(ST(4));
        int     yr = (int)SvIV(ST(5));
        long    RETVAL;
        dXSTARG;
#line 122 "TEST.xs"
        struct tm       ltm;

        ltm.tm_sec      = sec;
        ltm.tm_min      = min;
        ltm.tm_hour     = hr;
        ltm.tm_mday     = day;
        ltm.tm_mon      = mon;
        ltm.tm_year     = yr;
        ltm.tm_wday     = 0;
        ltm.tm_yday     = 0;
        ltm.tm_isdst    = 0;

        RETVAL = mktime (&ltm);
#line 239 "TEST.c"
        XSprePUSH; PUSHi((IV)RETVAL);
    }
    XSRETURN(1);
}

:
:

#ifdef __cplusplus
extern "C"
#endif
XS(boot_TEST); /* prototype to pass -Wmissing-prototypes */
XS(boot_TEST)
{
#ifdef dVAR
    dVAR; dXSARGS;
#else
    dXSARGS;
#endif
#if (PERL_REVISION == 5 && PERL_VERSION < 9)
    char* file = __FILE__;
#else
    const char* file = __FILE__;
#endif

    PERL_UNUSED_VAR(cv); /* -W */
    PERL_UNUSED_VAR(items); /* -W */
    XS_VERSION_BOOTCHECK ;

        (void)newXSproto_portable("main::mktime", XS_main_mktime, file
+, "$$$$$$");
#if (PERL_REVISION == 5 && PERL_VERSION >= 9)
  if (PL_unitcheckav)
       call_list(PL_scopestack_ix, PL_unitcheckav);
#endif
    XSRETURN_YES;
}

    [download]

    The code to call to set the prototype is newXSproto_portable (), but I don't know if you can be in time to do so in Inline::C.


    Enjoy, Have FUN! H.Merijn
[reply]
[d/l]
[select]
Re: Help me improve my XS.
by ReturnOfThelonious (Beadle) on Nov 23, 2010 at 22:50 UTC

    It's hard-coded in Inline::C to have prototypes disabled, but you can rename strIter and use a Perl wrapper function around it. E. g., sub strIter(&$) { _strIter($_[0], $_[1]) }

    It didn't crash when I tried it.

    For MULTICALL see LIGHTWEIGHT_CALLBACKS in perlcall.pod.

[reply]
[d/l]
      It's hard-coded in Inline::C to have prototypes disabled

      Yeah, I've noticed. Is there a good reason for that ?
      Is there a good reason to (try to) change that ?

      Cheers,
      Rob
[reply]
        It's probably just a question of there not being a means of specifying them.
[reply]
Re: Help me improve my XS.
by ikegami (Patriarch) on Nov 24, 2010 at 01:36 UTC 
    SvLEN( c ) = 2;

    [download]

    should be 

    SvLEN( c ) = 0;

    [download]

    since Perl isn't free to free the buffer. Furthermore, you replace the buffer you created with newSV without ever deallocating it, so you are leaking.

    Solution 1: 

    void strIter(SV* code, SV* string)  {
    dSP;
    STRLEN i;
    char* src = SvPV(string, i);
    SV* c;

    c = newSV_type(SVt_PV);
    SvCUR(c) = 1;
    SvLEN(c) = 0;
    SvPOK_only(c);

    SAVE_DEFSV;
    DEFSV_set(c);

    while (i--) {
        SvPVX(c) = src++;
        PUSHMARK(SP);
        call_sv(code, G_NOARGS | G_VOID | G_DISCARD);
    }
}

    [download]

    Solution 2: 

    void strIter(SV* code, SV* string)  {
    dSP;
    STRLEN i;
    char* src = SvPV(string, i);
    char* dst;
    SV* c;

    c = newSVpvn(" ", 1);
    dst = SvPVX(c);

    SAVE_DEFSV;
    DEFSV_set(c);

    while (i--) {
        *dst = *(src++);
        PUSHMARK(SP);
        call_sv(code, G_NOARGS | G_VOID | G_DISCARD);
    }
}

    [download]
[reply]
[d/l]
[select]
Re: Help me improve my XS.
by ikegami (Patriarch) on Nov 24, 2010 at 00:34 UTC

    The following works even with the commented out lines and doesn't appear to leak at all.

    There's no leak since you don't create mortals. I think it would also clear mortals returns by the called function, but maybe print returns nothing in void context?

    Why does it crash in a Benchmark?

    PUTBACK should come before the call, although it's not even required when there are no args.

    The documentation uses G_DISCARD instead of G_VOID.

    You change GvSV(PL_defgv).

    Do any of those matter? dunno.

    The code you posted doesn't crash for me using v5.12.2 built for i686-linux.

    How can it be improved?

    SAVE_DEFSV; appears to be the means to save $_, and DEFSV_set(sv); appears to be the means to set it.

    Does that work if there's a my $_ in scope of the callback? (Is that even possible?)

    I don't think it's safe to assume the SV still has a PV slot after the callback.

    You could accept strings in either formats instead of suffering from The Unicode Bug.

    Are there any documentation or examples of using LvTARG macros to do the aliasing?

    LvTARG is used by some types magic (e.g. lvalue substr) as they see fit. While you could use magic to effectively do aliasing, that wouldn't be as efficient as actually aliasing.

    It's pretty straightforward. Check out function pp_substr and the functions related to substr in mg.c

    Is there any documentation of the MULTICALL macros used by List::Util::reduce()?

    Multicall is documented in "LIGHTWEIGHT CALLBACKS" in perlcall.

    How can I apply a (&$) prototype to strIter()?

    Using the PROTOTYPE XS directive.

    Update: Mentioned SAVE_DEFSV and DEFSV_set.

[reply]
[d/l]
[select]

      I didn't explain properly about the lack of leak.

      There would be no leak even if you did use mortals. There's already a ENTER+SAVETMPS and FREETMPS+LEAVE around the call to the XS function.

      You'd use those or G_DISCARD if you want to free the mortals created by your callback sooner (e.g. after every call to call_sv instead of when strIter returns).

[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom