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
|
|
