Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

comment on

( #3333=superdoc: 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

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

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others imbibing at the Monastery: (1)
    As of 2021-01-19 04:31 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      Notices?