blob: 901b009dbdeacc559011eee865954ca95d7593dd [file] [log] [blame]
Kevind68c8f42007-10-06 05:15:30 +00001#!/usr/dcs/software/supported/bin/perl -w
2# LLVM Web Demo script
3#
4
5use strict;
6use CGI;
7use POSIX;
8use Mail::Send;
9
10$| = 1;
11
12my $ROOT = "/tmp/webcompile";
13#my $ROOT = "/home/vadve/lattner/webcompile";
14
15open( STDERR, ">&STDOUT" ) or die "can't redirect stderr to stdout";
16
17if ( !-d $ROOT ) { mkdir( $ROOT, 0777 ); }
18
19my $LOGFILE = "$ROOT/log.txt";
20my $FORM_URL = 'index.cgi';
21my $MAILADDR = 'sabre@nondot.org';
22my $CONTACT_ADDRESS = 'Questions or comments? Email the <a href="http://lists.cs.uiuc.edu/mailman/listinfo/llvmdev">LLVMdev mailing list</a>.';
23my $LOGO_IMAGE_URL = 'cathead.png';
24my $TIMEOUTAMOUNT = 20;
25$ENV{'LD_LIBRARY_PATH'} = '/home/vadve/shared/localtools/fc1/lib/';
26
27my @PREPENDPATHDIRS =
28 (
29 '/home/vadve/shared/llvm-gcc4.0-2.1/bin/',
30 '/home/vadve/shared/llvm-2.1/Release/bin');
31
32my $defaultsrc = "#include <stdio.h>\n#include <stdlib.h>\n\n" .
33 "int power(int X) {\n if (X == 0) return 1;\n" .
34 " return X*power(X-1);\n}\n\n" .
35 "int main(int argc, char **argv) {\n" .
36 " printf(\"%d\\n\", power(atoi(argv[0])));\n}\n";
37
38sub getname {
39 my ($extension) = @_;
40 for ( my $count = 0 ; ; $count++ ) {
41 my $name =
42 sprintf( "$ROOT/_%d_%d%s", $$, $count, $extension );
43 if ( !-f $name ) { return $name; }
44 }
45}
46
47my $c;
48
49sub barf {
50 print "<b>", @_, "</b>\n";
51 print $c->end_html;
52 system("rm -f $ROOT/locked");
53 exit 1;
54}
55
56sub writeIntoFile {
57 my $extension = shift @_;
58 my $contents = join "", @_;
59 my $name = getname($extension);
60 local (*FILE);
61 open( FILE, ">$name" ) or barf("Can't write to $name: $!");
62 print FILE $contents;
63 close FILE;
64 return $name;
65}
66
67sub addlog {
68 my ( $source, $pid, $result ) = @_;
69 open( LOG, ">>$LOGFILE" );
70 my $time = scalar localtime;
71 my $remotehost = $ENV{'REMOTE_ADDR'};
72 print LOG "[$time] [$remotehost]: $pid\n";
73 print LOG "<<<\n$source\n>>>\nResult is: <<<\n$result\n>>>\n";
74 close LOG;
75}
76
77sub dumpFile {
78 my ( $header, $file ) = @_;
79 my $result;
80 open( FILE, "$file" ) or barf("Can't read $file: $!");
81 while (<FILE>) {
82 $result .= $_;
83 }
84 close FILE;
85 my $UnhilightedResult = $result;
86 my $HtmlResult =
87 "<h3>$header</h3>\n<pre>\n" . $c->escapeHTML($result) . "\n</pre>\n";
88 if (wantarray) {
89 return ( $UnhilightedResult, $HtmlResult );
90 }
91 else {
92 return $HtmlResult;
93 }
94}
95
96sub syntaxHighlightLLVM {
97 my ($input) = @_;
98 $input =~ s@\b(void|i8|i1|i16|i32|i64|float|double|type|label|opaque)\b@<span class="llvm_type">$1</span>@g;
99 $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;
100
101 # Add links to the FAQ.
102 $input =~ s@(_ZNSt8ios_base4Init[DC]1Ev)@<a href="../docs/FAQ.html#iosinit">$1</a>@g;
103 $input =~ s@\bundef\b@<a href="../docs/FAQ.html#undef">undef</a>@g;
104 return $input;
105}
106
107sub mailto {
108 my ( $recipient, $body ) = @_;
109 my $msg =
110 new Mail::Send( Subject => "LLVM Demo Page Run", To => $recipient );
111 my $fh = $msg->open();
112 print $fh $body;
113 $fh->close();
114}
115
116$c = new CGI;
117print $c->header;
118
119print <<EOF;
120<html>
121<head>
122 <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
123 <title>Try out LLVM in your browser!</title>
124 <style>
125 \@import url("syntax.css");
126 \@import url("http://llvm.org/llvm.css");
127 </style>
128</head>
129<body leftmargin="10" marginwidth="10">
130
131<div class="www_sectiontitle">
132 Try out LLVM in your browser!
133</div>
134
135<table border=0><tr><td>
136<img align=right width=100 height=111 src="$LOGO_IMAGE_URL">
137</td><td>
138EOF
139
140if ( -f "$ROOT/locked" ) {
141 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$locktime) =
142 stat("$ROOT/locked");
143 my $currtime = time();
144 if ($locktime + 60 > $currtime) {
145 print "This page is already in use by someone else at this ";
146 print "time, try reloading in a second or two. Meow!</td></tr></table>'\n";
147 exit 0;
148 }
149}
150
151system("touch $ROOT/locked");
152
153print <<END;
154Bitter Melon the cat says, paste a C/C++ program in the text box or upload
155one from your computer, and you can see LLVM compile it, meow!!
156</td></tr></table><p>
157END
158
159print $c->start_multipart_form( 'POST', $FORM_URL );
160
161my $source = $c->param('source');
162
163
164# Start the user out with something valid if no code.
165$source = $defaultsrc if (!defined($source));
166
167print '<table border="0"><tr><td>';
168
169print "Type your source code in below: (<a href='DemoInfo.html#hints'>hints and
170advice</a>)<br>\n";
171
172print $c->textarea(
173 -name => "source",
174 -rows => 16,
175 -columns => 60,
176 -default => $source
177), "<br>";
178
179print "Or upload a file: ";
180print $c->filefield( -name => 'uploaded_file', -default => '' );
181
182print "<p />\n";
183
184
185print '<p></td><td valign=top>';
186
187print "<center><h3>General Options</h3></center>";
188
189print "Source language: ",
190 $c->radio_group(
191 -name => 'language',
192 -values => [ 'C', 'C++' ],
193 -default => 'C'
194 ), "<p>";
195
196print $c->checkbox(
197 -name => 'linkopt',
198 -label => 'Run link-time optimizer',
199 -checked => 'checked'
200 ),' <a href="DemoInfo.html#lto">?</a><br>';
201
202print $c->checkbox(
203 -name => 'showstats',
204 -label => 'Show detailed pass statistics'
205 ), ' <a href="DemoInfo.html#stats">?</a><br>';
206
207print $c->checkbox(
208 -name => 'cxxdemangle',
209 -label => 'Demangle C++ names'
210 ),' <a href="DemoInfo.html#demangle">?</a><p>';
211
212
213print "<center><h3>Output Options</h3></center>";
214
215print $c->checkbox(
216 -name => 'showbcanalysis',
217 -label => 'Show detailed bytecode analysis'
218 ),' <a href="DemoInfo.html#bcanalyzer">?</a><br>';
219
220print $c->checkbox(
221 -name => 'showllvm2cpp',
222 -label => 'Show LLVM C++ API code'
223 ), ' <a href="DemoInfo.html#llvm2cpp">?</a>';
224
225print "</td></tr></table>";
226
227print "<center>", $c->submit(-value=> 'Compile Source Code'),
228 "</center>\n", $c->endform;
229
230print "\n<p>If you have questions about the LLVM code generated by the
231front-end, please check the <a href='/docs/FAQ.html#cfe_code'>FAQ</a> and
232the demo page <a href='DemoInfo.html#hints'>hints section</a>.
233</p>\n";
234
235$ENV{'PATH'} = ( join ( ':', @PREPENDPATHDIRS ) ) . ":" . $ENV{'PATH'};
236
237sub sanitychecktools {
238 my $sanitycheckfail = '';
239
240 # insert tool-specific sanity checks here
241 $sanitycheckfail .= ' llvm-dis'
242 if `llvm-dis --help 2>&1` !~ /ll disassembler/;
243
244 $sanitycheckfail .= ' llvm-gcc'
245 if ( `llvm-gcc --version 2>&1` !~ /Free Software Foundation/ );
246
247 $sanitycheckfail .= ' llvm-ld'
248 if `llvm-ld --help 2>&1` !~ /llvm linker/;
249
250 $sanitycheckfail .= ' llvm-bcanalyzer'
251 if `llvm-bcanalyzer --help 2>&1` !~ /bcanalyzer/;
252
253 barf(
254"<br/>The demo page is currently unavailable. [tools: ($sanitycheckfail ) failed sanity check]"
255 )
256 if $sanitycheckfail;
257}
258
259sanitychecktools();
260
261sub try_run {
262 my ( $program, $commandline, $outputFile ) = @_;
263 my $retcode = 0;
264
265 eval {
266 local $SIG{ALRM} = sub { die "timeout"; };
267 alarm $TIMEOUTAMOUNT;
268 $retcode = system($commandline);
269 alarm 0;
270 };
271 if ( $@ and $@ =~ /timeout/ ) {
Bill Wendlinge1809072011-07-20 21:02:28 +0000272 barf("Program $program took too long, compile time limited for the web script, sorry!\n");
Kevind68c8f42007-10-06 05:15:30 +0000273 }
274 if ( -s $outputFile ) {
275 print scalar dumpFile( "Output from $program", $outputFile );
276 }
277 #print "<p>Finished dumping command output.</p>\n";
278 if ( WIFEXITED($retcode) && WEXITSTATUS($retcode) != 0 ) {
279 barf(
280"$program exited with an error. Please correct source and resubmit.<p>\n" .
281"Please note that this form only allows fully formed and correct source" .
282" files. It will not compile fragments of code.<p>"
283 );
284 }
285 if ( WIFSIGNALED($retcode) != 0 ) {
286 my $sig = WTERMSIG($retcode);
287 barf(
288 "Ouch, $program caught signal $sig. Sorry, better luck next time!\n"
289 );
290 }
291}
292
293my %suffixes = (
294 'Java' => '.java',
295 'JO99' => '.jo9',
296 'C' => '.c',
297 'C++' => '.cc',
298 'Stacker' => '.st',
299 'preprocessed C' => '.i',
300 'preprocessed C++' => '.ii'
301);
302my %languages = (
303 '.jo9' => 'JO99',
304 '.java' => 'Java',
305 '.c' => 'C',
306 '.i' => 'preprocessed C',
307 '.ii' => 'preprocessed C++',
308 '.cc' => 'C++',
309 '.cpp' => 'C++',
310 '.st' => 'Stacker'
311);
312
313my $uploaded_file_name = $c->param('uploaded_file');
314if ($uploaded_file_name) {
315 if ($source) {
316 barf(
317"You must choose between uploading a file and typing code in. You can't do both at the same time."
318 );
319 }
320 $uploaded_file_name =~ s/^.*(\.[A-Za-z]+)$/$1/;
321 my $language = $languages{$uploaded_file_name};
322 $c->param( 'language', $language );
323
324 print "<p>Processing uploaded file. It looks like $language.</p>\n";
325 my $fh = $c->upload('uploaded_file');
326 if ( !$fh ) {
327 barf( "Error uploading file: " . $c->cgi_error );
328 }
329 while (<$fh>) {
330 $source .= $_;
331 }
332 close $fh;
333}
334
335if ($c->param('source')) {
336 print $c->hr;
337 my $extension = $suffixes{ $c->param('language') };
338 barf "Unknown language; can't compile\n" unless $extension;
339
340 # Add a newline to the source here to avoid a warning from gcc.
341 $source .= "\n";
342
343 # Avoid security hole due to #including bad stuff.
344 $source =~
345s@(\n)?#include.*[<"](.*\.\..*)[">].*\n@$1#error "invalid #include file $2 detected"\n@g;
346
347 my $inputFile = writeIntoFile( $extension, $source );
348 my $pid = $$;
349
350 my $bytecodeFile = getname(".bc");
351 my $outputFile = getname(".llvm-gcc.out");
352 my $timerFile = getname(".llvm-gcc.time");
353
354 my $stats = '';
355 if ( $extension eq ".st" ) {
356 $stats = "-stats -time-passes "
357 if ( $c->param('showstats') );
358 try_run( "llvm Stacker front-end (stkrc)",
359 "stkrc $stats -o $bytecodeFile $inputFile > $outputFile 2>&1",
360 $outputFile );
361 } else {
362 #$stats = "-Wa,--stats,--time-passes,--info-output-file=$timerFile"
363 $stats = "-ftime-report"
364 if ( $c->param('showstats') );
365 try_run( "llvm C/C++ front-end (llvm-gcc)",
366 "llvm-gcc -emit-llvm -W -Wall -O2 $stats -o $bytecodeFile -c $inputFile > $outputFile 2>&1",
367 $outputFile );
368 }
369
370 if ( $c->param('showstats') && -s $timerFile ) {
371 my ( $UnhilightedResult, $HtmlResult ) =
372 dumpFile( "Statistics for front-end compilation", $timerFile );
373 print "$HtmlResult\n";
374 }
375
376 if ( $c->param('linkopt') ) {
377 my $stats = '';
378 my $outputFile = getname(".gccld.out");
379 my $timerFile = getname(".gccld.time");
380 $stats = "--stats --time-passes --info-output-file=$timerFile"
381 if ( $c->param('showstats') );
382 my $tmpFile = getname(".bc");
383 try_run(
384 "optimizing linker (llvm-ld)",
385"llvm-ld $stats -o=$tmpFile $bytecodeFile > $outputFile 2>&1",
386 $outputFile
387 );
388 system("mv $tmpFile.bc $bytecodeFile");
389 system("rm $tmpFile");
390
391 if ( $c->param('showstats') && -s $timerFile ) {
392 my ( $UnhilightedResult, $HtmlResult ) =
393 dumpFile( "Statistics for optimizing linker", $timerFile );
394 print "$HtmlResult\n";
395 }
396 }
397
398 print " Bytecode size is ", -s $bytecodeFile, " bytes.\n";
399
400 my $disassemblyFile = getname(".ll");
401 try_run( "llvm-dis",
402 "llvm-dis -o=$disassemblyFile $bytecodeFile > $outputFile 2>&1",
403 $outputFile );
404
405 if ( $c->param('cxxdemangle') ) {
406 print " Demangling disassembler output.\n";
407 my $tmpFile = getname(".ll");
408 system("c++filt < $disassemblyFile > $tmpFile 2>&1");
409 system("mv $tmpFile $disassemblyFile");
410 }
411
412 my ( $UnhilightedResult, $HtmlResult );
413 if ( -s $disassemblyFile ) {
414 ( $UnhilightedResult, $HtmlResult ) =
415 dumpFile( "Output from LLVM disassembler", $disassemblyFile );
416 print syntaxHighlightLLVM($HtmlResult);
417 }
418 else {
419 print "<p>Hmm, that's weird, llvm-dis didn't produce any output.</p>\n";
420 }
421
422 if ( $c->param('showbcanalysis') ) {
423 my $analFile = getname(".bca");
424 try_run( "llvm-bcanalyzer", "llvm-bcanalyzer $bytecodeFile > $analFile 2>&1",
425 $analFile);
426 }
427 if ($c->param('showllvm2cpp') ) {
428 my $l2cppFile = getname(".l2cpp");
429 try_run("llvm2cpp","llvm2cpp $bytecodeFile -o $l2cppFile 2>&1",
430 $l2cppFile);
431 }
432
433 # Get the source presented by the user to CGI, convert newline sequences to simple \n.
434 my $actualsrc = $c->param('source');
435 $actualsrc =~ s/\015\012/\n/go;
436 # Don't log this or mail it if it is the default code.
437 if ($actualsrc ne $defaultsrc) {
438 addlog( $source, $pid, $UnhilightedResult );
439
440 my ( $ip, $host, $lg, $lines );
441 chomp( $lines = `wc -l < $inputFile` );
442 $lg = $c->param('language');
443 $ip = $c->remote_addr();
444 chomp( $host = `host $ip` ) if $ip;
445 mailto( $MAILADDR,
446 "--- Query: ---\nFrom: ($ip) $host\nInput: $lines lines of $lg\n"
447 . "C++ demangle = "
448 . ( $c->param('cxxdemangle') ? 1 : 0 )
449 . ", Link opt = "
450 . ( $c->param('linkopt') ? 1 : 0 ) . "\n\n"
451 . ", Show stats = "
452 . ( $c->param('showstats') ? 1 : 0 ) . "\n\n"
453 . "--- Source: ---\n$source\n"
454 . "--- Result: ---\n$UnhilightedResult\n" );
455 }
456 unlink( $inputFile, $bytecodeFile, $outputFile, $disassemblyFile );
457}
458
459print $c->hr, "<address>$CONTACT_ADDRESS</address>", $c->end_html;
460system("rm $ROOT/locked");
461exit 0;