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