mirror of
https://github.com/pragma-/pbot.git
synced 2024-11-26 22:09:26 +01:00
compiler_vm: added trace() macro to trace function calls
This commit is contained in:
parent
e2e54079ae
commit
56bd0e9101
@ -13,8 +13,8 @@ use warnings;
|
|||||||
# These are set automatically by the build/commit script
|
# These are set automatically by the build/commit script
|
||||||
use constant {
|
use constant {
|
||||||
BUILD_NAME => "PBot",
|
BUILD_NAME => "PBot",
|
||||||
BUILD_REVISION => 355,
|
BUILD_REVISION => 356,
|
||||||
BUILD_DATE => "2012-02-02",
|
BUILD_DATE => "2012-02-03",
|
||||||
};
|
};
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
@ -7,7 +7,7 @@ use IPC::Open2;
|
|||||||
|
|
||||||
my $stdin_input = join ' ', @ARGV;
|
my $stdin_input = join ' ', @ARGV;
|
||||||
|
|
||||||
my $debug = 0;
|
my $debug = 5;
|
||||||
|
|
||||||
my $watching = 0;
|
my $watching = 0;
|
||||||
my $got_output = 0;
|
my $got_output = 0;
|
||||||
@ -27,11 +27,15 @@ sub execute {
|
|||||||
my $ignore_response = 0;
|
my $ignore_response = 0;
|
||||||
|
|
||||||
next if not length $line;
|
next if not length $line;
|
||||||
next if $line =~ m/^\(gdb\) No line \d+ in file/;
|
<$out> and next if $line =~ m/^\(gdb\) No line \d+ in/;
|
||||||
next if $line =~ m/^\(gdb\) Continuing/;
|
next if $line =~ m/^\(gdb\) Continuing/;
|
||||||
next if $line =~ m/^\(gdb\) \$\d+ = "Ok\."/;
|
next if $line =~ m/^\(gdb\) \$\d+ = "Ok\."/;
|
||||||
next if $line =~ m/^(\(gdb\) )?Breakpoint \d+ at 0x/;
|
next if $line =~ m/^(\(gdb\) )?Breakpoint \d+ at 0x/;
|
||||||
|
next if $line =~ m/^\(gdb\) Breakpoint \d+ at 0x/;
|
||||||
|
next if $line =~ m/^\(gdb\) Note: breakpoint \d+ also set/;
|
||||||
next if $line =~ m/^(\(gdb\) )?Starting program/;
|
next if $line =~ m/^(\(gdb\) )?Starting program/;
|
||||||
|
next if $line =~ m/PRETTY_FUNCTION__ =/;
|
||||||
|
next if $line =~ m/libc_start_main/;
|
||||||
|
|
||||||
if($line =~ m/^\d+: (.*? = .*)/) {
|
if($line =~ m/^\d+: (.*? = .*)/) {
|
||||||
print "<$1>\n";
|
print "<$1>\n";
|
||||||
@ -61,7 +65,7 @@ sub execute {
|
|||||||
} elsif($char eq '}') {
|
} elsif($char eq '}') {
|
||||||
$bracket--;
|
$bracket--;
|
||||||
|
|
||||||
if($bracket == 0) {
|
if($bracket == 0 and not $main_ended) {
|
||||||
$break = $line_number;
|
$break = $line_number;
|
||||||
$main_ended = 1;
|
$main_ended = 1;
|
||||||
last;
|
last;
|
||||||
@ -121,6 +125,7 @@ sub execute {
|
|||||||
next;
|
next;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
if($line =~ m/Breakpoint \d+, gdb/) {
|
if($line =~ m/Breakpoint \d+, gdb/) {
|
||||||
print $in "up\n";
|
print $in "up\n";
|
||||||
$line = <$out>;
|
$line = <$out>;
|
||||||
@ -130,6 +135,50 @@ sub execute {
|
|||||||
next;
|
next;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
if($line =~ m/^Breakpoint \d+, (.*?) at/) {
|
||||||
|
my $func = $1;
|
||||||
|
my $direction = "entered";
|
||||||
|
my $return_value = "";
|
||||||
|
my $nextline = <$out>;
|
||||||
|
|
||||||
|
print "got bt nextline: <$nextline>\n" if $debug >= 5;
|
||||||
|
|
||||||
|
if($nextline =~ m/^\d+\s+}$/) {
|
||||||
|
$direction = "leaving";
|
||||||
|
|
||||||
|
print $in "finish\n";
|
||||||
|
while(my $retval = <$out>) {
|
||||||
|
chomp $retval;
|
||||||
|
print "got retval line: <$retval>\n" if $debug >= 5;
|
||||||
|
if($retval =~ m/Value returned is \$\d+ = (.*)/) {
|
||||||
|
$return_value = ", returned $1";
|
||||||
|
last;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
my $indent = 0;
|
||||||
|
print $in "bt\n";
|
||||||
|
while(my $bt = <$out>) {
|
||||||
|
print "got bt: <$bt>\n" if $debug >= 5;
|
||||||
|
$bt =~ s/^\(gdb\) //;
|
||||||
|
if($bt =~ m/^#(\d+) .* main .* at prog/) {
|
||||||
|
$indent = $1;
|
||||||
|
last;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
$indent++ if $direction eq "leaving";
|
||||||
|
|
||||||
|
print "<$direction [$indent]", ' ' x $indent, "$func$return_value>\n";
|
||||||
|
print $in "cont\n";
|
||||||
|
next;
|
||||||
|
}
|
||||||
|
|
||||||
|
if($line =~ m/^\d+\s+.*\btrace\((.*)\)/) {
|
||||||
|
$line = "1 gdb(\"break $1\");";
|
||||||
|
}
|
||||||
|
|
||||||
if($line =~ m/^\d+\s+.*\bwatch\((.*)\)/) {
|
if($line =~ m/^\d+\s+.*\bwatch\((.*)\)/) {
|
||||||
$line = "1 gdb(\"watch $1\");";
|
$line = "1 gdb(\"watch $1\");";
|
||||||
}
|
}
|
||||||
@ -151,7 +200,44 @@ sub execute {
|
|||||||
my ($cmd, $args) = split / /, $command, 2;
|
my ($cmd, $args) = split / /, $command, 2;
|
||||||
$args = "" if not defined $args;
|
$args = "" if not defined $args;
|
||||||
|
|
||||||
#print "got command [$command]\n";
|
print "got command [$command]\n" if $debug >= 10;
|
||||||
|
|
||||||
|
if($cmd eq "break") {
|
||||||
|
$ignore_response = 1;
|
||||||
|
|
||||||
|
print $in "list $args,9001\n";
|
||||||
|
print $in "print \"Ok.\"\n";
|
||||||
|
my $break = 0;
|
||||||
|
my $bracket = 0;
|
||||||
|
my $func_ended = 0;
|
||||||
|
while(my $line = <$out>) {
|
||||||
|
chomp $line;
|
||||||
|
print "list break got: [$line]\n" if $debug >= 4;
|
||||||
|
if(not $func_ended and $line =~ m/^(\d+)\s+return(.*?);/) {
|
||||||
|
print "breaking at $1\n" if $debug >= 5;
|
||||||
|
print $in "break $1\n";
|
||||||
|
} else {
|
||||||
|
my ($line_number) = $line =~ m/^(\d+)/g;
|
||||||
|
while($line =~ m/(.)/g) {
|
||||||
|
my $char = $1;
|
||||||
|
if($char eq '{') {
|
||||||
|
$bracket++;
|
||||||
|
} elsif($char eq '}') {
|
||||||
|
$bracket--;
|
||||||
|
|
||||||
|
if($bracket == 0 and not $func_ended) {
|
||||||
|
print $in "break $line_number\n";
|
||||||
|
print "func ended, breaking at $line_number\n" if $debug >= 5;
|
||||||
|
$func_ended = 1;
|
||||||
|
last;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
last if $line =~ m/^\(gdb\) \$\d+ = "Ok."/;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
if($cmd eq "watch") {
|
if($cmd eq "watch") {
|
||||||
print $in "display $args\n";
|
print $in "display $args\n";
|
||||||
@ -276,10 +362,12 @@ sub execute {
|
|||||||
while(my $line = <$out>) {
|
while(my $line = <$out>) {
|
||||||
chomp $line;
|
chomp $line;
|
||||||
$line =~ s/^\(gdb\)\s+//;
|
$line =~ s/^\(gdb\)\s+//;
|
||||||
$line =~ s/main \(.*?\)/main ()/;
|
$line =~ s/main \(.*?\)/main ()/g;
|
||||||
|
|
||||||
print "signal got: [$line]\n" if $debug >= 5;
|
print "signal got: [$line]\n" if $debug >= 5;
|
||||||
|
|
||||||
|
next if $line =~ m/__PRETTY_FUNCTION__ =/;
|
||||||
|
|
||||||
if($line =~ s/^(#\d+\s+)?0x[0-9A-Fa-f]+\s//) {
|
if($line =~ s/^(#\d+\s+)?0x[0-9A-Fa-f]+\s//) {
|
||||||
$line =~ s/\s+at .*:\d+//;
|
$line =~ s/\s+at .*:\d+//;
|
||||||
$line =~ s/\s+from \/lib.*//;
|
$line =~ s/\s+from \/lib.*//;
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
#if 1
|
||||||
#include <limits.h>
|
#include <limits.h>
|
||||||
#include <wchar.h>
|
#include <wchar.h>
|
||||||
#include <stdio.h>
|
#include <stdio.h>
|
||||||
@ -86,10 +87,14 @@ __attribute__ (( constructor )) static void printf_binary_register(void)
|
|||||||
register_printf_specifier('b', printf_binary_handler, printf_binary_arginfo);
|
register_printf_specifier('b', printf_binary_handler, printf_binary_arginfo);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
#endif
|
||||||
|
|
||||||
#define STR(s) #s
|
#define STR(s) #s
|
||||||
#define REVEAL(s) STR(s)
|
#define REVEAL(s) STR(s)
|
||||||
|
|
||||||
void gdb() {}
|
void gdb() {}
|
||||||
#define dump(var) gdb("print " #var)
|
#define dump(expression) gdb("print " #expression)
|
||||||
#define ptype(var) gdb("ptype " #var)
|
#define print(expression) gdb("print " #expression)
|
||||||
#define watch(var) gdb("watch " #var)
|
#define ptype(expression) gdb("ptype " #expression)
|
||||||
|
#define trace(expression) gdb("break " #expression)
|
||||||
|
#define watch(expression) gdb("watch " #expression)
|
||||||
|
Loading…
Reference in New Issue
Block a user