GitHub/pbot
3
0
Fork 0
mirror of https://github.com/pragma-/pbot.git synced 2024-11-26 13:59:47 +01:00
Code Issues Projects Releases Wiki Activity

compiler_vm: updates (needs refactoring, pronto)

Browse Source
This commit is contained in:
Pragmatic Software 2012-02-02 04:14:38 +00:00
parent 22b43f21bf
commit fd1f18850a
5 changed files with 91 additions and 32 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 => 353, BUILD_REVISION => 354,
BUILD_DATE => "2012-01-30", BUILD_DATE => "2012-02-01",
}; };
1; 1;

4
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 = '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 = 'nice -n -20 qemu-system-x86_64 -M pc -net none -hda /home/compiler/compiler-saved-vm -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 {
@ -137,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-2.pl $tnick -lang=$tlang $code"); my ($ret, $result) = execute("./compiler_vm_client.pl $tnick -lang=$tlang $code");
if(not defined $ret) { if(not defined $ret) {
print "parent continued\n"; print "parent continued\n";

60
modules/compiler_vm/compiler_vm_client.pl
View File

@ -24,9 +24,9 @@ my %languages = (
); );
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 <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", 'C99' => "#define _XOPEN_SOURCE\n#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 <time.h>\n#include <assert.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", 'C11' => "#define _XOPEN_SOURCE\n#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 <time.h>\n#include <assert.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", 'C' => "#define _XOPEN_SOURCE\n#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 <assert.h>\n#include <prelude.h>\n\n",
); );
sub pretty { sub pretty {
@ -44,6 +44,7 @@ sub pretty {
return $result; return $result;
} }
=cut
sub paste_codepad { sub paste_codepad {
my $text = join(' ', @_); my $text = join(' ', @_);
@ -62,6 +63,29 @@ if(not $response->is_success) {
return $response->request->uri; return $response->request->uri;
} }
=cut
sub paste_codepad {
my $text = join(' ', @_);
$text =~ s/(.{120})\s/$1\n/g;
my $ua = LWP::UserAgent->new();
$ua->agent("Mozilla/5.0");
$ua->requests_redirectable([ ]);
my %post = ( 'sprunge' => $text, 'submit' => 'Submit' );
my $response = $ua->post("http://sprunge.us", \%post);
if(not $response->is_success) {
return $response->status_line;
}
my $result = $response->content;
$result =~ s/^\s+//;
$result =~ s/\s+$/?c/;
return $result;
}
sub compile { sub compile {
my ($lang, $code, $args, $input, $local) = @_; my ($lang, $code, $args, $input, $local) = @_;
@ -527,6 +551,7 @@ if($code =~ m/^\s*(run|paste)\s*$/i) {
last if(++$i > $MAX_UNDO_HISTORY); last if(++$i > $MAX_UNDO_HISTORY);
print FILE "$line\n"; print FILE "$line\n";
} }
close FILE; close FILE;
if($got_undo and not $got_sub) { if($got_undo and not $got_sub) {
@ -543,6 +568,7 @@ $args =~ s/\s+$//;
unless($got_run) { unless($got_run) {
open FILE, ">> log.txt"; open FILE, ">> log.txt";
print FILE "------------------------------------------------------------------------\n";
print FILE localtime() . "\n"; print FILE localtime() . "\n";
print FILE "$nick: $code\n"; print FILE "$nick: $code\n";
} }
@ -568,7 +594,7 @@ $code =~ s/#([\w\d_]+)\\n/#$1\n/g;
my $precode; my $precode;
if($code =~ m/#include/) { if($code =~ m/#include/) {
$precode = $code; $precode = "#include <prelude.h>\n" . $code;
} else { } else {
$precode = $preludes{$lang} . $code; $precode = $preludes{$lang} . $code;
} }
@ -668,14 +694,20 @@ if(defined $got_run and $got_run eq "paste") {
exit 0; exit 0;
} }
print FILE "$nick: [lang:$lang][args:$args][input:$input]\n$code\n"; print FILE "$nick: [lang:$lang][args:$args][input:$input]\n", pretty($code), "\n";
$output = compile($lang, pretty($code), $args, $input, $USE_LOCAL); $output = compile($lang, pretty($code), $args, $input, $USE_LOCAL);
$output =~ s/^\s+//;
$output =~ s/\s+$//;
if($output =~ m/^\s*$/) { if($output =~ m/^\s*$/) {
$output = $nooutput $output = $nooutput
} else { } else {
print FILE "\n$output\n"; unless($got_run) {
print FILE localtime() . "\n";
print FILE "$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;
@ -702,15 +734,19 @@ if($output =~ m/^\s*$/) {
$output =~ s/initializer\s+warning: \(near/initializer (near/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/note: each undeclared identifier is reported only once for each function it appears in//g;
$output =~ s/\(gdb\)//g; $output =~ s/\(gdb\)//g;
$output =~ s/", '\\(\d{3})' <repeats \d+ times>,? ?"/\\$1/g;
#$output =~ s/[\r\n]+/ /g; $output =~ s/, '\\(\d{3})' <repeats \d+ times>\s*//g;
#$output =~ s/\s+/ /g; print FILE $output, "\n";
$output =~ s/(\\000)+/\\0/g;
$output =~ s/\\0[^">]+/\\0/g;
#$output =~ s/(\\\d{3})+//g;
$output =~ s/\\0"/"/g;
$output =~ s/"\\0/"/g;
$output =~ s/\.\.\.>/>/g;
} }
unless($got_run) { unless($got_run) {
print FILE localtime() . "\n"; print FILE "$nick: $output\n";
print FILE "$nick: $output\n\n";
close FILE; close FILE;
} }

6
modules/compiler_vm/compiler_vm_server.pl
View File

@ -7,7 +7,7 @@ my $USE_LOCAL = defined $ENV{'CC_LOCAL'};
my %languages = ( my %languages = (
'C' => { 'C' => {
'cmdline' => 'gcc $args $file -o prog -ggdb', 'cmdline' => 'gcc $args $file -o prog -gdwarf-2 -g3',
'args' => '-Wextra -Wall -Wno-unused -std=gnu89 -lm', 'args' => '-Wextra -Wall -Wno-unused -std=gnu89 -lm',
'file' => 'prog.c', 'file' => 'prog.c',
}, },
@ -17,12 +17,12 @@ my %languages = (
'file' => 'prog.cpp', 'file' => 'prog.cpp',
}, },
'C99' => { 'C99' => {
'cmdline' => 'gcc $args $file -o prog -ggdb', 'cmdline' => 'gcc $args $file -o prog -gdwarf-2 -g3',
'args' => '-Wextra -Wall -Wno-unused -pedantic -std=c99 -lm', 'args' => '-Wextra -Wall -Wno-unused -pedantic -std=c99 -lm',
'file' => 'prog.c', 'file' => 'prog.c',
}, },
'C11' => { 'C11' => {
'cmdline' => 'gcc $args $file -o prog -ggdb', 'cmdline' => 'gcc $args $file -o prog -gdwarf-2 -g3',
'args' => '-Wextra -Wall -Wno-unused -pedantic -std=c11 -lm', 'args' => '-Wextra -Wall -Wno-unused -pedantic -std=c11 -lm',
'file' => 'prog.c', 'file' => 'prog.c',
}, },

47
modules/compiler_vm/compiler_watchdog.pl
View File

@ -27,6 +27,7 @@ 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/;
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/;
@ -40,16 +41,33 @@ sub execute {
if($line =~ m/^Reading symbols from.*done\.$/) { if($line =~ m/^Reading symbols from.*done\.$/) {
print $in "break gdb\n"; print $in "break gdb\n";
#<$out>;
print $in "list main,9001\n"; print $in "list main,9001\n";
print $in "print \"Ok.\"\n"; print $in "print \"Ok.\"\n";
my $break = 0; my $break = 0;
my $bracket = 0;
my $main_ended = 0;
while(my $line = <$out>) { while(my $line = <$out>) {
chomp $line; chomp $line;
print "list got: [$line]\n" if $debug >= 4; print "list got: [$line]\n" if $debug >= 4;
if($line =~ m/^(\d+)\s+return 0;/) { if(not $main_ended and $line =~ m/^(\d+)\s+return 0;/) {
$break = $1; $break = $1;
} 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) {
$break = $line_number;
$main_ended = 1;
last;
}
}
}
} }
last if $line =~ m/^\(gdb\) \$\d+ = "Ok."/; last if $line =~ m/^\(gdb\) \$\d+ = "Ok."/;
@ -63,7 +81,7 @@ sub execute {
if($line =~ m/^Breakpoint \d+, main/) { if($line =~ m/^Breakpoint \d+, main/) {
my $line = <$out>; my $line = <$out>;
print "== got: $line\n" if $debug >= 5; print "== got: $line\n" if $debug >= 5;
if($line =~ m/^\d+\s+return 0;$/) { if($line =~ m/^\d+\s+return 0;\s*$/ or $line =~ m/^\d+\s+}\s*$/) {
if($got_output == 0) { if($got_output == 0) {
print "no output, checking locals\n" if $debug >= 5; print "no output, checking locals\n" if $debug >= 5;
print $in "print \"Go.\"\ninfo locals\nprint \"Ok.\"\n"; print $in "print \"Go.\"\ninfo locals\nprint \"Ok.\"\n";
@ -97,10 +115,17 @@ sub execute {
$vars =~ s/\(gdb\)\s*//g; $vars =~ s/\(gdb\)\s*//g;
$local_vars = "<no output: $vars>" if length $vars; $local_vars = "<no output: $vars>" if length $vars;
print $in "cont\n";
next;
} else {
print $in "cont\n";
next;
} }
} else {
print $in "cont\n";
next;
} }
print $in "cont\n";
next;
} }
@ -113,23 +138,23 @@ sub execute {
next; next;
} }
if($line =~ m/^\d+\s+watch\((.*)\)/) { if($line =~ m/^\d+\s+.*\bwatch\((.*)\)/) {
$line = "1 gdb(\"watch $1\");"; $line = "1 gdb(\"watch $1\");";
} }
if($line =~ m/^\d+\s+dump\((.*)\)/) { if($line =~ m/^\d+\s+.*\bdump\((.*)\)/) {
$line = "1 gdb(\"print $1\");"; $line = "1 gdb(\"print $1\");";
} }
if($line =~ m/^\d+\s+print\((.*)\)/) { if($line =~ m/^\d+\s+.*\bprint\((.*)\)/) {
$line = "1 gdb(\"print $1\");"; $line = "1 gdb(\"print $1\");";
} }
if($line =~ m/^\d+\s+ptype\((.*)\)/) { if($line =~ m/^\d+\s+.*\bptype\((.*)\)/) {
$line = "1 gdb(\"ptype $1\");"; $line = "1 gdb(\"ptype $1\");";
} }
if($line =~ m/^\d+\s+.*gdb\("(.*)"\)/) { if($line =~ m/^\d+\s+.*\bgdb\("(.*)"\)/) {
my $command = $1; my $command = $1;
my ($cmd, $args) = split / /, $command, 2; my ($cmd, $args) = split / /, $command, 2;
$args = "" if not defined $args; $args = "" if not defined $args;
@ -208,8 +233,6 @@ sub execute {
if($line =~ m/^Watchpoint \d+ deleted/) { if($line =~ m/^Watchpoint \d+ deleted/) {
my $ignore = <$out>; my $ignore = <$out>;
print "ignored $ignore\n" if $debug >= 5; print "ignored $ignore\n" if $debug >= 5;
$ignore = <$out>;
print "ignored $ignore\n" if $debug >= 5;
print $in "cont\n"; print $in "cont\n";
next; next;
} }