$header
\n\n" . $c->escapeHTML($result) . "\n\n"; if (wantarray) { return ( $UnhilightedResult, $HtmlResult ); } else { return $HtmlResult; } } sub syntaxHighlightLLVM { my ($input) = @_; $input =~ s@\b(void|i8|i1|i16|i32|i64|float|double|type|label|opaque)\b@$1@g; $input =~ s@\b(add|sub|mul|div|rem|and|or|xor|setne|seteq|setlt|setgt|setle|setge|phi|tail|call|cast|to|shl|shr|vaarg|vanext|ret|br|switch|invoke|unwind|malloc|alloca|free|load|store|getelementptr|begin|end|true|false|declare|global|constant|const|internal|uninitialized|external|implementation|linkonce|weak|appending|null|to|except|not|target|endian|pointersize|big|little|volatile)\b@$1@g; # Add links to the FAQ. $input =~ s@(_ZNSt8ios_base4Init[DC]1Ev)@$1@g; $input =~ s@\bundef\b@undef@g; return $input; } sub mailto { my ( $recipient, $body ) = @_; my $msg = new Mail::Send( Subject => "LLVM Demo Page Run", To => $recipient ); my $fh = $msg->open(); print $fh $body; $fh->close(); } $c = new CGI; print $c->header; print <
Try out LLVM in your browser!
|
| EOF if ( -f "$ROOT/locked" ) { my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$locktime) = stat("$ROOT/locked"); my $currtime = time(); if ($locktime + 60 > $currtime) { print "This page is already in use by someone else at this "; print "time, try reloading in a second or two. Meow! |
END print $c->start_multipart_form( 'POST', $FORM_URL ); my $source = $c->param('source'); # Start the user out with something valid if no code. $source = $defaultsrc if (!defined($source)); print '
| ';
print "Type your source code in below: (hints and
advice) \n"; print $c->textarea( -name => "source", -rows => 16, -columns => 60, -default => $source ), " "; print "Or upload a file: "; print $c->filefield( -name => 'uploaded_file', -default => '' ); print "\n"; print ' | ';
print "General Options";
print $c->checkbox(
-name => 'linkopt',
-label => 'Run link-time optimizer',
-checked => 'checked'
),' ? '; print " Output Options'; print $c->checkbox( -name => 'showllvm2cpp', -label => 'Show LLVM C++ API code' ), ' ?'; print " |
If you have questions about the LLVM code generated by the front-end, please check the FAQ and the demo page hints section.
\n"; $ENV{'PATH'} = ( join ( ':', @PREPENDPATHDIRS ) ) . ":" . $ENV{'PATH'}; sub sanitychecktools { my $sanitycheckfail = ''; # insert tool-specific sanity checks here $sanitycheckfail .= ' llvm-dis' if `llvm-dis --help 2>&1` !~ /ll disassembler/; $sanitycheckfail .= ' llvm-gcc' if ( `llvm-gcc --version 2>&1` !~ /Free Software Foundation/ ); $sanitycheckfail .= ' llvm-ld' if `llvm-ld --help 2>&1` !~ /llvm linker/; $sanitycheckfail .= ' llvm-bcanalyzer' if `llvm-bcanalyzer --help 2>&1` !~ /bcanalyzer/; barf( "The demo page is currently unavailable. [tools: ($sanitycheckfail ) failed sanity check]" ) if $sanitycheckfail; } sanitychecktools(); sub try_run { my ( $program, $commandline, $outputFile ) = @_; my $retcode = 0; eval { local $SIG{ALRM} = sub { die "timeout"; }; alarm $TIMEOUTAMOUNT; $retcode = system($commandline); alarm 0; }; if ( $@ and $@ =~ /timeout/ ) { barf("Program $program took too long, compile time limited for the web script, sorry!\n"); } if ( -s $outputFile ) { print scalar dumpFile( "Output from $program", $outputFile ); } #print "
Finished dumping command output.
\n"; if ( WIFEXITED($retcode) && WEXITSTATUS($retcode) != 0 ) { barf( "$program exited with an error. Please correct source and resubmit.\n" . "Please note that this form only allows fully formed and correct source" . " files. It will not compile fragments of code.
" ); } if ( WIFSIGNALED($retcode) != 0 ) { my $sig = WTERMSIG($retcode); barf( "Ouch, $program caught signal $sig. Sorry, better luck next time!\n" ); } } my %suffixes = ( 'Java' => '.java', 'JO99' => '.jo9', 'C' => '.c', 'C++' => '.cc', 'Stacker' => '.st', 'preprocessed C' => '.i', 'preprocessed C++' => '.ii' ); my %languages = ( '.jo9' => 'JO99', '.java' => 'Java', '.c' => 'C', '.i' => 'preprocessed C', '.ii' => 'preprocessed C++', '.cc' => 'C++', '.cpp' => 'C++', '.st' => 'Stacker' ); my $uploaded_file_name = $c->param('uploaded_file'); if ($uploaded_file_name) { if ($source) { barf( "You must choose between uploading a file and typing code in. You can't do both at the same time." ); } $uploaded_file_name =~ s/^.*(\.[A-Za-z]+)$/$1/; my $language = $languages{$uploaded_file_name}; $c->param( 'language', $language ); print "
Processing uploaded file. It looks like $language.
\n"; my $fh = $c->upload('uploaded_file'); if ( !$fh ) { barf( "Error uploading file: " . $c->cgi_error ); } while (<$fh>) { $source .= $_; } close $fh; } if ($c->param('source')) { print $c->hr; my $extension = $suffixes{ $c->param('language') }; barf "Unknown language; can't compile\n" unless $extension; # Add a newline to the source here to avoid a warning from gcc. $source .= "\n"; # Avoid security hole due to #including bad stuff. $source =~ s@(\n)?#include.*[<"](.*\.\..*)[">].*\n@$1#error "invalid #include file $2 detected"\n@g; my $inputFile = writeIntoFile( $extension, $source ); my $pid = $$; my $bytecodeFile = getname(".bc"); my $outputFile = getname(".llvm-gcc.out"); my $timerFile = getname(".llvm-gcc.time"); my $stats = ''; if ( $extension eq ".st" ) { $stats = "-stats -time-passes " if ( $c->param('showstats') ); try_run( "llvm Stacker front-end (stkrc)", "stkrc $stats -o $bytecodeFile $inputFile > $outputFile 2>&1", $outputFile ); } else { #$stats = "-Wa,--stats,--time-passes,--info-output-file=$timerFile" $stats = "-ftime-report" if ( $c->param('showstats') ); try_run( "llvm C/C++ front-end (llvm-gcc)", "llvm-gcc -emit-llvm -W -Wall -O2 $stats -o $bytecodeFile -c $inputFile > $outputFile 2>&1", $outputFile ); } if ( $c->param('showstats') && -s $timerFile ) { my ( $UnhilightedResult, $HtmlResult ) = dumpFile( "Statistics for front-end compilation", $timerFile ); print "$HtmlResult\n"; } if ( $c->param('linkopt') ) { my $stats = ''; my $outputFile = getname(".gccld.out"); my $timerFile = getname(".gccld.time"); $stats = "--stats --time-passes --info-output-file=$timerFile" if ( $c->param('showstats') ); my $tmpFile = getname(".bc"); try_run( "optimizing linker (llvm-ld)", "llvm-ld $stats -o=$tmpFile $bytecodeFile > $outputFile 2>&1", $outputFile ); system("mv $tmpFile.bc $bytecodeFile"); system("rm $tmpFile"); if ( $c->param('showstats') && -s $timerFile ) { my ( $UnhilightedResult, $HtmlResult ) = dumpFile( "Statistics for optimizing linker", $timerFile ); print "$HtmlResult\n"; } } print " Bytecode size is ", -s $bytecodeFile, " bytes.\n"; my $disassemblyFile = getname(".ll"); try_run( "llvm-dis", "llvm-dis -o=$disassemblyFile $bytecodeFile > $outputFile 2>&1", $outputFile ); if ( $c->param('cxxdemangle') ) { print " Demangling disassembler output.\n"; my $tmpFile = getname(".ll"); system("c++filt < $disassemblyFile > $tmpFile 2>&1"); system("mv $tmpFile $disassemblyFile"); } my ( $UnhilightedResult, $HtmlResult ); if ( -s $disassemblyFile ) { ( $UnhilightedResult, $HtmlResult ) = dumpFile( "Output from LLVM disassembler", $disassemblyFile ); print syntaxHighlightLLVM($HtmlResult); } else { print "Hmm, that's weird, llvm-dis didn't produce any output.
\n"; } if ( $c->param('showbcanalysis') ) { my $analFile = getname(".bca"); try_run( "llvm-bcanalyzer", "llvm-bcanalyzer $bytecodeFile > $analFile 2>&1", $analFile); } if ($c->param('showllvm2cpp') ) { my $l2cppFile = getname(".l2cpp"); try_run("llvm2cpp","llvm2cpp $bytecodeFile -o $l2cppFile 2>&1", $l2cppFile); } # Get the source presented by the user to CGI, convert newline sequences to simple \n. my $actualsrc = $c->param('source'); $actualsrc =~ s/\015\012/\n/go; # Don't log this or mail it if it is the default code. if ($actualsrc ne $defaultsrc) { addlog( $source, $pid, $UnhilightedResult ); my ( $ip, $host, $lg, $lines ); chomp( $lines = `wc -l < $inputFile` ); $lg = $c->param('language'); $ip = $c->remote_addr(); chomp( $host = `host $ip` ) if $ip; mailto( $MAILADDR, "--- Query: ---\nFrom: ($ip) $host\nInput: $lines lines of $lg\n" . "C++ demangle = " . ( $c->param('cxxdemangle') ? 1 : 0 ) . ", Link opt = " . ( $c->param('linkopt') ? 1 : 0 ) . "\n\n" . ", Show stats = " . ( $c->param('showstats') ? 1 : 0 ) . "\n\n" . "--- Source: ---\n$source\n" . "--- Result: ---\n$UnhilightedResult\n" ); } unlink( $inputFile, $bytecodeFile, $outputFile, $disassemblyFile ); } print $c->hr, "$CONTACT_ADDRESS", $c->end_html; system("rm $ROOT/locked"); exit 0;