I have a way to call XS directly without compilation.
It uses Dynaloader to use dl_install_xsub() , and I load
perl58.dll to access XS functions where I install a callback
to the Perl interpreter using the Perl stack, call it, then back again. I also have a call to get the CPU vendor without using the C stack.
Since this is specific to Intel, the module might be better named AsmUtil::IA32; I will develop this further to see where it goes, unless somebody has better suggestions ???
The call to External libraries using the C stack isn't in this
example , but could be easily implemented(assembly block) and may be simpler than going through all the listed possible stack permutations that the P5NCI module does(Assembler loop would push any number of parameters with the right sizes on the stack ). Of course the disadvantages are that have to write this for different CPU's, and OS differences such as Win32 and Linux on a X86 machine may be a little different - the reason compilers were invented.
Here is the code 2 files(My output is after __END__):
#------------- CallXSdirect.pl -------------
use AsmUtil;
$asmblock = "\x90" . # nop or int3 for debugging
"\x55" . # push ebp
"\x89\xE5" . # mov ebp,esp
"\x53" . # push ebx
"\x52" . # push edx
"\x51" . # push ecx
"\xB8\x00\x00\x00\x00" . # mov eax,0x0
"\x0F\xA2" . # cpuid
"\x89\x1D\x00\x00\x00\x00" . # mov [$ebx],ebx ; save i
+n perl string $ebx
"\x89\x15\x00\x00\x00\x00" . # mov [$edx],edx ; save i
+n perl string $edx
"\x89\x0D\x00\x00\x00\x00" . # mov [$ecx],ecx ; save i
+n perl string $ecx
"\x59" . # pop ecx
"\x5a" . # pop edx
"\x5B" . # pop ebx
"\x89\xec" .# mov esp,ebp
"\x5D" . # pop ebp
"\xc3" ; # ret - back to perl
$ebx = "NUL1";
$edx = "NUL2";
$ecx = "NUL3";
# EDIT the 3 move instructions for the addresses of the last 3 perl s
+trings
substr $asmblock, 16, 4 , pack("P",$ebx); # store $ebx address on fi
+rst mov instruction
substr $asmblock, 22, 4 , pack("P",$edx); # store $edx address on se
+cond mov instruction
substr $asmblock, 28, 4 , pack("P",$ecx); # store $ecx address on th
+ird mov instruction
$asmsub = DeclareFarProc( "cpuid" , SVPtr($asmblock), "");
#$highnum = cpuid(); # call cpuid routine
&$asmsub; # invoke either way
print "cpu vendor: ",$ebx,$edx,$ecx,",\n";
$arg1="Assembly";
$arg2="CallBack";
$arg3="To";
$arg4="Perl";
$ptrptrargs = pack("PPPPI",$arg1,$arg2,$arg3,$arg4,0); # set up char *
+*ptrptrargs NULL terminated
$cbname = "asm2perl"; # callback name for sub below
$cb_asm2perl = "\x90" . # for debuggin
+g 0xcc debugbreak instruction or 0x90 nop
"\x68" . pack("I",$call_argv_ref) .# push [Perl_c
+all_argv()] PUSH POINTERS TO PERL XS FUNCTIONS
"\x68" . pack("I",$get_context_ref) .# push [Perl_g
+et_context()]
"\x68" . pack("I",$Tstack_sp_ptr_ref) .# push [Perl_T
+stack_sp_ptr()]
"\x55" .# push ebp
"\x89\xE5" .# mov ebp,esp
+ use ebp to access XS
# ----------------- dSP; MACRO starts -------------------
"\xff\x55\x08" .# call dword p
+tr [ebp+8] => call Perl_get_context()
"\x50" .# push eax
"\xff\x55\x04" .# call dword p
+tr [ebp+4] => call Perl_Tstack_sp_ptr()
"\x59" .# pop ecx
"\x8B\x00" .# mov eax,dwo
+rd ptr [eax]
"\x89\x45\xec" .# mov dword p
+tr [sp],eax => local copy of SP
# -------------- perl_call_argv("callbackname",G_DISCARD,char **args)
+-----
"\x68" . pack("P",$ptrptrargs) .# push char **args
"\x68\x02\x00\x00\x00" .# push G_DISCARD
"\x68" . pack("p",$cbname) .# push ptr to name
+ of perl subroutine
"\xff\x55\x08" .# call Perl_get_co
+ntext()
"\x50" .# push eax
"\xff\x55\x0c" .# call perl_call_a
+rgv: call dword ptr [ebp+0x0c]
"\x83\xc4\x10" .# add esp,10 CDEC
+L call we maintain stack
"\x89\xec" .# mov esp,ebp
"\x5D" .# pop ebp
"\x83\xc4\x0c" .# add esp,0c
"\xc3"; # ret - back to P
+erl interpeter
$asmsub = DeclareFarProc( "cbtest" , SVPtr($cb_asm2perl), "");
print "Perl calling an Assembly language routine(XSUB)\n";
cbtest();
sub asm2perl{
print join(" ",@_),"\n";
}
print "Back to Perl\n";
__END__
C:\Documents and Settings\bitshiftleft\Desktop>CallXSdirect.pl
cpu vendor: GenuineIntel,
Perl calling an Assembly language routine(XSUB)
Assembly CallBack To Perl
Back to Perl
### END OF FIRST FILE , START OF NEXT CUT HERE ######
# ---------- AsmUtil.pm --------------
package AsmUtil;
use DynaLoader;
use Exporter;
use strict;
our @ISA = qw(Exporter);
our @EXPORT = qw(DeclareFarProc SVPtr G_DISCARD G_SCALAR G_NOARGS $cal
+l_argv_ref $get_context_ref $Tstack_sp_ptr_ref);
our @EXPORT_NOT_OK = qw($perldll);
#-------- cop.h:
use constant G_SCALAR => 0;
use constant G_ARRAY => 1 ;
use constant G_VOID => 128 ;# skip this bit when adding flags bel
+ow */
use constant G_DISCARD => 2 ;# Call FREETMPS. */
use constant G_EVAL => 4 ;#* Assume eval {} around subroutine ca
+ll. */
use constant G_NOARGS => 8 ;# Don't construct a @_ array. */
use constant G_KEEPERR =>16 ;#* Append errors to $@, don't overwri
+te it */
use constant G_NODEBUG =>32 ;# Disable debugging at toplevel. */
use constant G_METHOD => 64 ;#* Calling method. */
use constant TRUE => 1;
use constant FALSE => 0;
#---------------
my $perldll = $^X;
my $VER = int($]) . int(1000*($]-int($])));
$perldll =~ s/\./$VER\./;
$perldll =~ s/\.exe/\.dll/;
our $perlXS = DynaLoader::dl_load_file("$perldll");
our $call_argv_ref = DynaLoader::dl_find_symbol($perlXS,"Perl_call_arg
+v"); # C:\Perl\lib\CORE\embed.h
our $get_context_ref = DynaLoader::dl_find_symbol($perlXS,"Perl_get_co
+ntext");
our $Tstack_sp_ptr_ref = DynaLoader::dl_find_symbol($perlXS,"Perl_Tsta
+ck_sp_ptr");
######################## Subs ###############
sub DeclareFarProc{
my $namespace = caller;
$namespace .= "::";
$namespace .= $_[0];
my $procptr = $_[1];
my $coderef = DynaLoader::dl_install_xsub($namespace, $procptr,__FILE
+__);
return $coderef;
}
sub SVPtr{
return unpack("I",pack("P",$_[0]));
}
1;
__END__