mirror of
https://github.com/pragma-/pbot.git
synced 2024-11-26 05:49:27 +01:00
compiler_vm: rewrote watchdog to execute within gdb; added dump(), ptype(), watch() macros
This commit is contained in:
Pragmatic Software
parent
2830147338
commit
84f2f979a6
@ -13,8 +13,8 @@ use warnings;
|
||||
# These are set automatically by the build/commit script
|
||||
use constant {
|
||||
BUILD_NAME => "PBot",
|
||||
BUILD_REVISION => 350,
|
||||
BUILD_DATE => "2012-01-23",
|
||||
BUILD_REVISION => 351,
|
||||
BUILD_DATE => "2012-01-27",
|
||||
};
|
||||
|
||||
1;
|
||||
|
||||
@ -40,7 +40,7 @@ sub vm_start {
|
||||
|
||||
if($pid == 0) {
|
||||
#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;
|
||||
exec(@command_list);
|
||||
} else {
|
||||
@ -51,14 +51,16 @@ sub vm_start {
|
||||
sub vm_reset {
|
||||
use IO::Socket;
|
||||
|
||||
print "Resetting vm\n";
|
||||
my $sock = IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => 4445, Prot => 'tcp');
|
||||
if(not defined $sock) {
|
||||
print "Unable to connect to monitor: $!\n";
|
||||
print "[vm_reset] Unable to connect to monitor: $!\n";
|
||||
return;
|
||||
}
|
||||
|
||||
print $sock "loadvm 1\n";
|
||||
close $sock;
|
||||
print "Resetted vm\n";
|
||||
}
|
||||
|
||||
sub execute {
|
||||
@ -135,7 +137,7 @@ sub compiler_server {
|
||||
my $tnick = quotemeta($nick);
|
||||
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) {
|
||||
print "parent continued\n";
|
||||
@ -172,7 +174,6 @@ sub compiler_server {
|
||||
alarm 0;
|
||||
|
||||
close $client;
|
||||
|
||||
print "stopping vm $vm_pid\n";
|
||||
vm_stop $vm_pid;
|
||||
$vm_pid = vm_start;
|
||||
|
||||
@ -12,23 +12,21 @@ use LWP::UserAgent;
|
||||
my $debug = 0;
|
||||
|
||||
my $USE_LOCAL = defined $ENV{'CC_LOCAL'};
|
||||
my $MAX_UNDO_HISTORY = 100;
|
||||
my $MAX_UNDO_HISTORY = 1000000;
|
||||
|
||||
my $output = "";
|
||||
my $nooutput = 'No output.';
|
||||
|
||||
my %languages = (
|
||||
'C99' => "std=C99 with pedantic warnings",
|
||||
'C' => "std=gnu89",
|
||||
'CLANG' => "std=gnu89 clang/llvm",
|
||||
'CLANG99' => "std=c99 clang/llvm with pedantic warnings",
|
||||
# 'C++' => 1,
|
||||
'C11' => "gcc -std=c11 -pedantic -Wall -Wextra (default)",
|
||||
'C99' => "gcc -std=c99 -pedantic -Wall -Wextra",
|
||||
'C89' => "gcc -std=c89 -pedantic -Wall -Wextra",
|
||||
);
|
||||
|
||||
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",
|
||||
'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",
|
||||
'C++' => "#include <iostream>\n#include <cstdio>\n\nusing namespace std;\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",
|
||||
'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 <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 {
|
||||
@ -75,7 +73,7 @@ sub compile {
|
||||
$pid = open2($compiler_output, $compiler, './compiler_vm_server.pl') || die "repl failed: $@\n";
|
||||
print "Started compiler, pid: $pid\n";
|
||||
} 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;
|
||||
$compiler_output = $compiler;
|
||||
}
|
||||
@ -121,9 +119,8 @@ my @last_code;
|
||||
|
||||
print " code: [$code]\n" if $debug;
|
||||
|
||||
my $lang = "C99";
|
||||
$lang = $1 if $code =~ s/-lang=([^\b\s]+)//i;
|
||||
$lang = "C" if $code =~ s/-nowarn[ings]*//i;
|
||||
my $lang = "C11";
|
||||
$lang = uc $1 if $code =~ s/-lang=([^\b\s]+)//i;
|
||||
|
||||
my $input = "";
|
||||
$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
|
||||
$lang = $1 if $code =~ s/-lang=([^\b\s]+)//i;
|
||||
$lang = "C" if $code =~ s/-nowarn[ings]*//i;
|
||||
$lang = uc $1 if $code =~ s/-lang=([^\b\s]+)//i;
|
||||
$input = $1 if $code =~ s/-input=(.*)$//i;
|
||||
$args .= "$1 " while $code =~ s/^\s*(-[^ ]+)\s*//;
|
||||
$args =~ s/\s+$//;
|
||||
@ -578,7 +574,7 @@ if($code =~ m/#include/) {
|
||||
}
|
||||
$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 $prelude = '';
|
||||
@ -679,6 +675,7 @@ $output = compile($lang, pretty($code), $args, $input, $USE_LOCAL);
|
||||
if($output =~ m/^\s*$/) {
|
||||
$output = $nooutput
|
||||
} else {
|
||||
print FILE "\n$output\n";
|
||||
$output =~ s/cc1: warnings being treated as errors//;
|
||||
$output =~ s/ Line \d+ ://g;
|
||||
$output =~ s/ \(first use in this function\)//g;
|
||||
@ -697,7 +694,14 @@ if($output =~ m/^\s*$/) {
|
||||
$output =~ s/$left_quote/'/g;
|
||||
$output =~ s/$right_quote/'/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/\s+/ /g;
|
||||
|
||||
@ -3,195 +3,141 @@
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use POSIX ":sys_wait_h";
|
||||
use IPC::Open2;
|
||||
|
||||
my @signame;
|
||||
$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 {
|
||||
my ($input, $output);
|
||||
|
||||
my $pid = open2($output, $input, 'gdb -silent -batch -x debugcommands ./prog ./core 2>/dev/null');
|
||||
|
||||
if(not $pid) {
|
||||
print "Error debugging program.\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
my $result = "";
|
||||
|
||||
while(my $line = <$output>) {
|
||||
if($line =~ s/^#\d+//) {
|
||||
next if $line =~ /\?\?/;
|
||||
next if $line =~ /in main\s*\(/;
|
||||
|
||||
$line =~ s/\s*0x[0-9a-fA-F]+\s*//;
|
||||
$line =~ s/\s+at .*:\d+//;
|
||||
|
||||
if($line !~ m/^\s*in\s+/) {
|
||||
$result = "in $line from ";
|
||||
} else {
|
||||
$result .= "$line at ";
|
||||
}
|
||||
}
|
||||
elsif($line =~ s/^\d+//) {
|
||||
next if $line =~ /No such file/;
|
||||
|
||||
$result .= "at " if not length $result;
|
||||
$result .= "statement: $line";
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
close $output;
|
||||
close $input;
|
||||
waitpid($pid, 0);
|
||||
|
||||
$result =~ s/^\s+//;
|
||||
$result =~ s/\s+$//;
|
||||
print "$result\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
sub reaper {
|
||||
my $child;
|
||||
while (($child=waitpid(-1,WNOHANG))>0) {
|
||||
|
||||
# See waitpid(2) and POSIX(3perl)
|
||||
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);
|
||||
my ($cmdline) = @_;
|
||||
my ($ret, $result);
|
||||
|
||||
local $SIG{CHLD} = \&reaper;
|
||||
my ($out, $in);
|
||||
open2($out, $in, "$cmdline 2>&1");
|
||||
#print $in "$stdin_input\n";
|
||||
while(my $line = <$out>) {
|
||||
chomp $line;
|
||||
#print "got: [$line]\n";
|
||||
if($line =~ m/^Reading symbols from.*done\.$/) {
|
||||
print $in "break gdb\n";
|
||||
print $in "run\n";
|
||||
next;
|
||||
}
|
||||
|
||||
my $child = fork;
|
||||
if($line =~ m/Breakpoint \d+, gdb/) {
|
||||
print $in "up\n";
|
||||
next;
|
||||
}
|
||||
|
||||
local $SIG{TERM} = sub { kill 'TERM', $child; };
|
||||
if($line =~ m/^\d+\s+watch\((.*)\)/) {
|
||||
$line = "1 gdb(\"watch $1\");";
|
||||
}
|
||||
|
||||
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;
|
||||
} else {
|
||||
exec("$cmdline 2>&1");
|
||||
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*\(/;
|
||||
|
||||
$line =~ s/\s+at .*:\d+//;
|
||||
|
||||
if($line !~ m/^\s*in\s+/) {
|
||||
$result = "in $line from ";
|
||||
} else {
|
||||
$result .= "$line at ";
|
||||
}
|
||||
}
|
||||
elsif($line =~ s/^\d+\s+//) {
|
||||
next if $line =~ /No such file/;
|
||||
|
||||
$result .= "at " if not length $result;
|
||||
$result .= "statement: $line";
|
||||
}
|
||||
elsif($line =~ m/([^=]+)=\s+(.*)/) {
|
||||
$vars .= "$varsep$1= $2";
|
||||
$varsep = "; ";
|
||||
}
|
||||
}
|
||||
|
||||
$result =~ s/^\s+//;
|
||||
$result =~ s/\s+$//;
|
||||
|
||||
$vars =~ s/\(gdb\)\s*//g;
|
||||
$vars = " [local variables: $vars]" if length $vars;
|
||||
|
||||
print "$result$vars\n";
|
||||
exit 0;
|
||||
}
|
||||
|
||||
if($line =~ m/^\(gdb\)/) {
|
||||
next;
|
||||
}
|
||||
|
||||
next if $line =~ m/^\d+\s+void gdb\(\) {}/;
|
||||
|
||||
next if not length $line;
|
||||
|
||||
print "$line\n";
|
||||
}
|
||||
} else {
|
||||
while(1) { sleep 10; }
|
||||
}
|
||||
}
|
||||
|
||||
execute("./prog");
|
||||
execute("gdb -silent ./prog");
|
||||
|
||||
@ -1,4 +1,3 @@
|
||||
#if 1
|
||||
#include <limits.h>
|
||||
#include <wchar.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);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
#define STR(s) #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)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user