________________________________
> Date: Sat, 21 Jul 2012 14:57:36 -0500
> Subject: RE: Creating an XSUB on the fly
> From: dcmertens.p...@gmail.com
> To: bul...@hotmail.com
> CC: perl-xs@perl.org
>
>
> 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.
