File Coverage

File:config/auto/llvm.pm
Coverage:59.5%

linestmtbrancondsubcode
1# Copyright (C) 2009-2011, Parrot Foundation.
2
3 - 16
=head1 NAME

config/auto/llvm - Check whether the Low Level Virtual Machine is present

=head1 DESCRIPTION

Determines whether the Low Level Virtual Machine (LLVM) is installed and
functional on the system.  It is okay when it is not present.  When a
sufficiently up-to-date version of LLVM is present, you will need to
specify C<--with-llvm> as an option to C<perl Configure.pl> in order to tell
Parrot to link to LLVM, I<i.e.,> building without LLVM is Parrot's default
setting.

=cut
17
18package auto::llvm;
19
2
2
2
use strict;
20
2
2
2
use warnings;
21
2
2
2
use base qw(Parrot::Configure::Step);
22
2
2
2
use Parrot::Configure::Utils ':auto';
23
24sub _init {
25
4
    my $self = shift;
26
4
    my %data;
27
4
    $data{description} = q{Is minimum version of LLVM installed};
28
4
    $data{result} = q{};
29
4
    $data{lli_min_version} = 2.7;
30
4
    return \%data;
31}
32
33sub runstep {
34
4
    my ( $self, $conf ) = @_;
35
36
4
    my $verbose = $conf->options->get( 'verbose' );
37
4
    unless ( $conf->options->get( 'with-llvm' ) ) {
38
3
        $self->_handle_result( $conf, 0 );
39
3
        print "LLVM not requested\n" if $verbose;
40
3
        return 1;
41    }
42
43    # We will run various probes for LLVM. If the probes are unsuccessful, we
44    # will set_result to 'no', set 'has_llvm' to '', then return from
45    # runstep() with a value of 1. If a given probe does not rule out LLVM,
46    # we will proceed onward.
47
48
1
    my $llvm_bindir = capture_output( qw| llvm-config --bindir | ) || '';
49
1
    chomp $llvm_bindir;
50
1
    if (! $llvm_bindir ) {
51
1
        print "Unable to find directory for 'llvm-config' executable\n"
52            if $verbose;
53
1
        $self->_handle_result( $conf, 0 );
54
1
        return 1;
55    }
56
0
    my @output;
57
0
    chomp(@output = `"$llvm_bindir/lli" --version`);
58
0
    my $rv = $self->version_check($conf, \@output, $verbose);
59
0
    return 1 unless $rv;
60
61    # Find lib
62
0
    my $ldd = `ldd "$llvm_bindir/lli"`;
63
0
    if ($ldd =~ /(libLLVM[^ ]+)(.*)/m){
64
0
        my $lib = $1;
65
0
        my $path = (split(' ',$2))[1];
66
0
        $conf->data->set( llvm_shared => $path );
67
0
        if ($lib =~ /lib(LLVM.*)\.(so|dll)/){
68
0
            $conf->data->set( llvm_ldflags => "-l$1" );
69        }
70    }
71
72
0
    $self->_handle_result($conf, 1);
73
0
    return 1;
74
75    # Having gotten this far, we will take a simple C file, compile it into
76    # an LLVM bitcode file, execute it as bitcode, then compile it to native
77    # assembly using the LLC code generator, then assemble the native assembly
78    # language file into a program and execute it. Cf.:
79    # http://llvm.org/releases/2.5/docs/GettingStarted.html#overview
80
81
0
    my $stem = q|hello|;
82
0
    my $cfile = qq|$stem.c|;
83
0
    my $fullcfile = qq|config/auto/llvm/$cfile|;
84
0
    my $bcfile = qq|$stem.bc|;
85
0
    my $sfile = qq|$stem.s|;
86
0
    my $nativefile = qq|$stem.native|;
87
0
    eval {
88
0
        system(qq{llvm-gcc -O3 -emit-llvm $fullcfile -c -o $bcfile});
89    };
90
0
    $rv = '';
91
0
    if ($@) {
92
0
        $rv = $self->_handle_failure_to_compile_into_bitcode(
93            $conf,
94            $verbose,
95        );
96
0
        if (! $rv) {
97
0
            uconf->cc_clean();
98
0
            return 1;
99        }
100    }
101    else {
102
0
        my $output;
103
0
        eval {
104
0
            $output = capture_output( 'lli', $bcfile );
105        };
106
0
        if ( $@ or $output !~ /hello world/ ) {
107
0
            $rv = $self->_handle_failure_to_execute_bitcode( $conf, $verbose );
108
0
            if (! $rv) {
109
0
                $conf->cc_clean();
110
0
                return 1;
111            }
112        }
113        else {
114
0
            eval {
115
0
                system(qq{llc $bcfile -o $sfile});
116            };
117
0
            if ( $@ or (! -e $sfile) ) {
118
0
                $rv = $self->_handle_failure_to_compile_to_assembly(
119                    $conf,
120                    $verbose,
121                );
122
0
                if (! $rv) {
123
0
                    $conf->cc_clean();
124
0
                    return 1;
125                }
126            }
127            else {
128
0
                eval {
129
0
                    my $cc = $conf->data->get('cc');
130
0
                    system(qq{$cc $sfile -o $nativefile});
131                };
132
0
                if ( $@ or (! -e $nativefile) ) {
133
0
                    $rv = $self->_handle_failure_to_assemble_assembly(
134                        $conf,
135                        $verbose,
136                    );
137
0
                    if (! $rv) {
138
0
                        $conf->cc_clean();
139
0
                        return 1;
140                    }
141                }
142                else {
143
0
                    eval {
144
0
                        $output = capture_output(qq{./$nativefile});
145                    };
146
0
                    $self->_handle_native_assembly_output(
147                        $conf, $output, $verbose
148                    );
149                }
150           }
151        }
152    }
153
154
0
    my $count_unlinked = _cleanup_llvm_files(
155        $bcfile, $sfile, $nativefile
156    );
157
0
    $conf->cc_clean();
158
0
    return 1;
159}
160
161sub version_check {
162
6
    my ($self, $conf, $outputref, $verbose) = @_;
163
6
    my $version;
164
6
    if ( $outputref->[1] =~ m/llvm\sversion\s(\d+\.\d+)/s ) {
165
4
        $version = $1;
166
4
        if ($version < $self->{lli_min_version}) {
167
2
            if ($verbose) {
168
1
                my $msg = "LLVM component 'lli' must be at least version ";
169
1
                $msg .= "$self->{lli_min_version}; found version $version\n";
170
1
                print $msg;
171            }
172
2
            $self->_handle_result( $conf, 0 );
173
2
            return;
174        }
175        else {
176
2
            if ($verbose) {
177
1
                print "Found 'lli' version $version\n";
178            }
179
2
            return 1;
180        }
181    }
182    else {
183
2
        print "Unable to extract version for LLVM component 'lli'\n"
184            if $verbose;
185
2
        $self->_handle_result( $conf, 0 );
186
2
        return;
187    }
188}
189
190sub _handle_failure_to_compile_into_bitcode {
191
2
    my ($self, $conf, $verbose ) = @_;
192
2
    print "Unable to compile C file into LLVM bitcode file\n"
193        if $verbose;
194
2
    $self->_handle_result( $conf, 0 );
195
2
    return 0;
196}
197
198sub _handle_failure_to_execute_bitcode {
199
2
    my ($self, $conf, $verbose ) = @_;
200
2
    print "Unable to run LLVM bitcode file with 'lli'\n"
201        if $verbose;
202
2
    $self->_handle_result( $conf, 0 );
203}
204
205sub _handle_failure_to_compile_to_assembly {
206
2
    my ($self, $conf, $verbose ) = @_;
207
2
    print "Unable to compile program to native assembly using 'llc'\n"
208        if $verbose;
209
2
    $self->_handle_result( $conf, 0 );
210}
211
212sub _handle_failure_to_assemble_assembly {
213
2
    my ($self, $conf, $verbose ) = @_;
214
2
    print "Unable to assemble native assembly into program\n"
215         if $verbose;
216
2
    $self->_handle_result( $conf, 0 );
217}
218
219sub _handle_result {
220
23
    my ($self, $conf, $result) = @_;
221
23
    if ( $result ) {
222
2
        $self->set_result('yes');
223
2
        $conf->data->set( has_llvm => 1 );
224    }
225    else {
226
21
        $self->set_result('no');
227
21
        $conf->data->set( has_llvm => '' );
228    }
229
23
    return 1;
230}
231
232sub _handle_native_assembly_output {
233
5
    my ($self, $conf, $output, $verbose) = @_;
234
5
    if ( $@ or ( $output !~ /hello world/ ) ) {
235
4
        print "Unable to execute native assembly program successfully\n"
236            if $verbose;
237
4
        $self->_handle_result( $conf, 0 );
238    }
239    else {
240
1
        $self->_handle_result( $conf, 1 );
241    }
242}
243
244sub _cleanup_llvm_files {
245
3
   my @llvm_files = @_;
246
3
   my $count_unlinked = 0;
247
3
   foreach my $f ( @llvm_files ) {
248
9
      if ( defined($f) and ( -e $f ) ) {
249
1
          unlink $f;
250
1
          $count_unlinked++;
251      }
252   }
253
3
   return $count_unlinked;
254};
255
2561;
257
258 - 262
=head1 AUTHOR

James E Keenan

=cut
263
264# Local Variables:
265# mode: cperl
266# cperl-indent-level: 4
267# fill-column: 100
268# End:
269# vim: expandtab shiftwidth=4:
270