maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity
llvm-project/lldb/scripts/disasm-gdb-remote.pl

2035 lines
62 KiB
Perl
Raw Normal View History

Added a perl script to disassemble, into human readable form, the GDB remote packet output from "log enable gdb-remote packets". This should help people track down and see what is going wrong more easily when you have log output that includes GDB remote packets. llvm-svn: 131713
2011-05-20 10:00:47 +08:00
#!/usr/bin/perl
use strict;
#----------------------------------------------------------------------
# Globals
#----------------------------------------------------------------------
Update the handle many of the packets that our current LLDB debugserver handles. Also fixed a case where the packet wouldn't be dumped if it returned the unimplemented packet. llvm-svn: 132498
2011-06-03 06:21:38 +08:00
our $unimplemented_str = "UNIMPLEMENTED";
Added a perl script to disassemble, into human readable form, the GDB remote packet output from "log enable gdb-remote packets". This should help people track down and see what is going wrong more easily when you have log output that includes GDB remote packets. llvm-svn: 131713
2011-05-20 10:00:47 +08:00
our $success_str = "OK";
our $swap = 1;
our $addr_size = 4;
our $thread_suffix_supported = 0;
our $max_bytes_per_line = 32;
our $addr_format = sprintf("0x%%%u.%ux", $addr_size*2, $addr_size*2);
our $pid_format = "%04.4x";
our $tid_format = "%04.4x";
our $reg8_href = { extract => \&get8, format => "0x%2.2x" };
our $reg16_href = { extract => \&get16, format => "0x%4.4x" };
our $reg32_href = { extract => \&get32, format => "0x%8.8x" };
our $reg64_href = { extract => \&get64, format => "0x%s" };
our $reg80_href = { extract => \&get80, format => "0x%s" };
our $reg128_href = { extract => \&get128, format => "0x%s" };
our $float32_href = { extract => \&get32, format => "0x%8.8x" };
our $float64_href = { extract => \&get64, format => "0x%s" };
our $float96_href = { extract => \&get96, format => "0x%s" };
our $curr_cmd = undef;
our $reg_cmd_reg;
our %reg_map = (
'i386-gdb' => [
{ name => 'eax', info => $reg32_href },
{ name => 'ecx', info => $reg32_href },
{ name => 'edx', info => $reg32_href },
{ name => 'ebx', info => $reg32_href },
{ name => 'esp', info => $reg32_href },
{ name => 'ebp', info => $reg32_href },
{ name => 'esi', info => $reg32_href },
{ name => 'edi', info => $reg32_href },
{ name => 'eip', info => $reg32_href },
{ name => 'eflags', info => $reg32_href },
{ name => 'cs', info => $reg32_href },
{ name => 'ss', info => $reg32_href },
{ name => 'ds', info => $reg32_href },
{ name => 'es', info => $reg32_href },
{ name => 'fs', info => $reg32_href },
{ name => 'gs', info => $reg32_href },
{ name => 'st0', info => $reg80_href },
{ name => 'st1', info => $reg80_href },
{ name => 'st2', info => $reg80_href },
{ name => 'st3', info => $reg80_href },
{ name => 'st4', info => $reg80_href },
{ name => 'st5', info => $reg80_href },
{ name => 'st6', info => $reg80_href },
{ name => 'st7', info => $reg80_href },
{ name => 'fctrl', info => $reg32_href },
{ name => 'fstat', info => $reg32_href },
{ name => 'ftag', info => $reg32_href },
{ name => 'fiseg', info => $reg32_href },
{ name => 'fioff', info => $reg32_href },
{ name => 'foseg', info => $reg32_href },
{ name => 'fooff', info => $reg32_href },
{ name => 'fop', info => $reg32_href },
{ name => 'xmm0', info => $reg128_href },
{ name => 'xmm1', info => $reg128_href },
{ name => 'xmm2', info => $reg128_href },
{ name => 'xmm3', info => $reg128_href },
{ name => 'xmm4', info => $reg128_href },
{ name => 'xmm5', info => $reg128_href },
{ name => 'xmm6', info => $reg128_href },
{ name => 'xmm7', info => $reg128_href },
{ name => 'mxcsr', info => $reg32_href },
{ name => 'mm0', info => $reg64_href },
{ name => 'mm1', info => $reg64_href },
{ name => 'mm2', info => $reg64_href },
{ name => 'mm3', info => $reg64_href },
{ name => 'mm4', info => $reg64_href },
{ name => 'mm5', info => $reg64_href },
{ name => 'mm6', info => $reg64_href },
{ name => 'mm7', info => $reg64_href },
],
'i386-lldb' => [
{ name => 'eax', info => $reg32_href },
{ name => 'ebx', info => $reg32_href },
{ name => 'ecx', info => $reg32_href },
{ name => 'edx', info => $reg32_href },
{ name => 'edi', info => $reg32_href },
{ name => 'esi', info => $reg32_href },
{ name => 'ebp', info => $reg32_href },
{ name => 'esp', info => $reg32_href },
{ name => 'ss', info => $reg32_href },
{ name => 'eflags', info => $reg32_href },
{ name => 'eip', info => $reg32_href },
{ name => 'cs', info => $reg32_href },
{ name => 'ds', info => $reg32_href },
{ name => 'es', info => $reg32_href },
{ name => 'fs', info => $reg32_href },
{ name => 'gs', info => $reg32_href },
{ name => 'fctrl', info => $reg16_href },
{ name => 'fstat', info => $reg16_href },
{ name => 'ftag', info => $reg8_href },
{ name => 'fop', info => $reg16_href },
{ name => 'fioff', info => $reg32_href },
{ name => 'fiseg', info => $reg16_href },
{ name => 'fooff', info => $reg32_href },
{ name => 'foseg', info => $reg16_href },
{ name => 'mxcsr', info => $reg32_href },
{ name => 'mxcsrmask', info => $reg32_href },
{ name => 'stmm0', info => $reg80_href },
{ name => 'stmm1', info => $reg80_href },
{ name => 'stmm2', info => $reg80_href },
{ name => 'stmm3', info => $reg80_href },
{ name => 'stmm4', info => $reg80_href },
{ name => 'stmm5', info => $reg80_href },
{ name => 'stmm6', info => $reg80_href },
{ name => 'stmm7', info => $reg80_href },
{ name => 'xmm0', info => $reg128_href },
{ name => 'xmm1', info => $reg128_href },
{ name => 'xmm2', info => $reg128_href },
{ name => 'xmm3', info => $reg128_href },
{ name => 'xmm4', info => $reg128_href },
{ name => 'xmm5', info => $reg128_href },
{ name => 'xmm6', info => $reg128_href },
{ name => 'xmm7', info => $reg128_href },
{ name => 'trapno', info => $reg32_href },
{ name => 'err', info => $reg32_href },
{ name => 'faultvaddr', info => $reg32_href },
],
'arm-gdb' => [
{ name => 'r0' , info => $reg32_href },
{ name => 'r1' , info => $reg32_href },
{ name => 'r2' , info => $reg32_href },
{ name => 'r3' , info => $reg32_href },
{ name => 'r4' , info => $reg32_href },
{ name => 'r5' , info => $reg32_href },
{ name => 'r6' , info => $reg32_href },
{ name => 'r7' , info => $reg32_href },
{ name => 'r8' , info => $reg32_href },
{ name => 'r9' , info => $reg32_href },
{ name => 'r10' , info => $reg32_href },
{ name => 'r11' , info => $reg32_href },
{ name => 'r12' , info => $reg32_href },
{ name => 'sp' , info => $reg32_href },
{ name => 'lr' , info => $reg32_href },
{ name => 'pc' , info => $reg32_href },
{ name => 'f0' , info => $float96_href },
{ name => 'f1' , info => $float96_href },
{ name => 'f2' , info => $float96_href },
{ name => 'f3' , info => $float96_href },
{ name => 'f4' , info => $float96_href },
{ name => 'f5' , info => $float96_href },
{ name => 'f6' , info => $float96_href },
{ name => 'f7' , info => $float96_href },
{ name => 'fps' , info => $reg32_href },
{ name => 'cpsr' , info => $reg32_href },
{ name => 's0' , info => $float32_href },
{ name => 's1' , info => $float32_href },
{ name => 's2' , info => $float32_href },
{ name => 's3' , info => $float32_href },
{ name => 's4' , info => $float32_href },
{ name => 's5' , info => $float32_href },
{ name => 's6' , info => $float32_href },
{ name => 's7' , info => $float32_href },
{ name => 's8' , info => $float32_href },
{ name => 's9' , info => $float32_href },
{ name => 's10' , info => $float32_href },
{ name => 's11' , info => $float32_href },
{ name => 's12' , info => $float32_href },
{ name => 's13' , info => $float32_href },
{ name => 's14' , info => $float32_href },
{ name => 's15' , info => $float32_href },
{ name => 's16' , info => $float32_href },
{ name => 's17' , info => $float32_href },
{ name => 's18' , info => $float32_href },
{ name => 's19' , info => $float32_href },
{ name => 's20' , info => $float32_href },
{ name => 's21' , info => $float32_href },
{ name => 's22' , info => $float32_href },
{ name => 's23' , info => $float32_href },
{ name => 's24' , info => $float32_href },
{ name => 's25' , info => $float32_href },
{ name => 's26' , info => $float32_href },
{ name => 's27' , info => $float32_href },
{ name => 's28' , info => $float32_href },
{ name => 's29' , info => $float32_href },
{ name => 's30' , info => $float32_href },
{ name => 's31' , info => $float32_href },
{ name => 'fpscr' , info => $reg32_href },
{ name => 'd16' , info => $float64_href },
{ name => 'd17' , info => $float64_href },
{ name => 'd18' , info => $float64_href },
{ name => 'd19' , info => $float64_href },
{ name => 'd20' , info => $float64_href },
{ name => 'd21' , info => $float64_href },
{ name => 'd22' , info => $float64_href },
{ name => 'd23' , info => $float64_href },
{ name => 'd24' , info => $float64_href },
{ name => 'd25' , info => $float64_href },
{ name => 'd26' , info => $float64_href },
{ name => 'd27' , info => $float64_href },
{ name => 'd28' , info => $float64_href },
{ name => 'd29' , info => $float64_href },
{ name => 'd30' , info => $float64_href },
{ name => 'd31' , info => $float64_href },
],
Fixed an issue in GDBRemoteCommunicationClient where we weren't listening to the "payload_length" argument for the "payload" packet data. This meant we could end up sending random extra data with a packet depending on how the packet was constructed. Fixed GDBRemoteRegisterContext to properly save and restore all registers. Previous fixes had been added to work around the "payload_length" issues fixed above and aren't needed anymore. Fix logging in GDBRemoteCommunication to make sure we log the correct packet data being sent by using the packet length when dumping the packet contents. Added register definitions for 'arm-lldb' in the "disasm-gdb-remote.pl" script so if you have a register dump from the GDB remote that doesn't include the qRegisterInfo packets, you can manually tell the script which registers are which. llvm-svn: 131715
2011-05-20 11:15:54 +08:00
'arm-lldb' => [
{ name => 'r0' , info => $reg32_href },
{ name => 'r1' , info => $reg32_href },
{ name => 'r2' , info => $reg32_href },
{ name => 'r3' , info => $reg32_href },
{ name => 'r4' , info => $reg32_href },
{ name => 'r5' , info => $reg32_href },
{ name => 'r6' , info => $reg32_href },
{ name => 'r7' , info => $reg32_href },
{ name => 'r8' , info => $reg32_href },
{ name => 'r9' , info => $reg32_href },
{ name => 'r10' , info => $reg32_href },
{ name => 'r11' , info => $reg32_href },
{ name => 'r12' , info => $reg32_href },
{ name => 'sp' , info => $reg32_href },
{ name => 'lr' , info => $reg32_href },
{ name => 'pc' , info => $reg32_href },
{ name => 'cpsr' , info => $reg32_href },
{ name => 's0' , info => $float32_href },
{ name => 's1' , info => $float32_href },
{ name => 's2' , info => $float32_href },
{ name => 's3' , info => $float32_href },
{ name => 's4' , info => $float32_href },
{ name => 's5' , info => $float32_href },
{ name => 's6' , info => $float32_href },
{ name => 's7' , info => $float32_href },
{ name => 's8' , info => $float32_href },
{ name => 's9' , info => $float32_href },
{ name => 's10' , info => $float32_href },
{ name => 's11' , info => $float32_href },
{ name => 's12' , info => $float32_href },
{ name => 's13' , info => $float32_href },
{ name => 's14' , info => $float32_href },
{ name => 's15' , info => $float32_href },
{ name => 's16' , info => $float32_href },
{ name => 's17' , info => $float32_href },
{ name => 's18' , info => $float32_href },
{ name => 's19' , info => $float32_href },
{ name => 's20' , info => $float32_href },
{ name => 's21' , info => $float32_href },
{ name => 's22' , info => $float32_href },
{ name => 's23' , info => $float32_href },
{ name => 's24' , info => $float32_href },
{ name => 's25' , info => $float32_href },
{ name => 's26' , info => $float32_href },
{ name => 's27' , info => $float32_href },
{ name => 's28' , info => $float32_href },
{ name => 's29' , info => $float32_href },
{ name => 's30' , info => $float32_href },
{ name => 's31' , info => $float32_href },
{ name => 'd0' , info => $float64_href },
{ name => 'd1' , info => $float64_href },
{ name => 'd2' , info => $float64_href },
{ name => 'd3' , info => $float64_href },
{ name => 'd4' , info => $float64_href },
{ name => 'd5' , info => $float64_href },
{ name => 'd6' , info => $float64_href },
{ name => 'd7' , info => $float64_href },
{ name => 'd8' , info => $float64_href },
{ name => 'd9' , info => $float64_href },
{ name => 'd10' , info => $float64_href },
{ name => 'd11' , info => $float64_href },
{ name => 'd12' , info => $float64_href },
{ name => 'd13' , info => $float64_href },
{ name => 'd14' , info => $float64_href },
{ name => 'd15' , info => $float64_href },
{ name => 'd16' , info => $float64_href },
{ name => 'd17' , info => $float64_href },
{ name => 'd18' , info => $float64_href },
{ name => 'd19' , info => $float64_href },
{ name => 'd20' , info => $float64_href },
{ name => 'd21' , info => $float64_href },
{ name => 'd22' , info => $float64_href },
{ name => 'd23' , info => $float64_href },
{ name => 'd24' , info => $float64_href },
{ name => 'd25' , info => $float64_href },
{ name => 'd26' , info => $float64_href },
{ name => 'd27' , info => $float64_href },
{ name => 'd28' , info => $float64_href },
{ name => 'd29' , info => $float64_href },
{ name => 'd30' , info => $float64_href },
{ name => 'd31' , info => $float64_href },
{ name => 'fpscr' , info => $reg32_href },
{ name => 'exc' , info => $reg32_href },
{ name => 'fsr' , info => $reg32_href },
{ name => 'far' , info => $reg32_href },
],
Added a perl script to disassemble, into human readable form, the GDB remote packet output from "log enable gdb-remote packets". This should help people track down and see what is going wrong more easily when you have log output that includes GDB remote packets. llvm-svn: 131713
2011-05-20 10:00:47 +08:00
'x86_64-gdb' => [
{ name => 'rax' , info => $reg64_href },
{ name => 'rbx' , info => $reg64_href },
{ name => 'rcx' , info => $reg64_href },
{ name => 'rdx' , info => $reg64_href },
{ name => 'rsi' , info => $reg64_href },
{ name => 'rdi' , info => $reg64_href },
{ name => 'rbp' , info => $reg64_href },
{ name => 'rsp' , info => $reg64_href },
{ name => 'r8' , info => $reg64_href },
{ name => 'r9' , info => $reg64_href },
{ name => 'r10' , info => $reg64_href },
{ name => 'r11' , info => $reg64_href },
{ name => 'r12' , info => $reg64_href },
{ name => 'r13' , info => $reg64_href },
{ name => 'r14' , info => $reg64_href },
{ name => 'r15' , info => $reg64_href },
{ name => 'rip' , info => $reg64_href },
{ name => 'eflags' , info => $reg32_href },
{ name => 'cs' , info => $reg32_href },
{ name => 'ss' , info => $reg32_href },
{ name => 'ds' , info => $reg32_href },
{ name => 'es' , info => $reg32_href },
{ name => 'fs' , info => $reg32_href },
{ name => 'gs' , info => $reg32_href },
{ name => 'stmm0' , info => $reg80_href },
{ name => 'stmm1' , info => $reg80_href },
{ name => 'stmm2' , info => $reg80_href },
{ name => 'stmm3' , info => $reg80_href },
{ name => 'stmm4' , info => $reg80_href },
{ name => 'stmm5' , info => $reg80_href },
{ name => 'stmm6' , info => $reg80_href },
{ name => 'stmm7' , info => $reg80_href },
{ name => 'fctrl' , info => $reg32_href },
{ name => 'fstat' , info => $reg32_href },
{ name => 'ftag' , info => $reg32_href },
{ name => 'fiseg' , info => $reg32_href },
{ name => 'fioff' , info => $reg32_href },
{ name => 'foseg' , info => $reg32_href },
{ name => 'fooff' , info => $reg32_href },
{ name => 'fop' , info => $reg32_href },
{ name => 'xmm0' , info => $reg128_href },
{ name => 'xmm1' , info => $reg128_href },
{ name => 'xmm2' , info => $reg128_href },
{ name => 'xmm3' , info => $reg128_href },
{ name => 'xmm4' , info => $reg128_href },
{ name => 'xmm5' , info => $reg128_href },
{ name => 'xmm6' , info => $reg128_href },
{ name => 'xmm7' , info => $reg128_href },
{ name => 'xmm8' , info => $reg128_href },
{ name => 'xmm9' , info => $reg128_href },
{ name => 'xmm10' , info => $reg128_href },
{ name => 'xmm11' , info => $reg128_href },
{ name => 'xmm12' , info => $reg128_href },
{ name => 'xmm13' , info => $reg128_href },
{ name => 'xmm14' , info => $reg128_href },
{ name => 'xmm15' , info => $reg128_href },
{ name => 'mxcsr' , info => $reg32_href },
],
'x86_64-lldb' => [
{ name => 'rax' , info => $reg64_href },
{ name => 'rbx' , info => $reg64_href },
{ name => 'rcx' , info => $reg64_href },
{ name => 'rdx' , info => $reg64_href },
{ name => 'rdi' , info => $reg64_href },
{ name => 'rsi' , info => $reg64_href },
{ name => 'rbp' , info => $reg64_href },
{ name => 'rsp' , info => $reg64_href },
{ name => 'r8 ' , info => $reg64_href },
{ name => 'r9 ' , info => $reg64_href },
{ name => 'r10' , info => $reg64_href },
{ name => 'r11' , info => $reg64_href },
{ name => 'r12' , info => $reg64_href },
{ name => 'r13' , info => $reg64_href },
{ name => 'r14' , info => $reg64_href },
{ name => 'r15' , info => $reg64_href },
{ name => 'rip' , info => $reg64_href },
{ name => 'rflags' , info => $reg64_href },
{ name => 'cs' , info => $reg64_href },
{ name => 'fs' , info => $reg64_href },
{ name => 'gs' , info => $reg64_href },
{ name => 'fctrl' , info => $reg16_href },
{ name => 'fstat' , info => $reg16_href },
{ name => 'ftag' , info => $reg8_href },
{ name => 'fop' , info => $reg16_href },
{ name => 'fioff' , info => $reg32_href },
{ name => 'fiseg' , info => $reg16_href },
{ name => 'fooff' , info => $reg32_href },
{ name => 'foseg' , info => $reg16_href },
{ name => 'mxcsr' , info => $reg32_href },
{ name => 'mxcsrmask' , info => $reg32_href },
{ name => 'stmm0' , info => $reg80_href },
{ name => 'stmm1' , info => $reg80_href },
{ name => 'stmm2' , info => $reg80_href },
{ name => 'stmm3' , info => $reg80_href },
{ name => 'stmm4' , info => $reg80_href },
{ name => 'stmm5' , info => $reg80_href },
{ name => 'stmm6' , info => $reg80_href },
{ name => 'stmm7' , info => $reg80_href },
{ name => 'xmm0' , info => $reg128_href },
{ name => 'xmm1' , info => $reg128_href },
{ name => 'xmm2' , info => $reg128_href },
{ name => 'xmm3' , info => $reg128_href },
{ name => 'xmm4' , info => $reg128_href },
{ name => 'xmm5' , info => $reg128_href },
{ name => 'xmm6' , info => $reg128_href },
{ name => 'xmm7' , info => $reg128_href },
{ name => 'xmm8' , info => $reg128_href },
{ name => 'xmm9' , info => $reg128_href },
{ name => 'xmm10' , info => $reg128_href },
{ name => 'xmm11' , info => $reg128_href },
{ name => 'xmm12' , info => $reg128_href },
{ name => 'xmm13' , info => $reg128_href },
{ name => 'xmm14' , info => $reg128_href },
{ name => 'xmm15' , info => $reg128_href },
{ name => 'trapno' , info => $reg32_href },
{ name => 'err' , info => $reg32_href },
{ name => 'faultvaddr' , info => $reg64_href },
]
);
our $max_register_name_len = 0;
calculate_max_register_name_length();
our @point_types = ( "software_bp", "hardware_bp", "write_wp", "read_wp", "access_wp" );
our $opt_v = 0; # verbose
our $opt_g = 0; # debug
our $opt_q = 0; # quiet
our $opt_r = undef;
use Getopt::Std;
getopts('gvqr:');
our $registers_aref = undef;
if (length($opt_r))
{
Update the handle many of the packets that our current LLDB debugserver handles. Also fixed a case where the packet wouldn't be dumped if it returned the unimplemented packet. llvm-svn: 132498
2011-06-03 06:21:38 +08:00
if (exists $reg_map{$opt_r})
{
$registers_aref = $reg_map{$opt_r};
}
else
{
die "Can't get registers group for '$opt_r'\n";
}
Added a perl script to disassemble, into human readable form, the GDB remote packet output from "log enable gdb-remote packets". This should help people track down and see what is going wrong more easily when you have log output that includes GDB remote packets. llvm-svn: 131713
2011-05-20 10:00:47 +08:00
}
sub extract_key_value_pairs
{
my $kv_href = {};
my $arrayref = shift;
my $str = join('',@$arrayref);
my @kv_strs = split(/;/, $str);
foreach my $kv_str (@kv_strs)
{
my ($key, $value) = split(/:/, $kv_str);
$kv_href->{$key} = $value;
}
return $kv_href;
}
sub get_thread_from_thread_suffix
{
if ($thread_suffix_supported)
{
my $arrayref = shift;
# Skip leading semi-colon if needed
$$arrayref[0] == ';' and shift @$arrayref;
my $thread_href = extract_key_value_pairs ($arrayref);
if (exists $thread_href->{thread})
{
return $thread_href->{thread};
}
}
return undef;
}
sub calculate_max_register_name_length
{
$max_register_name_len = 7;
foreach my $reg_href (@$registers_aref)
{
my $name_len = length($reg_href->{name});
if ($max_register_name_len < $name_len)
{
$max_register_name_len = $name_len;
}
}
}
#----------------------------------------------------------------------
# Hash that maps command characters to the appropriate functions using
# the command character as the key and the value being a reference to
# the dump function for dumping the command itself.
#----------------------------------------------------------------------
our %cmd_callbacks =
(
'?' => \&dump_last_signal_cmd,
'H' => \&dump_set_thread_cmd,
'T' => \&dump_thread_is_alive_cmd,
'q' => \&dump_general_query_cmd,
'Q' => \&dump_general_set_cmd,
'g' => \&dump_read_regs_cmd,
'G' => \&dump_write_regs_cmd,
'p' => \&dump_read_single_register_cmd,
'P' => \&dump_write_single_register_cmd,
'm' => \&dump_read_mem_cmd,
'M' => \&dump_write_mem_cmd,
'X' => \&dump_write_mem_binary_cmd,
'Z' => \&dump_bp_wp_command,
'z' => \&dump_bp_wp_command,
'k' => \&dump_kill_cmd,
'A' => \&dump_A_command,
'c' => \&dump_continue_cmd,
'C' => \&dump_continue_with_signal_cmd,
'_M' => \&dump_allocate_memory_cmd,
'_m' => \&dump_deallocate_memory_cmd,
# extended commands
'v' => \&dump_extended_cmd
);
#----------------------------------------------------------------------
# Hash that maps command characters to the appropriate functions using
# the command character as the key and the value being a reference to
# the dump function for the response to the command.
#----------------------------------------------------------------------
our %rsp_callbacks =
(
'c' => \&dump_stop_reply_packet,
'C' => \&dump_stop_reply_packet,
'?' => \&dump_stop_reply_packet,
'T' => \&dump_thread_is_alive_rsp,
'H' => \&dump_set_thread_rsp,
'q' => \&dump_general_query_rsp,
'g' => \&dump_read_regs_rsp,
'p' => \&dump_read_single_register_rsp,
'm' => \&dump_read_mem_rsp,
'_M' => \&dump_allocate_memory_rsp,
# extended commands
'v' => \&dump_extended_rsp,
);
sub dump_register_value
{
my $indent = shift;
my $arrayref = shift;
my $reg_num = shift;
if ($reg_num >= @$registers_aref)
{
printf("\tinvalid register index %d\n", $reg_num);
}
my $reg_href = $$registers_aref[$reg_num];
my $reg_name = $reg_href->{name};
if ($$arrayref[0] eq '#')
{
printf("\t%*s: error: EOS reached when trying to read register %d\n", $max_register_name_len, $reg_name, $reg_num);
}
my $reg_info = $reg_href->{info};
my $reg_extract = $reg_info->{extract};
my $reg_format = $reg_info->{format};
my $reg_val = &$reg_extract($arrayref);
if ($indent) {
printf("\t%*s = $reg_format", $max_register_name_len, $reg_name, $reg_val);
} else {
printf("%s = $reg_format", $reg_name, $reg_val);
}
}
#----------------------------------------------------------------------
# Extract the command into an array of ASCII char strings for easy
# processing
#----------------------------------------------------------------------
sub extract_command
{
my $cmd_str = shift;
my @cmd_chars = split(/ */, $cmd_str);
if ($cmd_chars[0] ne '$')
{
# only set the current command if it isn't a reply
$curr_cmd = $cmd_chars[0];
}
return @cmd_chars;
}
#----------------------------------------------------------------------
# Strip the 3 checksum array entries after we don't need them anymore
#----------------------------------------------------------------------
sub strip_checksum
{
my $arrayref = shift;
splice(@$arrayref, -3);
}
#----------------------------------------------------------------------
# Dump all strings in array by joining them together with no space
# between them
#----------------------------------------------------------------------
sub dump_chars
{
print join('',@_);
}
#----------------------------------------------------------------------
# Check if the response is an error 'EXX'
#----------------------------------------------------------------------
sub is_error_response
{
if ($_[0] eq 'E')
{
shift;
print "ERROR = " . join('',@_) . "\n";
return 1;
}
return 0;
}
#----------------------------------------------------------------------
# 'H' command
#----------------------------------------------------------------------
sub dump_set_thread_cmd
{
my $cmd = shift;
my $mod = shift;
print "set_thread ( $mod, " . join('',@_) . " )\n";
}
#----------------------------------------------------------------------
# 'T' command
#----------------------------------------------------------------------
our $T_cmd_tid = -1;
sub dump_thread_is_alive_cmd
{
my $cmd = shift;
$T_cmd_tid = get_hex(\@_);
printf("thread_is_alive ( $tid_format )\n", $T_cmd_tid);
}
sub dump_thread_is_alive_rsp
{
my $rsp = join('',@_);
printf("thread_is_alive ( $tid_format ) =>", $T_cmd_tid);
if ($rsp eq 'OK')
{
print " alive.\n";
}
else
{
print " dead.\n";
}
}
#----------------------------------------------------------------------
# 'H' response
#----------------------------------------------------------------------
sub dump_set_thread_rsp
{
if (!is_error_response(@_))
{
print join('',@_) . "\n";
}
}
#----------------------------------------------------------------------
# 'q' command
#----------------------------------------------------------------------
our $gen_query_cmd;
Update the handle many of the packets that our current LLDB debugserver handles. Also fixed a case where the packet wouldn't be dumped if it returned the unimplemented packet. llvm-svn: 132498
2011-06-03 06:21:38 +08:00
our $qRegisterInfo_reg_num = -1;
Added a perl script to disassemble, into human readable form, the GDB remote packet output from "log enable gdb-remote packets". This should help people track down and see what is going wrong more easily when you have log output that includes GDB remote packets. llvm-svn: 131713
2011-05-20 10:00:47 +08:00
sub dump_general_query_cmd
{
$gen_query_cmd = join('',@_);
if ($gen_query_cmd eq 'qC')
{
print 'get_current_pid ()';
}
elsif ($gen_query_cmd eq 'qfThreadInfo')
{
print 'get_first_active_threads ()';
}
elsif ($gen_query_cmd eq 'qsThreadInfo')
{
print 'get_subsequent_active_threads ()';
}
elsif (index($gen_query_cmd, 'qThreadExtraInfo') == 0)
{
# qThreadExtraInfo,id
print 'get_thread_extra_info ()';
}
elsif (index($gen_query_cmd, 'qThreadStopInfo') == 0)
{
# qThreadStopInfoXXXX
@_ = splice(@_, length('qThreadStopInfo'));
my $tid = get_addr(\@_);
printf('get_thread_stop_info ( thread = 0x%4.4x )', $tid);
}
elsif (index($gen_query_cmd, 'qSymbol:') == 0)
{
# qCRC:addr,length
print 'gdb_ready_to_serve_symbol_lookups ()';
}
elsif (index($gen_query_cmd, 'qCRC:') == 0)
{
# qCRC:addr,length
@_ = splice(@_, length('qCRC:'));
my $address = get_addr(\@_);
shift @_;
my $length = join('', @_);
printf("compute_crc (addr = $addr_format, length = $length)", $address);
}
elsif (index($gen_query_cmd, 'qGetTLSAddr:') == 0)
{
# qGetTLSAddr:thread-id,offset,lm
@_ = splice(@_, length('qGetTLSAddr:'));
my ($tid, $offset, $lm) = split (/,/, join('', @_));
print "get_thread_local_storage_addr (thread-id = $tid, offset = $offset, lm = $lm)";
}
elsif ($gen_query_cmd eq 'qOffsets')
{
print 'get_section_offsets ()';
}
elsif (index($gen_query_cmd, 'qRegisterInfo') == 0)
{
@_ = splice(@_, length('qRegisterInfo'));
Update the handle many of the packets that our current LLDB debugserver handles. Also fixed a case where the packet wouldn't be dumped if it returned the unimplemented packet. llvm-svn: 132498
2011-06-03 06:21:38 +08:00
$qRegisterInfo_reg_num = get_hex(\@_);
printf "get_dynamic_register_info ($qRegisterInfo_reg_num)";
Added a perl script to disassemble, into human readable form, the GDB remote packet output from "log enable gdb-remote packets". This should help people track down and see what is going wrong more easily when you have log output that includes GDB remote packets. llvm-svn: 131713
2011-05-20 10:00:47 +08:00
}
else
{
print $gen_query_cmd;
}
print "\n";
}
#----------------------------------------------------------------------
# 'q' response
#----------------------------------------------------------------------
sub dump_general_query_rsp
{
my $gen_query_rsp = join('',@_);
Update the handle many of the packets that our current LLDB debugserver handles. Also fixed a case where the packet wouldn't be dumped if it returned the unimplemented packet. llvm-svn: 132498
2011-06-03 06:21:38 +08:00
my $gen_query_rsp_len = length ($gen_query_rsp);
Added a perl script to disassemble, into human readable form, the GDB remote packet output from "log enable gdb-remote packets". This should help people track down and see what is going wrong more easily when you have log output that includes GDB remote packets. llvm-svn: 131713
2011-05-20 10:00:47 +08:00
if ($gen_query_cmd eq 'qC' and index($gen_query_rsp, 'QC') == 0)
{
shift @_; shift @_;
my $pid = get_hex(\@_);
Update the handle many of the packets that our current LLDB debugserver handles. Also fixed a case where the packet wouldn't be dumped if it returned the unimplemented packet. llvm-svn: 132498
2011-06-03 06:21:38 +08:00
printf("pid = $pid_format\n", $pid);
Added a perl script to disassemble, into human readable form, the GDB remote packet output from "log enable gdb-remote packets". This should help people track down and see what is going wrong more easily when you have log output that includes GDB remote packets. llvm-svn: 131713
2011-05-20 10:00:47 +08:00
return;
}
elsif (index($gen_query_cmd, 'qRegisterInfo') == 0)
{
Update the handle many of the packets that our current LLDB debugserver handles. Also fixed a case where the packet wouldn't be dumped if it returned the unimplemented packet. llvm-svn: 132498
2011-06-03 06:21:38 +08:00
if ($gen_query_rsp_len == 0)
Added a perl script to disassemble, into human readable form, the GDB remote packet output from "log enable gdb-remote packets". This should help people track down and see what is going wrong more easily when you have log output that includes GDB remote packets. llvm-svn: 131713
2011-05-20 10:00:47 +08:00
{
Update the handle many of the packets that our current LLDB debugserver handles. Also fixed a case where the packet wouldn't be dumped if it returned the unimplemented packet. llvm-svn: 132498
2011-06-03 06:21:38 +08:00
print "$unimplemented_str\n";
}
else
{
if (index($gen_query_rsp, 'name') == 0)
Added a perl script to disassemble, into human readable form, the GDB remote packet output from "log enable gdb-remote packets". This should help people track down and see what is going wrong more easily when you have log output that includes GDB remote packets. llvm-svn: 131713
2011-05-20 10:00:47 +08:00
{
Update the handle many of the packets that our current LLDB debugserver handles. Also fixed a case where the packet wouldn't be dumped if it returned the unimplemented packet. llvm-svn: 132498
2011-06-03 06:21:38 +08:00
$qRegisterInfo_reg_num == 0 and $registers_aref = [];
my @name_and_values = split (/;/, $gen_query_rsp);
my $reg_name = undef;
my $byte_size = 0;
foreach (@name_and_values)
{
my ($name, $value) = split /:/;
if ($name eq "name") { $reg_name = $value; }
elsif ($name eq "bitsize") { $byte_size = $value / 8; last; }
}
if (defined $reg_name and $byte_size > 0)
{
if ($byte_size == 4) {push @$registers_aref, { name => $reg_name, info => $reg32_href };}
elsif ($byte_size == 8) {push @$registers_aref, { name => $reg_name, info => $reg64_href };}
elsif ($byte_size == 10) {push @$registers_aref, { name => $reg_name, info => $reg80_href };}
elsif ($byte_size == 12) {push @$registers_aref, { name => $reg_name, info => $float96_href };}
elsif ($byte_size == 16) {push @$registers_aref, { name => $reg_name, info => $reg128_href };}
}
Added a perl script to disassemble, into human readable form, the GDB remote packet output from "log enable gdb-remote packets". This should help people track down and see what is going wrong more easily when you have log output that includes GDB remote packets. llvm-svn: 131713
2011-05-20 10:00:47 +08:00
}
Update the handle many of the packets that our current LLDB debugserver handles. Also fixed a case where the packet wouldn't be dumped if it returned the unimplemented packet. llvm-svn: 132498
2011-06-03 06:21:38 +08:00
elsif ($gen_query_rsp_len == 3 and index($gen_query_rsp, 'E') == 0)
Added a perl script to disassemble, into human readable form, the GDB remote packet output from "log enable gdb-remote packets". This should help people track down and see what is going wrong more easily when you have log output that includes GDB remote packets. llvm-svn: 131713
2011-05-20 10:00:47 +08:00
{
Update the handle many of the packets that our current LLDB debugserver handles. Also fixed a case where the packet wouldn't be dumped if it returned the unimplemented packet. llvm-svn: 132498
2011-06-03 06:21:38 +08:00
calculate_max_register_name_length();
Added a perl script to disassemble, into human readable form, the GDB remote packet output from "log enable gdb-remote packets". This should help people track down and see what is going wrong more easily when you have log output that includes GDB remote packets. llvm-svn: 131713
2011-05-20 10:00:47 +08:00
}
}
}
elsif ($gen_query_cmd =~ 'qThreadStopInfo')
{
dump_stop_reply_packet (@_);
}
if (dump_standard_response(\@_))
{
# Do nothing...
}
else
{
print join('',@_) . "\n";
}
}
#----------------------------------------------------------------------
# 'Q' command
#----------------------------------------------------------------------
our $gen_set_cmd;
sub dump_general_set_cmd
{
$gen_query_cmd = join('',@_);
if ($gen_query_cmd eq 'QStartNoAckMode')
{
print "StartNoAckMode ()"
}
elsif ($gen_query_cmd eq 'QThreadSuffixSupported')
{
$thread_suffix_supported = 1;
print "ThreadSuffixSupported ()"
}
elsif (index($gen_query_cmd, 'QSetMaxPayloadSize:') == 0)
{
@_ = splice(@_, length('QSetMaxPayloadSize:'));
my $max_payload_size = get_hex(\@_);
# QSetMaxPayloadSize:XXXX where XXXX is a hex length of the max
# packet payload size supported by gdb
printf("SetMaxPayloadSize ( 0x%x (%u))", $max_payload_size, $max_payload_size);
}
Update the handle many of the packets that our current LLDB debugserver handles. Also fixed a case where the packet wouldn't be dumped if it returned the unimplemented packet. llvm-svn: 132498
2011-06-03 06:21:38 +08:00
elsif (index ($gen_query_cmd, 'QSetSTDIN:') == 0)
{
@_ = splice(@_, length('QSetSTDIN:'));
printf ("SetSTDIN (path ='%s')\n", get_hex_string (\@_));
}
elsif (index ($gen_query_cmd, 'QSetSTDOUT:') == 0)
{
@_ = splice(@_, length('QSetSTDOUT:'));
printf ("SetSTDOUT (path ='%s')\n", get_hex_string (\@_));
}
elsif (index ($gen_query_cmd, 'QSetSTDERR:') == 0)
{
@_ = splice(@_, length('QSetSTDERR:'));
printf ("SetSTDERR (path ='%s')\n", get_hex_string (\@_));
}
Added a perl script to disassemble, into human readable form, the GDB remote packet output from "log enable gdb-remote packets". This should help people track down and see what is going wrong more easily when you have log output that includes GDB remote packets. llvm-svn: 131713
2011-05-20 10:00:47 +08:00
else
{
print $gen_query_cmd;
}
print "\n";
}
#----------------------------------------------------------------------
# 'k' command
#----------------------------------------------------------------------
sub dump_kill_cmd
{
my $cmd = shift;
print "kill (" . join('',@_) . ")\n";
}
#----------------------------------------------------------------------
# 'g' command
#----------------------------------------------------------------------
sub dump_read_regs_cmd
{
my $cmd = shift;
print "read_registers ()\n";
}
#----------------------------------------------------------------------
# 'G' command
#----------------------------------------------------------------------
sub dump_write_regs_cmd
{
print "write_registers:\n";
my $cmd = shift;
foreach my $reg_href (@$registers_aref)
{
last if ($_[0] eq '#');
my $reg_info_href = $reg_href->{info};
my $reg_name = $reg_href->{name};
my $reg_extract = $reg_info_href->{extract};
my $reg_format = $reg_info_href->{format};
my $reg_val = &$reg_extract(\@_);
printf("\t%*s = $reg_format\n", $max_register_name_len, $reg_name, $reg_val);
}
}
sub dump_read_regs_rsp
{
print "read_registers () =>\n";
if (!is_error_response(@_))
{
# print join('',@_) . "\n";
foreach my $reg_href (@$registers_aref)
{
last if ($_[0] eq '#');
my $reg_info_href = $reg_href->{info};
my $reg_name = $reg_href->{name};
my $reg_extract = $reg_info_href->{extract};
my $reg_format = $reg_info_href->{format};
my $reg_val = &$reg_extract(\@_);
printf("\t%*s = $reg_format\n", $max_register_name_len, $reg_name, $reg_val);
}
}
}
sub dump_read_single_register_rsp
{
dump_register_value(0, \@_, $reg_cmd_reg);
print "\n";
}
#----------------------------------------------------------------------
# '_M' - allocate memory command (LLDB extension)
#
# Command: '_M'
# Arg1: Hex byte size as big endian hex string
# Separator: ','
# Arg2: permissions as string that must be a string that contains any
# combination of 'r' (readable) 'w' (writable) or 'x' (executable)
#
# Returns: The address that was allocated as a big endian hex string
# on success, else an error "EXX" where XX are hex bytes
# that indicate an error code.
#
# Examples:
# _M10,rw # allocate 16 bytes with read + write permissions
# _M100,rx # allocate 256 bytes with read + execute permissions
#----------------------------------------------------------------------
sub dump_allocate_memory_cmd
{
shift; shift; # shift off the '_' and the 'M'
my $byte_size = get_addr(\@_);
shift; # Skip ','
printf("allocate_memory ( byte_size = %u (0x%x), permissions = %s)\n", $byte_size, $byte_size, join('',@_));
}
sub dump_allocate_memory_rsp
{
if (@_ == 3 and $_[0] == 'E')
{
printf("allocated memory addr = ERROR (%s))\n", join('',@_));
}
else
{
printf("allocated memory addr = 0x%s\n", join('',@_));
}
}
#----------------------------------------------------------------------
# '_m' - deallocate memory command (LLDB extension)
#
# Command: '_m'
# Arg1: Hex address as big endian hex string
#
# Returns: "OK" on success "EXX" on error
#
# Examples:
# _m201000 # Free previously allocated memory at address 0x201000
#----------------------------------------------------------------------
sub dump_deallocate_memory_cmd
{
shift; shift; # shift off the '_' and the 'm'
printf("deallocate_memory ( addr = 0x%s)\n", join('',@_));
}
#----------------------------------------------------------------------
# 'p' command
#----------------------------------------------------------------------
sub dump_read_single_register_cmd
{
my $cmd = shift;
Update the handle many of the packets that our current LLDB debugserver handles. Also fixed a case where the packet wouldn't be dumped if it returned the unimplemented packet. llvm-svn: 132498
2011-06-03 06:21:38 +08:00
my $reg_num = get_hex(\@_);
Added a perl script to disassemble, into human readable form, the GDB remote packet output from "log enable gdb-remote packets". This should help people track down and see what is going wrong more easily when you have log output that includes GDB remote packets. llvm-svn: 131713
2011-05-20 10:00:47 +08:00
my $thread = get_thread_from_thread_suffix (\@_);
Update the handle many of the packets that our current LLDB debugserver handles. Also fixed a case where the packet wouldn't be dumped if it returned the unimplemented packet. llvm-svn: 132498
2011-06-03 06:21:38 +08:00
my $reg_href = $$registers_aref[$reg_num];
Added a perl script to disassemble, into human readable form, the GDB remote packet output from "log enable gdb-remote packets". This should help people track down and see what is going wrong more easily when you have log output that includes GDB remote packets. llvm-svn: 131713
2011-05-20 10:00:47 +08:00
if (defined $thread)
{
Update the handle many of the packets that our current LLDB debugserver handles. Also fixed a case where the packet wouldn't be dumped if it returned the unimplemented packet. llvm-svn: 132498
2011-06-03 06:21:38 +08:00
print "read_register ( reg = \"$reg_href->{name}\", thread = $thread )\n";
Added a perl script to disassemble, into human readable form, the GDB remote packet output from "log enable gdb-remote packets". This should help people track down and see what is going wrong more easily when you have log output that includes GDB remote packets. llvm-svn: 131713
2011-05-20 10:00:47 +08:00
}
else
{
Update the handle many of the packets that our current LLDB debugserver handles. Also fixed a case where the packet wouldn't be dumped if it returned the unimplemented packet. llvm-svn: 132498
2011-06-03 06:21:38 +08:00
print "read_register ( reg = \"$reg_href->{name}\" )\n";
Added a perl script to disassemble, into human readable form, the GDB remote packet output from "log enable gdb-remote packets". This should help people track down and see what is going wrong more easily when you have log output that includes GDB remote packets. llvm-svn: 131713
2011-05-20 10:00:47 +08:00
}
}
#----------------------------------------------------------------------
# 'P' command
#----------------------------------------------------------------------
sub dump_write_single_register_cmd
{
my $cmd = shift;
my $reg_num = get_hex(\@_);
shift (@_); # Discard the '='
print "write_register ( ";
dump_register_value(0, \@_, $reg_num);
my $thread = get_thread_from_thread_suffix (\@_);
if (defined $thread)
{
print ", thread = $thread";
}
print " )\n";
}
#----------------------------------------------------------------------
# 'm' command
#----------------------------------------------------------------------
our $read_mem_address = 0;
sub dump_read_mem_cmd
{
my $cmd = shift;
$read_mem_address = get_addr(\@_);
shift; # Skip ','
printf("read_mem ( $addr_format, %s )\n", $read_mem_address, join('',@_));
}
#----------------------------------------------------------------------
# 'm' response
#----------------------------------------------------------------------
sub dump_read_mem_rsp
{
# If the memory read was 2 or 4 bytes, print it out in native format
# instead of just as bytes.
my $num_nibbles = @_;
if ($num_nibbles == 2)
{
printf(" 0x%2.2x", get8(\@_));
}
elsif ($num_nibbles == 4)
{
printf(" 0x%4.4x", get16(\@_));
}
elsif ($num_nibbles == 8)
{
printf(" 0x%8.8x", get32(\@_));
}
elsif ($num_nibbles == 16)
{
printf(" 0x%s", get64(\@_));
}
else
{
my $curr_address = $read_mem_address;
my $nibble;
my $nibble_offset = 0;
my $max_nibbles_per_line = 2 * $max_bytes_per_line;
foreach $nibble (@_)
{
if (($nibble_offset % $max_nibbles_per_line) == 0)
{
($nibble_offset > 0) and print "\n ";
printf("$addr_format: ", $curr_address + $nibble_offset/2);
}
(($nibble_offset % 2) == 0) and print ' ';
print $nibble;
$nibble_offset++;
}
}
print "\n";
}
#----------------------------------------------------------------------
# 'c' command
#----------------------------------------------------------------------
sub dump_continue_cmd
{
my $cmd = shift;
my $address = -1;
if (@_)
{
my $address = get_addr(\@_);
printf("continue ($addr_format)\n", $address);
}
else
{
printf("continue ()\n");
}
}
#----------------------------------------------------------------------
# 'Css' continue (C) with signal (ss where 'ss' is two hex digits)
#----------------------------------------------------------------------
sub dump_continue_with_signal_cmd
{
my $cmd = shift;
my $address = -1;
my $signal = get_hex(\@_);
if (@_)
{
my $address = 0;
if (@_ && $_[0] == ';')
{
shift;
$address = get_addr(\@_);
}
}
if ($address != -1)
{
printf("continue_with_signal (signal = 0x%2.2x, address = $addr_format)\n", $signal, $address);
}
else
{
printf("continue_with_signal (signal = 0x%2.2x)\n", $signal);
}
}
#----------------------------------------------------------------------
# 'A' command
#----------------------------------------------------------------------
sub dump_A_command
{
my $cmd = get_exptected_char(\@_, 'A') or print "error: incorrect command letter for argument packet, exptected 'A'\n";
printf("set_program_arguments (\n");
do
{
my $arg_len = get_uint(\@_);
get_exptected_char(\@_, ',') or die "error: missing comma after argument length...?\n";
my $arg_idx = get_uint(\@_);
get_exptected_char(\@_, ',') or die "error: missing comma after argument number...?\n";
my $arg = '';
my $num_hex8_bytes = $arg_len/2;
for (1 .. $num_hex8_bytes)
{
$arg .= sprintf("%c", get8(\@_))
}
printf(" <%3u> argv[%u] = '%s'\n", $arg_len, $arg_idx, $arg);
if (@_ > 0)
{
get_exptected_char(\@_, ',') or die "error: missing comma after argument argument ASCII hex bytes...?\n";
}
} while (@_ > 0);
printf(" )\n");
}
#----------------------------------------------------------------------
# 'z' and 'Z' command
#----------------------------------------------------------------------
sub dump_bp_wp_command
{
my $cmd = shift;
my $type = shift;
shift; # Skip ','
my $address = get_addr(\@_);
shift; # Skip ','
my $length = join('',@_);
if ($cmd eq 'z')
{
printf("remove $point_types[$type]($addr_format, %d)\n", $address, $length);
}
else
{
printf("insert $point_types[$type]($addr_format, %d)\n", $address, $length);
}
}
#----------------------------------------------------------------------
# 'X' command
#----------------------------------------------------------------------
sub dump_write_mem_binary_cmd
{
my $cmd = shift;
my $address = get_addr(\@_);
shift; # Skip ','
my ($length, $binary) = split(/:/, join('',@_));
printf("write_mem_binary ( $addr_format, %d, %s)\n", $address, $length, $binary);
}
#----------------------------------------------------------------------
# 'M' command
#----------------------------------------------------------------------
sub dump_write_mem_cmd
{
my $cmd = shift;
my $address = get_addr(\@_);
shift; # Skip ','
my ($length, $hex_bytes) = split(/:/, join('',@_));
# printf("write_mem ( $addr_format, %d, %s)\n", $address, $length, $hex_bytes);
printf("write_mem ( addr = $addr_format, len = %d (0x%x), bytes = ", $address, $length, $length);
splice(@_, 0, length($length)+1);
my $curr_address = $address;
my $nibble;
my $nibble_count = 0;
my $max_nibbles_per_line = 2 * $max_bytes_per_line;
foreach $nibble (@_)
{
(($nibble_count % 2) == 0) and print ' ';
print $nibble;
$nibble_count++;
}
# If the memory to write is 2 or 4 bytes, print it out in native format
# instead of just as bytes.
if (@_ == 4)
{
printf(" ( 0x%4.4x )", get16(\@_));
}
elsif (@_ == 8)
{
printf(" ( 0x%8.8x )", get32(\@_));
}
print " )\n";
}
#----------------------------------------------------------------------
# 'v' command
#----------------------------------------------------------------------
our $extended_rsp_callback = 0;
sub dump_extended_cmd
{
$extended_rsp_callback = 0;
if (join('', @_[0..4]) eq "vCont")
{
dump_extended_continue_cmd(splice(@_,5));
}
elsif (join('', @_[0..11]) eq 'vAttachWait;')
{
dump_attach_wait_command (splice(@_,12));
}
}
#----------------------------------------------------------------------
# 'v' response
#----------------------------------------------------------------------
sub dump_extended_rsp
{
if ($extended_rsp_callback)
{
&$extended_rsp_callback(@_);
}
$extended_rsp_callback = 0;
}
#----------------------------------------------------------------------
# 'vAttachWait' command
#----------------------------------------------------------------------
sub dump_attach_wait_command
{
print "attach_wait ( ";
while (@_)
{
printf("%c", get8(\@_))
}
printf " )\n";
}
#----------------------------------------------------------------------
# 'vCont' command
#----------------------------------------------------------------------
sub dump_extended_continue_cmd
{
print "extended_continue ( ";
my $cmd = shift;
if ($cmd eq '?')
{
print "list supported modes )\n";
$extended_rsp_callback = \&dump_extended_continue_rsp;
}
elsif ($cmd eq ';')
{
$extended_rsp_callback = \&dump_stop_reply_packet;
my $i = 0;
while ($#_ >= 0)
{
if ($i > 0)
{
print ", ";
}
my $continue_cmd = shift;
my $tmp;
if ($continue_cmd eq 'c')
{
print "continue";
}
elsif ($continue_cmd eq 'C')
{
print "continue with signal ";
print shift;
print shift;
}
elsif ($continue_cmd eq 's')
{
print "step";
}
elsif ($continue_cmd eq 'S')
{
print "step with signal ";
print shift;
print shift;
}
if ($_[0] eq ':')
{
shift; # Skip ':'
print " for thread ";
while ($#_ >= 0)
{
$tmp = shift;
if (length($tmp) > 0 && $tmp ne ';') {
print $tmp;
} else {
last;
}
}
}
$i++;
}
printf " )\n";
}
}
#----------------------------------------------------------------------
# 'vCont' response
#----------------------------------------------------------------------
sub dump_extended_continue_rsp
{
Update the handle many of the packets that our current LLDB debugserver handles. Also fixed a case where the packet wouldn't be dumped if it returned the unimplemented packet. llvm-svn: 132498
2011-06-03 06:21:38 +08:00
if (scalar(@_) == 0)
{
print "$unimplemented_str\n";
}
else
{
print "extended_continue supports " . join('',@_) . "\n";
}
Added a perl script to disassemble, into human readable form, the GDB remote packet output from "log enable gdb-remote packets". This should help people track down and see what is going wrong more easily when you have log output that includes GDB remote packets. llvm-svn: 131713
2011-05-20 10:00:47 +08:00
}
#----------------------------------------------------------------------
# Dump the command ascii for any unknown commands
#----------------------------------------------------------------------
sub dump_other_cmd
{
print "other = " . join('',@_) . "\n";
}
#----------------------------------------------------------------------
# Check to see if the response was unsupported with appropriate checksum
#----------------------------------------------------------------------
sub rsp_is_unsupported
{
return join('',@_) eq "#00";
}
#----------------------------------------------------------------------
# Check to see if the response was "OK" with appropriate checksum
#----------------------------------------------------------------------
sub rsp_is_OK
{
return join('',@_) eq "OK#9a";
}
#----------------------------------------------------------------------
# Dump a response for an unknown command
#----------------------------------------------------------------------
sub dump_other_rsp
{
print "other = " . join('',@_) . "\n";
}
#----------------------------------------------------------------------
# Get a byte from the ascii string assuming that the 2 nibble ascii
# characters are in hex.
#
# The argument for this function needs to be a reference to an array
# that contains single character strings and the array will get
# updated by shifting characters off the front of it (no leading # "0x")
#----------------------------------------------------------------------
sub get8
{
my $arrayref = shift;
my $val = hex(shift(@$arrayref) . shift(@$arrayref));
return $val;
}
#----------------------------------------------------------------------
# Get a 16 bit integer and swap if $swap global is set to a non-zero
# value.
#
# The argument for this function needs to be a reference to an array
# that contains single character strings and the array will get
# updated by shifting characters off the front of it (no leading # "0x")
#----------------------------------------------------------------------
sub get16
{
my $arrayref = shift;
my $val = 0;
if ($swap)
{
$val = get8($arrayref) |
get8($arrayref) << 8;
}
else
{
$val = get8($arrayref) << 8 |
get8($arrayref) ;
}
return $val;
}
#----------------------------------------------------------------------
# Get a 32 bit integer and swap if $swap global is set to a non-zero
# value.
#
# The argument for this function needs to be a reference to an array
# that contains single character strings and the array will get
# updated by shifting characters off the front of it (no leading # "0x")
#----------------------------------------------------------------------
sub get32
{
my $arrayref = shift;
my $val = 0;
if ($swap)
{
$val = get8($arrayref) |
get8($arrayref) << 8 |
get8($arrayref) << 16 |
get8($arrayref) << 24 ;
}
else
{
$val = get8($arrayref) << 24 |
get8($arrayref) << 16 |
get8($arrayref) << 8 |
get8($arrayref) ;
}
return $val;
}
#----------------------------------------------------------------------
# Get a 64 bit hex value as a string
#
# The argument for this function needs to be a reference to an array
# that contains single character strings and the array will get
# updated by shifting characters off the front of it (no leading # "0x")
#----------------------------------------------------------------------
sub get64
{
my $arrayref = shift;
my $val = '';
my @nibbles;
if ($swap)
{
push @nibbles, splice(@$arrayref, 14, 2);
push @nibbles, splice(@$arrayref, 12, 2);
push @nibbles, splice(@$arrayref, 10, 2);
push @nibbles, splice(@$arrayref, 8, 2);
push @nibbles, splice(@$arrayref, 6, 2);
push @nibbles, splice(@$arrayref, 4, 2);
push @nibbles, splice(@$arrayref, 2, 2);
push @nibbles, splice(@$arrayref, 0, 2);
}
else
{
(@nibbles) = splice(@$arrayref, 0, 24);
}
$val = join('', @nibbles);
return $val;
}
#----------------------------------------------------------------------
# Get a 80 bit hex value as a string
#
# The argument for this function needs to be a reference to an array
# that contains single character strings and the array will get
# updated by shifting characters off the front of it (no leading # "0x")
#----------------------------------------------------------------------
sub get80
{
my $arrayref = shift;
my $val = '';
my @nibbles;
if ($swap)
{
push @nibbles, splice(@$arrayref, 18, 2);
push @nibbles, splice(@$arrayref, 16, 2);
push @nibbles, splice(@$arrayref, 14, 2);
push @nibbles, splice(@$arrayref, 12, 2);
push @nibbles, splice(@$arrayref, 10, 2);
push @nibbles, splice(@$arrayref, 8, 2);
push @nibbles, splice(@$arrayref, 6, 2);
push @nibbles, splice(@$arrayref, 4, 2);
push @nibbles, splice(@$arrayref, 2, 2);
push @nibbles, splice(@$arrayref, 0, 2);
}
else
{
(@nibbles) = splice(@$arrayref, 0, 24);
}
$val = join('', @nibbles);
return $val;
}
#----------------------------------------------------------------------
# Get a 96 bit hex value as a string
#
# The argument for this function needs to be a reference to an array
# that contains single character strings and the array will get
# updated by shifting characters off the front of it (no leading # "0x")
#----------------------------------------------------------------------
sub get96
{
my $arrayref = shift;
my $val = '';
my @nibbles;
if ($swap)
{
push @nibbles, splice(@$arrayref, 22, 2);
push @nibbles, splice(@$arrayref, 20, 2);
push @nibbles, splice(@$arrayref, 18, 2);
push @nibbles, splice(@$arrayref, 16, 2);
push @nibbles, splice(@$arrayref, 14, 2);
push @nibbles, splice(@$arrayref, 12, 2);
push @nibbles, splice(@$arrayref, 10, 2);
push @nibbles, splice(@$arrayref, 8, 2);
push @nibbles, splice(@$arrayref, 6, 2);
push @nibbles, splice(@$arrayref, 4, 2);
push @nibbles, splice(@$arrayref, 2, 2);
push @nibbles, splice(@$arrayref, 0, 2);
}
else
{
(@nibbles) = splice(@$arrayref, 0, 24);
}
$val = join('', @nibbles);
return $val;
}
#----------------------------------------------------------------------
# Get a 128 bit hex value as a string
#
# The argument for this function needs to be a reference to an array
# that contains single character strings and the array will get
# updated by shifting characters off the front of it (no leading # "0x")
#----------------------------------------------------------------------
sub get128
{
my $arrayref = shift;
my $val = '';
my @nibbles;
if ($swap)
{
push @nibbles, splice(@$arrayref, 30, 2);
push @nibbles, splice(@$arrayref, 28, 2);
push @nibbles, splice(@$arrayref, 26, 2);
push @nibbles, splice(@$arrayref, 24, 2);
push @nibbles, splice(@$arrayref, 22, 2);
push @nibbles, splice(@$arrayref, 20, 2);
push @nibbles, splice(@$arrayref, 18, 2);
push @nibbles, splice(@$arrayref, 16, 2);
push @nibbles, splice(@$arrayref, 14, 2);
push @nibbles, splice(@$arrayref, 12, 2);
push @nibbles, splice(@$arrayref, 10, 2);
push @nibbles, splice(@$arrayref, 8, 2);
push @nibbles, splice(@$arrayref, 6, 2);
push @nibbles, splice(@$arrayref, 4, 2);
push @nibbles, splice(@$arrayref, 2, 2);
push @nibbles, splice(@$arrayref, 0, 2);
}
else
{
(@nibbles) = splice(@$arrayref, 0, 24);
}
$val = join('', @nibbles);
return $val;
}
#----------------------------------------------------------------------
# Get a an unsigned integer value by grabbing items off the front of
# the array stopping when a non-digit char string is encountered.
#
# The argument for this function needs to be a reference to an array
# that contains single character strings and the array will get
# updated by shifting characters off the front of it
#----------------------------------------------------------------------
sub get_uint
{
my $arrayref = shift;
@$arrayref == 0 and return 0;
my $val = 0;
while ($$arrayref[0] =~ /[0-9]/)
{
$val = $val * 10 + int(shift(@$arrayref));
}
return $val;
}
#----------------------------------------------------------------------
# Check the first character in the array and if it matches the expected
# character, return that character, else return undef;
#
# The argument for this function needs to be a reference to an array
# that contains single character strings and the array will get
# updated by shifting characters off the front of it. If the expected
# character doesn't match, it won't touch the array. If the first
# character does match, it will shift it off and return it.
#----------------------------------------------------------------------
sub get_exptected_char
{
my $arrayref = shift;
my $expected_char = shift;
if ($expected_char eq $$arrayref[0])
{
return shift(@$arrayref);
}
return undef;
}
#----------------------------------------------------------------------
# Get a hex value by grabbing items off the front of the array and
# stopping when a non-hex char string is encountered.
#
# The argument for this function needs to be a reference to an array
# that contains single character strings and the array will get
# updated by shifting characters off the front of it (no leading # "0x")
#----------------------------------------------------------------------
sub get_hex
{
my $arrayref = shift;
my $my_swap = @_ ? shift : 0;
my $shift = 0;
my $val = 0;
while ($$arrayref[0] =~ /[0-9a-fA-F]/)
{
if ($my_swap)
{
my $byte = hex(shift(@$arrayref)) << 4 | hex(shift(@$arrayref));
$val |= $byte << $shift;
$shift += 8;
}
else
{
$val <<= 4;
$val |= hex(shift(@$arrayref));
}
}
return $val;
}
#----------------------------------------------------------------------
# Get an address value by grabbing items off the front of the array.
#
# The argument for this function needs to be a reference to an array
# that contains single character strings and the array will get
# updated by shifting characters off the front of it (no leading # "0x")
#----------------------------------------------------------------------
sub get_addr
{
get_hex(shift);
}
Update the handle many of the packets that our current LLDB debugserver handles. Also fixed a case where the packet wouldn't be dumped if it returned the unimplemented packet. llvm-svn: 132498
2011-06-03 06:21:38 +08:00
sub get_hex_string
{
my $arrayref = shift;
my $str = '';
while ($$arrayref[0] =~ /[0-9a-fA-F]/ and $$arrayref[1] =~ /[0-9a-fA-F]/)
{
my $hi_nibble = hex(shift(@$arrayref));
my $lo_nibble = hex(shift(@$arrayref));
my $byte = ($hi_nibble << 4) | $lo_nibble;
$str .= chr($byte);
}
return $str;
}
Added a perl script to disassemble, into human readable form, the GDB remote packet output from "log enable gdb-remote packets". This should help people track down and see what is going wrong more easily when you have log output that includes GDB remote packets. llvm-svn: 131713
2011-05-20 10:00:47 +08:00
sub dump_stop_reply_data
{
while ($#_ >= 0)
{
last unless ($_[0] ne '#');
my $key = '';
my $value = '';
if ($_[0] =~ /[0-9a-fA-F]/ && $_[1] =~ /[0-9a-fA-F]/)
{
my $reg_num = get8(\@_);
shift(@_); # Skip ':'
if (defined ($registers_aref) && $reg_num < @$registers_aref)
{
dump_register_value(1, \@_, $reg_num);
print "\n";
shift(@_); # Skip ';'
next;
}
$key = sprintf("reg %u", $reg_num);
}
my $char;
if (length($key) == 0)
{
while (1)
{
$char = shift(@_);
if (length($char) == 0 or $char eq ':' or $char eq '#') { last; }
$key .= $char;
}
}
while (1)
{
$char = shift(@_);
if (length($char) == 0 or $char eq ';' or $char eq '#') { last; }
$value .= $char;
}
printf("\t%*s = %s\n", $max_register_name_len, $key, $value);
}
}
#----------------------------------------------------------------------
# Dumps a Stop Reply Packet which happens in response to a step,
# continue, last signal, and probably a few other commands.
#----------------------------------------------------------------------
sub dump_stop_reply_packet
{
my $what = shift(@_);
if ($what eq 'S')
{
print 'signal ( 0x' . shift(@_) . shift(@_) . " )\n";
}
elsif ($what eq 'T')
{
print 'signal ( 0x' . shift(@_) . shift(@_) . " )\n";
dump_stop_reply_data (@_);
}
elsif ($what eq 'W')
{
print 'process_exited( ' . shift(@_) . shift(@_) . " )\n";
}
elsif ($what eq 'X')
{
print 'process_terminated( ' . shift(@_) . shift(@_) . " )\n";
}
elsif ($what eq 'O')
{
my $console_output = '';
my $num_hex8_bytes = @_/2;
for (1 .. $num_hex8_bytes)
{
$console_output .= sprintf("%c", get8(\@_))
}
print "program_console_output('$console_output')\n";
}
}
#----------------------------------------------------------------------
# '?' command
#----------------------------------------------------------------------
sub dump_last_signal_cmd
{
my $cmd = shift;
print 'last_signal (' . join('',@_) . ")\n";
}
sub dump_raw_command
{
my $cmd_aref = shift;
my $callback_ref;
$curr_cmd = $$cmd_aref[0];
$curr_cmd eq '_' and $curr_cmd .= $$cmd_aref[1];
$callback_ref = $cmd_callbacks{$curr_cmd};
if ($callback_ref)
{
&$callback_ref(@$cmd_aref);
}
else
{
# Strip the command byte for responses since we injected that above
dump_other_cmd(@$cmd_aref);
}
}
sub dump_standard_response
{
my $cmd_aref = shift;
Update the handle many of the packets that our current LLDB debugserver handles. Also fixed a case where the packet wouldn't be dumped if it returned the unimplemented packet. llvm-svn: 132498
2011-06-03 06:21:38 +08:00
my $cmd_len = scalar(@$cmd_aref);
if ($cmd_len == 0)
Added a perl script to disassemble, into human readable form, the GDB remote packet output from "log enable gdb-remote packets". This should help people track down and see what is going wrong more easily when you have log output that includes GDB remote packets. llvm-svn: 131713
2011-05-20 10:00:47 +08:00
{
Update the handle many of the packets that our current LLDB debugserver handles. Also fixed a case where the packet wouldn't be dumped if it returned the unimplemented packet. llvm-svn: 132498
2011-06-03 06:21:38 +08:00
print "$unimplemented_str\n";
Added a perl script to disassemble, into human readable form, the GDB remote packet output from "log enable gdb-remote packets". This should help people track down and see what is going wrong more easily when you have log output that includes GDB remote packets. llvm-svn: 131713
2011-05-20 10:00:47 +08:00
return 1;
}
my $response = join('', @$cmd_aref);
if ($response eq 'OK')
{
print "$success_str\n";
return 1;
}
Update the handle many of the packets that our current LLDB debugserver handles. Also fixed a case where the packet wouldn't be dumped if it returned the unimplemented packet. llvm-svn: 132498
2011-06-03 06:21:38 +08:00
if ($cmd_len == 3 and index($response, 'E') == 0)
Added a perl script to disassemble, into human readable form, the GDB remote packet output from "log enable gdb-remote packets". This should help people track down and see what is going wrong more easily when you have log output that includes GDB remote packets. llvm-svn: 131713
2011-05-20 10:00:47 +08:00
{
print "ERROR: " . substr($response, 1) . "\n";
return 1;
}
return 0;
}
sub dump_raw_response
{
my $cmd_aref = shift;
my $callback_ref;
$callback_ref = $rsp_callbacks{$curr_cmd};
if ($callback_ref)
{
&$callback_ref(@$cmd_aref);
}
else
{
dump_standard_response($cmd_aref) or dump_other_rsp(@$cmd_aref);
}
}
#----------------------------------------------------------------------
# Dumps any command and handles simple error checking on the responses
# for commands that are unsupported or OK.
#----------------------------------------------------------------------
sub dump_command
{
my $cmd_str = shift;
# Dump the original command string if verbose is on
if ($opt_v)
{
print "dump_command($cmd_str)\n ";
}
my @cmd_chars = extract_command($cmd_str);
my $is_cmd = 1;
my $cmd = $cmd_chars[0];
if ($cmd eq '$')
{
$is_cmd = 0; # Note that this is a reply
$cmd = $curr_cmd; # set the command byte appropriately
shift @cmd_chars; # remove the '$' from the cmd bytes
}
# Check for common responses across all commands and handle them
# if we can
if ( $is_cmd == 0 )
{
if (rsp_is_unsupported(@cmd_chars))
{
Update the handle many of the packets that our current LLDB debugserver handles. Also fixed a case where the packet wouldn't be dumped if it returned the unimplemented packet. llvm-svn: 132498
2011-06-03 06:21:38 +08:00
print "$unimplemented_str\n";
Added a perl script to disassemble, into human readable form, the GDB remote packet output from "log enable gdb-remote packets". This should help people track down and see what is going wrong more easily when you have log output that includes GDB remote packets. llvm-svn: 131713
2011-05-20 10:00:47 +08:00
return;
}
elsif (rsp_is_OK(@cmd_chars))
{
print "$success_str\n";
return;
}
# Strip the checksum information for responses
strip_checksum(\@cmd_chars);
}
my $callback_ref;
if ($is_cmd) {
$callback_ref = $cmd_callbacks{$cmd};
} else {
$callback_ref = $rsp_callbacks{$cmd};
}
if ($callback_ref)
{
&$callback_ref(@cmd_chars);
}
else
{
# Strip the command byte for responses since we injected that above
if ($is_cmd) {
dump_other_cmd(@cmd_chars);
} else {
dump_other_rsp(@cmd_chars);
}
}
}
#----------------------------------------------------------------------
# Process a gdbserver log line by looking for getpkt and putkpt and
# tossing any other lines.
#----------------------------------------------------------------------
sub process_log_line
{
my $line = shift;
#($opt_v and $opt_g) and print "# $line";
my $extract_cmd = 0;
if ($line =~ /getpkt /)
{
$extract_cmd = 1;
print "\n--> ";
}
elsif ($line =~ /putpkt /)
{
$extract_cmd = 1;
print "<-- ";
}
elsif ($line =~ /.*Sent: \[[0-9]+\.[0-9]+[:0-9]*\] (.*)/)
{
$opt_g and print "maintenance dump-packets command: $1\n";
my @raw_cmd_bytes = split(/ */, $1);
print "\n--> ";
dump_raw_command(\@raw_cmd_bytes);
process_log_line($2);
}
elsif ($line =~ /.*Recvd: \[[0-9]+\.[0-9]+[:0-9]*\] (.*)/)
{
$opt_g and print "maintenance dump-packets reply: $1\n";
my @raw_rsp_bytes = split(/ */, $1);
print "<-- ";
dump_raw_response(\@raw_rsp_bytes);
print "\n";
}
elsif ($line =~ /getpkt: (.*)/)
{
if ($1 =~ /\$([^#]+)#[0-9a-fA-F]{2}/)
{
$opt_g and print "command: $1\n";
my @raw_cmd_bytes = split(/ */, $1);
print "--> ";
dump_raw_command(\@raw_cmd_bytes);
}
elsif ($1 =~ /\+/)
{
#print "--> ACK\n";
}
elsif ($1 =~ /-/)
{
#print "--> NACK\n";
}
}
elsif ($line =~ /putpkt: (.*)/)
{
if ($1 =~ /\$([^#]+)#[0-9a-fA-F]{2}/)
{
$opt_g and print "response: $1\n";
my @raw_rsp_bytes = split(/ */, $1);
print "<-- ";
dump_raw_response(\@raw_rsp_bytes);
print "\n";
}
elsif ($1 =~ /\+/)
{
#print "<-- ACK\n";
}
elsif ($1 =~ /-/)
{
#print "<-- NACK\n";
}
}
elsif ($line =~ /send packet: (.*)/)
{
if ($1 =~ /\$([^#]+)#[0-9a-fA-F]{2}/)
{
$opt_g and print "command: $1\n";
my @raw_cmd_bytes = split(/ */, $1);
print "--> ";
dump_raw_command(\@raw_cmd_bytes);
}
elsif ($1 =~ /\+/)
{
#print "--> ACK\n";
}
elsif ($1 =~ /-/)
{
#print "--> NACK\n";
}
}
elsif ($line =~ /read packet: (.*)/)
{
Update the handle many of the packets that our current LLDB debugserver handles. Also fixed a case where the packet wouldn't be dumped if it returned the unimplemented packet. llvm-svn: 132498
2011-06-03 06:21:38 +08:00
if ($1 =~ /\$([^#]*)#[0-9a-fA-F]{2}/)
Added a perl script to disassemble, into human readable form, the GDB remote packet output from "log enable gdb-remote packets". This should help people track down and see what is going wrong more easily when you have log output that includes GDB remote packets. llvm-svn: 131713
2011-05-20 10:00:47 +08:00
{
$opt_g and print "response: $1\n";
my @raw_rsp_bytes = split(/ */, $1);
print "<-- ";
dump_raw_response(\@raw_rsp_bytes);
print "\n";
}
elsif ($1 =~ /\+/)
{
#print "<-- ACK\n";
}
elsif ($1 =~ /-/)
{
#print "<-- NACK\n";
}
}
elsif ($line =~ /Sending packet: \$([^#]+)#[0-9a-fA-F]{2}\.\.\.(.*)/)
{
$opt_g and print "command: $1\n";
my @raw_cmd_bytes = split(/ */, $1);
print "\n--> ";
dump_raw_command(\@raw_cmd_bytes);
process_log_line($2);
}
elsif ($line =~ /Packet received: (.*)/)
{
$opt_g and print "response: $1\n";
my @raw_rsp_bytes = split(/ */, $1);
print "<-- ";
dump_raw_response(\@raw_rsp_bytes);
print "\n";
}
if ($extract_cmd)
{
my $beg = index($line, '("') + 2;
my $end = rindex($line, '");');
dump_command(substr($line, $beg, $end - $beg));
}
}
our $line_num = 0;
while(<>)
{
$line_num++;
$opt_q or printf("# %5d: $_", $line_num);
process_log_line($_);
}