RE: Creating an XSUB on the fly

________________________________
> Date: Sat, 21 Jul 2012 14:57:36 -0500 
> Subject: RE: Creating an XSUB on the fly 
> From: [email protected] 
> To: [email protected] 
> CC: [email protected] 
>  
>  
> In this case, Perl stack args. The easy solution would be to include  
> EXTERN.h, perl.h, etc (as with a normal XS file), but that leads to a  
> lot of work for the preprocessor. This work targets true jit compiling,  
> so the less work I throw at the preprocessor, the better. My plan here  
> is to comb over those header files and pull out the most useful bits  
> into fine-grained pieces so function writers only pull in what they  
> need. One of those pieces would be Perl stack manipulation. 

Its easier than you realize. Some code I mostly wrote. First is after preprocessor. 2nd is before.

_____________________________________________________
void
w32_GetProductInfo (register PerlInterpreter * my_perl, CV * cv)
{
    SV **sp = (my_perl->Istack_sp);
    I32 ax = (*(my_perl->Imarkstack_ptr)--);
    register SV **mark = (my_perl->Istack_base) + ax++;
    I32 items = (I32) (sp - mark);
    DWORD type;
    PFNGetProductInfo pfnGetProductInfo;
    DWORD major;
    DWORD minor;
    DWORD spmajor;
    DWORD spminor;

    if (items != 4)
        my_croak (my_perl, "usage: %s($major,$minor,$spmajor,$spminor)", "Win32::GetProductInfo");

    pfnGetProductInfo =
        (PFNGetProductInfo) GetProcAddress (k32module, "Win32::GetProductInfo" + sizeof ("Win32::") - 1);
    if (pfnGetProductInfo)
      {
          {
              SV *tmpsv = (*sp--);
              spminor =
                  (DWORD) (((tmpsv)->sv_flags & 0x00000100) ? ((XPVIV *) (tmpsv)->sv_any)->xiv_u.
                           xivu_iv : Perl_sv_2iv_flags (my_perl, tmpsv, 2));
          }
          {
              SV *tmpsv = (*sp--);
              spmajor =
                  (DWORD) (((tmpsv)->sv_flags & 0x00000100) ? ((XPVIV *) (tmpsv)->sv_any)->xiv_u.
                           xivu_iv : Perl_sv_2iv_flags (my_perl, tmpsv, 2));
          }
          {
              SV *tmpsv = (*sp--);
              minor =
                  (DWORD) (((tmpsv)->sv_flags & 0x00000100) ? ((XPVIV *) (tmpsv)->sv_any)->xiv_u.
                           xivu_iv : Perl_sv_2iv_flags (my_perl, tmpsv, 2));
          }
          {
              SV *tmpsv = (*sp--);
              major =
                  (DWORD) (((tmpsv)->sv_flags & 0x00000100) ? ((XPVIV *) (tmpsv)->sv_any)->xiv_u.
                           xivu_iv : Perl_sv_2iv_flags (my_perl, tmpsv, 2));
          }
          if (pfnGetProductInfo (major, minor, spmajor, spminor, &type))
              goto haverettype;
      }
    else
      {
          (*sp--);
          (*sp--);
          (*sp--);
          (*sp--);
      }

    type = 0;
  haverettype:
    (*++sp = (Perl_sv_2mortal (my_perl, Perl_newSViv (my_perl, type))));
    (my_perl->Istack_sp) = sp;
}
______________________________________________________
XS(w32_GetProductInfo)
{
    dXSARGS;
    DWORD type;
    PFNGetProductInfo pfnGetProductInfo;
    DWORD major;
    DWORD minor;
    DWORD spmajor;
    DWORD spminor;

    if (items != 4)
    Perl_croak(aTHX_ "usage: %s($major,$minor,$spmajor,$spminor)", "Win32::GetProductInfo");
    
    pfnGetProductInfo = (PFNGetProductInfo)GetProcAddress(k32module, "Win32::GetProductInfo"+sizeof("Win32::")-1);
    if (pfnGetProductInfo){
        {   SV * tmpsv = POPs;
            spminor = (DWORD)SvIV(tmpsv);
        }
        {   SV * tmpsv = POPs;
            spmajor = (DWORD)SvIV(tmpsv);
        }
        {   SV * tmpsv = POPs;
            minor = (DWORD)SvIV(tmpsv);
        }
        {   SV * tmpsv = POPs;
            major = (DWORD)SvIV(tmpsv);
        }
        if(pfnGetProductInfo(major, minor, spmajor, spminor, &type))
            goto haverettype;
    }
    else{POPs;POPs;POPs;POPs;}//careful here, we didn't pull all SVs off the stack,
    //since above POPs are in branch,x
    /* PRODUCT_UNDEFINED */
    type = 0;
    haverettype:
    PUSHs(sv_2mortal(newSViv(type)));
    PUTBACK;
}
_______________________________________________________________
The perl stack goes upward, going down/smaller numerically is left side parameters in Perl language, going up/bigger numerically is right side parameters in Perl language, this is opposite of x86 C stack. The typical way of accessing perl params that is taught in POD in XS is with the ST(0/1/2/..) macro. Instead, you can get the interp's PL stack pointer, make it a local pl stack pointer ("SP" macro), then POPs it. POPs is not a function call. Of course you need to know how many items you have or you will go backwards into your caller's Perl Stack (very bad, most of the SVs are freeded or undef SVs). Of course the 2 major differences macro wise are ithreads (my_perl pointers) or no ithreads (DLL global interp struct in perl5**.dll). At the end, the elements that are returned to caller are between mark and global pl stack pointer, just as incoming elements are between mark and global pl stack pointer. The putback is very important. Typical XS code uses XS_RETURN(1/2/3/...) which sets interp global SP to a fixed offset from mark. Instead with putback the local SP is used to update the global interp SP. IMHO, using POPs and PUSHs and a putback lead to the smallest possible machine code, since no depointerings of my_perl are performed. Meanwhile with ST(0) between function calls, in asm, b/c of aliasing rules, C compiler must reread the my_perl struct each time. Not getting the balancing between POPs and PUSHs right will lead to disaster (crash/"bizarre copy of"/perl panics). XPREPUSH macro rewinds local SP to the beginning, so 0 elements are returned if a putback is done immediately after xprepush. xprepush "wipes" off all the incoming pl stack parameters. You must POPs all items before you PUSHs since the PUSHses will overwrite what you want to read with POPs (not entirly true, if your using SP directly or you make a copy of SP with ++s/--s/+1/2/3s you can process item by item generating a return list equal in length, to incoming SVs, but not updating in place in SVs, something like "scalar(myXS(@arr)) == scalar(@arr)"). PPCODE: in XS does with XPREPUSH for you silently. CODE: leaves SP at the end of your in params. But to use POPs with CODE:, you need to bypass the CODE: boilerplate code at the end (a XS_RETURN(0) specifically), with a "PUTBACK; return;".

Other ideas that I've not done personally is rewinding SP to 0, then going up (left to right). No such macro exists in Perl, or doing *(SP+3) instead of using ST(3) (I've something like that in the past). SP is a auto with type of SV **. Some compilers will register it depending on the C function.

EXTEND only needs to be done if you are returning more SVs on the PL stack than you got in on the PL stack.

Note the line "    I32 ax = (*(my_perl->Imarkstack_ptr)--);" is destructive. XS C functions can not call XS C functions in C, you must use PUSHMARK, call_pv and etc.

Hopefully this is all the info you need to complete your project.

If some other readers see mistakes above, correct them.