test-ProcessDebug.pl [plain text]
use strict;
use Cwd 'abs_path';
our $home = $ENV{HOME} || die "ERROR: Couldn't deduce your home directory...\n";
our @inc_paths = (
'./include',
);
my $inc_paths_added = 0;
foreach my $inc_path (@inc_paths)
{
if (-e $inc_path)
{
push (@INC, abs_path($inc_path));
$inc_paths_added++;
}
}
if ($inc_paths_added == 0)
{
die "Please compile the Release version of lldb\n";
}
require lldb;
use constant UINT32_MAX => 4294967295;
our %commands = (
break => {
name => 'break', description => "Sets a breakpoint.",
usage => ["break ADDR"],
function => \&command_set_breakpoint,
runs_target => 0,
},
delete => {
name => 'delete', description => "Deletes one or more breakpoints by ID.\
If no breakpoint IDs are given all breakpoints will be deleted.\
If one or more IDs are given, only those breakpoints will be deleted.",
usage => ["delete [ID1 ID2 ...]"],
function => \&command_clear_breakpoint,
runs_target => 0,
},
continue => {
name => 'continue', description => "Continues target execution.",
usage => ["continue [ADDR]"],
function => \&command_continue,
runs_target => 1
},
step => {
name => 'step', description => "Single steps one instruction.",
usage => ["step"],
function => \&command_step,
runs_target => 1
},
info => {
name => 'info', description => "Gets info on a variety of things.",
usage => ["info reg", "info thread", "info threads"],
function => \&command_info,
runs_target => 0
},
help => {
name => 'help', description => "Displays a list of all commands, or help for a specific command.",
usage => ["help", "help CMD"],
function => \&command_help,
runs_target => 0
}
);
our %aliases = (
b => $commands{break},
c => $commands{continue},
s => $commands{step},
d => $commands{delete},
h => $commands{help}
);
our $opt_g = 0; our $opt_v = 0; my $prev_command_href = undef;
my $stdio = '/dev/stdin';
my $launch = 0;
my @env = ();
my @break_ids;
sub get_command_hash_ref
{
my $cmd = shift;
my $cmd_href = undef;
if (length($cmd) == 0) { $cmd_href = $prev_command_href; }
elsif (exists $aliases{$cmd}) { $cmd_href = $aliases{$cmd}; }
elsif (exists $commands{$cmd}) { $cmd_href = $commands{$cmd}; }
defined $cmd_href and $prev_command_href = $cmd_href;
return $cmd_href;
}
sub command_set_breakpoint
{
my $pid = shift;
my $tid = shift;
$opt_g and print "command_set_breakpoint (pid = $pid, locations = @_)\n";
foreach my $location (@_)
{
my $success = 0;
my $address = hex($location);
if ($address != 0)
{
my $break_id = lldb::PDBreakpointSet ($pid, $address, 1, 0);
if ($break_id != $lldb::PD_INVALID_BREAK_ID)
{
printf("Breakpoint %i is set.\n", $break_id);
push(@break_ids, $break_id);
$success = 1;
}
}
$success or print("error: failed to set breakpoint at $location.\n");
}
return 1;
}
sub command_clear_breakpoint
{
my $pid = shift;
my $tid = shift;
if (@_)
{
my $break_id;
my @cleared_break_ids;
my @new_break_ids;
$opt_g and print "command_clear_breakpoint (pid = $pid, break_ids = @_)\n";
foreach $break_id (@_)
{
if (lldb::PDBreakpointClear ($pid, $break_id))
{
printf("Breakpoint %i has been cleared.\n", $break_id);
push (@cleared_break_ids, $break_id);
}
else
{
printf("error: failed to clear breakpoint %i.\n", $break_id);
}
}
foreach my $old_break_id (@break_ids)
{
my $found_break_id = 0;
foreach $break_id (@cleared_break_ids)
{
if ($old_break_id == $break_id)
{
$found_break_id = 1;
}
}
$found_break_id or push (@new_break_ids, $old_break_id);
}
@break_ids = @new_break_ids;
}
else
{
return command_clear_breakpoint($pid, $tid, @break_ids);
}
return 1;
}
sub command_continue
{
my $pid = shift;
my $tid = shift;
$opt_g and print "command_continue (pid = $pid)\n";
if ($pid != $lldb::PD_INVALID_PROCESS_ID)
{
$opt_v and printf("Resuming pid %d...\n", $pid);
return lldb::PDProcessResume ($pid);
}
return 0;
}
sub command_step
{
my $pid = shift;
my $tid = shift;
$opt_g and print "command_step (pid = $pid, tid = $tid)\n";
if ($pid != $lldb::PD_INVALID_PROCESS_ID)
{
$opt_v and printf("Single stepping pid %d tid = %4.4x...\n", $pid, $tid);
return lldb::PDThreadResume ($pid, $tid, 1);
}
return 0;
}
sub command_info
{
my $pid = shift;
my $tid = shift;
$opt_g and print "command_step (pid = $pid, tid = $tid)\n";
if ($pid != $lldb::PD_INVALID_PROCESS_ID)
{
if (@_)
{
my $info_cmd = shift;
if ($info_cmd eq 'reg')
{
}
elsif ($info_cmd eq 'thread')
{
printf("thread 0x%4.4x %s\n", $tid, lldb::PDThreadGetInfo($pid, $tid));
}
elsif ($info_cmd eq 'threads')
{
my $num_threads = lldb::PDProcessGetNumThreads( $pid );
for my $thread_num (1..$num_threads)
{
my $curr_tid = lldb::PDProcessGetThreadAtIndex ( $pid, $thread_num - 1 );
printf("%c%u - thread 0x%4.4x %s\n", $curr_tid == $tid ? '*' : ' ', $thread_num, $curr_tid, lldb::PDThreadGetInfo($pid, $curr_tid));
}
}
}
}
return 1;
}
sub command_help
{
my $pid = shift;
my $tid = shift;
if (@_)
{
$opt_g and print "command_continue (pid = $pid, commands = @_)\n";
foreach my $cmd (@_)
{
my $cmd_href = get_command_hash_ref($cmd);
if ($cmd_href)
{
print '#', '-' x 72, "\n# $cmd_href->{name}\n", '#', '-' x 72, "\n";
my $usage_aref = $cmd_href->{usage};
if (@{$usage_aref})
{
print " USAGE\n";
foreach my $usage (@{$usage_aref}) {
print " $usage\n";
}
print "\n";
}
print " DESCRIPTION\n $cmd_href->{description}\n\n";
}
else
{
print " invalid command: '$cmd'\n\n";
}
}
}
else
{
return command_help($pid, sort keys %commands);
}
return 1;
}
print "running: ", join(' ', @ARGV), "\n";
my $pid = lldb::PDProcessLaunch ($ARGV[0], \@ARGV, \@env, "i386", '/dev/stdin', '/dev/stdout', '/dev/stderr', $launch, '', 0);
my $pid_state;
while ($pid)
{
$opt_g and printf("PDProcessWaitForEvents (%d, 0x%4.4x, SET, 1)\n", $pid, $lldb::PD_ALL_EVENTS);
my $events = lldb::PDProcessWaitForEvents ($pid, $lldb::PD_ALL_EVENTS, 1, 1);
if ($events)
{
$opt_g and printf ("Got event: 0x%8.8x\n", $events);
if ($events & $lldb::PD_EVENT_IMAGES_CHANGED)
{
$opt_g and printf("pid %d images changed...\n", $pid);
}
if ($events & $lldb::PD_EVENT_STDIO)
{
$opt_g and printf("pid %d has stdio...\n", $pid);
}
if ($events & $lldb::PD_EVENT_ASYNC_INTERRUPT)
{
$opt_g and printf("pid %d got async interrupt...\n", $pid);
}
if ($events & $lldb::PD_EVENT_RUNNING)
{
$pid_state = lldb::PDProcessGetState ($pid);
$opt_v and printf( "pid %d state: %s.\n", $pid, lldb::PDStateAsString ($pid_state) );
}
if ($events & $lldb::PD_EVENT_STOPPED)
{
$pid_state = lldb::PDProcessGetState ($pid);
$opt_v and printf( "pid %d state: %s.\n", $pid, lldb::PDStateAsString ($pid_state) );
if ($pid_state == $lldb::eStateUnloaded ||
$pid_state == $lldb::eStateAttaching ||
$pid_state == $lldb::eStateLaunching )
{
}
elsif ( $pid_state == $lldb::eStateStopped )
{
my $tid = lldb::PDProcessGetSelectedThread ( $pid );
my $pc = lldb::PDThreadGetRegisterHexValueByName($pid, $tid, $lldb::PD_REGISTER_SET_ALL, "eip", 0);
$pc != 0 and printf("pc = 0x%8.8x ", $pc);
my $done = 0;
my $input;
while (!$done)
{
print '(pdbg) ';
chomp($input = <STDIN>);
my @argv = split(/\s+/, $input);
my $cmd = @argv ? shift @argv : undef;
my $cmd_href = get_command_hash_ref ($cmd);
if ($cmd_href)
{
if ($opt_v and $cmd_href->{name} ne $cmd)
{
print "$cmd_href->{name} @argv\n";
}
if ($cmd_href->{function}($pid, $tid, @argv))
{
$done = $cmd_href->{runs_target};
}
}
else
{
print "invalid command: '$cmd'\nType 'help' for a list of all commands.\nType 'help CMD' for help on a specific commmand.\n";
}
}
}
elsif ( $pid_state == $lldb::eStateRunning ||
$pid_state == $lldb::eStateStepping )
{
}
elsif ( $pid_state == $lldb::eStateCrashed ||
$pid_state == $lldb::eStateDetached ||
$pid_state == $lldb::eStateExited )
{
$pid = 0;
}
elsif ( $pid_state == $lldb::eStateSuspended )
{
}
else
{
}
}
if ($pid)
{
$opt_g and printf("PDProcessResetEvents(%d, 0x%8.8x)\n", $pid, $events);
lldb::PDProcessResetEvents($pid, $events);
}
}
}
if ($pid != $lldb::PD_INVALID_PROCESS_ID)
{
lldb::PDProcessDetach ($pid);
}