diff options
author | Zancanaro; Carlo <czan8762@plang3.cs.usyd.edu.au> | 2012-09-24 09:58:17 +1000 |
---|---|---|
committer | Zancanaro; Carlo <czan8762@plang3.cs.usyd.edu.au> | 2012-09-24 09:58:17 +1000 |
commit | 222e2a7620e6520ffaf4fc4e69d79c18da31542e (patch) | |
tree | 7bfbc05bfa3b41c8f9d2e56d53a0bc3e310df239 /clang/www/demo/index.cgi | |
parent | 3d206f03985b50beacae843d880bccdc91a9f424 (diff) |
Add the clang library to the repo (with some of my changes, too).
Diffstat (limited to 'clang/www/demo/index.cgi')
-rw-r--r-- | clang/www/demo/index.cgi | 461 |
1 files changed, 461 insertions, 0 deletions
diff --git a/clang/www/demo/index.cgi b/clang/www/demo/index.cgi new file mode 100644 index 0000000..901b009 --- /dev/null +++ b/clang/www/demo/index.cgi @@ -0,0 +1,461 @@ +#!/usr/dcs/software/supported/bin/perl -w +# LLVM Web Demo script +# + +use strict; +use CGI; +use POSIX; +use Mail::Send; + +$| = 1; + +my $ROOT = "/tmp/webcompile"; +#my $ROOT = "/home/vadve/lattner/webcompile"; + +open( STDERR, ">&STDOUT" ) or die "can't redirect stderr to stdout"; + +if ( !-d $ROOT ) { mkdir( $ROOT, 0777 ); } + +my $LOGFILE = "$ROOT/log.txt"; +my $FORM_URL = 'index.cgi'; +my $MAILADDR = 'sabre@nondot.org'; +my $CONTACT_ADDRESS = 'Questions or comments? Email the <a href="http://lists.cs.uiuc.edu/mailman/listinfo/llvmdev">LLVMdev mailing list</a>.'; +my $LOGO_IMAGE_URL = 'cathead.png'; +my $TIMEOUTAMOUNT = 20; +$ENV{'LD_LIBRARY_PATH'} = '/home/vadve/shared/localtools/fc1/lib/'; + +my @PREPENDPATHDIRS = + ( + '/home/vadve/shared/llvm-gcc4.0-2.1/bin/', + '/home/vadve/shared/llvm-2.1/Release/bin'); + +my $defaultsrc = "#include <stdio.h>\n#include <stdlib.h>\n\n" . + "int power(int X) {\n if (X == 0) return 1;\n" . + " return X*power(X-1);\n}\n\n" . + "int main(int argc, char **argv) {\n" . + " printf(\"%d\\n\", power(atoi(argv[0])));\n}\n"; + +sub getname { + my ($extension) = @_; + for ( my $count = 0 ; ; $count++ ) { + my $name = + sprintf( "$ROOT/_%d_%d%s", $$, $count, $extension ); + if ( !-f $name ) { return $name; } + } +} + +my $c; + +sub barf { + print "<b>", @_, "</b>\n"; + print $c->end_html; + system("rm -f $ROOT/locked"); + exit 1; +} + +sub writeIntoFile { + my $extension = shift @_; + my $contents = join "", @_; + my $name = getname($extension); + local (*FILE); + open( FILE, ">$name" ) or barf("Can't write to $name: $!"); + print FILE $contents; + close FILE; + return $name; +} + +sub addlog { + my ( $source, $pid, $result ) = @_; + open( LOG, ">>$LOGFILE" ); + my $time = scalar localtime; + my $remotehost = $ENV{'REMOTE_ADDR'}; + print LOG "[$time] [$remotehost]: $pid\n"; + print LOG "<<<\n$source\n>>>\nResult is: <<<\n$result\n>>>\n"; + close LOG; +} + +sub dumpFile { + my ( $header, $file ) = @_; + my $result; + open( FILE, "$file" ) or barf("Can't read $file: $!"); + while (<FILE>) { + $result .= $_; + } + close FILE; + my $UnhilightedResult = $result; + my $HtmlResult = + "<h3>$header</h3>\n<pre>\n" . $c->escapeHTML($result) . "\n</pre>\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@<span class="llvm_type">$1</span>@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@<span class="llvm_keyword">$1</span>@g; + + # Add links to the FAQ. + $input =~ s@(_ZNSt8ios_base4Init[DC]1Ev)@<a href="../docs/FAQ.html#iosinit">$1</a>@g; + $input =~ s@\bundef\b@<a href="../docs/FAQ.html#undef">undef</a>@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 <<EOF; +<html> +<head> + <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1"> + <title>Try out LLVM in your browser!</title> + <style> + \@import url("syntax.css"); + \@import url("http://llvm.org/llvm.css"); + </style> +</head> +<body leftmargin="10" marginwidth="10"> + +<div class="www_sectiontitle"> + Try out LLVM in your browser! +</div> + +<table border=0><tr><td> +<img align=right width=100 height=111 src="$LOGO_IMAGE_URL"> +</td><td> +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!</td></tr></table>'\n"; + exit 0; + } +} + +system("touch $ROOT/locked"); + +print <<END; +Bitter Melon the cat says, paste a C/C++ program in the text box or upload +one from your computer, and you can see LLVM compile it, meow!! +</td></tr></table><p> +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 '<table border="0"><tr><td>'; + +print "Type your source code in below: (<a href='DemoInfo.html#hints'>hints and +advice</a>)<br>\n"; + +print $c->textarea( + -name => "source", + -rows => 16, + -columns => 60, + -default => $source +), "<br>"; + +print "Or upload a file: "; +print $c->filefield( -name => 'uploaded_file', -default => '' ); + +print "<p />\n"; + + +print '<p></td><td valign=top>'; + +print "<center><h3>General Options</h3></center>"; + +print "Source language: ", + $c->radio_group( + -name => 'language', + -values => [ 'C', 'C++' ], + -default => 'C' + ), "<p>"; + +print $c->checkbox( + -name => 'linkopt', + -label => 'Run link-time optimizer', + -checked => 'checked' + ),' <a href="DemoInfo.html#lto">?</a><br>'; + +print $c->checkbox( + -name => 'showstats', + -label => 'Show detailed pass statistics' + ), ' <a href="DemoInfo.html#stats">?</a><br>'; + +print $c->checkbox( + -name => 'cxxdemangle', + -label => 'Demangle C++ names' + ),' <a href="DemoInfo.html#demangle">?</a><p>'; + + +print "<center><h3>Output Options</h3></center>"; + +print $c->checkbox( + -name => 'showbcanalysis', + -label => 'Show detailed bytecode analysis' + ),' <a href="DemoInfo.html#bcanalyzer">?</a><br>'; + +print $c->checkbox( + -name => 'showllvm2cpp', + -label => 'Show LLVM C++ API code' + ), ' <a href="DemoInfo.html#llvm2cpp">?</a>'; + +print "</td></tr></table>"; + +print "<center>", $c->submit(-value=> 'Compile Source Code'), + "</center>\n", $c->endform; + +print "\n<p>If you have questions about the LLVM code generated by the +front-end, please check the <a href='/docs/FAQ.html#cfe_code'>FAQ</a> and +the demo page <a href='DemoInfo.html#hints'>hints section</a>. +</p>\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( +"<br/>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 "<p>Finished dumping command output.</p>\n"; + if ( WIFEXITED($retcode) && WEXITSTATUS($retcode) != 0 ) { + barf( +"$program exited with an error. Please correct source and resubmit.<p>\n" . +"Please note that this form only allows fully formed and correct source" . +" files. It will not compile fragments of code.<p>" + ); + } + 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 "<p>Processing uploaded file. It looks like $language.</p>\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 "<p>Hmm, that's weird, llvm-dis didn't produce any output.</p>\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, "<address>$CONTACT_ADDRESS</address>", $c->end_html; +system("rm $ROOT/locked"); +exit 0; |