GitHub/pbot
3
0
Fork 0
mirror of https://github.com/pragma-/pbot.git synced 2024-11-29 23:39:24 +01:00
Code Issues Projects Releases Wiki Activity

compiler_vm: rewrote watchdog to execute within gdb; added dump(), ptype(), watch() macros

Browse Source
This commit is contained in:
Pragmatic Software 2012-01-28 07:39:13 +00:00
parent 2830147338
commit 84f2f979a6
5 changed files with 159 additions and 206 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
PBot/VERSION.pm
View File

@ -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 => 350, BUILD_REVISION => 351,
BUILD_DATE => "2012-01-23", BUILD_DATE => "2012-01-27",
}; };
1; 1;

9
modules/compiler_vm/compiler_server.pl
View File

@ -40,7 +40,7 @@ sub vm_start {
if($pid == 0) { if($pid == 0) {
#system('cp /home/compiler/compiler-saved-vm-backup /home/compiler/compiler-saved-vm'); #system('cp /home/compiler/compiler-saved-vm-backup /home/compiler/compiler-saved-vm');
my $command = 'qemu-system-x86_64 -M pc -net none -hda /home/compiler/compiler-saved-vm -m 128 -monitor tcp:127.0.0.1:4445,server,nowait -serial tcp:127.0.0.1:4444,server,nowait -enable-kvm -boot c -nographic -loadvm 1'; my $command = 'nice -n -20 qemu-system-x86_64 -M pc -net none -hda /home/compiler/compiler-saved-vm-2 -m 76 -monitor tcp:127.0.0.1:3335,server,nowait -serial tcp:127.0.0.1:3333,server,nowait -enable-kvm -boot c -loadvm 1 -nographic';
my @command_list = split / /, $command; my @command_list = split / /, $command;
exec(@command_list); exec(@command_list);
} else { } else {
@ -51,14 +51,16 @@ sub vm_start {
sub vm_reset { sub vm_reset {
use IO::Socket; use IO::Socket;
print "Resetting vm\n";
my $sock = IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => 4445, Prot => 'tcp'); my $sock = IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => 4445, Prot => 'tcp');
if(not defined $sock) { if(not defined $sock) {
print "Unable to connect to monitor: $!\n"; print "[vm_reset] Unable to connect to monitor: $!\n";
return; return;
} }
print $sock "loadvm 1\n"; print $sock "loadvm 1\n";
close $sock; close $sock;
print "Resetted vm\n";
} }
sub execute { sub execute {
@ -135,7 +137,7 @@ sub compiler_server {
my $tnick = quotemeta($nick); my $tnick = quotemeta($nick);
my $tlang = quotemeta($lang); my $tlang = quotemeta($lang);
my ($ret, $result) = execute("./compiler_vm_client.pl $tnick -lang=$tlang $code"); my ($ret, $result) = execute("./compiler_vm_client-2.pl $tnick -lang=$tlang $code");
if(not defined $ret) { if(not defined $ret) {
print "parent continued\n"; print "parent continued\n";
@ -172,7 +174,6 @@ sub compiler_server {
alarm 0; alarm 0;
close $client; close $client;
print "stopping vm $vm_pid\n"; print "stopping vm $vm_pid\n";
vm_stop $vm_pid; vm_stop $vm_pid;
$vm_pid = vm_start; $vm_pid = vm_start;

38
modules/compiler_vm/compiler_vm_client.pl
View File

@ -12,23 +12,21 @@ use LWP::UserAgent;
my $debug = 0; my $debug = 0;
my $USE_LOCAL = defined $ENV{'CC_LOCAL'}; my $USE_LOCAL = defined $ENV{'CC_LOCAL'};
my $MAX_UNDO_HISTORY = 100; my $MAX_UNDO_HISTORY = 1000000;
my $output = ""; my $output = "";
my $nooutput = 'No output.'; my $nooutput = 'No output.';
my %languages = ( my %languages = (
'C99' => "std=C99 with pedantic warnings", 'C11' => "gcc -std=c11 -pedantic -Wall -Wextra (default)",
'C' => "std=gnu89", 'C99' => "gcc -std=c99 -pedantic -Wall -Wextra",
'CLANG' => "std=gnu89 clang/llvm", 'C89' => "gcc -std=c89 -pedantic -Wall -Wextra",
'CLANG99' => "std=c99 clang/llvm with pedantic warnings",
# 'C++' => 1,
); );
my %preludes = ( my %preludes = (
'C99' => "#include <stdio.h>\n#include <stdlib.h>\n#include <string.h>\n#include <unistd.h>\n#include <math.h>\n#include <limits.h>\n#include <sys/types.h>\n#include <stdint.h>\n#include <stdbool.h>\n#include \"prelude.h\"\n\n", 'C99' => "#include <stdio.h>\n#include <stdlib.h>\n#include <string.h>\n#include <unistd.h>\n#include <math.h>\n#include <limits.h>\n#include <sys/types.h>\n#include <stdint.h>\n#include <stdbool.h>\n#include <stddef.h>\n#include <stdarg.h>\n#include <ctype.h>\n#include <inttypes.h>\n#include <float.h>\n#include <errno.h>\n#include <prelude.h>\n\n",
'C' => "#include <stdio.h>\n#include <stdlib.h>\n#include <string.h>\n#include <unistd.h>\n#include <math.h>\n#include <limits.h>\n#include <sys/types.h>\n#include <stdint.h>\n\n", 'C11' => "#include <stdio.h>\n#include <stdlib.h>\n#include <string.h>\n#include <unistd.h>\n#include <math.h>\n#include <limits.h>\n#include <sys/types.h>\n#include <stdint.h>\n#include <stdbool.h>\n#include <stddef.h>\n#include <stdarg.h>\n#include <stdnoreturn.h>\n#include <stdalign.h>\n#include <ctype.h>\n#include <inttypes.h>\n#include <float.h>\n#include <errno.h>\n#include <prelude.h>\n\n",
'C++' => "#include <iostream>\n#include <cstdio>\n\nusing namespace std;\n\n", 'C' => "#include <stdio.h>\n#include <stdlib.h>\n#include <string.h>\n#include <unistd.h>\n#include <math.h>\n#include <limits.h>\n#include <sys/types.h>\n#include <stdint.h>\n#include <errno.h>\n#include <ctype.h>\n#include <prelude.h>\n\n",
); );
sub pretty { sub pretty {
@ -75,7 +73,7 @@ sub compile {
$pid = open2($compiler_output, $compiler, './compiler_vm_server.pl') || die "repl failed: $@\n"; $pid = open2($compiler_output, $compiler, './compiler_vm_server.pl') || die "repl failed: $@\n";
print "Started compiler, pid: $pid\n"; print "Started compiler, pid: $pid\n";
} else { } else {
$compiler = IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => '4444', Proto => 'tcp', Type => SOCK_STREAM); $compiler = IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => '3333', Proto => 'tcp', Type => SOCK_STREAM);
die "Could not create socket: $!" unless $compiler; die "Could not create socket: $!" unless $compiler;
$compiler_output = $compiler; $compiler_output = $compiler;
} }
@ -121,9 +119,8 @@ my @last_code;
print " code: [$code]\n" if $debug; print " code: [$code]\n" if $debug;
my $lang = "C99"; my $lang = "C11";
$lang = $1 if $code =~ s/-lang=([^\b\s]+)//i; $lang = uc $1 if $code =~ s/-lang=([^\b\s]+)//i;
$lang = "C" if $code =~ s/-nowarn[ings]*//i;
my $input = ""; my $input = "";
$input = $1 if $code =~ s/-input=(.*)$//i; $input = $1 if $code =~ s/-input=(.*)$//i;
@ -539,8 +536,7 @@ if($code =~ m/^\s*(run|paste)\s*$/i) {
} }
# check to see if -flags were added by replacements # check to see if -flags were added by replacements
$lang = $1 if $code =~ s/-lang=([^\b\s]+)//i; $lang = uc $1 if $code =~ s/-lang=([^\b\s]+)//i;
$lang = "C" if $code =~ s/-nowarn[ings]*//i;
$input = $1 if $code =~ s/-input=(.*)$//i; $input = $1 if $code =~ s/-input=(.*)$//i;
$args .= "$1 " while $code =~ s/^\s*(-[^ ]+)\s*//; $args .= "$1 " while $code =~ s/^\s*(-[^ ]+)\s*//;
$args =~ s/\s+$//; $args =~ s/\s+$//;
@ -578,7 +574,7 @@ if($code =~ m/#include/) {
} }
$code = ''; $code = '';
if($lang eq 'C' or $lang eq 'C99' or $lang eq 'C++') { if($lang eq 'C' or $lang eq 'C99' or $lang eq 'C11' or $lang eq 'C++') {
my $has_main = 0; my $has_main = 0;
my $prelude = ''; my $prelude = '';
@ -679,6 +675,7 @@ $output = compile($lang, pretty($code), $args, $input, $USE_LOCAL);
if($output =~ m/^\s*$/) { if($output =~ m/^\s*$/) {
$output = $nooutput $output = $nooutput
} else { } else {
print FILE "\n$output\n";
$output =~ s/cc1: warnings being treated as errors//; $output =~ s/cc1: warnings being treated as errors//;
$output =~ s/ Line \d+ ://g; $output =~ s/ Line \d+ ://g;
$output =~ s/ \(first use in this function\)//g; $output =~ s/ \(first use in this function\)//g;
@ -697,7 +694,14 @@ if($output =~ m/^\s*$/) {
$output =~ s/$left_quote/'/g; $output =~ s/$left_quote/'/g;
$output =~ s/$right_quote/'/g; $output =~ s/$right_quote/'/g;
$output =~ s/\s*In function 'main':\s*//g; $output =~ s/\s*In function 'main':\s*//g;
$output =~ s/warning: unknown conversion type character 'b' in format\s+warning: too many arguments for format/info: conversion type character 'b' in format is a candide extension/g; $output =~ s/warning: unknown conversion type character 'b' in format \[-Wformat\]\s+warning: too many arguments for format \[-Wformat-extra-args\]/info: conversion type character 'b' in format is a candide extension/g;
$output =~ s/warning: unknown conversion type character 'b' in format \[-Wformat\]//g;
$output =~ s/\s\(core dumped\)/./;
$output =~ s/\[\s+/[/g;
$output =~ s/ \[enabled by default\]//g;
$output =~ s/initializer\s+warning: \(near/initializer (near/g;
$output =~ s/note: each undeclared identifier is reported only once for each function it appears in//g;
$output =~ s/\(gdb\)//g;
#$output =~ s/[\r\n]+/ /g; #$output =~ s/[\r\n]+/ /g;
#$output =~ s/\s+/ /g; #$output =~ s/\s+/ /g;

264
modules/compiler_vm/compiler_watchdog.pl
View File

@ -3,98 +3,101 @@
use warnings; use warnings;
use strict; use strict;
use POSIX ":sys_wait_h";
use IPC::Open2; use IPC::Open2;
my @signame; my $stdin_input = join ' ', @ARGV;
$signame[0] = 'SIGZERO';
$signame[1] = 'SIGHUP';
$signame[2] = 'SIGINT';
$signame[3] = 'SIGQUIT';
$signame[4] = 'SIGILL';
$signame[5] = 'SIGTRAP';
$signame[6] = 'SIGABRT';
$signame[7] = 'SIGBUS';
$signame[8] = 'SIGFPE';
$signame[9] = 'SIGKILL';
$signame[10] = 'SIGUSR1';
$signame[11] = 'SIGSEGV';
$signame[12] = 'SIGUSR2';
$signame[13] = 'SIGPIPE';
$signame[14] = 'SIGALRM';
$signame[15] = 'SIGTERM';
$signame[16] = 'SIGSTKFLT';
$signame[17] = 'SIGCHLD';
$signame[18] = 'SIGCONT';
$signame[19] = 'SIGSTOP';
$signame[20] = 'SIGTSTP';
$signame[21] = 'SIGTTIN';
$signame[22] = 'SIGTTOU';
$signame[23] = 'SIGURG';
$signame[24] = 'SIGXCPU';
$signame[25] = 'SIGXFSZ';
$signame[26] = 'SIGVTALRM';
$signame[27] = 'SIGPROF';
$signame[28] = 'SIGWINCH';
$signame[29] = 'SIGIO';
$signame[30] = 'SIGPWR';
$signame[31] = 'SIGSYS';
$signame[32] = 'SIGNUM32';
$signame[33] = 'SIGNUM33';
$signame[34] = 'SIGRTMIN';
$signame[35] = 'SIGNUM35';
$signame[36] = 'SIGNUM36';
$signame[37] = 'SIGNUM37';
$signame[38] = 'SIGNUM38';
$signame[39] = 'SIGNUM39';
$signame[40] = 'SIGNUM40';
$signame[41] = 'SIGNUM41';
$signame[42] = 'SIGNUM42';
$signame[43] = 'SIGNUM43';
$signame[44] = 'SIGNUM44';
$signame[45] = 'SIGNUM45';
$signame[46] = 'SIGNUM46';
$signame[47] = 'SIGNUM47';
$signame[48] = 'SIGNUM48';
$signame[49] = 'SIGNUM49';
$signame[50] = 'SIGNUM50';
$signame[51] = 'SIGNUM51';
$signame[52] = 'SIGNUM52';
$signame[53] = 'SIGNUM53';
$signame[54] = 'SIGNUM54';
$signame[55] = 'SIGNUM55';
$signame[56] = 'SIGNUM56';
$signame[57] = 'SIGNUM57';
$signame[58] = 'SIGNUM58';
$signame[59] = 'SIGNUM59';
$signame[60] = 'SIGNUM60';
$signame[61] = 'SIGNUM61';
$signame[62] = 'SIGNUM62';
$signame[63] = 'SIGNUM63';
$signame[64] = 'SIGRTMAX';
$signame[65] = 'SIGIOT';
$signame[66] = 'SIGCLD';
$signame[67] = 'SIGPOLL';
$signame[68] = 'SIGUNUSED';
sub debug_program { sub execute {
my ($input, $output); my ($cmdline) = @_;
my ($ret, $result);
my $pid = open2($output, $input, 'gdb -silent -batch -x debugcommands ./prog ./core 2>/dev/null'); my ($out, $in);
open2($out, $in, "$cmdline 2>&1");
if(not $pid) { #print $in "$stdin_input\n";
print "Error debugging program.\n"; while(my $line = <$out>) {
exit; chomp $line;
#print "got: [$line]\n";
if($line =~ m/^Reading symbols from.*done\.$/) {
print $in "break gdb\n";
print $in "run\n";
next;
} }
my $result = ""; if($line =~ m/Breakpoint \d+, gdb/) {
print $in "up\n";
next;
}
while(my $line = <$output>) { if($line =~ m/^\d+\s+watch\((.*)\)/) {
if($line =~ s/^#\d+//) { $line = "1 gdb(\"watch $1\");";
next if $line =~ /\?\?/; }
if($line =~ m/^\d+\s+dump\((.*)\)/) {
$line = "1 gdb(\"print $1\");";
}
if($line =~ m/^\d+\s+ptype\((.*)\)/) {
$line = "1 gdb(\"ptype $1\");";
}
if($line =~ m/^\d+\s+gdb\("(.*)"\);/) {
my $command = $1;
print $in "$command\n";
my ($cmd, $args) = split / /, $command, 2;
$args = "" if not defined $args;
my $next_line = <$out>;
chomp $next_line;
$next_line =~ s/^\(gdb\)\s+\$\d+//;
$next_line =~ s/^\(gdb\)\s+type//;
print "$args$next_line\n" if $next_line =~ m/=/;
print $in "cont\n";
next;
}
if($line =~ m/^Hardware watchpoint \d+: (.*)/) {
my $var = $1;
my $ignore = <$out>;
my $old = <$out>;
my $new = <$out>;
$ignore = <$out>;
$ignore = <$out>;
my ($val1) = $old =~ m/Old value = (.*)/;
my ($val2) = $new =~ m/New value = (.*)/;
print "<$var changed: $val1 => $val2>\n";
print $in "cont\n";
next;
}
if($line =~ m/^Watchpoint \d+ deleted/) {
my $ignore = <$out>;
$ignore = <$out>;
print $in "cont\n";
next;
}
if($line =~ m/^Program exited/) {
exit 0;
}
if($line =~ m/Program received signal/) {
my $result = "";
my $vars = "";
my $varsep = "";
$line =~ s/\.$//;
print "$line ";
print $in "up\nup\nup\nup\nup\nup\nup\ninfo locals\nquit\ny\n";
while(my $line = <$out>) {
chomp $line;
#print "got: [$line]\n";
if($line =~ s/^0x[0-9A-Fa-f]+\s//) {
next if $line =~ /in main\s*\(/; next if $line =~ /in main\s*\(/;
$line =~ s/\s*0x[0-9a-fA-F]+\s*//;
$line =~ s/\s+at .*:\d+//; $line =~ s/\s+at .*:\d+//;
if($line !~ m/^\s*in\s+/) { if($line !~ m/^\s*in\s+/) {
@ -103,95 +106,38 @@ sub debug_program {
$result .= "$line at "; $result .= "$line at ";
} }
} }
elsif($line =~ s/^\d+//) { elsif($line =~ s/^\d+\s+//) {
next if $line =~ /No such file/; next if $line =~ /No such file/;
$result .= "at " if not length $result; $result .= "at " if not length $result;
$result .= "statement: $line"; $result .= "statement: $line";
last; }
elsif($line =~ m/([^=]+)=\s+(.*)/) {
$vars .= "$varsep$1= $2";
$varsep = "; ";
} }
} }
close $output;
close $input;
waitpid($pid, 0);
$result =~ s/^\s+//; $result =~ s/^\s+//;
$result =~ s/\s+$//; $result =~ s/\s+$//;
print "$result\n";
exit;
}
sub reaper { $vars =~ s/\(gdb\)\s*//g;
my $child; $vars = " [local variables: $vars]" if length $vars;
while (($child=waitpid(-1,WNOHANG))>0) {
# See waitpid(2) and POSIX(3perl) print "$result$vars\n";
my $status = $?;
my $exitcode = $status >> 8;
my $wifexited = WIFEXITED($status);
my $wexitstatus = $wifexited ? WEXITSTATUS($status) : undef;
my $wifsignaled = WIFSIGNALED($status);
my $wtermsig = $wifsignaled ? WTERMSIG($status) : undef;
my $wifstopped = WIFSTOPPED($status);
my $wstopsig = $wifstopped ? WSTOPSIG($status) : undef;
if($wifsignaled == 1) {
print "\nProgram received signal $wtermsig ($signame[$wtermsig])\n";
debug_program if $wtermsig != 0;
exit;
}
if(($wifexited == 1) && ($exitcode != 0)) {
print "\nExit: $exitcode\n";
exit;
} elsif(($wifexited ==1) && ($exitcode == 0)) {
exit;
}
else {
print ""
." status=$status exitcode=$exitcode"
." wifexited=$wifexited"
." wexitstatus=".(defined($wexitstatus) ? $wexitstatus : "
+undef")
." wifsignaled=$wifsignaled"
." wtermsig=".(defined($wtermsig) ? $wtermsig : "undef")
." wifstopped=$wifstopped"
." wstopsig=".(defined($wstopsig) ? $wstopsig : "undef")
."\n";
exit;
}
}
}
my $stdin_input = join ' ', @ARGV;
sub execute {
my ($cmdline) = @_;
my ($ret, $result);
local $SIG{CHLD} = \&reaper;
my $child = fork;
local $SIG{TERM} = sub { kill 'TERM', $child; };
if($child == 0) {
if(length $stdin_input) {
my ($out, $in);
open2($out, $in, "$cmdline 2>&1");
print $in "$stdin_input\n";
while(<$out>) {
print $_ . "\n";
}
exit 0; exit 0;
} else {
exec("$cmdline 2>&1");
} }
} else {
while(1) { sleep 10; } if($line =~ m/^\(gdb\)/) {
next;
}
next if $line =~ m/^\d+\s+void gdb\(\) {}/;
next if not length $line;
print "$line\n";
} }
} }
execute("./prog"); execute("gdb -silent ./prog");

8
modules/compiler_vm/prelude.h
View File

@ -1,4 +1,3 @@
#if 1
#include <limits.h> #include <limits.h>
#include <wchar.h> #include <wchar.h>
#include <stdio.h> #include <stdio.h>
@ -87,7 +86,10 @@ __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() {}
#define dump(var) gdb("print " #var)
#define ptype(var) gdb("ptype " #var)
#define watch(var) gdb("watch " #var)