| #!/usr/bin/perl |
| |
| 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; |
| |
| # my $state = lldb::eStateAttaching; |
| |
| use constant UINT32_MAX => 4294967295; |
| |
| #---------------------------------------------------------------------- |
| # Interactive Commands |
| #---------------------------------------------------------------------- |
| our %commands = ( |
| break => { |
| name => 'break', # in case an alias is used to get to this command |
| description => "Sets a breakpoint.", |
| usage => ["break ADDR"], |
| function => \&command_set_breakpoint, |
| runs_target => 0, |
| }, |
| delete => { |
| name => 'delete', # in case an alias is used to get to this command |
| 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', # in case an alias is used to get to this command |
| description => "Continues target execution.", |
| usage => ["continue [ADDR]"], |
| function => \&command_continue, |
| runs_target => 1 |
| }, |
| step => { |
| name => 'step', # in case an alias is used to get to this command |
| description => "Single steps one instruction.", |
| usage => ["step"], |
| function => \&command_step, |
| runs_target => 1 |
| }, |
| info => { |
| name => 'info', # in case an alias is used to get to this command |
| description => "Gets info on a variety of things.", |
| usage => ["info reg", "info thread", "info threads"], |
| function => \&command_info, |
| runs_target => 0 |
| }, |
| help => { |
| name => 'help', # in case an alias is used to get to this command |
| description => "Displays a list of all commands, or help for a specific command.", |
| usage => ["help", "help CMD"], |
| function => \&command_help, |
| runs_target => 0 |
| } |
| ); |
| |
| #---------------------------------------------------------------------- |
| # Command aliases |
| #---------------------------------------------------------------------- |
| our %aliases = ( |
| b => $commands{break}, |
| c => $commands{continue}, |
| s => $commands{step}, |
| d => $commands{delete}, |
| h => $commands{help} |
| ); |
| |
| our $opt_g = 0; # Enable verbose debug logging |
| our $opt_v = 0; # Verbose mode |
| my $prev_command_href = undef; |
| my $stdio = '/dev/stdin'; |
| my $launch = 0; |
| my @env = (); |
| my @break_ids; |
| |
| #---------------------------------------------------------------------- |
| # Given a command string, return the command hash reference for it, or |
| # undef if it doesn't exist. |
| #---------------------------------------------------------------------- |
| 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; |
| } |
| |
| #---------------------------------------------------------------------- |
| # Set a breakpoint |
| #---------------------------------------------------------------------- |
| 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; |
| } |
| |
| #---------------------------------------------------------------------- |
| # Clear a breakpoint |
| #---------------------------------------------------------------------- |
| 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 |
| { |
| # Nothing specified, clear all breakpoints |
| return command_clear_breakpoint($pid, $tid, @break_ids); |
| } |
| return 1; |
| } |
| #---------------------------------------------------------------------- |
| # Continue program execution |
| #---------------------------------------------------------------------- |
| 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') |
| { |
| # info on the current 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; |
| } |
| #---------------------------------------------------------------------- |
| # Get help on all commands, or a specific list of commands |
| #---------------------------------------------------------------------- |
| 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; |
| } |
| |
| |
| #lldb::PDLogSetLogMask ($lldb::PD_LOG_ALL); |
| #lldb::PDLogSetLogFile ('/dev/stdout'); |
| |
| 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::PDProcessGetCurrentThread ( $pid ); |
| my $pc = lldb::PDThreadGetRegisterHexValueByName($pid, $tid, $lldb::PD_REGISTER_SET_ALL, "eip", 0); |
| $pc != 0 and printf("pc = 0x%8.8x ", $pc); |
| # my $sp = lldb::PDThreadGetRegisterHexValueByName($pid, $tid, $lldb::PD_REGISTER_SET_ALL, "esp", 0); |
| # $sp != 0 and printf("sp = 0x%8.8x ", $sp); |
| # my $fp = lldb::PDThreadGetRegisterHexValueByName($pid, $tid, $lldb::PD_REGISTER_SET_ALL, "ebp", 0); |
| # $sp != 0 and printf("fp = 0x%8.8x ", $fp); |
| # print "\n"; |
| 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) |
| { |
| # Print the expanded alias if one was used |
| if ($opt_v and $cmd_href->{name} ne $cmd) |
| { |
| print "$cmd_href->{name} @argv\n"; |
| } |
| |
| # Call the command's callback function to make things happen |
| 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); |
| } |