Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

Pure Perl module(246 lines, Linux/Win32) that calls external libraries - no XS file.

by bitshiftleft (Sexton)
on Jan 24, 2009 at 05:42 UTC ( #738658=CUFP: print w/ replies, xml ) Need Help??

Here is my update of Pure Perl module(245 lines) that calls external libraries - no XS file., that now does both Win32/Linux.
The test script below is for Linux , use the last posting for the Win32 version, but you use the updated AsmUtil_IA32.pm here.
I only had to add one line of Perl code to AsmUtil_IA32.pm
The assembly code was platform independent - no changes !!!!!!
How about that for portability - and at the machine language level yet !!!!!!
It was the perl callback code I had to check for ActiveState's "Perl_Istack_sp_ptr" and Debian Linux "Perl_Tstack_sp_ptr".
Just as in the previous posting cited:
1) does Win32 API __stdcall calling convention.
2) does UNIX/Win32 __cdecl calling convention.
2__a) I included Pi = Gamma(.5) ** 2 Special function test in the linux version.
3) Does callbacks - qsort test, self callback test.
4) Passes or returns doubles/quads for unsupported 32 bit Perls.
5) Gives the user finer control on argument packing order less than 4 bytes - shorts and chars -
a likely source of compiler bugs and poor or wrong vendor documentation.
6) saves arguments passed after the call !!!! - some calls return values back to the stack
overwritng the original arguments(ie: FORTRAN's INTENTION IN,OUT).

TODO: AsmUtil_x86-64.pm - I have an AMD64 machine with 64 bit Debian Linux, 64 bit Perl.

In the module, Perl constructs the machine language string for your call, during the Declare phase ,
then edits your machine language with your parameters during the call.
Because of its low level, this is an experimental module, but its for the user who wants to get down to the nuts and bolts of
what he/she is doing, usually skipping the compile stage.
I developed this latest with Debian Linux , and I would like this tested with other
Linux distributions: Slakware, Knoppix, Fedora, ...., then I would post on CPAN.
The worst that can happen is a core dump. Your output should look like mine after __END__ below.
The code below is three files: "linuxtests.pl", "AsmUtil_IA32.pm" and ".gdbint" addition if you want to explore yourself
#!/usr/bin/perl # linuxtests.pl use AsmUtil_IA32; use Config; use sigtrap; # --- get myperl shared objects and get C and math libs ---- @perl_so = `ldd $^X`; @system_so = `/sbin/ldconfig -N -X -p`; # not used here, but interesti +ng to hack at $Clib = (grep {/^\// and /libc\.so/i} split(/ /,(grep( m/libc\.so/i, @ +perl_so))[0]))[0]; # usually links to $Config{libc} $mathlib = (grep {/^\// and /libm\.so/i} split(/ /,(grep( m/libm\.so/i +, @perl_so))[0]))[0]; $a = "Just Another C&ASM Hacker\n"; $b = "Perl "; # ---- CopyMemory - the 30 lb. sledge hammer version to perl's substr +() or unpack("p??",...) # ---- remember peek & poke ? its back as CopyMemory: $CopyMemory = DeclareXSub( "_CopyMemory" , "$Config{libc}!memcpy", "i, +i,i","","c"); $qsort = DeclareXSub( "_qsort" , "$Config{libc}!qsort", "i,i,i,i",""," +c"); if(!defined($qsort)){$qsort = DeclareXSub( "_qsort" , "$mathlib" . "!q +sort", "i,i,i,i","","c");} $Gamma = DeclareXSub( "_gamma" , "$Config{libm}!tgamma", "d","d","c"); $ClibAtan = DeclareXSub( "_atan" , "$mathlib" . "!atan", "d","d","c"); $atoi64 = DeclareXSub( "_atoi64" , "$Config{libc}!atoll", "i","q","c") +; # strtoll $i64toa = DeclareXSub( "_i64toa" , "$Config{libc}!sprintf", "i,i,q","i +","c"); print "Before CopyMemory: ",$a; $CopyMemory->{Call}(SVPtr($a)+13,SVPtr($b),5); print "After CopyMemory: ",$a; # 0n18446744073709551615 = 0xfffffffff +fffffff , 0n4294967295 = 0xffffffff my $Quad = "\x08\x07\x06\x05\x04\x03\x02\x01" ; # little endian for \x +01\x02\x03\x04\x05\x06\x07\x08 $qstr = "\x00" x 80; $i64toa->{Call}(SVPtr($qstr),SVPtr("%lld"),$Quad); print "i64toa decimal: 0n72623859790382856 == ",$qstr ,"\n"; print ">>> $Config{archname} C Run Time $Clib tests <<<\n"; $qstr = "72623859790382856"; # 0n72623859790382856 == 0x01020304050607 +08 $atoi64->{Call}(SVPtr($qstr)); printf "atoi64 call: Quad(longlong) return test (EDX:EAX)=> %08X%08X\n +", unpack("L",$atoi64->{RetEDX}),unpack("L",$atoi64->{RetEAX}); printf("Perl emulated \(un\)pack\(Q,...\) test: %s\n",SVQuad(CQuad("72 +623859790382856"))); print ">>> $Config{archname} Math Run Time $mathlib tests <<<\n"; $ClibAtan->{Call}(1.00000); printf("FPU doubles test: 4*atan(1) = Pi = %18.16f\n",4*unpack("d",$Cl +ibAtan->{Ret64bit})); $Gamma->{Call}(0.5); printf("Special functions test Gamma(0.5)**2 = Pi = %18.16f\n",unpack( +"d",$Gamma->{Ret64bit})**2); print "---C library qsort calls back to Perl test:\n"; $qcompare = DeclareCallback(__PACKAGE__."::qcompare","p2,p2","","c"); +#p2==(short *) $iArray = pack("s13",399,99,3,1,234,546,789,34,124,894,521,67,754); print "Before sort:" ,join(",",unpack("s13",$iArray)),"\n"; $qsort->{Call}(SVPtr($iArray),13, 2, $qcompare->{Ptr}); print "After sort:" ,join(",",unpack("s13",$iArray)),"\n"; sub qcompare(){ # ----- reconstruct @_ without XS ----- my $Cstack = substr(unpack("P16",$qcompare->{stackPtr}),8); # copy s +tack in binary form #@_ = getparameters($qcompare->{stackPtr},$qcompare->{args}); $_[0] = substr($Cstack,0,4); # $_[0] == void* $_[1] = substr($Cstack,4,4); $e1=unpack("s",unpack("P2",$_[0])); # $e1 = (Perl scalar) *(short *) +$_[0] $e2=unpack("s",unpack("P2",$_[1])); # $e1=unpack("s",$_[0]); # $e2=unpack("s",$_[1]); print $e1," ",$e2,"\n"; # substr($qcompare->{CallerRtn1},0,4,pack("i",$e1-$e2)); # return resu +lt back to C qsort routine cbreturn({cbref => $qcompare ,ret32 => $e1-$e2,}); # return result ba +ck to C qsort routine } $arg1="Assembly"; $arg2="Callback", $arg3="To"; $arg4="Perl"; $ptrptrargs = pack("PPPPI",$arg1,$arg2,$arg3,$arg4,0); $cbname = __PACKAGE__ . "::". "asm2perl"; $cb_asm2perl = "\x90" . "\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|I)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 print ">>> internal XSUB\'s(ASM routine) call/callback test <<<\n"; print "---Perl calls assembly calls back to Perl test:\n"; $cbtest = DeclareXSub( __PACKAGE__."::cbtest" , SVPtr($cb_asm2perl), " +"); $cbtest->{Call}(); sub asm2perl{ my $lastcaller = (caller(1))[3]; print "called from ",$lastcaller . "(\@_ = ",join(" ",@_),")\n"; } print "Back to Perl\n"; __END__ Before CopyMemory: Just Another C&ASM Hacker After CopyMemory: Just Another Perl Hacker i64toa decimal: 0n72623859790382856 == 72623859790382856 >>> i486-linux-gnu-thread-multi C Run Time /lib/i686/cmov/libc.so.6 t +ests <<< atoi64 call: Quad(longlong) return test (EDX:EAX)=> 0102030405060708 Perl emulated (un)pack(Q,...) test: 0x0102030405060708 >>> i486-linux-gnu-thread-multi Math Run Time /lib/i686/cmov/libm.so.6 + tests <<< FPU doubles test: 4*atan(1) = Pi = 3.1415926535897931 Special functions test Gamma(0.5)**2 = Pi = 3.1415926535897936 ---C library qsort calls back to Perl test: Before sort:399,99,3,1,234,546,789,34,124,894,521,67,754 After sort:1,3,34,67,99,124,234,399,521,546,754,789,894 >>> internal XSUB's(ASM routine) call/callback test <<< ---Perl calls assembly calls back to Perl test: called from AsmUtil_IA32::__ANON__(@_ = Assembly Callback To Perl) Back to Perl
package AsmUtil_IA32; use DynaLoader; use Exporter; use File::Basename; use Config; use strict; our @ISA = qw(Exporter); our @EXPORT = qw(DeclareXSub DeclareCallback SVPtr CInt CQuad cbreturn SVQuad getparameters $call_argv_ref $get_context_ref + $Tstack_sp_ptr_ref); our @EXPORT_OK = qw(G_DISCARD G_SCALAR G_NOARGS); our @EXPORT_NOT_OK = qw(); our $VERSION = "0.01"; my $perldll; #-------- cop.h: use constant G_SCALAR => 0; use constant G_DISCARD => 2; use constant TRUE => 1; use constant FALSE => 0; #--------------- get perl shared object and some API routines--- push @DynaLoader::dl_library_path, dirname($^X) ; # ActiveState's Win +32 perl dll location ($perldll = $Config{libperl}) =~ s/\.lib/\.$Config{so}/i; $perldll = DynaLoader::dl_findfile($perldll); our $perlAPI = DynaLoader::dl_load_file($perldll); our $call_argv_ref = DynaLoader::dl_find_symbol($perlAPI,"Perl_call_ar +gv"); # embed.h our $get_context_ref = DynaLoader::dl_find_symbol($perlAPI,"Perl_get_c +ontext"); our $Tstack_sp_ptr_ref = DynaLoader::dl_find_symbol($perlAPI,"Perl_Ist +ack_sp_ptr"); # perlapi.h if (!$Tstack_sp_ptr_ref){$Tstack_sp_ptr_ref = DynaLoader::dl_find_symb +ol($perlAPI,"Perl_Tstack_sp_ptr");} ######################## Subs ############### sub DeclareXSub{ my %FARPROC; $FARPROC{namespace} = $_[0]; $FARPROC{lib} = DynaLoader::dl_load_file((split("!",$_[1]))[0]) if $_ +[1] =~ m/\!/; $FARPROC{procptr} = defined($FARPROC{lib}) ? DynaLoader::dl_find_symb +ol($FARPROC{lib},(split("!",$_[1]))[1]) : $_[1]; return if !defined($FARPROC{procptr}); $FARPROC{args} = $_[2]; $FARPROC{rtn} = $_[3]; if ($^O =~ /win32/i){ $FARPROC{conv} = defined($_[4]) ? $_[4] : "s" ; # default calling +convention: Win32 __stdcall }else{ $FARPROC{conv} = defined($_[4]) ? $_[4] : "c" ; # default calling +convention: UNIX __cdecl } my $stackIN; my @stridx; my @bytype; my $bytspushed; my $asmcode = "\x90"; # machine code starts , this can also be \xcc - +user breakpoint my @Args = split(",",$FARPROC{args}); @Args = reverse @Args; # pushing order last args first foreach my $arg (@Args){ $stackIN .= "\x68" . pack("I",0) ; # 4 byte push $stackIN .= "\x68" . pack("I",0) if($arg =~ m/d|q/i) ; # another +4 byte push for doubles,quads push(@stridx,length($stackIN)-4+1) if $arg !~ m/d|q/i; push(@stridx,length($stackIN)-9+1) if $arg =~ m/d|q/i; push(@bytype,"byval") if $arg =~ m/v|l|i|c|d|q/i; push(@bytype,"byref") if $arg =~ m/p|r/i; # 32 bit pointers $bytspushed += 4 ; # 4 byte aligned $bytspushed += 4 if($arg =~ m/d|q/i); # another 4 for doubles or qua +ds } $FARPROC{sindex} = \@stridx; $FARPROC{types} = \@bytype; $FARPROC{stklen} = $bytspushed; $FARPROC{edi} = "null"; # 4 bytes long !!! ,how convenient $FARPROC{esi} = "null"; $FARPROC{RetEAX} = "null"; # usual return register $FARPROC{RetEDX} = "null"; $FARPROC{Ret64bit} = "nullnull"; # save double or quad returns $FARPROC{stackOUT} ="\x00" x $bytspushed; $asmcode .= "$stackIN"; $asmcode .= "\xb8" . CInt($FARPROC{procptr}); # mov eax, $procptr $asmcode .= "\xFF\xd0" ; # call eax => CALL THE PROCEDURE # --- save return values info into Perl Strings, including the stack: # - some calls return values back to the stack, overwriting the origin +al args $asmcode .= "\xdd\x1d" . CPtr($FARPROC{Ret64bit}) if $FARPROC{rtn} = +~ m/d/i; # fstp qword [$FARPROC{Ret64bit}] $asmcode .= "\xa3" . CPtr($FARPROC{RetEAX}); # mov [$FARPROC{RetE +AX}], eax $asmcode .= "\x89\x15" . CPtr($FARPROC{RetEDX}); # mov [$FARPROC{RetE +DX}], edx $asmcode .= "\x89\x35" . CPtr($FARPROC{esi}); # mov [$FARPROC{esi} +], esi $asmcode .= "\x89\x3d" . CPtr($FARPROC{edi}); # mov [$FARPROC{edi} +], edi $asmcode .= "\x8d\xb4\x24" if $FARPROC{conv} =~ m/s/i; # $asmcode .= CInt(-$bytspushed) if $FARPROC{conv} =~ m/s/i;# lea e +si,[esp-$bytspushed] $asmcode .= "\x89\xe6" if $FARPROC{conv} =~ m/c/i; # mov esi,esp $asmcode .= "\xbf" .CPtr($FARPROC{stackOUT}); # mov edi, [$FARPROC +{stackOUT}] $asmcode .= "\xb9" . CInt($bytspushed); # mov ecx,$bytspushe +d $asmcode .= "\xfc"; # cld $asmcode .= "\xf3\xa4"; # rep movsb [edi],[e +si] => copy the stack $asmcode .= "\x8b\x3d" . CPtr($FARPROC{edi}); # mov edi,[$FARPROC{ +edi}] $asmcode .= "\x8b\x35" . CPtr($FARPROC{esi}); # mov esi,[$FARPROC{ +esi}] $asmcode .= "\x81\xc4" . CInt($bytspushed) if $FARPROC{conv} =~ m/c/ +i; # add esp,$bytspushed : __cdecl $asmcode .= "\xc3" ;# ret __stdcall or __cdecl $FARPROC{ASM} = $asmcode; $FARPROC{coderef} = DynaLoader::dl_install_xsub($FARPROC{namespace}, +SVPtr($FARPROC{ASM}),__FILE__); $FARPROC{Call} = sub{ my @templates = reverse split(",",$FARPROC{args}); my @args = reverse @_; # parameters get pushed last firs +t; # --- edit the machine language pushes with @args --- for(my $index = 0; $index < scalar(@{$FARPROC{sindex}}) ; +++$index ) { my @a=split(":",$args[$index]) if $args[$index] =~ m/\:/; if($templates[$index] eq "ss"){ $args[$index] = $a[0]<<16 + + $a[1];} if($templates[$index] eq "cccc"){$args[$index] = $a[0]<<2 +4 + $a[1]<<16 + $a[2]<<8 + $a[3]; } if($templates[$index] eq "ccc"){$args[$index] = $a[0]<<16 + + $a[1]<<8 + $a[2]; } if($templates[$index] eq "cc"){$args[$index] = $a[0]<<8 + + $a[1]; } if($templates[$index] eq "scc"){$args[$index] = $a[0]<<16 + + $a[1]<<8 + $a[2] ; } if($templates[$index] eq "ccs"){$args[$index] = $a[0]<<24 + + $a[1]<<16 + $a[2] ; } if($templates[$index] eq "sc"){$args[$index] = $a[0]<<16 ++ $a[1] ; } if($templates[$index] eq "cs"){$args[$index] = $a[0]<<16 ++ $a[1]; } if($templates[$index] =~ m/d|q/i){ $args[$index] = pack("d",$args[$index]) if $templates[$i +ndex] =~ m/d/i; my $Quad = $args[$index] if $templates[$index] =~ m/q/i; + substr($FARPROC{ASM}, $FARPROC{sindex}->[$index]+5, 4 , + substr($args[$index],0,4)) if $templates[$index] =~ m/d/i; substr($FARPROC{ASM}, $FARPROC{sindex}->[$index], 4 , s +ubstr($args[$index],4,4)) if $templates[$index] =~ m/d/i; substr($FARPROC{ASM}, $FARPROC{sindex}->[$index]+5, 4 , + substr($Quad,0,4)) if $templates[$index] =~ m/q/i; substr($FARPROC{ASM}, $FARPROC{sindex}->[$index], 4 , s +ubstr($Quad,4,4)) if $templates[$index] =~ m/q/i; }else{ substr($FARPROC{ASM}, $FARPROC{sindex}->[$index], 4 , C +Int($args[$index])) if $FARPROC{types}->[$index] eq "byval"; } substr($FARPROC{ASM}, $FARPROC{sindex}->[$index], 4 , CP +tr($args[$index])) if $FARPROC{types}->[$index] eq "byref"; } my $ret = &{$FARPROC{coderef}}; # Invoke it return $ret; # usually EAX==return value - not as reliab +e as $FARPROC{RetEAX} }; return \%FARPROC; # make an object out of a hash( has 1 XSUB, 1 sub, + 2 arrays, several scalars) } sub DeclareCallback{ my %CALLBACK; $CALLBACK{cbname} = $_[0]; $CALLBACK{args} = $_[1]; $CALLBACK{cbrtn} = defined($_[2]) ? $_[2] : "I"; $CALLBACK{conv} = defined($_[3]) ? $_[3] : "c" ; $CALLBACK{ptrptrargs} = "\x00" x 4 ; # char **args, NULL FOR NOW $CALLBACK{stackPtr} = "\x00" x 4; # ebp $CALLBACK{CallerRtn1} = "\x00" x 8; # eax register usually, possibly + for a double $CALLBACK{CallerRtn2} = "\x00" x 4; # edx register usually , for ret +urning 8 byte values edx:eax - doubles $CALLBACK{ASM} = "\x90" .# nop or debug brea +k "\x55" .# push ebp "\x89\xE5" .# mov ebp,esp # -------- local variables - Perl function pointers, stack info "\x68" . CInt($call_argv_ref) .# push *Perl_call_a +rgv() "\x68" . CInt($get_context_ref) .# push *Perl_get_co +ntext() "\x68" . CInt($Tstack_sp_ptr_ref) .# push *Perl_(I|T)s +tack_sp_ptr() "\x68\x00\x00\x00\x00" .# empty local varia +ble "\x68\x00\x00\x00\x00" .# empty local varia +ble # ------- get ebp to access C stack on the Perl side and save return +registers---------------- "\x89\x2d" . CPtr($CALLBACK{stackPtr}) .# mov ds:[$CALLBA +CK{stackPtr}],ebp - stack access "\xA3" . CPtr($CALLBACK{CallerRtn1}) .# mov ds:[$CALLBA +CK{CallerRtn1}],eax - save eax primary return register "\x89\x15" . CPtr($CALLBACK{CallerRtn2}) .# mov ds:[$CALLBA +CK{CallerRtn2}],edx - save edx secondary return register # ----------------- dSP; MACRO starts ------------------- "\xff\x55\xf8" .# call dword ptr [e +bp-0x08] => call Perl_get_context() "\x50" .# push eax "\xff\x55\xf4" .# call dword ptr [e +bp-0x0c] => call Perl_Tstack_sp_ptr() "\x59" .# pop ecx "\x8B\x00" .# mov eax,dword pt +r [eax] "\x89\x45\xec" .# mov dword ptr [s +p],eax => local copy of SP # -------------- perl_call_argv(char *callbackname,G_DISCARD,char **ar +gs) ----- "\x68" . CPtr($CALLBACK{ptrptrargs}) .# push char **args "\x68\x02\x00\x00\x00" .# push G_DISCARD "\x68" . CPtr($CALLBACK{cbname}) .# push ptr to name of p +erl subroutine "\xff\x55\xf8" .# call Perl_get_context +() "\x50" .# push eax "\xff\x55\xfc" .# call perl_call_argv = +> call dword ptr [ebp-0x04] "\x83\xc4\x10" .# add esp,0x10 CDECL c +all we maintain stack "\x83\xc4\x0c" .# add esp,14 # dealloca +te local variables "\x89\xec" .# mov esp,ebp "\x5D" .# pop ebp "\xA1" . CPtr($CALLBACK{CallerRtn1}) .# mov eax,[$CALLB +ACK{CallerRtn1}] - return eax to caller "\x8b\x15" . CPtr($CALLBACK{CallerRtn2}) .# mov edx,[$CALLB +ACK{CallerRtn2}] - return edx to caller "\xc3"; # ret $CALLBACK{Ptr} = SVPtr($CALLBACK{ASM}); return \%CALLBACK; } sub getparameters{ my $argtmpl; if(!defined($_[1])) {return [];}; my @args = split(",",$_[1]); foreach my $arg (@args){ $argtmpl .= $arg;} my $template = "P" . (4*scalar(@args)+8); my $Cstack = substr(unpack($template,$_[0]),8); # copy stack in bin +ary form return unpack($argtmpl,$Cstack); } sub cbreturn{ my %rets = %{$_[0]}; substr($rets{cbref}->{CallerRtn1},0,4,pack("i",$rets{ret32})) if def +ined($rets{ret32}); substr($rets{cbref}->{CallerRtn1},0,4,pack("x4i",$rets{ret32})) if d +efined($rets{ret64}); # little endian substr($rets{cbref}->{CallerRtn2},0,4,pack("ix4",$rets{ret32})) if d +efined($rets{ret64}); } sub SVPtr{ return unpack("I",pack("p",$_[0])); } sub CPtr{ return pack("p",$_[0]); } sub CInt{ return pack("i",$_[0]); } sub CShort{ return pack("s",$_[0]); } sub CByte{ return pack("c",$_[0]); } sub CDbl{ return pack("d",$_[0]); } sub CQuad{ # emulates pack("Q",...) - assumes decimal string input # --- convert an arbitrary length decimal string to a hex string --- my @digits = split(//, $_[0]); my $lohexstr = substr(sprintf("%08X",substr($_[0],-8)),-2); # gets t +he first 8 bits my $totquotient = ""; # bit shift to the right 8 bits by dividing by 256, # using arbitrary precision grade school long division for (my $j = 0;$j <4 ; ++$j){ # shift 8 bits, 4 times for lower long my $remainder = ""; $totquotient = ""; my $quotient = ""; my $dividend = ""; my $remainder = ""; for(my $i=0;$i<=$#digits;++$i){ $dividend = $remainder . $digits[$i]; $quotient = int($dividend/256); $remainder = $dividend % 256; $totquotient .= sprintf("%01d",$quotient); } $totquotient =~ s/^0*//; last if $j==3; $lohexstr = substr(sprintf("%08X",substr($totquotient,-8)),6,2) . $lo +hexstr; # unshift 8 more bits @digits = split(//,$totquotient); } my $hihexstr = sprintf("%08X",$totquotient); my $lo = pack("H*", $lohexstr); my $hi = pack("H*", $hihexstr); ( $hi, $lo ) = ( $lo, $hi ) ; # little endian return $hi . $lo; } sub SVQuad{ # emulates unpack("Q",...) - assumes binary input my ($hi, $lo) = unpack("NN",$_[0]) ; ( $hi, $lo ) = ( $lo, $hi ) ; # little endian return sprintf("0x%08X%08X",$hi,$lo); # - Are 64 bit decimal expressi +ons meaningful ? } 1;
# add this to your .gdbinit file define vdis if $argc != 2 help vdis else set $_icount = $arg1 set $_iptr = $arg0 while ( $_icount > 0 ) x/2i $_iptr echo \033[1A echo \033[K set $_nbytes = ($_ - $_iptr) set $_bcount = 0 while ( $_bcount < $_nbytes ) printf "%02X ", *(unsigned char*)($_iptr + $_bcount) set $_bcount++ end printf "\n" set $_iptr = $_iptr + $_nbytes set $_icount-- end end end document vdis Verbose Display of Disassembly mnemonics with machine code bytes Usage: vdis address number Example: (gdb) vdis $pc 3 0x400c30 <main>: push %rbx 53 0x400c31 <main+1>: sub $0x20,%rsp 48 83 EC 20 0x400c35 <main+5>: mov 0x200604(%rip),%rax # 0x601240 48 8B 05 04 06 20 00 end # Init parameters #set output-radix 0x10 #set input-radix 0x10 #set disassembly-flavor intel set disassembly-flavor att

Comment on Pure Perl module(246 lines, Linux/Win32) that calls external libraries - no XS file.
Select or Download Code
Re: Pure Perl module(246 lines, Linux/Win32) that calls external libraries - no XS file.
by dk (Chaplain) on Mar 01, 2009 at 08:35 UTC
    Check out P5NCI, it seems not to be limited to IA32 arch.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://738658]
Front-paged by grinder
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (6)
As of 2014-12-28 03:18 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (178 votes), past polls